------------------------------------------------------------------------------
MC logo
Main Program
[^] 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]
The main method creates the initial context, fills it up with the pre-defined names, then handles what the user types. This is the read-eval-print loop.
main.cpp [Download]
//*****************************************************************************
//***  Tom's Lisp Main Program
//*** 
//***    Tom's lisp is a simple lisp interpreter, neither fast nor standard.
//***    Mostly, the code is reading.
//*****************************************************************************

#include <typeinfo>
#include <iostream>
#include <fstream>
#include <string>
#include <sstream>
#include <vector>
#include <map>

#include <ctype.h>
#include <stdlib.h>
#include <unistd.h>
#include <getopt.h>
#include <signal.h>

using namespace std;

#include "interrupt.h"
#include "refct.h"
#include "context.h"
#include "evaluable.h"
#include "atoms.h"
#include "builtin.h"
#include "read.h"

// The name of initial file.  Can be changed with compile defs.
#ifndef INIT_FILE
#define INIT_FILE "tomsinit.lsp"
#endif

// The name MEM_DEBUG adds memory mgt debuggin code.

// The settings based on the target.
#ifdef WIN32
#define COMP_FOR "Win 32"

// The default search path for all file loads (windows)
#ifndef LSP_PATH
#define LSP_PATH ".;C:\\TOMSLSP;C:\\PROGRAM FILES\\TOMSLSP"
#endif

#else

#define COMP_FOR "Unix/Unix-like"

// The default search path for all file loads.
#ifndef LSP_PATH
#define LSP_PATH ".:/usr/local/lib/tomslsp:/usr/lib/tomslsp"
#endif

#endif

// Also MEM_DEBUG if set adds checks related to debugging the ref count
// memory system.

#define VERSION "0.95"

// Load the file, print an message and exit if the load fails.  Used for
// loading the init file and files listed on the command line.
void bload(const char *name, Ptr<Context> c)
{
        Ptr<Evaluable> res = load(name, c);
        if(res.points_to(typeid(Error))) {
                Error::history_off();
                cerr << "Error loading " << name << ": ";
                res->print(cerr);
                cerr << endl;
                exit(1);
        }
}

