------------------------------------------------------------------------------
MC logo
Classes for Lisp Atoms
[^] 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 code provides objects for all the atoms: base class Atom, and Nil, Str (strings), Error, Id (identifiers) and Int (integers) derived from it. There is also a set of integer code numbers for the various errors which the interpreted code can raise. There are a few other variables representng code values, and a variable for the unique Nil object.

Tom's Lisp can be compiled with integers represented by the C++ int type, or by unbounded values suppored by the Gnu Multiple Precision Arithmetic Library. This provides the complication of conditional compilation on the UNBOUND_INTS define flag.

atoms.h [Download]
//*****************************************************************************
//***  Atoms.
//***
//***    Various types of atoms.  These represent the indivisible data 
//***    objects in the list system.  The classes for various atomic
//***    types tend to look a lot alike.
//*****************************************************************************

#include <iostream>
#include <string>
#include <sstream>

using namespace std;

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

#ifndef _atoms_h_
#define _atoms_h_

// Atoms.  That is, data which has no parts.
class Atom: public Evaluable {
public:
        // All Evaluables can be printed and have a name, but for atoms,
        // printing usually just means printing the name.  This is 
        // overridden for some of them.
        virtual void print(ostream &s) { s << name(); }
};

// The nil atom.  Should create only one object of this class.  
class Nil: public Atom {
        Nil() { }
public:
        string name() { return "nil"; }
        static Ptr<Nil> alloc() {
                return RefCtObj::newRefPtr(new Nil);
        }

        // Evalution yields a pointer to the same object: nil evaluates
        // to itself.
        Ptr<Evaluable> eval(Ptr<Context>) { return newref(); }

        // Any Nil object is equal to any other (though unless there's a bug
        // somewhere, this can only be called to compare the nil object to
        // itself.)
        virtual bool equal_same(RefCtObj& other) { return true; }
};

// The unique Nil object (I hope).
extern Ptr<Nil> the_nil;

// String constant atom.
class Str: public Atom {
protected:
        const string _val;              // Just the string this is.
        Str(string s): _val(s) { }
public:
        // The name is the value with quotes around it.
        string name() { 
                return string("\"") + _val + string("\"");
        }
        const string val() { return _val; }

        // Allocate one and return a pointer.
        static Ptr<Str> alloc(string s) {
                return RefCtObj::newRefPtr(new Str(s));
        }

        // This just allocates the string from the individual character, which
        // turns out to be convenient.  
        static Ptr<Str> alloc(char ch) {
                char s[] = { 0, 0 };  // Does static prevent combining?
                s[0] = ch;
                return alloc(s);
        }

        // Evaluates to itself.
        Ptr<Evaluable> eval(Ptr<Context> c) { 
                return newref();
        }

        // Lisp equality is just the normal string comparison.
        virtual bool equal_same(RefCtObj& other) { 
                return _val == ((Str*)&other)->_val;
        }
};

/* This is an error result.  Each error result is a code number and a
   description.  The code number indicates the type of error, and the 
   description with each error code will vary a bit, mostly being more
   specific.  It operates as an exception, because any operation
   which sees an error object in any of its inputs will return it rather than
   performing its usual operation.  The function apply and list evaluation
   operators also add to the history when they pass an Error in this way,
   so when the error is finally printed it will contain a history of each
   operation which its presence aborted.  This forms essentially a call
   trace. */
class Error: public Atom {
        string _msg;            // Error message.
        int _code;              // Code number.
        Ptr<Evaluable> _hist;   // Error's history (list of evaluated forms)
        static bool _histon;    // Use the history feature.
        static int _toplim, _botlim;
                                // Limits on history printing.

        // Simple constructor.  
        Error(int c, string m):
                _code(c), _msg(m), _hist(the_nil) { }

public:
        // Allocator.
        static Ptr<Error> alloc(int c, string m, Ptr<Evaluable> h = the_nil) 
        {
                Ptr<Error> e = RefCtObj::newRefPtr(new Error(c, m));
                if(!h.points_to(typeid(Nil))) e->hist(h);
                return e;
        }

        // Get code and string.
        int code() { return _code; }
        string msg() { return _msg; }

