/*
* 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;
}
