Sugar and prelude extension

9 files changed, 232 insertions, 43 deletions

diff --git a/ast.h b/ast.h
index c0b0d90..700fc80 100644
--- a/ast.h
+++ b/ast.h
@@ -1,5 +1,6 @@
 #pragma once
 
+#include <functional>
 #include <iostream>
 #include <string>
 #include <vector>
@@ -82,4 +83,13 @@ public:
 	static AST makeNative(const Native &native);
 };
 
+namespace std {
+	template <>
+	struct hash<AST::Type>{
+		size_t operator()(const AST::Type &type) const {
+			return (size_t)type;
+		}
+	};
+}
+
 ostream& operator<<(ostream &os,const AST &ast);
diff --git a/environment.cpp b/environment.cpp
index 3ca55b1..b38d73b 100644
--- a/environment.cpp
+++ b/environment.cpp
@@ -5,7 +5,7 @@
 
 using namespace std;
 
-#undef DEBUG
+#define DEBUG
 
 
 void Environment::load(const Environment &other){
@@ -25,14 +25,6 @@ void Environment::define(const Name &name,const Hook &hook){
 	hooks[name]=hook;
 }
 
-void Environment::define2(const Name &name,const Hook2 &hook2){
-	hooks[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()){
@@ -277,7 +269,7 @@ static bool hasFree(AST &ast,Index fromIndex){
 			return false;
 
 		case AST::Type::name:
-			return true;
+			return false;
 
 		case AST::Type::index:
 			return ast.indexval>=fromIndex;
diff --git a/environment.h b/environment.h
index bc86efb..d3f3031 100644
--- a/environment.h
+++ b/environment.h
@@ -9,11 +9,11 @@
 using namespace std;
 
 
-class Environment{
-public:
-	using Hook = function<AST(Environment&,const AST&)>;
-	using Hook2 = function<AST(Environment&,const AST&,const AST&)>;
+class Environment;
 
+using Hook = function<AST(Environment&,const AST&)>;
+
+class Environment{
 private:
 	unordered_map<string,AST> defs;
 	unordered_map<string,Hook> hooks;
@@ -29,7 +29,6 @@ public:
 
 	void define(const Name &name,const AST &ast);
 	void define(const Name &name,const Hook &hook);
-	void define2(const Name &name,const Hook2 &hook2);
 
 	AST get(const Name &name);
 };
diff --git a/error.cpp b/error.cpp
index 2084319..151f4bc 100644
--- a/error.cpp
+++ b/error.cpp
@@ -11,3 +11,8 @@ TypeError::TypeError(const string &what_arg)
 	:runtime_error(what_arg){}
 TypeError::TypeError(const char *what_arg)
 	:runtime_error(what_arg){}
+
+FormError::FormError(const string &what_arg)
+	:runtime_error(what_arg){}
+FormError::FormError(const char *what_arg)
+	:runtime_error(what_arg){}
diff --git a/error.h b/error.h
index 02aafec..e57267c 100644
--- a/error.h
+++ b/error.h
@@ -17,3 +17,9 @@ public:
 	TypeError(const string &what_arg);
 	TypeError(const char *what_arg);
 };
+
+class FormError : public runtime_error{
+public:
+	FormError(const string &what_arg);
+	FormError(const char *what_arg);
+};
diff --git a/main.cpp b/main.cpp
index 1918874..9f85093 100644
--- a/main.cpp
+++ b/main.cpp
@@ -10,7 +10,6 @@ using namespace std;
 int main(){
 	Environment env;
 	env.load(prelude);
-	// cerr<<"Global env = "<<&env<<endl;
 
 	string line;
 	cout<<"> ";
diff --git a/prelude.cpp b/prelude.cpp
index cd51cad..5738844 100644
--- a/prelude.cpp
+++ b/prelude.cpp
@@ -3,6 +3,7 @@
 #include <string>
 #include "error.h"
 #include "prelude.h"
+#include "sugar.h"
 
 using namespace std;
 
@@ -15,7 +16,8 @@ const AST afterBootstrap=AST(R"RAW(
 	(def 'flip \f \a \b (f b a))
 	(def 'id \x x)
 	(def 'const \x \y x)
-	(def 'print (. putstr repr)))
+	(def 'print (. putstr repr))
+	(def '$ \f \x (f x)))
 )RAW");
 
 static AST dofunction(const AST&);
@@ -36,23 +38,14 @@ public:
 			return AST::makeString(res);
 		}));
 
-		intoEnv.define("putstr",AST::makeNative([](const AST &ast) -> AST {
-			if(ast.type!=AST::Type::string){
-				throw TypeError("Argument to 'putstr' is not a String");
-			}
-			cout<<ast.strval<<endl;
-			return AST();
-		}));
+		intoEnv.define("putstr",checkedHook("putstr",{AST::Type::string},
+			[](Environment&,const AST &ast) -> AST {cout<<ast.strval<<endl; return AST();}));
 
-		intoEnv.define("def",[](Environment &env,const AST &arg1) -> AST {
-			return AST::makeNative([&env,arg1](const AST &arg2) -> AST {
-				if(arg1.type!=AST::Type::name){
-					throw TypeError("First argument to 'def' is not a Name");
-				}
+		intoEnv.define("def",checkedHook("def",{AST::Type::name},{},
+			[](Environment &env,const AST &arg1,const AST &arg2) -> AST {
 				env.define(arg1.nameval,arg2);
 				return AST();
-			});
-		});
+			}));
 
 		intoEnv.define("do",doNative);
 
@@ -62,18 +55,79 @@ public:
 			return res;
 		}));
 
-		intoEnv.define2("+",[](Environment&,const AST &arg1,const AST &arg2) -> AST {
-			if(arg1.type!=arg2.type){
-				throw TypeError("Unequal types in '+'");
-			}
-			if(arg1.type==AST::Type::number){
-				return AST::makeNumber(arg1.numval+arg2.numval);
-			} else if(arg1.type==AST::Type::string){
-				return AST::makeString(arg1.strval+arg2.strval);
-			} else {
-				throw TypeError("Arguments to '+' neither Number nor String");
-			}
-		});
+		intoEnv.define("head",checkedHook("head",{AST::Type::tuple},
+			[](Environment&,const AST &arg) -> AST {
+				if(arg.terms.size()==0){
+					throw FormError("Empty tuple in 'head'");
+				}
+				return arg.terms[0];
+			}));
+
+		intoEnv.define("tail",checkedHook("tail",{AST::Type::tuple},
+			[](Environment&,const AST &arg) -> AST {
+				if(arg.terms.size()==0){
+					throw FormError("Empty tuple in 'tail'");
+				}
+				return AST::makeTuple(Terms(arg.terms.begin()+1,arg.terms.end()));
+			}));
+
+		intoEnv.define("nil",checkedHook("nil",{AST::Type::tuple},
+			[](Environment&,const AST &arg) -> AST {
+				return AST::makeNumber(arg.terms.size()==0);
+			}));
+
+		intoEnv.define("not",checkedHook("not",{AST::Type::number},
+			[](Environment&,const AST &arg) -> AST {
+				return AST::makeNumber(arg.numval==0);
+			}));
+
+		intoEnv.define("if",checkedHook("if",{AST::Type::number},{},{},
+			[](Environment&,const AST &arg1,const AST &arg2,const AST &arg3) -> AST {
+				if(arg1.numval!=0){
+					return arg2;
+				} else {
+					return arg3;
+				}
+			}));
+
+		intoEnv.define("+",checkedHook("+",{AST::Type::number,AST::Type::string},
+			                               {AST::Type::number,AST::Type::string},
+			[](Environment&,const AST &arg1,const AST &arg2) -> AST {
+				if(arg1.type!=arg2.type){
+					throw TypeError("Unequal types in '+'");
+				}
+				if(arg1.type==AST::Type::number){
+					return AST::makeNumber(arg1.numval+arg2.numval);
+				} else {
+					return AST::makeString(arg1.strval+arg2.strval);
+				}
+			}));
+
+		intoEnv.define("-",checkedHook("-",{AST::Type::number},{AST::Type::number},
+			[](Environment&,const AST &arg1,const AST &arg2) -> AST {
+				return AST::makeNumber(arg1.numval-arg2.numval);
+			}));
+
+		intoEnv.define("*",checkedHook("*",{AST::Type::number},{AST::Type::number},
+			[](Environment&,const AST &arg1,const AST &arg2) -> AST {
+				return AST::makeNumber(arg1.numval*arg2.numval);
+			}));
+
+		intoEnv.define("/",checkedHook("/",{AST::Type::number},{AST::Type::number},
+			[](Environment&,const AST &arg1,const AST &arg2) -> AST {
+				return AST::makeNumber(arg1.numval/arg2.numval);
+			}));
+
+		intoEnv.define("%",checkedHook("%",{AST::Type::number},{AST::Type::number},
+			[](Environment&,const AST &arg1,const AST &arg2) -> AST {
+				return AST::makeNumber(arg1.numval%arg2.numval);
+			}));
+
+		intoEnv.define("=",checkedHook("=",{AST::Type::number,AST::Type::string},
+		                                   {AST::Type::number,AST::Type::string},
+			[](Environment&,const AST &arg1,const AST &arg2) -> AST {
+			return AST::makeNumber(arg1.type==arg2.type&&arg1.numval==arg2.numval);
+		}));
 
 		intoEnv.run(afterBootstrap);
 	}
diff --git a/sugar.cpp b/sugar.cpp
new file mode 100644
index 0000000..6980978
--- /dev/null
+++ b/sugar.cpp
@@ -0,0 +1,89 @@
+#include <sstream>
+#include "error.h"
+#include "sugar.h"
+
+using namespace std;
+
+
+const unordered_map<AST::Type,string> typeName={
+	{AST::Type::number,"Number"},
+	{AST::Type::string,"String"},
+	{AST::Type::name,"Name"},
+	{AST::Type::index,"Index"},
+	{AST::Type::tuple,"Tuple"},
+	{AST::Type::lambda,"Lambda"},
+	{AST::Type::native,"Native"},
+};
+
+
+ostream& operator<<(ostream &os,AST::Type t){
+	return os<<typeName.at(t);
+}
+
+template <typename T>
+string stringify(const vector<T> &v,const string &join){
+	stringstream ss;
+	bool first=true;
+	for(const T &t : v){
+		if(first){
+			first=false;
+		} else {
+			ss<<join;
+		}
+		ss<<t;
+	}
+	return ss.str();
+}
+
+
+Hook checkedHook(const Name &name,const vector<AST::Type> &types,const Hook &func){
+	return [types,func,name](Environment &env,const AST &arg) -> AST {
+		if(types.size()!=0&&find(types.begin(),types.end(),arg.type)==types.end()){
+			throw TypeError("Function "+name+" got "+typeName.at(arg.type)+
+			                " but accepts "+stringify(types));
+		}
+		return func(env,arg);
+	};
+}
+
+Hook checkedHook(const Name &name,
+                 const vector<AST::Type> &types1,const vector<AST::Type> &types2,
+                 const Hook2 &func){
+	return [types1,types2,func,name](Environment &env,const AST &arg1) -> AST {
+		return AST::makeNative([types1,types2,func,name,&env,arg1](const AST &arg2) -> AST {
+			if(types1.size()!=0&&find(types1.begin(),types1.end(),arg1.type)==types1.end()){
+				throw TypeError("Function "+name+" got "+typeName.at(arg1.type)+
+				                " as first argument but accepts "+stringify(types1));
+			}
+			if(types2.size()!=0&&find(types2.begin(),types2.end(),arg2.type)==types2.end()){
+				throw TypeError("Function "+name+" got "+typeName.at(arg2.type)+
+				                " as second argument but accepts "+stringify(types2));
+			}
+			return func(env,arg1,arg2);
+		});
+	};
+}
+
+Hook checkedHook(const Name &name,
+                 const vector<AST::Type> &types1,const vector<AST::Type> &types2,const vector<AST::Type> &types3,
+                 const Hook3 &func){
+	return [types1,types2,types3,func,name](Environment &env,const AST &arg1) -> AST {
+		return AST::makeNative([types1,types2,types3,func,name,&env,arg1](const AST &arg2) -> AST {
+			return AST::makeNative([types1,types2,types3,func,name,&env,arg1,arg2](const AST &arg3) -> AST {
+				if(types1.size()!=0&&find(types1.begin(),types1.end(),arg1.type)==types1.end()){
+					throw TypeError("Function "+name+" got "+typeName.at(arg1.type)+
+					                " as first argument but accepts "+stringify(types1));
+				}
+				if(types2.size()!=0&&find(types2.begin(),types2.end(),arg2.type)==types2.end()){
+					throw TypeError("Function "+name+" got "+typeName.at(arg2.type)+
+					                " as second argument but accepts "+stringify(types2));
+				}
+				if(types3.size()!=0&&find(types3.begin(),types3.end(),arg3.type)==types3.end()){
+					throw TypeError("Function "+name+" got "+typeName.at(arg3.type)+
+					                " as third argument but accepts "+stringify(types3));
+				}
+				return func(env,arg1,arg2,arg3);
+			});
+		});
+	};
+}
diff --git a/sugar.h b/sugar.h
new file mode 100644
index 0000000..1140ef3
--- /dev/null
+++ b/sugar.h
@@ -0,0 +1,35 @@
+#pragma once
+
+#include <iostream>
+#include <string>
+#include <unordered_map>
+#include <vector>
+#include "ast.h"
+#include "environment.h"
+
+using namespace std;
+
+
+using Hook2 = function<AST(Environment&,const AST&,const AST&)>;
+using Hook3 = function<AST(Environment&,const AST&,const AST&,const AST&)>;
+
+
+extern const unordered_map<AST::Type,string> typeName;
+
+ostream& operator<<(ostream &os,AST::Type t);
+
+template <typename T>
+string stringify(const vector<T> &v,const string &join=", ");
+
+
+Hook checkedHook(const Name &name,
+                 const vector<AST::Type> &types,
+                 const Hook &func);
+
+Hook checkedHook(const Name &name,
+                 const vector<AST::Type> &types1,const vector<AST::Type> &types2,
+                 const Hook2 &func);
+
+Hook checkedHook(const Name &name,
+                 const vector<AST::Type> &types1,const vector<AST::Type> &types2,const vector<AST::Type> &types3,
+                 const Hook3 &func);