------------------------------------------------------------------------------
MC logo
Classes for Closures
[^] Tom's Lisp Code
------------------------------------------------------------------------------
[Classes for Lisp Atoms] [Functions for Lisp Built-Ins] [Classes for Closures] [Context] [Base For Evaluable Objects] [Callable Objects] [Interrupt Utility] [Main Program] [Pairs] [Code Reader] [Reference Counting]

A closure is some code to execute and a context to run it in. The context contains all symbol definitions used during the execution. The Closure object contains a pointer to some code, a pointer to an argument list, and a pointer to a context. The first two describe a function to run (the parameter list and the function body), and the second is context used to evaluate global references.

The closure object is abstract, extended as FuncClosure and MacClosure, the versions for functions (lambda) and for macros. They differ mainly in the operation of the apply method, which must reflect the behavioral differences between functions and macros.

The first class is DiscRefPtr, which specializes the reference counting pointer for the pointer to the context object used by the closure. This is explained here.

closure.h [Download]
//*****************************************************************************
//***  Closures.
//*** 
//***    A closure is executable code and a context to run it in.  This file
//***    contains the Closure class and descendents, and other supporting code.
//*****************************************************************************

#include <iostream>
#include <string>

using namespace std;

#include "refct.h"
#include "context.h"
#include "evaluable.h"
#include "atoms.h"
#include "func.h"

#ifndef _closure_h_
#define _closure_h_

/* This is a modified version of the smart pointer that allows a pointer to
   be "discounted," which means it is not included in the ref counts of what
   it points to.  This is needed for breaking the context-closure-context
   cycle.  I only need this for Contexts, so it's derived from Ptr<Context>. */
class DiscRefPtr: public Ptr<Context> {
        bool discounted;

        // Copying and assignment are not allowed.  This is for one
        // special use, and I really don't want it used for much.
        DiscRefPtr(DiscRefPtr &) { }
        void operator=(DiscRefPtr &) { }
public:
        // Construct naked or from the more standard variety.
        DiscRefPtr(): Ptr<Context>(), discounted(false) { }
        DiscRefPtr(RefPtr &r): Ptr<Context>(r), discounted(false) { 
#ifdef MEM_DEBUG
                if(target && RefCtObj::alo_rpt > 1)
                        cout << "disc. copy " << " " << this << endl;
#endif
        }

        // Assignment from a normal RefPtr.
        DiscRefPtr & operator=(const RefPtr & lft) { 
#ifdef MEM_DEBUG
                if(target && RefCtObj::alo_rpt > 1)
                        cout << "disc. assign to " << " " << this << endl;
#endif
                if(discounted && target) target->mkref();
                assign(lft);
                discounted = false;
                return *this;
        }

        // Remove from the target count.
        void discount() {
                if(discounted) return;
#ifdef MEM_DEBUG
                if(target && RefCtObj::alo_rpt > 1)
                        cout << "discount " << " " << this << endl;
#endif
                discounted = true;
                if(target) target->unref();
        }

        // Return to count.
        void recount() {
                if(!discounted) return;
#ifdef MEM_DEBUG
                if(target && RefCtObj::alo_rpt > 1)
                        cout << "reount " << " " << this << endl;
#endif
                discounted = false;
                if(target) target->mkref();
        }

        // Discounted pointers need to prevent the main destructor from 
        // decrementing the ref count again.
        ~DiscRefPtr() {
                if(discounted) target = 0;
        }
};

/* A Closure is code and a context in which to run it.  This is still and
   abstract class; FuncClosure and MacClosure are derived from it for 
   functional (lambda) and macro closures, respectively. */
class Closure: public Applyable {
protected:
        Ptr<Evaluable> code;            // Code to be run.
        Ptr<Evaluable> parms;           // Parameter list.
        DiscRefPtr context;             // Context from creation.
        Closure(Ptr<Evaluable> p, Ptr<Evaluable> c, Ptr<Context> cn): 
                code(c), parms(p), context(cn), nonsupp(0) { }

        // Count the number of non-supporting pointers.  Non-supporting
        // pointers are ones stored in an exited context.  When all of our
        // pointers are non-supporting, we discount our context pointer.
        // When that changes, we recount it.
        friend class Context;
        int nonsupp;
        void nonsup() {
#ifdef MEM_DEBUG
                if(alo_rpt) 
                        cout << "Nonsup " << this << nonsupp << " -> "
                             << nonsupp + 1 << endl;
#endif
                if(++nonsupp >= curr_refct()) context.discount();
        }

        // This extends the ref count mech to deal with the nonsupp.
        virtual void mkref() 
        {
#ifdef MEM_DEBUG
                if(RefCtObj::alo_rpt > 1)
                        cout << "Closure::mkref() " << this << " "
                             << nonsupp << endl;
#endif
                RefCtObj::mkref();
                if(nonsupp < curr_refct()) context.recount();
        }
        virtual void unref() 
        {
#ifdef MEM_DEBUG
                if(RefCtObj::alo_rpt > 1)
                        cout << "Closure::unref() " << this << " "
                             << nonsupp << endl;
#endif
                if(nonsupp >= curr_refct() - 1) context.discount();
                RefCtObj::unref();
        }

        // Print designed to be used by both closures.
        virtual void print(ostream &strm, const char *type);

        // This is most of the code for apply for both function and
        // macro closures.  It pushes a new scope on the context cont, 
        // sets each parameter name with the value from the argument
        // list args, then evaluates the body in this new context.
        virtual Ptr<Evaluable> apply_guts(Ptr<Evaluable> args, 
                                          Ptr<Context> cont);
public:
        // Equality is just equality of all parts.
        virtual bool equal_same(RefCtObj& other) { 
                return code.same_value(((Closure*)&other)->code) &&
                        parms.same_value(((Closure*)&other)->code) &&
                        context.same_value(((Closure*)&other)->context);
        }

