diff options
| -rw-r--r-- | environment.cpp | 152 | ||||
| -rw-r--r-- | prelude.cpp | 16 |
2 files changed, 112 insertions, 56 deletions
diff --git a/environment.cpp b/environment.cpp index e36031b..3ca55b1 100644 --- a/environment.cpp +++ b/environment.cpp @@ -153,6 +153,44 @@ static void singlify(AST &ast){ } } +bool Environment::resolve(AST &ast){ + if(ast.quoted){ + return false; + } + + bool ret=false; + + switch(ast.type){ + case AST::Type::number: + case AST::Type::string: + case AST::Type::index: + case AST::Type::native: + break; + + case AST::Type::name: + try { + ast=get(ast.nameval); + resolve(ast); + ret=true; + } catch(NameError){ + // just leave an unknown name as it is + } + break; + + case AST::Type::tuple: + for(AST &term : ast.terms){ + ret=resolve(term)||ret; + } + break; + + case AST::Type::lambda: + ret=resolve(*ast.lambdaval.body)||ret; + break; + } + + return ret; +} + AST Environment::run(const AST &astinput){ AST ast(astinput); @@ -160,10 +198,6 @@ AST Environment::run(const AST &astinput){ #ifdef DEBUG cerr<<"indexify gave "<<ast<<endl; #endif - singlify(ast); -#ifdef DEBUG - cerr<<"singlify gave "<<ast<<endl; -#endif reduce(ast); return ast; } @@ -283,6 +317,9 @@ bool Environment::betareduce(AST &ast,i64 depth){ if(ast.terms.size()!=2){ return false; } + if(ast.terms[0].type!=AST::Type::lambda){ + return false; + } #ifdef DEBUG cerr<<indent(depth)<<"Betareducing "<<ast<<endl; @@ -290,37 +327,25 @@ bool Environment::betareduce(AST &ast,i64 depth){ bool success; - if(ast.terms[0].type==AST::Type::lambda){ - // cerr<<"=== β-REDUCE LAMBDA ==="<<endl; - // cerr<<"ast = "<<ast<<endl; - AST newterm=*ast.terms[0].lambdaval.body; - ast.terms[0]=newterm; - // cerr<<"ast = "<<ast<<endl; - - vector<pair<AST*,Index>> repl; - recursiveFindLevel(ast.terms[0],1,repl); - // cerr<<"Level 2:"; for(i64 i=0;i<(i64)repl.size();i++)cerr<<" {"<<*repl[i].first<<','<<repl[i].second<<'}'; cerr<<endl; - - increaseFree(ast.terms[0],-1,2); - - for(const pair<AST*,Index> &p : repl){ - *p.first=ast.terms[1]; - increaseFree(*p.first,p.second-1,1); - } - newterm=ast.terms[0]; - ast=newterm; - success=true; - } else if(ast.terms[0].type==AST::Type::native){ - reduce(ast.terms[1],depth+1); - ast=ast.terms[0].nativeval(ast.terms[1]); - success=true; - } else if(ast.terms[0].type==AST::Type::name&&ast.terms[0].nameval=="do"){ - reduce(ast.terms[1],depth+1); - ast=ast.terms[0]; - success=true; - } else { - success=false; + // cerr<<"=== β-REDUCE LAMBDA ==="<<endl; + // cerr<<"ast = "<<ast<<endl; + AST newterm=*ast.terms[0].lambdaval.body; + ast.terms[0]=newterm; + // cerr<<"ast = "<<ast<<endl; + + vector<pair<AST*,Index>> repl; + recursiveFindLevel(ast.terms[0],1,repl); + // cerr<<"Level 2:"; for(i64 i=0;i<(i64)repl.size();i++)cerr<<" {"<<*repl[i].first<<','<<repl[i].second<<'}'; cerr<<endl; + + increaseFree(ast.terms[0],-1,2); + + for(const pair<AST*,Index> &p : repl){ + *p.first=ast.terms[1]; + increaseFree(*p.first,p.second-1,1); } + newterm=ast.terms[0]; + ast=newterm; + success=true; #ifdef DEBUG cerr<<indent(depth)<<"'=> "<<ast<<endl; @@ -339,14 +364,16 @@ static bool etareduce(AST &ast){ } -void Environment::reduce(AST &ast,i64 depth){ +bool Environment::reduce(AST &ast,i64 depth){ #ifdef DEBUG cerr<<indent(depth)<<"Reducing "<<ast<<endl; #endif if(ast.quoted){ - return; + return false; } + bool ret=false; + switch(ast.type){ case AST::Type::number: case AST::Type::string: @@ -355,34 +382,51 @@ void Environment::reduce(AST &ast,i64 depth){ break; case AST::Type::name: - if(ast.nameval!="do"){ - ast=get(ast.nameval); - indexify(ast); - } + ret=resolve(ast); break; case AST::Type::lambda: - reduce(*ast.lambdaval.body,depth+1); - etareduce(ast); + ret=reduce(*ast.lambdaval.body,depth+1); + ret=etareduce(ast)||ret; break; case AST::Type::tuple: - // reduce(ast.terms[0],depth+1); - // reduce(ast.terms[1],depth+1); // TODO: this is dodgy - // while(betareduce(ast,depth+1)){} - do { - reduce(ast.terms[0],depth+1); - if(!betareduce(ast,depth+1)){ - break; + if(ast.terms.size()==0){ + break; + } + if(ast.terms.size()==1){ + AST newast=ast.terms[0]; + ast=newast; + ret=true; + break; + } + if(ast.terms.size()>2){ + singlify(ast); + } + ret=reduce(ast.terms[0],depth+1); + if(ast.terms[0].type==AST::Type::lambda){ + bool brret=betareduce(ast,depth+1); + ret=ret||brret; + if(brret){ + ret=reduce(ast,depth+1)||ret; + } + } else if(ast.terms[0].type==AST::Type::native){ +#ifdef DEBUG + cerr<<indent(depth+1)<<"Preparation for native call, reducing argument"<<endl; +#endif + ret=reduce(ast.terms[1],depth+1)||ret; + if(!hasFree(ast.terms[1],1)){ + ast=ast.terms[0].nativeval(ast.terms[1]); + ret=true; + } else { + cerr<<indent(depth+1)<<"Argument contained free indices, not calling"<<endl; } - } while(ast.type==AST::Type::tuple&&ast.terms.size()>0); - if(ast.type==AST::Type::name){ - // TODO: this is really dodgy; why is this necessary? - reduce(ast,depth+1); } break; } + #ifdef DEBUG - cerr<<indent(depth)<<"'-> "<<ast<<endl; + cerr<<indent(depth)<<"'-> "<<ast<<" (ret="<<ret<<")"<<endl; #endif + return ret; } diff --git a/prelude.cpp b/prelude.cpp index eb503b0..cd51cad 100644 --- a/prelude.cpp +++ b/prelude.cpp @@ -18,6 +18,14 @@ const AST afterBootstrap=AST(R"RAW( (def 'print (. putstr repr))) )RAW"); +static AST dofunction(const AST&); + +const AST doNative=AST::makeNative(dofunction); + +static AST dofunction(const AST&){ + return doNative; +} + class PreludeInit{ public: PreludeInit(Environment &intoEnv){ @@ -46,8 +54,12 @@ public: }); }); - intoEnv.define("do",AST::makeNative([](const AST&) -> AST { - throw logic_error("'do' stub called; this should not happen"); + intoEnv.define("do",doNative); + + intoEnv.define("unquote",AST::makeNative([](const AST &ast) -> AST { + AST res(ast); + res.quoted=false; + return res; })); intoEnv.define2("+",[](Environment&,const AST &arg1,const AST &arg2) -> AST { |