int main(int argc, char **argv) 
{
        // Search path environmet or default.
        const char *src;
        if(getenv("LSP_PATH")) src = getenv("LSP_PATH");
        else src = LSP_PATH;

        // Bare mode (parameter).  Skips init load.
        bool bare = false;

        // Do not enter the interactive read-eval-print loop.
        bool batch = false;

        // Options.  The -s can replace search path.
        extern char *optarg;
        int found;
        while((found = getopt(argc, argv, "s:bqBle:S:F:CV")) >= 0) {
                switch(found) {
                case 's':
                        src = optarg;
                        break;
#ifdef MEM_DEBUG
                case 'l':
                        RefCtObj::reporting(atoi(optarg));
                        break;
#endif
                case 'b':
                        bare = true;
                        break;
                case 'B':
                        batch = true;
                        break;
                case 'q':
                        Error::history_off();
                        break;
                case 'e': {
                        int cnt = atoi(optarg);
                        int bot = 2*cnt / 3;
                        Error::toplim(cnt - bot);
                        Error::botlim(bot); }
                        break; 
                case 'S':
                        Error::toplim(atoi(optarg));
                        break;
                case 'F':
                        Error::botlim(atoi(optarg));
                        break;
                case 'V':
                        cout << VERSION << endl;
                        exit(0);
                case 'C':
                        cout << "Tom's Lisp " << VERSION << " compiled for "
                             << COMP_FOR << " systems." << endl;
                        cout << "Compiled on " 
                             << __DATE__ << " " << __TIME__ << endl;
#ifdef __VERSION__
                        cout << "Compiler version: " << __VERSION__ << endl;
#endif
                        cout << "LSP_PATH = \"" << LSP_PATH << "\"" << endl;
                        cout << "search path = \"" << src << "\"" << endl;
#ifdef UNBOUND_INTS
                        cout << "Unbound integer values.  ";
#else
                        cout << "System integer values.  ";
#endif 
#ifdef MEM_DEBUG
                        cout << "Memory debug on.";
#endif
                        cout << endl;
                        break;
                default:
                        exit(3);
                }
        }

        setsearch(src);

        // Set the code values for the built-in error codes.
        int enct = set_error_codes();

        // Create the main context.  This declares the main context object.
        Ptr<Context> maincon = Context::alloc();
#ifdef MEM_DEBUG
        RefCtObj::rpt("Main context created");
#endif

        // This section creates entries in the main context for the standard
        // definitions.  Most of these are Builtin functions, but there are 
        // also nil and #t, and Catch is down there a ways.
        maincon->set("nil", the_nil);
        maincon->set("#t", the_true);
        maincon->set("car", Builtin::alloc(bi_car, "car", "p"));
        maincon->set("cdr", Builtin::alloc(bi_cdr, "cdr", "p"));
        maincon->set("cons", Builtin::alloc(bi_cons, "cons", ".."));
        maincon->set("null?", Builtin::alloc(bi_null, "null?", "."));
        maincon->set("pair?", Builtin::alloc(bi_ispair, "pair?", "."));
        maincon->set("id?", Builtin::alloc(bi_isid, "id?", "."));
        maincon->set("int?", Builtin::alloc(bi_isint, "int?", "."));
        maincon->set("str?", Builtin::alloc(bi_isstring, "str?", "."));
        maincon->set("lambda?", Builtin::alloc(bi_islambda, "lambda?", "."));
        maincon->set("macro?", Builtin::alloc(bi_ismacro, "macro?", "."));
        maincon->set("builtin?", 
                     Builtin::alloc(bi_isbuiltin, "builtin?", "."));

        maincon->set("quote", Builtin::alloc(bi_quote, "quote", ".", false));
        maincon->set("eval", Builtin::alloc(bi_eval, "eval", "."));

        maincon->set("begin", Builtin::alloc(bi_begin, "begin", "+", false));
        maincon->set("cond", Builtin::alloc(bi_cond, "cond", "+", false));
        maincon->set("or", Builtin::alloc(bi_or, "or", "+", false));
        maincon->set("error", Builtin::alloc(bi_error, "error", "is"));
        maincon->set("catch", Catch::alloc());

        maincon->set("set", Builtin::alloc(bi_set, "set", "n."));
        maincon->set("scope", Builtin::alloc(bi_scope, "scope", "+", false));

        maincon->set("macro", Builtin::alloc(bi_macro, "macro", "F.", false));
        maincon->set("lambda", Builtin::alloc(bi_lambda, "lambda", 
                                              "F.", false));

        maincon->set("exit", Builtin::alloc(bi_exit, "exit", "i"));

        maincon->set("+", Builtin::alloc(bi_plus, "+", "+i"));
        maincon->set("*", Builtin::alloc(bi_times, "*", "+i"));
        maincon->set("-", Builtin::alloc(bi_minus, "-", "ii"));
        maincon->set("/", Builtin::alloc(bi_div, "/", "ii"));
        maincon->set("%", Builtin::alloc(bi_mod, "%", "ii"));

        maincon->set("<", Builtin::alloc(bi_lt, "<", "ii"));
        maincon->set(">", Builtin::alloc(bi_gt, ">", "ii"));
        maincon->set("<=", Builtin::alloc(bi_le, "<=", "ii"));
        maincon->set(">=", Builtin::alloc(bi_ge, ">=", "ii"));
        maincon->set("=", Builtin::alloc(bi_eq, "=", "ii"));
        maincon->set("!=", Builtin::alloc(bi_ne, "!=", "ii"));
        maincon->set("eq?", Builtin::alloc(bi_ptreq, "eq?", ".."));
        maincon->set("equal?", Builtin::alloc(bi_equal, "equal?", ".."));

        maincon->set("strlen", Builtin::alloc(bi_strlen, "strlen", "s"));
        maincon->set("shatter", Builtin::alloc(bi_shatter, "shatter", "s"));
        maincon->set("collect", Builtin::alloc(bi_collect, "collect", "(+s)"));
        maincon->set("chr", Builtin::alloc(bi_chr, "chr", "i"));
        maincon->set("ord", Builtin::alloc(bi_ord, "ord", "s"));

        maincon->set("load", Builtin::alloc(bi_load, "load", "s"));
        maincon->set("print", Builtin::alloc(bi_print, "print", "."));
        maincon->set("sprint", Builtin::alloc(bi_sprint, "sprint", "s"));

#ifdef MEM_DEBUG
        maincon->set("memrpt", Builtin::alloc(bi_memrpt, "memrpt", ""));
        maincon->set("aloc-log", Builtin::alloc(bi_aloc_log, "aloc-log", "i"));
#endif

        // Create definitions for the standard error classes.
        maincon->set("ERR_UNDEF", Int::alloc(UNDEF));
        maincon->set("ERR_BADOP", Int::alloc(BADOP));
        maincon->set("ERR_BADARG", Int::alloc(BADARG));
        maincon->set("ERR_SHORTARG", Int::alloc(SHORTARG));
        maincon->set("ERR_BADTYPE", Int::alloc(BADTYPE));
        maincon->set("ERR_LONGARG", Int::alloc(LONGARG));
        maincon->set("ERR_RPAREN", Int::alloc(RPAREN));
        maincon->set("ERR_SYN", Int::alloc(SYN));
        maincon->set("ERR_OPFAIL", Int::alloc(OPFAIL));
        maincon->set("ERR_DIVZERO", Int::alloc(DIVZERO));
        maincon->set("ERR_INTER", Int::alloc(INTER));
        maincon->set("NEXT_ERR", Int::alloc(enct));

        // A couple of important environment variables.
        if(getenv("USER"))
                maincon->set("USER", Str::alloc(getenv("USER")));
        if(getenv("HOME"))
                maincon->set("HOME", Str::alloc(getenv("HOME")));

        // What the heck.  Might be useful.
        maincon->set("PID", Int::alloc(getpid()));

        // Load the standard init file.
        if(!bare) bload(INIT_FILE, maincon);

        // Load the command line files.
        for(argc -= optind, argv += optind; argc--; ++argv) 
                bload(*argv, maincon);

        // For batch mode, we're done.
        if(batch) exit(0);

        // Main read and print loop.  This reads s-expressions from the
        // console (standard input), evaluates each, and prints the result.
        initsig();                                      // Init sig handling.
        Scanner in(cin, "[standard input]", &cout);     // Init tokenizer.
        cout << "Welcome to Tom's Lisp " << VERSION <<  // Welcome msg.
                ".  Recur well." << endl;
#ifdef MEM_DEBUG
        RefCtObj::rpt("Before main loop");
#endif
        // Read-eval-print loop.
        while(in.peek().type != tok_eof) {
                // Read.
                Ptr<Evaluable> e = read_sexpr(in);

                // Reset ^c flag, then evaluate the expression.
                signalled = false;
                e = e->eval(maincon);

                // Print the result.
                e->print(cout);
                cout << endl;

                // Clear the input stream.
                in.clear();
        }
        cout << endl;

#ifdef MEM_DEBUG
        // This actually does a bit extra cleanup that we don't bother with
        // when we're exiting anyway.  But it tests the algorithms.
        RefCtObj::rpt("Main loop exit");
        maincon->last_rites();
        maincon.nullify();
        RefCtObj::rpt("Finish");
#endif
}

#ifdef MEM_DEBUG
int RefCtObj::alocnt = 0;
int RefCtObj::alo_rpt = 0;
#endif