From 3b390967e7c2ee4ac6d1a67c77f40ed43005e012 Mon Sep 17 00:00:00 2001
From: tomsmeding <tom.smeding@gmail.com>
Date: Sun, 20 Nov 2016 11:27:07 +0100
Subject: Initial

---
 environment.cpp | 383 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 383 insertions(+)
 create mode 100644 environment.cpp

(limited to 'environment.cpp')

diff --git a/environment.cpp b/environment.cpp
new file mode 100644
index 0000000..1d2c657
--- /dev/null
+++ b/environment.cpp
@@ -0,0 +1,383 @@
+#include <stdexcept>
+#include <string>
+#include "environment.h"
+#include "error.h"
+
+using namespace std;
+
+#undef DEBUG
+
+
+void Environment::load(const Environment &other){
+	defs.insert(other.defs.begin(),other.defs.end());
+	hooks.insert(other.hooks.begin(),other.hooks.end());
+}
+
+void Environment::define(const Name &name,const AST &ast){
+	defs.insert({name,ast});
+}
+
+void Environment::define(const Name &name,const Hook &hook){
+	hooks.insert({name,hook});
+}
+
+void Environment::define2(const Name &name,const Hook2 &hook2){
+	hooks.insert({name,[hook2](Environment &env,const AST &arg1) -> AST {
+		return AST::makeNative([&env,arg1,hook2](const AST &arg2) -> AST {
+			return hook2(env,arg1,arg2);
+		});
+	}});
+}
+
+AST Environment::get(const Name &name){
+	auto it=defs.find(name);
+	if(it==defs.end()){
+		auto it=hooks.find(name);
+		if(it==hooks.end()){
+			throw NameError(name);
+		}
+		Hook hook=it->second;
+		return AST::makeNative([this,hook](const AST &ast){
+			return hook(*this,ast);
+		});
+	}
+	return it->second;
+}
+
+
+// ------------------------------------------------------------
+
+
+void indexReplace(AST &ast,const Name &name,Index index){
+	if(ast.quoted){
+		return;
+	}
+
+	switch(ast.type){
+		case AST::Type::number:
+		case AST::Type::string:
+		case AST::Type::index:
+		case AST::Type::native:
+			break;
+
+		case AST::Type::name:
+			if(ast.nameval==name){
+				ast.type=AST::Type::index;
+				ast.indexval=index;
+			}
+			break;
+
+		case AST::Type::tuple:
+			for(AST &term : ast.terms){
+				indexReplace(term,name,index);
+			}
+			break;
+
+		case AST::Type::lambda:
+			if(ast.lambdaval.arg!=name){
+				indexReplace(*ast.lambdaval.body,name,index+1);
+			}
+			break;
+	}
+}
+
+
+void indexify(AST &ast){
+	if(ast.quoted){
+		return;
+	}
+
+	switch(ast.type){
+		case AST::Type::number:
+		case AST::Type::string:
+		case AST::Type::name:
+		case AST::Type::index:
+		case AST::Type::native:
+			break;
+
+		case AST::Type::tuple:
+			for(AST &term : ast.terms){
+				indexify(term);
+			}
+			break;
+
+		case AST::Type::lambda:
+			indexReplace(*ast.lambdaval.body,ast.lambdaval.arg,1);
+			ast.lambdaval.arg="";
+			indexify(*ast.lambdaval.body);
+			break;
+	}
+}
+
+void singlify(AST &ast){
+	if(ast.quoted){
+		return;
+	}
+
+	switch(ast.type){
+		case AST::Type::number:
+		case AST::Type::string:
+		case AST::Type::name:
+		case AST::Type::index:
+		case AST::Type::native:
+			break;
+
+		case AST::Type::lambda:
+			singlify(*ast.lambdaval.body);
+			break;
+
+		case AST::Type::tuple:
+			if(ast.terms.size()==0){
+				break;
+			}
+			if(ast.terms.size()==1){
+				AST newast=ast.terms[0];
+				ast=newast;
+				singlify(ast);
+				break;
+			}
+			while(ast.terms.size()>2){
+				AST two=AST::makeTuple({ast.terms[0],ast.terms[1]});
+				ast.terms.erase(ast.terms.begin()+1);
+				ast.terms[0]=move(two);
+			}
+			if(ast.terms.size()==2){
+				singlify(ast.terms[0]);
+				singlify(ast.terms[1]);
+			}
+			break;
+	}
+}
+
+
+AST Environment::run(const AST &astinput){
+	AST ast(astinput);
+	indexify(ast);
+#ifdef DEBUG
+	cerr<<"indexify gave "<<ast<<endl;
+#endif
+	singlify(ast);
+#ifdef DEBUG
+	cerr<<"singlify gave "<<ast<<endl;
+#endif
+	reduce(ast);
+	return ast;
+}
+
+
+void recursiveFindLevel(AST &ast,Index index,vector<pair<AST*,Index>> &nodes){
+	if(ast.quoted){
+		return;
+	}
+
+	switch(ast.type){
+		case AST::Type::number:
+		case AST::Type::string:
+		case AST::Type::name:
+		case AST::Type::native:
+			break;
+
+		case AST::Type::index:
+			if(ast.indexval==index){
+				nodes.emplace_back(&ast,index);
+			}
+			break;
+
+		case AST::Type::tuple:
+			for(AST &term : ast.terms){
+				recursiveFindLevel(term,index,nodes);
+			}
+			break;
+
+		case AST::Type::lambda:
+			recursiveFindLevel(*ast.lambdaval.body,index+1,nodes);
+			break;
+	}
+}
+
+
+void increaseFree(AST &ast,Index amount,Index fromIndex){
+	if(ast.quoted){
+		return;
+	}
+
+	switch(ast.type){
+		case AST::Type::number:
+		case AST::Type::string:
+		case AST::Type::name:
+		case AST::Type::native:
+			break;
+
+		case AST::Type::index:
+			if(ast.indexval>=fromIndex){
+				ast.indexval+=amount;
+			}
+			break;
+
+		case AST::Type::tuple:
+			for(AST &term : ast.terms){
+				increaseFree(term,amount,fromIndex);
+			}
+			break;
+
+		case AST::Type::lambda:
+			increaseFree(*ast.lambdaval.body,amount,fromIndex+1);
+			break;
+	}
+}
+
+
+bool hasFree(AST &ast,Index fromIndex){
+	if(ast.quoted){
+		return false;
+	}
+
+	switch(ast.type){
+		case AST::Type::number:
+		case AST::Type::string:
+		case AST::Type::native:
+			return false;
+
+		case AST::Type::name:
+			return true;
+
+		case AST::Type::index:
+			return ast.indexval>=fromIndex;
+
+		case AST::Type::tuple:
+			for(AST &term : ast.terms){
+				if(hasFree(term,fromIndex)){
+					return true;
+				}
+			}
+			return false;
+
+		case AST::Type::lambda:
+			return hasFree(*ast.lambdaval.body,fromIndex+1);
+	}
+}
+
+
+#ifdef DEBUG
+static string indent(i64 depth){
+	string s(2*depth,' ');
+	for(i64 i=0;i<depth;i++){
+		s[2*i]='|';
+	}
+	return s;
+}
+#endif
+
+bool Environment::betareduce(AST &ast,i64 depth){
+	if(ast.quoted){
+		return false;
+	}
+
+	if(ast.type!=AST::Type::tuple){
+		return false;
+	}
+	if(ast.terms.size()!=2){
+		return false;
+	}
+
+#ifdef DEBUG
+	cerr<<indent(depth)<<"Betareducing "<<ast<<endl;
+#endif
+
+	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;
+	}
+
+#ifdef DEBUG
+	cerr<<indent(depth)<<"'=> "<<ast<<endl;
+#endif
+	return success;
+}
+
+
+void etareduce(AST &ast){
+	if(ast.quoted){
+		return;
+	}
+
+	// do nothing yet
+}
+
+
+void Environment::reduce(AST &ast,i64 depth){
+#ifdef DEBUG
+	cerr<<indent(depth)<<"Reducing "<<ast<<endl;
+#endif
+	if(ast.quoted){
+		return;
+	}
+
+	switch(ast.type){
+		case AST::Type::number:
+		case AST::Type::string:
+		case AST::Type::index:
+		case AST::Type::native:
+			break;
+
+		case AST::Type::name:
+			if(ast.nameval!="do"){
+				ast=get(ast.nameval);
+				indexify(ast);
+			}
+			break;
+
+		case AST::Type::lambda:
+			reduce(*ast.lambdaval.body,depth+1);
+			etareduce(ast);
+			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;
+				}
+			} 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;
+#endif
+}
-- 
cgit v1.2.3-70-g09d2