        // Name of the error, a description showing its code and string.
        virtual string name() {
                ostringstream strm;
                strm << _code;
                return string("Error ") +  strm.str() + ": " + _msg;
        }

        // This prints the error message.  Printing generally prints
        // not only the code and message, but the history (stack trace)
        // as well.
        virtual void print(ostream &s);

        // Evaluates to itself.
        Ptr<Evaluable> eval(Ptr<Context> c) { 
                return newref();
        }

        // Errors are considered equal if their codes are equal.  However,
        // as far as I know, there's not way to actually invoke this, 
        // because if you send equal? a couple of errors to compare, 
        // it will just return the first one.
        virtual bool equal_same(RefCtObj& other) {
                return _code == ((Error*)&other)->_code;
        }

        // Turn the history facilty on or off.
        static void history_off() { _histon = false; }
        static void history_on() { _histon = true; }
        static void toplim(int n) { _toplim = n; }
        static void botlim(int n) { _botlim = n; }

        // Add to the history.  This really just does something like
        // _hist = (e . _hist):  it adds e to the front of the object
        // variable _hist, which is just a lisp list.
        Ptr<Error> hist(Ptr<Evaluable> e);

        // This adds e to the front of the first first member of _hist.
        // Essentially: _hist = ((e . car(_hist)) . cdr(_hist)).
        Ptr<Error> histinc(Ptr<Evaluable> e);
};

// Code numbers and for each type of builtin error.
extern int UNDEF;       // Undefined name.
extern int BADOP;       // Operation on inappropriate type.
extern int BADARG;      // Badly-formed argument list.
extern int SHORTARG;    // Missing arguments.
extern int BADTYPE;     // Bad argument type.
extern int LONGARG;     // Too many arguments to a builtin.
extern int RPAREN;      // Right paren expected.
extern int SYN;         // General syntax error.
extern int OPFAIL;      // Loaded file could not be openend.
extern int DIVZERO;     // Division by zero.
extern int INTER;       // Operation interrupted.

// Set the error codes, return the next unused one.
extern int set_error_codes();

// Identifier atoms.
class Id: public Atom {
        // The string it looks like.
        const string _name;

        Id(const string s): _name(s) { }
public:
        string name() { return _name; }

        // Allocate one.
        static Ptr<Id> alloc(const string s) {
                return RefCtObj::newRefPtr(new Id(s));
        }

        // Evaluate by looking up in the current context.
        Ptr<Evaluable> eval(Ptr<Context> c) { 
                RefPtr v = c->find(_name);
                if(v.isnull())
                        return Error::alloc(UNDEF,
                                            string("Undefined ") + _name);
                else
                        return v;
        }

        // They are equal if they have the same id (string name).  That will
        // matter if you run (equal? 'fred 'fred), which will be true, or
        // (equal? 'fred 'barney), which won't.  If you run 
        // (equal? fred barney), it will evaluate fred and barney (look them
        // up in the current context) and compare the results, which, in
        // most cases, won't call this at all.
        virtual bool equal_same(RefCtObj& other) { 
                return _name == ((Id*)&other)->_name;
        }

};

// This atom is used to return true results from tests.  It's just an 
// ordinary identifier, though.  Down in main() we set it to equal itself
// in the base context, so it will evaluate to itself, unless some fool
// changes the setting.
extern Ptr<Id> the_true;

// Integer class.  If the UNBOUND_INTS flag is set, this will use the C++
// unbounded integer type from Gnu Multiple Precision Arithmetic Library (GMP).
// Otherwise, the native integer is used.  
#ifdef UNBOUND_INTS
#include <gmpxx.h>
typedef mpz_class int_type;
#else
typedef int int_type;
#endif
class Int: public Atom {
        const int_type _val;
        Int(int_type v): _val(v) { }
public:
        // This mumbo-jumbo just converts the integer to a string, and
        // returns it.  There's probably an easier way to do this, but
        // I haven't found it yet.
        string name() { 
                ostringstream strm;
                strm << _val;
                return strm.str();
        }

#ifdef UNBOUND_INTS
        // For unbound, need both kinds.  If the stupid library would
        // allow automatic conversions, to integer, or the stupid language
        // would allow me to add them, this would be much simpler.
        int val() { return _val.get_si(); }
        int_type opval() { return _val; }
#else
        // Plain value.
        int val() { return _val; }
        int opval() { return _val; }
#endif

