------------------------------------------------------------------------------
MC logo
Code Reader
[^] 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]
read.h [Download]
//*****************************************************************************
//***  Input.
//***
//***    Functions and objects to read and parse lisp lists.
//*****************************************************************************

#include <iostream>
#include <string>

using namespace std;

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

#ifndef _read_h_
#define _read_h_

// The settings based on the target.
#ifdef WIN32
#define SEP_CHAR ";"
#define PATH_CHR "\\"
#else
#define SEP_CHAR ":"
#define PATH_CHR "/"
#endif

// Function to decide if a file name looks absolute (don't use the path).
inline bool isabs(const string fn)
{
#ifdef WIN32
        if(fn.length() < 3) return 0;
        return fn[0] == '.' || 
                (isupper(fn[0]) && fn[1] == ':' && fn[2] == '\\');
#else
        return fn.length() && (fn[0] == '/' || fn[0] == '.');
#endif
}
// Token types.
enum tok_t { tok_id, tok_int, tok_str, tok_left, tok_right, tok_period,
             tok_eof, tok_tick };

// Token values.
struct token {
        tok_t type;
        string text;
        token(tok_t tt = tok_eof, string txt = ""): type(tt), text(txt) { }
};

// Scanner objects.
class Scanner {
        istream &strm;          // Stream which is the character source.
        int lno;                // Current line number.
        char lastin;            // Last character read.(one-char lookahead).
        token _currtok;         // Current token.
        int nest;               // Current paren nesting depth.
        ostream *prompt;        // Promt stream.
        bool ahead;             // Scanner is "ahead" -- _currtok contains
                                // valid data.
        string _filename;       // File name (for err report only).

        // Get the next character.
        bool getchr();

        // Read the next token.
        token readtok();

public:
        // Initialize the object.  Set set state and read one character.
        Scanner(istream &is, string fn, ostream *pr = 0): 
                strm(is), _filename(fn), prompt(pr), lastin('\n'), lno(0),
                ahead(false), nest(0) { }

        // Current token (does not change input stream).
        token peek() { 
                if(!ahead) {
                        _currtok = readtok();
                        ahead = true;
                }
                return _currtok; 
        }

        // Return current token, then go to the next one.
        token next() { 
                token retval = peek();
                ahead = false;
                return retval;
        }

        // Current line number.
        int line() { return lno; }

        // Current filename.
        string filename() { return _filename; }

        // Current location (for error reports).
        string location() {
                ostringstream strm;
                strm << _filename << ":" << lno << ends;
                return strm.str();
        }
        
        // Clear to end of line.
        void clear();

        // Clear until the nesting depth is zero or negative, then clear 
        // to the end of the line.  Used to clean up after an error.
        void purge();

        // EOF detect on the underlying stream.  
        bool eof() { return !strm.good(); }
};

// Read an s-expression.  At EOF, returns the NULL pointer (not to be confused
// with Nil, a perfectly valid input.)
extern Ptr<Evaluable> read_sexpr(Scanner &s);

// Load a file.  Return the last value produced, or an error if the file
// could not be opened.
extern Ptr<Evaluable> load(string name, Ptr<Context> c);

// This is a utility used to separate a search path string into its 
// parts and store them in as the search pathe for load.
// Empty components are discarded.
extern void setsearch(string str);

#endif
read.cpp [Download]
#include <fstream>
#include <string>
#include <vector>

using namespace std;

#include "pair.h"
#include "read.h"

// Get the next character.
bool Scanner::getchr() 
{
        if(lastin == '\n') {
                ++lno;
                if(prompt)
                        if(nest <=  0)
                                *prompt << "lsp>";
                        else
                                *prompt << "--->";
        }
        if(strm.get(lastin)) 
                return true;

        lastin = ' ';
        return false;
}

// Read the next token.
token Scanner::readtok()
{
        // This loop scans through blanks and comments.
        while(1) {
                // Look for a non-blank.
                while(isspace(lastin))
                        if(!getchr()) return token(tok_eof);

                // If that non-blank was a comment designator,
                // munch the line.
                if(lastin == ';') {
                        while(lastin != '\n')
                                if(!getchr()) return token(tok_eof);
                        getchr();
                } else
                        // Process it.
                        break;
        }

        char first = lastin;
        getchr();

        // Now for some simple ones.
        switch(first)
        {
        case '(': 
                ++nest;
                return token(tok_left, "(");
        case ')': 
                --nest;
                return token(tok_right, ")");
        case '.': 
                return token(tok_period, ".");
        case '\'': 
                return token(tok_tick, "'");
        case '"':
                string ret = "";
                while(1) {
                        if(lastin == '"' || lastin == '\n') break;
                        else if(lastin == '\\') {
                                getchr();
                                char inch = lastin;
                                if(lastin == 'n') inch = '\n';
                                else if(lastin == 't') inch = '\t';
                                else if(lastin == '\n') inch = ' ';
                                ret += inch;
                        } else
                                ret += lastin;
                        if(!getchr()) break;
                }
                getchr(); // Clear the closing " 
                return token(tok_str, ret);
        }

        // Whatever's left is allowed as an identifier character or
        // a digit.  Accumulate it, and recall if it's all digits.
        string str = " ";
        str[0] = first;
        bool numeric = isdigit(first) || first == '-' || first == '+';
        while(1) {
                if(isspace(lastin) || lastin == '(' || lastin == ')' ||
                   lastin == '.' || lastin == ';' || lastin == '\'' ||
                   lastin == '"')
                        break;
                if(!isdigit(lastin)) numeric = false;
                str += lastin;
                if(!getchr()) break;
        }

        // One kind or another.
        if(numeric && (str.length() > 1 || isdigit(str[0])))
                return token(tok_int, str);
        else
                return token(tok_id, str);
}

