------------------------------------------------------------------------------
MC logo
Functions for Lisp Built-Ins
[^] 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]

This contains C++ functions to implement the built-in Lisp functions. The name of the C++ function is the name of the Lisp function with the prefix bi_. Each one takes two parameters, the first is the parameter(s), and the second is the context for evaluation. That first C++ parameter is a a pointer to an evaluable object, which is either the single parameter, or a Pair which is the start of a Lisp list of all the parameters. The parameters have already been evaluated and checked for correct number and type before the the implementation here is called. (That work is done by the apply method of class Builtin.

Have look at the functions; most are small. At least examine the first three, which implement car, cdr and cons. The first two simply select the appropriate field from the parameter object using the car and cdr methods. The cons function allocates a new pair, fills in its two parameters, and returns the pair.

builtin.h [Download]
//*****************************************************************************
//***  Builtins
//*** 
//***    These are C functions which implement Lisp builtins.
//*****************************************************************************

#include <iostream>
#include <string>

using namespace std;

#include <stdlib.h>

#include "refct.h"
#include "context.h"
#include "evaluable.h"
#include "atoms.h"
#include "func.h"
#include "closure.h"
#include "read.h"
#include "pair.h"

#ifndef _builtin_h_
#define _builtin_h_

// Following are functions which perform the builtin operations.  Each one
// is named bi_whatever, where whatever is the name of the builtin Lisp
// function it implements.

// *** Fundamental list operations ***
inline Ptr<Evaluable> bi_car(Ptr<Evaluable> e, Ptr<Context> c)
{
        return e->car()->car();
}

inline Ptr<Evaluable> bi_cdr(Ptr<Evaluable> e, Ptr<Context> c)
{
        return e->car()->cdr();
}

inline Ptr<Evaluable> bi_cons(Ptr<Evaluable> e, Ptr<Context> c)
{
        return Pair::alloc(e->car(), e->cdr()->car());
}

// *** Tests.  Actual names have ? on them in lisp. ***
inline Ptr<Evaluable> bi_null(Ptr<Evaluable> e, Ptr<Context> c)
{
        return e->car().points_to(typeid(Nil)) ? 
                Ptr<Evaluable>(the_true) : Ptr<Evaluable>(the_nil);
}

inline Ptr<Evaluable> bi_ispair(Ptr<Evaluable> e, Ptr<Context> c)
{
        return e->car().points_to(typeid(Pair)) ? 
                Ptr<Evaluable>(the_true) : Ptr<Evaluable>(the_nil);
}

inline Ptr<Evaluable> bi_isid(Ptr<Evaluable> e, Ptr<Context> c)
{
        return e->car().points_to(typeid(Id)) ? 
                Ptr<Evaluable>(the_true) : Ptr<Evaluable>(the_nil);
}

inline Ptr<Evaluable> bi_isint(Ptr<Evaluable> e, Ptr<Context> c)
{
        return e->car().points_to(typeid(Int)) ? 
                Ptr<Evaluable>(the_true) : Ptr<Evaluable>(the_nil);
}

inline Ptr<Evaluable> bi_isstring(Ptr<Evaluable> e, Ptr<Context> c)
{
        return e->car().points_to(typeid(Str)) ? 
                Ptr<Evaluable>(the_true) : Ptr<Evaluable>(the_nil);
}

inline Ptr<Evaluable> bi_islambda(Ptr<Evaluable> e, Ptr<Context> c)
{
        return e->car().points_to(typeid(FuncClosure)) ? 
                Ptr<Evaluable>(the_true) : Ptr<Evaluable>(the_nil);
}

inline Ptr<Evaluable> bi_ismacro(Ptr<Evaluable> e, Ptr<Context> c)
{
        return e->car().points_to(typeid(MacClosure)) ? 
                Ptr<Evaluable>(the_true) : Ptr<Evaluable>(the_nil);
}

inline Ptr<Evaluable> bi_isbuiltin(Ptr<Evaluable> e, Ptr<Context> c)
{
        return e->car().points_to(typeid(Builtin)) ? 
                Ptr<Evaluable>(the_true) : Ptr<Evaluable>(the_nil);
}

// *** Evaluation ***

// Evaluate and return the arg.
inline Ptr<Evaluable> bi_eval(Ptr<Evaluable> e, Ptr<Context> c)
{
        return e->car()->eval(c);
}

// Quote.
inline Ptr<Evaluable> bi_quote(Ptr<Evaluable> e, Ptr<Context> c)
{
        return e->car();
}

// *** Control ***

// Evaluate all forms, return the last.  This is also used by
// class Catch, which is essentially a begin which treats errors
// differently.
extern Ptr<Evaluable> bi_begin(Ptr<Evaluable> e, Ptr<Context> c);

// Traditional cond operator
extern Ptr<Evaluable> bi_cond(Ptr<Evaluable> e, Ptr<Context> c);

// Return the first to evaluate non-nil
extern Ptr<Evaluable> bi_or(Ptr<Evaluable> e, Ptr<Context> c);

// This returns the error object, as specified.  Essential a throw.
inline Ptr<Evaluable> bi_error(Ptr<Evaluable> e, Ptr<Context> c)
{
        return Error::alloc(Ptr<Int>(e->car())->val(), 
                            Ptr<Str>(e->cdr()->car())->val());
}

// Time to go.
inline Ptr<Evaluable> bi_exit(Ptr<Evaluable> e, Ptr<Context> c)
{
        exit(Ptr<Int>(e->car())->val());
}

// *** Definition and Context ***

// Set a name.
inline Ptr<Evaluable> bi_set(Ptr<Evaluable> e, Ptr<Context> c)
{
        c->set(Ptr<Id>(e->car())->name(), e->cdr()->car());
        return e->car();
}

// This evaluates its contents in a new scope.
extern Ptr<Evaluable> bi_scope(Ptr<Evaluable> e, Ptr<Context> c);

// *** Closures ***
inline Ptr<Evaluable> bi_macro(Ptr<Evaluable> e, Ptr<Context> c)
{
        return MacClosure::alloc(e->car(), e->cdr()->car(), c);
}
inline Ptr<Evaluable> bi_lambda(Ptr<Evaluable> e, Ptr<Context> c)
{
        return FuncClosure::alloc(e->car(), e->cdr()->car(), c);
}

// *** Arithmetic ***
extern Ptr<Evaluable> bi_plus(Ptr<Evaluable> e, Ptr<Context> c);
extern Ptr<Evaluable> bi_times(Ptr<Evaluable> e, Ptr<Context> c); 
inline Ptr<Evaluable> bi_minus(Ptr<Evaluable> e, Ptr<Context> c)
{
        return Int::alloc(Ptr<Int>(e->car())->opval() -
                          Ptr<Int>(e->cdr()->car())->opval());
}
extern Ptr<Evaluable> bi_div(Ptr<Evaluable> e, Ptr<Context> c);
extern Ptr<Evaluable> bi_mod(Ptr<Evaluable> e, Ptr<Context> c);

// Numerical comparison.
inline Ptr<Evaluable> bi_lt(Ptr<Evaluable> e, Ptr<Context> c)
{
        return Ptr<Int>(e->car())->opval() < Ptr<Int>(e->cdr()->car())->opval()?
                Ptr<Evaluable>(the_true) : Ptr<Evaluable>(the_nil);
}

inline Ptr<Evaluable> bi_gt(Ptr<Evaluable> e, Ptr<Context> c)
{
        return Ptr<Int>(e->car())->opval() > Ptr<Int>(e->cdr()->car())->opval()?
                Ptr<Evaluable>(the_true) : Ptr<Evaluable>(the_nil);
}

inline Ptr<Evaluable> bi_le(Ptr<Evaluable> e, Ptr<Context> c)
{
        return Ptr<Int>(e->car())->opval()<=Ptr<Int>(e->cdr()->car())->opval() ?
                Ptr<Evaluable>(the_true) : Ptr<Evaluable>(the_nil);
}

inline Ptr<Evaluable> bi_ge(Ptr<Evaluable> e, Ptr<Context> c)
{
        return Ptr<Int>(e->car())->opval()>=Ptr<Int>(e->cdr()->car())->opval() ?
                Ptr<Evaluable>(the_true) : Ptr<Evaluable>(the_nil);
}

inline Ptr<Evaluable> bi_eq(Ptr<Evaluable> e, Ptr<Context> c)
{
        return Ptr<Int>(e->car())->opval()==Ptr<Int>(e->cdr()->car())->opval() ?
                Ptr<Evaluable>(the_true) : Ptr<Evaluable>(the_nil);
}

inline Ptr<Evaluable> bi_ne(Ptr<Evaluable> e, Ptr<Context> c)
{
        return Ptr<Int>(e->car())->opval()!=Ptr<Int>(e->cdr()->car())->opval() ?
                Ptr<Evaluable>(the_true) : Ptr<Evaluable>(the_nil);
}

// Plain eq?
inline Ptr<Evaluable> bi_ptreq(Ptr<Evaluable> e, Ptr<Context> c)
{
        return e->car().eq(e->cdr()->car()) ? 
                Ptr<Evaluable>(the_true) : Ptr<Evaluable>(the_nil);
}

// Recursive equal?
inline Ptr<Evaluable> bi_equal(Ptr<Evaluable> e, Ptr<Context> c)
{
        return e->car().same_value(e->cdr()->car()) ? 
                Ptr<Evaluable>(the_true) : Ptr<Evaluable>(the_nil);
}

// String operations.  There's enough here to make user-level operations
// using lists or characters, though this will not be particularly efficient.

// Well, this isn't strictly necessary, but I couldn't quite bear to pay the
// overhead of computing length with a shatter.
inline Ptr<Evaluable> bi_strlen(Ptr<Evaluable> e, Ptr<Context> c)
{
        return Int::alloc(Ptr<Str>(e->car())->val().length());
}

// Turn a string into a list of one-character strings.
extern Ptr<Evaluable> shatter(const char *str);
inline Ptr<Evaluable> bi_shatter(Ptr<Evaluable> e, Ptr<Context> c)
{
        return  shatter(Ptr<Str>(e->car())->Str::val().c_str());
}

// Take a list of strings and append them all together into one string.
extern string collect(Ptr<Evaluable> e);
inline Ptr<Evaluable> bi_collect(Ptr<Evaluable> e, Ptr<Context> c)
{
        return Str::alloc(collect(e->car()));
}

// Chr and ord.  Ord works on the first character of a string, and returns
// nil for the empty string.
inline Ptr<Evaluable> bi_chr(Ptr<Evaluable> e, Ptr<Context> c)
{
        return Str::alloc((char)(Ptr<Int>(e->car())->val()));
}
extern Ptr<Evaluable> bi_ord(Ptr<Evaluable> e, Ptr<Context> c);

// Print whatever.
inline Ptr<Evaluable> bi_print(Ptr<Evaluable> e, Ptr<Context> c)
{
        e->car()->print(cout);
        return e->car();
}

// Print a string w/o quotes.  Useful for building more powerful 
// printing constructs.
inline Ptr<Evaluable> bi_sprint(Ptr<Evaluable> e, Ptr<Context> c)
{
        cout << Ptr<Str>(e->car())->val();
        return e->car();
}

// Load a file.  Includes the proto for the load() function from the
// i/o section which does most of the work.  The bi_load() is really an
// adaptor.
inline Ptr<Evaluable> bi_load(Ptr<Evaluable> e, Ptr<Context> c)
{
        return load(Ptr<Str>(e->car())->val(), c);
}

#ifdef MEM_DEBUG
// Report the memory allocation count.
inline Ptr<Evaluable> bi_memrpt(Ptr<Evaluable> e, Ptr<Context> c)
{
        RefCtObj::rpt("Memory");
        return the_nil;
}

// Set the alloc/dealloc flag
inline Ptr<Evaluable> bi_aloc_log(Ptr<Evaluable> e, Ptr<Context> c)
{
        RefCtObj::reporting(Ptr<Int>(e->car())->val());
        return the_nil;
}
#endif

#endif
builtin.cpp [Download]
#include "pair.h"
#include "builtin.h"

Ptr<Evaluable> bi_begin(Ptr<Evaluable> e, Ptr<Context> c)
{
        Ptr<Evaluable> res = the_nil;
        while(e.points_to(typeid(Pair))) {
                res = e->car()->eval(c);
                if(res.points_to(typeid(Error))) return res;
                e = e->cdr();
        }
        return res;
}

// Cond operation.
Ptr<Evaluable> bi_cond(Ptr<Evaluable> e, Ptr<Context> c)
{
        while(!e.points_to(typeid(Nil))) {
                // List form.
                if(!e.points_to(typeid(Pair)))
                        return Error::alloc(BADARG, "Bad cond form.");

                // Consider this case.
                Ptr<Evaluable> thiscase = e->car();
                e = e->cdr();

                // Looking for that end default
                if(e.points_to(typeid(Nil)) && 
                   !thiscase.points_to(typeid(Pair)))
                        return thiscase->eval(c);

                // Regular case, must be a pair.
                if(!thiscase.points_to(typeid(Pair)))
                        return Error::alloc(BADARG, "Bad cond form.");

                // Evaluate the test.
                Ptr<Evaluable> test = thiscase->car()->eval(c);
                if(test.points_to(typeid(Error))) return test;
                if(!test.points_to(typeid(Nil)))
                        return thiscase->cdr()->car()->eval(c);
        }
        return the_nil;
}

// Return the first to evaluate non-nil
Ptr<Evaluable> bi_or(Ptr<Evaluable> e, Ptr<Context> c)
{
        if(e.points_to(typeid(Nil))) return the_nil;
        Ptr<Evaluable> v = e->car()->eval(c);
        if(v.points_to(typeid(Nil))) return bi_or(e->cdr(), c);
        return v;
}

// This evaluates its contents in a new scope.
Ptr<Evaluable> bi_scope(Ptr<Evaluable> e, Ptr<Context> c)
{
        Ptr<Context> newcont = c->scope();
        Ptr<Evaluable> ret = bi_begin(e, newcont);
        newcont->last_rites();
        return ret;
}


// Addition and multiplication
Ptr<Evaluable> bi_plus(Ptr<Evaluable> e, Ptr<Context> c)
{
        int_type sum = 0;

        while(!e.points_to(typeid(Nil))) {
                sum += Ptr<Int>(e->car())->opval();
                e = e->cdr();
        }

        return Int::alloc(sum);
}
Ptr<Evaluable> bi_times(Ptr<Evaluable> e, Ptr<Context> c)
{
        int_type prod = 1;

        while(!e.points_to(typeid(Nil))) {
                prod *= Ptr<Int>(e->car())->opval();
                e = e->cdr();
        }

        return Int::alloc(prod);
}

// Division and modulus.
Ptr<Evaluable> bi_div(Ptr<Evaluable> e, Ptr<Context> c)
{
        int_type divor = Ptr<Int>(e->cdr()->car())->opval();
        if(divor == 0)
                return Error::alloc(DIVZERO, "Division by zero.");
        else
                return Int::alloc(Ptr<Int>(e->car())->opval() / divor);
}
Ptr<Evaluable> bi_mod(Ptr<Evaluable> e, Ptr<Context> c)
{
        int_type divor = Ptr<Int>(e->cdr()->car())->opval();
        if(divor == 0)
                return Error::alloc(DIVZERO, "Division by zero.");
        else
                return Int::alloc(Ptr<Int>(e->car())->opval() % divor);
}

// Turn a string into a list of one-character strings.
Ptr<Evaluable> shatter(const char *str) 
{
        if(*str == 0)
                return the_nil;
        else
                return Pair::alloc(Str::alloc(*str), shatter(str+1));
}

// Take a list of strings and append them all together into one string.
string collect(Ptr<Evaluable> e)
{
        if(e.points_to(typeid(Nil)))
                return string("");
        else
                return Ptr<Str>(e->car())->val() + collect(e->cdr());
}

// Character code.
Ptr<Evaluable> bi_ord(Ptr<Evaluable> e, Ptr<Context> c)
{
        if(Ptr<Str>(e->car())->val().length() > 0)
                return Int::alloc(Ptr<Str>(e->car())->val()[0]);
        else
                return the_nil;
}