summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ast.h10
-rw-r--r--environment.cpp12
-rw-r--r--environment.h9
-rw-r--r--error.cpp5
-rw-r--r--error.h6
-rw-r--r--main.cpp1
-rw-r--r--prelude.cpp108
-rw-r--r--sugar.cpp89
-rw-r--r--sugar.h35
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);
generated by cgit v1.2.3-70-g09d2 (git 2.48.1) at 2025-04-09 16:19:14 +0200