PNI: Polish Notation Interpreter in C++11

[compsystems]

LISP interpreter, version beta 0.0.1

https://www.dropbox.com/s/1dyken80fz2a97p/lisp.cpp?dl=0

Screen captures

Code:

 
/*
* Zaskar's Mini-LISP
* Small incomplete and inefficient LISP interpreter.
* By Pablo Novara, zaskar_84@yahoo.com.ar, 
* distributed under GNU GPL license.
*/
 

#include <iostream>
#include <map>
#include <functional>
#include <sstream>
#include <list>
#include <algorithm>
#include <stack>
#include <cstdlib>
using namespace std;
 
class env_t; // ambiente, mapeo de nombres/operadores a procedimientos/valores
using list_t = list<string>; // una lista
using function_t = function<string(list_t,env_t&)>; // un operador o procedimiento
 
// ambiente... debería ser directamente un map, pero necesitaba la 
// forward declaration de la clase para function_t
struct env_t : public map<string,function_t> { };
 
// func auxiliar para mostrar los runtime-errors
string error(string s1, string s2="") { cout << "Error: " << s1 << s2 << endl; return ""; }
 
// conversiones entre string y verdadero/falso, y entre double y string
bool stob(string s) { return s=="#t"; }
string btos(bool b) { return b?"#t":"#f"; }
string dtos(double d) { stringstream ss; ss<<d; return ss.str(); }
double stod(string &s) { 
    if (s.empty() || ((s[0]<'0'||s[0]>'9') && s[0]!='.' && s[0]!='-')) {
        error("invalid numeric value ",s); return 0;
    } else return std::stod(s);
}
 
// dada una lista como string, la transforma en una lista posta (list_t)
list_t split(string line) {
    stringstream ss(line); // el stringstream::operator>> hará el corte por espacios
    string aux; list_t args;
    ss>>aux; // extraer el "(" inicial
    while (ss>>aux && aux!=")") {
        if (aux=="(") { // si es sub-lista, saltearla completa
            string aux2; int par_level=1; 
            while(par_level>0 && ss>>aux2) { 
                if (aux2=="(") ++par_level;
                else if (aux2==")") --par_level;
                aux+=string(" ")+aux2;
            }
        }
        args.push_back(aux);
    }
    return args;
}
 
// para saber si la expresión a evaluar es una constante... versión "heurística", no es perfecta, pero alcanza
bool is_constant(string in) { return in.empty() || in[0]=='\"' || (in[0]>='0'&&in[0]<='9') || (in[0]=='.'||in[0]=='-'); }
 
// evalua una instruccion (lista dada como string) en el ambiente dado env
string eval(string in, env_t &env) {
    if (is_constant(in)) return in;
    if (in[0]=='(') { // si es procedimiento, destripar y ejecutar
        list_t lin = split(in);
        string oper = lin.front(); // nombre del proc/operador
        lin.pop_front();
        auto proc = env.find(oper);
        if (proc != env.end()) 
            return (proc->second)(lin,env);
        else return error("undefined procedure ",oper);
    } else { // si es un solo valor...
        auto var = env.find(in);
        if (var != env.end()) return (var->second)(list_t(),env);
        else return error("unbound variable ",in);
    }
}
 
// func auxiliar que dada una lista, evalua todos sus argumentos (reemplaza la lista)
void eval_all(list_t &args, env_t env) {
    for(auto &x:args) x = eval(x,env);
}
 
// para el indentado del prompt, busca el ultimo parentesis sin cerrar
int pos_par(string &s) {
    stack<int> pars;
    for(size_t i=0;i<s.size();i++) {
        if (s[i]=='(') pars.push(i);
        else if (s[i]==')') {
            if (pars.empty()) { s = error("unbalanced parentesis"); return 0; }
            pars.pop();
        }
    }
    if (pars.empty()) return 0; else {
        size_t i = pars.top()+1;
        while (i<s.length() && s[i]==' ') ++i;
        while (i<s.length() && s[i]!=' ') ++i;
        while (i<s.length() && s[i]==' ') ++i;
        for(size_t j = i-1; j>0; --j) if (s[j]=='\n'||s[j]=='\r') return i-j-1;
        return i;
    }
}
 
