summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.gitignore3
-rw-r--r--Makefile26
-rw-r--r--ast.cpp244
-rw-r--r--ast.h85
-rw-r--r--environment.cpp383
-rw-r--r--environment.h34
-rw-r--r--error.cpp13
-rw-r--r--error.h19
-rw-r--r--global.h20
-rw-r--r--indirect.cpp11
-rw-r--r--indirect.h157
-rw-r--r--main.cpp29
-rw-r--r--prelude.cpp68
-rw-r--r--prelude.h6
14 files changed, 1098 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..740a324
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,3 @@
+*.o
+*.dSYM
+main
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..591ace8
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,26 @@
+CXX = g++
+CXXFLAGS = -Wall -Wextra -std=c++11 -fwrapv -Werror=switch
+BIN = main
+DEBUG = 1
+ifneq ($(DEBUG),)
+ CXXFLAGS += -g
+else
+ CXXFLAGS += -O2
+endif
+
+
+.PHONY: all clean remake
+
+all: $(BIN)
+
+clean:
+ rm -rf $(BIN) *.o *.dSYM
+
+remake: clean all
+
+
+$(BIN): $(patsubst %.cpp,%.o,$(wildcard *.cpp))
+ $(CXX) -o $@ $^ $(LDFLAGS)
+
+%.o: %.cpp $(wildcard *.h)
+ $(CXX) $(CXXFLAGS) -c -o $@ $<
diff --git a/ast.cpp b/ast.cpp
new file mode 100644
index 0000000..88d716a
--- /dev/null
+++ b/ast.cpp
@@ -0,0 +1,244 @@
+#include <stdexcept>
+#include <cctype>
+#include "ast.h"
+
+using namespace std;
+
+
+ParseError::ParseError(const string &what_arg)
+ :runtime_error(what_arg){}
+ParseError::ParseError(const char *what_arg)
+ :runtime_error(what_arg){}
+
+
+Lambda::Lambda(){}
+Lambda::Lambda(const Name &arg,const AST &ast)
+ :arg(arg),body(ast){}
+
+
+AST::AST()
+ :type(Type::tuple){}
+
+AST AST::makeNumber(Number numval){
+ AST ast; ast.type=AST::Type::number; ast.numval=numval; return ast;
+}
+AST AST::makeString(String strval){
+ AST ast; ast.type=AST::Type::string; ast.strval=strval; return ast;
+}
+AST AST::makeName(Name nameval){
+ AST ast; ast.type=AST::Type::name; ast.nameval=nameval; return ast;
+}
+AST AST::makeIndex(Index indexval){
+ AST ast; ast.type=AST::Type::index; ast.indexval=indexval; return ast;
+}
+AST AST::makeTuple(Terms terms){
+ AST ast; ast.type=AST::Type::tuple; ast.terms=terms; return ast;
+}
+AST AST::makeLambda(Lambda lambdaval){
+ AST ast; ast.type=AST::Type::lambda; ast.lambdaval=lambdaval; return ast;
+}
+AST AST::makeLambda(const Name &arg,const AST &body){
+ AST ast; ast.type=AST::Type::lambda; ast.lambdaval.arg=arg; ast.lambdaval.body=body; return ast;
+}
+AST AST::makeNative(const Native &native){
+ AST ast; ast.type=AST::Type::native; ast.nativeval=native; return ast;
+}
+
+
+bool iswordchar(char c){
+ return isalpha(c)||isdigit(c)||strchr("!$%&*+,-./:;<=>?@^_|~",c)!=nullptr;
+}
+
+class AST::Tokeniser{
+ const string source;
+ const i64 size;
+ i64 index=0,nextat=0;
+
+public:
+ Tokeniser(const string &source)
+ :source(source),size(source.size()){
+ // cerr<<"Tokeniser: initialised with <<"<<source<<">>"<<endl;
+ advance();
+ }
+
+ bool eof() const {
+ return index==-1;
+ }
+
+ string get(){
+ if(index==-1)throw logic_error("Tokeniser::get() after last token");
+ if(nextat==index)throw logic_error("Tokeniser::get() before advance()");
+ // cerr<<"Tokeniser: got <<"<<source.substr(index,nextat-index)<<">>"<<endl;
+ // cerr<<" left: <<"<<source.substr(nextat)<<">>"<<endl;
+ return source.substr(index,nextat-index);
+ }
+
+ bool advance(){
+ index=nextat;
+ // cerr<<"advance: reading from <<"<<source.substr(index)<<">>"<<endl;
+
+ do {
+ while(index<size&&isspace(source[index])){
+ index++;
+ }
+ if(index==size){
+ index=nextat=-1;
+ return false;
+ }
+ if(source[index]!='#')break;
+ while(index<size&&source[index]!='\n'){
+ index++;
+ }
+ if(index==size){
+ index=nextat=-1;
+ return false;
+ }
+ } while(isspace(source[index])||source[index]=='#');
+
+ if(strchr("'()\\",source[index])!=nullptr){
+ nextat=index+1;
+ return true;
+ } else if(index<size-1&&source[index]=="λ"[0]&&source[index+1]=="λ"[1]){
+ nextat=index+2;
+ return true;
+ } else if(isdigit(source[index])||(index<size-1&&source[index]=='-'&&isdigit(source[index+1]))){
+ nextat=index+1;
+ while(nextat<size&&isdigit(source[nextat])){
+ nextat++;
+ }
+ return true;
+ } else if(iswordchar(source[index])){
+ nextat=index+1;
+ while(nextat<size&&iswordchar(source[nextat])){
+ nextat++;
+ }
+ return true;
+ } else {
+ throw ParseError(string("Invalid token starting with '")+source[index]+"'");
+ }
+ }
+};
+
+AST& AST::parse(AST::Tokeniser &tokeniser){
+ if(tokeniser.eof()){
+ throw ParseError("No tokens to parse");
+ }
+ const string &token=tokeniser.get();
+ if(token.size()==0){
+ throw logic_error("Unexpected empty token from tokeniser");
+ }
+ if(isdigit(token[0])||(token.size()>1&&token[0]=='-'&&isdigit(token[1]))){
+ // cerr<<"AST::parse: type = number"<<endl;
+ type=Type::number;
+ numval=strtol(token.data(),NULL,10);
+ } else if(iswordchar(token[0])){
+ // cerr<<"AST::parse: type = name"<<endl;
+ type=Type::name;
+ nameval=token;
+ } else if(token=="("){
+ // cerr<<"AST::parse: type = tuple"<<endl;
+ type=Type::tuple;
+ while(true){
+ if(!tokeniser.advance()){
+ throw ParseError("List opened with '(' not closed");
+ }
+ if(tokeniser.get()==")")break;
+ terms.push_back(AST().parse(tokeniser));
+ }
+ } else if(token=="'"){
+ if(!tokeniser.advance()){
+ throw ParseError("Unexpected EOF after quote");
+ }
+ parse(tokeniser);
+ quoted=true;
+ } else if(token=="\\"||token=="λ"){
+ type=Type::lambda;
+ if(!tokeniser.advance()){
+ throw ParseError("Unexpected EOF after '\\'");
+ }
+ const string &arg=tokeniser.get();
+ if(!iswordchar(arg[0])){
+ throw ParseError("Name expected after '\\'");
+ }
+ lambdaval.arg=arg;
+ if(!tokeniser.advance()){
+ throw ParseError("Body expected after argument of '\\'");
+ }
+ lambdaval.body=AST().parse(tokeniser);
+ } else if(token==")"){
+ throw ParseError("Unexpected token '"+token+"'");
+ } else {
+ throw logic_error("Unrecognised token from tokeniser: '"+token+"'");
+ }
+ return *this;
+}
+
+AST::AST(const string &source)
+ :AST(source.data()){};
+
+AST::AST(const char *source){
+ Tokeniser tokeniser(source);
+ parse(tokeniser);
+ if(tokeniser.advance()){
+ throw ParseError("Trailing content in source");
+ }
+}
+
+
+ostream& operator<<(ostream &os,const AST &ast){
+ if(ast.quoted){
+ os<<"'";
+ }
+
+ switch(ast.type){
+ case AST::Type::number:
+ os<<ast.numval;
+ break;
+
+ case AST::Type::string:
+ os<<'"';
+ for(char c : ast.strval){
+ switch(c){
+ case 9: os<<"\\t"; break;
+ case 10: os<<"\\n"; break;
+ case 13: os<<"\\r"; break;
+ default:
+ if(c>=32&&c<=126){
+ os<<c;
+ } else {
+ os<<"\\x"
+ <<"0123456789abcdef"[(unsigned char)c/16]
+ <<"0123456789abcdef"[(unsigned char)c%16];
+ }
+ }
+ }
+ os<<'"';
+ break;
+
+ case AST::Type::name:
+ os<<ast.nameval;
+ break;
+
+ case AST::Type::index:
+ os<<'['<<ast.indexval<<']';
+ break;
+
+ case AST::Type::tuple:
+ os<<'(';
+ for(i64 i=0;i<(i64)ast.terms.size();i++){
+ if(i!=0)os<<' ';
+ os<<ast.terms[i];
+ }
+ os<<')';
+ break;
+
+ case AST::Type::lambda:
+ os<<"\\"<<ast.lambdaval.arg<<' '<<*ast.lambdaval.body;
+ break;
+
+ case AST::Type::native:
+ os<<"\\ [native]";
+ break;
+ }
+ return os;
+}
diff --git a/ast.h b/ast.h
new file mode 100644
index 0000000..c0b0d90
--- /dev/null
+++ b/ast.h
@@ -0,0 +1,85 @@
+#pragma once
+
+#include <iostream>
+#include <string>
+#include <vector>
+#include <cstdlib>
+#include "global.h"
+#include "indirect.h"
+
+using namespace std;
+
+
+class AST;
+
+
+using Number = i64;
+using String = string;
+using Name = string;
+using Index = i64;
+class Terms : public vector<AST>{
+public:
+ using vector<AST>::vector;
+ using vector<AST>::operator=;
+};
+class Lambda{
+public:
+ Name arg; // if empty, then can only be referred to with indices
+ Indirect<AST> body=Indirect<AST>::makeEmpty();
+
+ Lambda();
+ Lambda(const Name &arg,const AST &ast);
+};
+using Native = function<AST(const AST&)>;
+
+
+
+class ParseError : public runtime_error{
+public:
+ explicit ParseError(const string &what_arg);
+ explicit ParseError(const char *what_arg);
+};
+
+class AST{
+public:
+ enum class Type{
+ number,
+ string,
+ name,
+ index,
+ tuple,
+ lambda,
+ native,
+ };
+
+ Type type;
+ Number numval;
+ String strval;
+ Name nameval;
+ Index indexval;
+ Terms terms;
+ Lambda lambdaval;
+ Native nativeval;
+
+ bool quoted=false;
+
+private:
+ class Tokeniser;
+ AST& parse(Tokeniser &tokeniser);
+
+public:
+ AST(); // initialises to nil value ()
+ explicit AST(const string &source); // parses source
+ explicit AST(const char *source); // parses source
+
+ static AST makeNumber(Number numval);
+ static AST makeString(String strval);
+ static AST makeName(Name nameval);
+ static AST makeIndex(Index indexval);
+ static AST makeTuple(Terms terms);
+ static AST makeLambda(Lambda lambdaval);
+ static AST makeLambda(const Name &arg,const AST &body);
+ static AST makeNative(const Native &native);
+};
+
+ostream& operator<<(ostream &os,const AST &ast);
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
+}
diff --git a/environment.h b/environment.h
new file mode 100644
index 0000000..5776122
--- /dev/null
+++ b/environment.h
@@ -0,0 +1,34 @@
+#pragma once
+
+#include <functional>
+#include <unordered_set>
+#include <unordered_map>
+#include "ast.h"
+#include "global.h"
+
+using namespace std;
+
+
+class Environment{
+public:
+ using Hook = function<AST(Environment&,const AST&)>;
+ using Hook2 = function<AST(Environment&,const AST&,const AST&)>;
+
+private:
+ unordered_map<string,AST> defs;
+ unordered_map<string,Hook> hooks;
+
+ void reduce(AST &ast,i64 depth=0);
+ bool betareduce(AST &ast,i64 depth);
+
+public:
+ void load(const Environment &other);
+
+ AST run(const AST &ast);
+
+ 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
new file mode 100644
index 0000000..2084319
--- /dev/null
+++ b/error.cpp
@@ -0,0 +1,13 @@
+#include "error.h"
+
+using namespace std;
+
+NameError::NameError(const string &what_arg)
+ :runtime_error("Name '"+what_arg+"' not found"){}
+NameError::NameError(const char *what_arg)
+ :NameError(string(what_arg)){}
+
+TypeError::TypeError(const string &what_arg)
+ :runtime_error(what_arg){}
+TypeError::TypeError(const char *what_arg)
+ :runtime_error(what_arg){}
diff --git a/error.h b/error.h
new file mode 100644
index 0000000..02aafec
--- /dev/null
+++ b/error.h
@@ -0,0 +1,19 @@
+#pragma once
+
+#include <stdexcept>
+#include <string>
+
+using namespace std;
+
+
+class NameError : public runtime_error{
+public:
+ NameError(const string &what_arg);
+ NameError(const char *what_arg);
+};
+
+class TypeError : public runtime_error{
+public:
+ TypeError(const string &what_arg);
+ TypeError(const char *what_arg);
+};
diff --git a/global.h b/global.h
new file mode 100644
index 0000000..522dd1f
--- /dev/null
+++ b/global.h
@@ -0,0 +1,20 @@
+#pragma once
+
+#include <cstdint>
+
+using i64 = int64_t;
+using u64 = uint64_t;
+
+#define TYPESUBCLASS(parenttype,newtype) \
+ class newtype : public parenttype{ \
+ public: \
+ using parenttype::parenttype; \
+ using parenttype::operator=; \
+ }
+
+#define TYPESUBCLASSTEMPLATE(parenttype,parenttemplate,newtype) \
+ class newtype : public parenttype parenttemplate{ \
+ public: \
+ using parenttype parenttemplate::parenttype; \
+ using parenttype parenttemplate::operator=; \
+ }
diff --git a/indirect.cpp b/indirect.cpp
new file mode 100644
index 0000000..75d35be
--- /dev/null
+++ b/indirect.cpp
@@ -0,0 +1,11 @@
+#include "indirect.h"
+
+using namespace std;
+
+
+NullIndirectError::NullIndirectError()
+ :runtime_error("NullIndirectError()"){}
+NullIndirectError::NullIndirectError(const string &what_arg)
+ :runtime_error(what_arg){}
+NullIndirectError::NullIndirectError(const char *what_arg)
+ :runtime_error(what_arg){}
diff --git a/indirect.h b/indirect.h
new file mode 100644
index 0000000..da93955
--- /dev/null
+++ b/indirect.h
@@ -0,0 +1,157 @@
+#pragma once
+
+#include <stdexcept>
+
+using namespace std;
+
+
+class NullIndirectError : public runtime_error{
+public:
+ NullIndirectError();
+ NullIndirectError(const string &what_arg);
+ NullIndirectError(const char *what_arg);
+};
+
+
+template <typename T>
+class Indirect{
+ T *ptr;
+
+ class Dummy{};
+
+ Indirect(Dummy);
+
+public:
+ template <typename ...Args>
+ Indirect(Args... args);
+
+ Indirect(const Indirect &other);
+ Indirect(Indirect &&other);
+
+ ~Indirect();
+
+ Indirect<T>& operator=(const T &value);
+ Indirect<T>& operator=(T &&value);
+
+ Indirect<T>& operator=(const Indirect<T> &other);
+ Indirect<T>& operator=(Indirect<T> &&other);
+
+ bool isEmpty() const;
+
+ T& operator*();
+ const T& operator*() const;
+
+ static Indirect<T> makeEmpty();
+};
+
+template <typename T>
+Indirect<T>::Indirect(Dummy)
+ :ptr(nullptr){}
+
+template <typename T>
+Indirect<T> Indirect<T>::makeEmpty(){
+ return Indirect<T>(Indirect::Dummy());
+};
+
+
+template <typename T>
+template <typename ...Args>
+Indirect<T>::Indirect(Args... args)
+ :ptr(new T(args...)){}
+
+template <typename T>
+Indirect<T>::Indirect(const Indirect &other){
+ if(!other.ptr){
+ ptr=nullptr;
+ } else {
+ ptr=new T(*other.ptr);
+ }
+}
+
+template <typename T>
+Indirect<T>::Indirect(Indirect &&other){
+ if(!other.ptr){
+ ptr=nullptr;
+ } else {
+ ptr=new T(move(*other.ptr));
+ other.ptr=nullptr;
+ }
+}
+
+template <typename T>
+Indirect<T>::~Indirect(){
+ if(ptr){
+ delete ptr;
+ }
+}
+
+
+template <typename T>
+Indirect<T>& Indirect<T>::operator=(const T &value){
+ if(!ptr){
+ ptr=new T(value);
+ } else {
+ *ptr=value;
+ }
+ return *this;
+}
+
+template <typename T>
+Indirect<T>& Indirect<T>::operator=(T &&value){
+ if(!ptr){
+ ptr=new T(value);
+ } else {
+ *ptr=value;
+ }
+ return *this;
+}
+
+
+template <typename T>
+Indirect<T>& Indirect<T>::operator=(const Indirect<T> &other){
+ if(ptr){
+ delete ptr;
+ }
+ if(!other.ptr){
+ ptr=nullptr;
+ } else {
+ ptr=new T(*other.ptr);
+ }
+ return *this;
+}
+
+template <typename T>
+Indirect<T>& Indirect<T>::operator=(Indirect<T> &&other){
+ if(ptr){
+ delete ptr;
+ }
+ if(!other.ptr){
+ ptr=nullptr;
+ } else {
+ ptr=new T(move(*other.ptr));
+ other.ptr=nullptr;
+ }
+ return *this;
+}
+
+
+template <typename T>
+bool Indirect<T>::isEmpty() const {
+ return ptr!=nullptr;
+}
+
+template <typename T>
+T& Indirect<T>::operator*(){
+ if(!ptr){
+ throw NullIndirectError();
+ }
+ return *ptr;
+}
+
+template <typename T>
+const T& Indirect<T>::operator*() const {
+ if(!ptr){
+ throw NullIndirectError();
+ }
+ return *ptr;
+}
diff --git a/main.cpp b/main.cpp
new file mode 100644
index 0000000..1918874
--- /dev/null
+++ b/main.cpp
@@ -0,0 +1,29 @@
+#include <iostream>
+#include "ast.h"
+#include "environment.h"
+#include "error.h"
+#include "prelude.h"
+
+using namespace std;
+
+
+int main(){
+ Environment env;
+ env.load(prelude);
+ // cerr<<"Global env = "<<&env<<endl;
+
+ string line;
+ cout<<"> ";
+ while(getline(cin,line)){
+ try {
+ AST parsed(line);
+ cerr<<"Parsed: "<<parsed<<endl;
+ const AST &res=env.run(parsed);
+ cout<<res<<endl;
+ } catch(runtime_error e){
+ cerr<<"\x1B[1mError: "<<e.what()<<"\x1B[0m"<<endl;
+ }
+ cout<<"> ";
+ }
+ return 0;
+}
diff --git a/prelude.cpp b/prelude.cpp
new file mode 100644
index 0000000..eb503b0
--- /dev/null
+++ b/prelude.cpp
@@ -0,0 +1,68 @@
+#include <iostream>
+#include <sstream>
+#include <string>
+#include "error.h"
+#include "prelude.h"
+
+using namespace std;
+
+
+Environment prelude;
+
+const AST afterBootstrap=AST(R"RAW(
+(do
+ (def '. \f \g \x (f (g x)))
+ (def 'flip \f \a \b (f b a))
+ (def 'id \x x)
+ (def 'const \x \y x)
+ (def 'print (. putstr repr)))
+)RAW");
+
+class PreludeInit{
+public:
+ PreludeInit(Environment &intoEnv){
+ intoEnv.define("repr",AST::makeNative([](const AST &ast) -> AST {
+ stringstream ss;
+ ss<<ast;
+ String res=ss.str();
+ 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("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");
+ }
+ env.define(arg1.nameval,arg2);
+ return AST();
+ });
+ });
+
+ intoEnv.define("do",AST::makeNative([](const AST&) -> AST {
+ throw logic_error("'do' stub called; this should not happen");
+ }));
+
+ 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.run(afterBootstrap);
+ }
+} preludeInit(prelude);
diff --git a/prelude.h b/prelude.h
new file mode 100644
index 0000000..643eb43
--- /dev/null
+++ b/prelude.h
@@ -0,0 +1,6 @@
+#pragma once
+
+#include "environment.h"
+
+
+extern Environment prelude;
generated by cgit v1.2.3-70-g09d2 (git 2.48.1) at 2025-04-06 07:04:23 +0200