        // Standard allocator.
        static Ptr<Int> alloc(int_type v) {
                return RefCtObj::newRefPtr(new Int(v));
        }

        // Allocate from a string of digits.  This is needed mainly by
        // input routine.
        static Ptr<Int> alloc(string v) {
                istringstream is(v);
                int iv;
                is >> iv;
                return RefCtObj::newRefPtr(new Int(iv));
        }

        // Evaluates to itself.
        Ptr<Evaluable> eval(Ptr<Context> c) { 
                return newref();
        }

        // Equality is equality of values, which will be either plain C language
        // int comparison of the two _val fields.  Note that if you're using
        // unbound integers, this comparison will be an overloaded operator call
        // from the GMP library.
        virtual bool equal_same(RefCtObj& other) { 
                return _val == ((Int *)&other)->_val;
        }
};

#endif
atoms.cpp [Download]
#include "evaluable.h"
#include "pair.h"
#include "atoms.h"

// The unique Nil object (I hope).
Ptr<Nil> the_nil = Nil::alloc();

Ptr<Id> the_true = Id::alloc("#t");

// By default, the history feature is on.  Program opts turn it off.
bool Error::_histon = true;
int Error::_toplim = 5;
int Error::_botlim = 10;

// Error code values.
int UNDEF;      // Undefined name.
int BADOP;      // Operation on inappropriate type.
int BADARG;     // Badly-formed argument list.
int SHORTARG;   // Missing arguments.
int BADTYPE;    // Bad argument type.
int LONGARG;    // Too many arguments to a builtin.
int RPAREN;     // Right paren expected.
int SYN;        // General syntax error.
int OPFAIL;     // Loaded file could not be openend.
int DIVZERO;    // Division by zero.
int INTER;      // Operation interrupted.

int set_error_codes()
{
        int enct = 1;
        UNDEF = enct++;
        BADOP = enct++;
        BADARG = enct++;
        SHORTARG = enct++;
        BADTYPE = enct++;
        LONGARG = enct++;
        RPAREN = enct++;
        SYN = enct++;
        OPFAIL = enct++;
        DIVZERO = enct++;
        INTER = enct++;
        return enct;
}

// Print for an error object.  Prints the history, with output limits.
void Error::print(ostream &s)
{
        s << "**** " << name() << " ****";
        if(!_histon) return;

        // Print the first part, up to the limit.
        int toplim = _toplim;
        Ptr<Evaluable> i = _hist;
        for(; !i.points_to(typeid(Nil)); i = i->cdr()) {
                if(toplim-- == 0) break;
                cout << endl << "   "; 
                i->car()->print(cout);
        }

        // If we printed the whole list, we're done.
        if(i.points_to(typeid(Nil))) return;

        // Find where the second part starts.  The lag pointer waits until
        // i has moved _botlim ahead, then lag starts to move at the same
        // rate.
        Ptr<Evaluable> lag = i;
        int botlim = _botlim;
        for(; !i.points_to(typeid(Nil)); i = i->cdr())
                if(botlim-- <= 0) lag = lag->cdr();

        // Do the limits create a gap in the list?  If so, say so.
        if(botlim < 0) cout << endl << "   . . .";

        // Print the last part.
        for(i = lag; !i.points_to(typeid(Nil)); i = i->cdr()) {
                cout << endl << "   "; 
                i->car()->print(cout);
        }
}

#include "func.h"

// Add to the error message history.  Needs to be located below pair.
Ptr<Error> Error::hist(Ptr<Evaluable> e)
{
        if(!_histon) return newref();
        _hist = Pair::alloc(e, _hist);
        return newref();
}

// Add to the front of the first item in the error message history.
Ptr<Error> Error::histinc(Ptr<Evaluable> e)
{
        if(!_histon) return newref();
        if(e.points_to(typeid(Nil))) return newref();
        _hist = Pair::alloc(Pair::alloc(e, _hist->car()), _hist->cdr());
        return newref();
}