        // Nice to be able to find these, too.
        virtual bool closure() { return true; }
};

/* Closure for a function. */
class FuncClosure: public Closure {
        // It would be nice if there were some way to ask to inherit
        // a constructor.
        FuncClosure(Ptr<Evaluable> p, Ptr<Evaluable> c, Ptr<Context> cn): 
                Closure(p, c, cn) { }
public:
        // Make one.
        static Ptr<FuncClosure> alloc(Ptr<Evaluable> p, 
                                  Ptr<Evaluable> c, Ptr<Context> cn) {
                Ptr<FuncClosure> ret =
                        RefCtObj::newRefPtr(new FuncClosure(p, c, cn));
                return ret;
        }

        // Apply the closure.  This means to evaluate the arguments p in the
        // calling context c, then evaluate the body in its stored context
        // with an added scope containing the arguments.  Return the result.
        virtual Ptr<Evaluable> apply(Ptr<Evaluable> p, Ptr<Context> c);

        virtual string name() { return "[a closure]"; }
        virtual void print(ostream &strm) { Closure::print(strm, "lambda"); }
};

/* Closure for a macro. */
class MacClosure: public Closure {
        // It would be nice if there were some way to ask to inherit
        // a constructor.
        MacClosure(Ptr<Evaluable> p, Ptr<Evaluable> c, Ptr<Context> cn): 
                Closure(p, c, cn) { }
public:
        // Make one.
        static Ptr<MacClosure> alloc(Ptr<Evaluable> p, 
                                  Ptr<Evaluable> c, Ptr<Context> cn) {
                Ptr<MacClosure> ret =
                        RefCtObj::newRefPtr(new MacClosure(p, c, cn));
                return ret;
        }

        // Apply the closure.  This means to evaluate the arguments p in the
        // calling context c, then evaluate the body in its stored context
        // with an added scope containing the arguments.  Return the result.
        virtual Ptr<Evaluable> apply(Ptr<Evaluable> a, Ptr<Context> c)
        {
                Ptr<Evaluable> res = apply_guts(a, c)->eval(c);
                if(res.points_to(typeid(Error)))
                        Ptr<Error>(res)->hist(a);
                return res;
        }

        // Fillers, really.
        virtual string name() { return "[a macro]"; }
        virtual void print(ostream &strm) { Closure::print(strm, "macro"); }
};

#endif
closure.cpp [Download]
#include "interrupt.h"
#include "pair.h"
#include "closure.h"

// Print designed to be used by both closures.
void Closure::print(ostream &strm, const char *type) { 
        strm << "(" << type << " ";
        parms->print(strm);
        strm << " ";
        code->print(strm);
        strm << ")";
}

// This contains most of the work for apply in MacClosure and FuncClosure.
Ptr<Evaluable> Closure::apply_guts(Ptr<Evaluable> p, Ptr<Context> c) 
{
        // Check for an interrupt.
        if(zapped()) return Error::alloc(INTER, "Interrupted.");

        // Get the parms.
        Ptr<Evaluable> parms = this->parms;

        // If the parms are a single identifier instead of a list of
        // identifiers, we bind the whole argument list to the single
        // id.  The easiest way to do this is to pretend we have one
        // ordinary parameter and were sent a single list argument.
        // That is, we wrap each one in an additional level of list.
        if(parms.points_to(typeid(Id))) {
                parms = Pair::alloc(parms, the_nil);
                p = Pair::alloc(p, the_nil);
        }

        // Scan the argument and parameter lists and add the parameters to
        // the context with their proper values.
        Ptr<Context> cont = this->context->scope();
        while(!parms.points_to(typeid(Nil))) {
                // Make sure the argument exists.
                if(p.points_to(typeid(Nil))) {
                        cont->last_rites();
                        return Error::alloc(SHORTARG, "Missing argument.");
                }

                // Make sure the list is well-formed.
                if(!p.points_to(typeid(Pair))) {
                        cont->last_rites();
                        return Error::alloc(BADARG, "Bad argument list.");
                }

                // Get the argument.
                RefPtr value = p->car();
                p = p->cdr();

                // Check for a boom.
                if(value.points_to(typeid(Error))) {
                        cont->last_rites();
                        return value;
                }

                // Find the name, and move the ptr.
                cont->set(Ptr<Id>(parms->car())->name(), value);
                parms = parms->cdr();
        }

        // Check for extras.
        if(!p.points_to(typeid(Nil))) {
                cont->last_rites();
                return Error::alloc(LONGARG, "Too many arguments");
        }

        // Evaluate.
        Ptr<Evaluable> v = code->eval(cont);
        cont->last_rites();
        return v;
}

// Apply the closure.  This means to evaluate the arguments p in the
// calling context c, then evaluate the body in its stored context
// with an added scope containing the arguments.  Return the result.
Ptr<Evaluable> FuncClosure::apply(Ptr<Evaluable> p, Ptr<Context> c) {
        // Evaluate the parameters, bail on fail.
        Ptr<Evaluable> ep = evalall(p, c);
        if(ep.points_to(typeid(Error))) 
                return Ptr<Error>(ep)->hist(p);

        // Peform the application on the parameters.
        Ptr<Evaluable> res = Closure::apply_guts(ep, c);
        if(res.points_to(typeid(Error))) 
                Ptr<Error>(res)->hist(ep);

        // Send it back.
        return res;
}