// dada una cadena de entrada, la reformatea un poco para que 
// el parseo con el stringstream sea mas facil (separa los parentesis y
// colapsa los espacios extra (esto ultimo es solo estética)
string normalize(string in) {
    string ret;
    for(size_t i=0;i<in.size();i++) {
        if (in[i]==' '|| in[i]=='\n' || in[i]=='\r') {
            if (ret.size()&&ret[ret.size()-1]!=' ') ret += " ";
        }
        else if (in[i]=='(') ret += "( ";
        else if (in[i]==')') ret += ((i&&in[i-1]!=' '))?" )":")";
        else ret+=in[i];
    }
    return ret;
}
 
// una variable es en realidad un procedimiento que no recibe nada y retorna un
// valor constante, esta función hace esos procedimientos (la usa env["define"])
function_t make_var(string retval) {
    return [retval](list_t args,env_t &env) {
        auto it = env.find(retval);
        if (it!=env.end()) return it->second(args,env); // para "(define x (lambda ....))"
        if (!args.empty()) return error(retval," is not a procedure"); 
        else return retval;
    };
}
 
// func axiliar para env["lamba"], para generar nombre auxiliares diferentes para cada nueva lambda
string new_name() {
    static int lambda_num = 0;
    stringstream ss;
    ss<<"lambda#"<<(++lambda_num);
    return ss.str();
}
 
 
int main() {
     
    // incializar el ambiente por defecto con los built-in operators
    env_t env; 
    env["+"]   =[](list_t args,env_t env){ eval_all(args,env); double x = stod(args.front()); args.pop_front(); for(auto &y:args) x+=stod(y); return dtos(x); };
    env["-"]   =[](list_t args,env_t env){ eval_all(args,env); double x = stod(args.front()); args.pop_front(); if (args.empty()) x=-x; for(auto &y:args) x-=stod(y); return dtos(x); };
    env["*"]   =[](list_t args,env_t env){ eval_all(args,env); double x = stod(args.front()); args.pop_front(); for(auto &y:args) x*=stod(y); return dtos(x); };
    env["/"]   =[](list_t args,env_t env){ eval_all(args,env); double x = stod(args.front()); args.pop_front(); for(auto &y:args) x/=stod(y); return dtos(x); };
    env["="]   =[](list_t args,env_t env){ eval_all(args,env); return (stod(args.front())==stod(args.back()))?"#t":"#f"; };
    env["<"]   =[](list_t args,env_t env){ eval_all(args,env); return (stod(args.front())<stod(args.back()))?"#t":"#f"; };
    env[">"]   =[](list_t args,env_t env){ eval_all(args,env); return (stod(args.front())>stod(args.back()))?"#t":"#f"; };
    env["and"] =[](list_t args,env_t env){ for(auto &x:args) if (!stob(eval(x,env))) return "#f"; return "#t"; };
    env["or"]  =[](list_t args,env_t env){ for(auto &x:args) if (stob(eval(x,env))) return "#t"; return "#f"; };
 
    // estructuras de control basicas
    env["if"]  =[](list_t args,env_t env){ 
        string x = eval(args.front(),env); args.pop_front(); 
        if (stob(x)) return eval(args.front(),env); 
        else         return eval(args.back(),env); 
    };
    env["cond"]=[](list_t args,env_t env){ 
        // el cond convierte todo en una monton de ifs anidados...
        string ifs = "???";
        reverse(args.begin(),args.end());
        for(auto x: args) {
            x.insert(1," if");
            x.insert(x.size()-1,ifs+" ");
            ifs = x;
        }
        return eval(ifs,env);
    };
    env["else"]=[](list_t args,env_t env){ return "#t"; }; // para simplificar el cond
     
    // algunas constantes
    env["true"]  =[](list_t args,env_t env){ return "#t"; };
    env["false"] =[](list_t args,env_t env){ return "#f"; };
     
    // define una variable o un procedimiento... ambas son lambdas que se 
    // guardan en el ambiente (mapa) env
    env["define"] =[](list_t args,env_t &env){
        if (args.size()<2) return error("ill formed define");
        string name = args.front(); args.pop_front(); // extraer el nombre de lo que se define
        string retval; // lo que retorna esta definicion para mostrarle al usuario
        if (name[0]=='(') { // si es un procedimiento
            list_t def_args = split(name); 
            string pname = def_args.front(); def_args.pop_front(); // extraer el nombre...
            list_t instr = args; // ...y los argumentos formales
            retval = instr.back(); instr.pop_back(); // extraer la instruccion a ejecutar (lo que queda son defs anidadas)
            env[pname] = [pname,retval,instr,def_args](list_t args,env_t &env){ // generar la lambda y guardarla en el mapa
                auto env2 = env; // ambiente local de la funcion, "hereda" del de la llamada
                if (def_args.size()!=args.size()) return error("bad arguments count for ",pname); 
                auto it1 = def_args.begin(); auto it2 = args.begin();
                while (it1!=def_args.end()) { // reemplazar argumentos formales con actuales
                    auto it = env.find(*it2);
                    if (it!=env.end()) env2[*it1] = it->second; // functions (not calls) should be passed by as function
                    else env2[*it1] = make_var(eval(*it2,((*it2).substr(0,9)=="( lambda ")?env2:env));
                    ++it1; ++it2;
                }
                for(auto &x:instr) eval(x,env2); // para definir procedimientos anidados en el ambiente local
                return eval(retval,env2); // ejecutar el cuerpo en este ambiente
            };
        } else { // si es variable (valor constante)
            retval = args.front(); // extraer el valor
            env[name] = make_var(eval(retval,env));  // guardar en el mapa una nueva lambda que retorna ese valor
        }
        return name + " := " + retval; // para mostrar en el prompt
    };
     
    // para las lambdas propias inventa un nombre y se convierte en un define
    env["lambda"] =[](list_t args,env_t &env){ 
        if (args.size()<2) return error("ill formed lambda");
        string name = new_name();
        stringstream ss;
        ss<<"( define ( "<<name;
        args.front()[0]=' ';
        for(auto &x:args) ss << x << " ";
        ss << ")"; eval(ss.str(),env);
        return name;
    };
     
    // funciones matematicas
    env["abs"]     =[](list_t args,env_t env){ double x = stod(eval(args.front(),env)); return dtos(x<0?-x:x); };
    env["sqrt"]    =[](list_t args,env_t env){ double x = stod(eval(args.front(),env)); return dtos(sqrt(x)); };
    env["square"]  =[](list_t args,env_t env){ double x = stod(eval(args.front(),env)); return dtos(x*x); };
    env["exp"]     =[](list_t args,env_t env){ double x = stod(eval(args.front(),env)); return dtos(exp(x)); };
    env["log"]     =[](list_t args,env_t env){ double x = stod(eval(args.front(),env)); return dtos(log(x)); };
    env["even?"]   =[](list_t args,env_t env){ double x = stod(eval(args.front(),env)); return btos(int(x)%2==0); };
    env["expt"]    =[](list_t args,env_t env){ double a = stod(eval(args.front(),env)), b = stod(eval(args.back(),env)); return dtos(pow(a,b)); };
    env["reminder"]=[](list_t args,env_t env){ double a = stod(eval(args.front(),env)), b = stod(eval(args.back(),env)); return dtos(int(a)%int(b)); };
     
    // otras de utilería
    env["newline"] =[](list_t args,env_t env){ cout << endl; return ""; };
    env["display"] =[](list_t args,env_t env){ for(auto &x:args) cout << eval(x,env) << " "; cout << endl; return ""; };
    env["random"]  =[](list_t args,env_t env){ double x = stod(eval(args.front(),env)); return dtos(rand()%int(x)); };
     
    // prompt interactivo, lee y ejecuta hasta fin de archivo (o ctrl+d)
    cout << "Welcome to Zaskar's mini LISP!" << endl;
    string in, aux;
    while(cout << "$ " && getline(cin,in)) {
        // si no termino la instruccion (faltan cerrar parentesis), indentar y continuar
        while (pos_par(in)!=0 && cout << "  " << string(pos_par(in),' ') && getline(cin,aux)) 
            in+=string("\n")+string(pos_par(in),' ')+aux;
        cout << eval(normalize(in),env) << endl; // normalizar entrada, ejecutar, y mostrar resultado
    }
    cout << endl << "Have a nice day!" << endl;
}