// Clear to end of line.
void Scanner::clear()
{
        while(lastin != '\n') if(!getchr()) return;
        getchr();
        nest = 0;
        ahead = false;
}

// Clear until the nesting depth is zero or negative, then clear 
// to the end of the line.  Used to clean up after an error.
void Scanner::purge() 
{
        while(nest > 0) if(next().type == tok_eof) break;
        clear();
}


// Read an s-expression.  At EOF, returns the NULL pointer (not to be confused
// with Nil, a perfectly valid input.)
static Ptr<Evaluable> read_rest_list(Scanner &s);
Ptr<Evaluable> read_sexpr(Scanner &s)
{
        // Now do something with it.
        token t = s.next();
        if(t.type == tok_eof) return RefPtr();
        if(t.type == tok_id) return Id::alloc(t.text);
        if(t.type == tok_int) return Int::alloc(t.text);
        if(t.type == tok_str) return Str::alloc(t.text);
        if(t.type == tok_tick) {
                // Tick quotes the next whatever.  Read it, and
                // insert the quote atom.
                Ptr<Evaluable> e = read_sexpr(s);
                if(e.points_to(typeid(Error))) return e;
                return Pair::alloc(Id::alloc("quote"), 
                                   Pair::alloc(e, the_nil));
        }
        if(t.type == tok_left) {
                // Left paren.  Look recursively for a sublist.
                Ptr<Evaluable> e = read_rest_list(s);
                if(s.peek().type != tok_right)
                        return Error::alloc(RPAREN, string("At ") +
                                            s.location() +
                                            ": Right paren expected.");
                s.next();
                return e;
        } 

        return Error::alloc(SYN, string("At ") + 
                            s.location() + ": Input syntax error");
}

// A helper for read_sexpr() which reads the balance of a list, after
// the opening ( has been consumed.
static Ptr<Evaluable> read_rest_list(Scanner &s)
{
        // If we've reached ), we're done.
        if(s.peek().type == tok_right || s.peek().type == tok_eof)
                return the_nil;

        // Read the next list member.
        Ptr<Evaluable> car = read_sexpr(s);
        if(car.points_to(typeid(Error))) return car;

        // Check for a dot indicating dot-pair notation.
        if(s.peek().type == tok_period) {
                // Since we have a dot, we must have a cdr value then a closing
                // ) to finish out the pair.  Read and enforce.
                s.next();
                Ptr<Evaluable> cdr = read_sexpr(s);
                if(cdr.points_to(typeid(Error))) return cdr;
                return Pair::alloc(car, cdr);
        } else {
                // Just more list.
                Ptr<Evaluable> cdr = read_rest_list(s);
                if(cdr.points_to(typeid(Error))) return cdr;
                return Pair::alloc(car, cdr);
        }
}

// This is the include file search path.  It is initialized in main()
// from the parameters, then the environment, then hardwired default.
vector<string> srch_list;

// This is a utility used to separate a search path string into its 
// parts and add them to the global search path, srch_list.  Empty
// components are discarded.
void setsearch(string str)
{
        // Clear it out.
        srch_list.clear();

        // Go through the :-separated parts.
        int loc;
        while((loc = str.find(SEP_CHAR)) >= 0) {
                if(loc > 0)
                        srch_list.push_back(str.substr(0, loc) + PATH_CHR);
                str = str.substr(loc+1);
        }
        if(str.length())
                srch_list.push_back(str + PATH_CHR);
}

// Load a file.  Return the last value produced, or an error if the file
// could not be opened.
Ptr<Evaluable> load(string name, Ptr<Context> c)
{
        ifstream in;
        bool found = false;

        if(isabs(name)) {
                in.open(name.c_str(), ios::in);
                found = in;
        }
        else {
                // Search and try all the opens.
                vector<string>::iterator i;
                for(i = srch_list.begin(); i < srch_list.end(); ++i) {
                        string fn = *i + name;
                        in.open(fn.c_str(), ios::in);
                        if(in) {
                                found = true;
                                break;
                        }
                        in.clear();
                }
        }

        // If it didn't, boom.
        if(!found)
                return Error::alloc(OPFAIL, string("Open of ") +
                                    name + " failed.");

        // Load the contents.
        Scanner fs(in, name);
        Ptr<Evaluable> e = the_nil;
        while(fs.peek().type != tok_eof) {
                e = read_sexpr(fs);
                e = e->eval(c);
                if(e.points_to(typeid(Error))) return e;
        }
        return e;
}