aboutsummaryrefslogtreecommitdiffstats
path: root/src/resp.hpp
diff options
context:
space:
mode:
Diffstat (limited to 'src/resp.hpp')
-rw-r--r--src/resp.hpp245
1 files changed, 160 insertions, 85 deletions
diff --git a/src/resp.hpp b/src/resp.hpp
index ade7257..f172548 100644
--- a/src/resp.hpp
+++ b/src/resp.hpp
@@ -30,6 +30,7 @@
#include <map>
#include <set>
#include <sstream>
+#include <stack>
#include <string>
#include <vector>
#include <boost/format.hpp>
@@ -92,6 +93,12 @@ struct Env : public list< vector< pair<K,V> > > {
return true;
return false;
}
+ bool innermost(const K& key) const {
+ for (typename Frame::const_iterator b = this->front().begin(); b != this->front().end(); ++b)
+ if (b->first == key)
+ return true;
+ return false;
+ }
};
template<typename K, typename V>
@@ -187,6 +194,8 @@ struct CEnv; ///< Compile-Time Environment
struct AST;
extern ostream& operator<<(ostream& out, const AST* ast);
+typedef list<AST*> Code;
+
/// Base class for all AST nodes
struct AST : public Object {
AST(Cursor c=Cursor()) : loc(c) {}
@@ -196,7 +205,8 @@ struct AST : public Object {
virtual bool contains(const AST* child) const { return false; }
virtual void constrain(TEnv& tenv, Constraints& c) const throw(Error) {}
virtual AST* cps(TEnv& tenv, AST* cont) const;
- virtual void lift(CEnv& cenv) throw() {}
+ virtual AST* lift(CEnv& cenv, Code& code) throw() { return this; }
+ virtual AST* depoly(CEnv& cenv, Code& code) throw() { return this; }
virtual CVal compile(CEnv& cenv) throw() = 0;
string str() const { ostringstream ss; ss << this; return ss.str(); }
template<typename T> T to() { return dynamic_cast<T>(this); }
@@ -247,6 +257,7 @@ struct AString : public AST, public std::string {
struct ASymbol : public AST {
bool operator==(const AST& rhs) const { return this == &rhs; }
void constrain(TEnv& tenv, Constraints& c) const throw(Error);
+ AST* lift(CEnv& cenv, Code& code) throw();
CVal compile(CEnv& cenv) throw();
const string cppstr;
private:
@@ -273,6 +284,12 @@ struct ATuple : public AST {
newvec[_len++] = ast;
_vec = newvec;
}
+ void push_front(AST* ast) {
+ AST** newvec = (AST**)malloc(sizeof(AST*) * (_len + 1));
+ newvec[0] = ast;
+ memcpy(newvec + 1, _vec, sizeof(AST*) * _len++);
+ _vec = newvec;
+ }
const AST* head() const { assert(_len > 0); return _vec[0]; }
AST* head() { assert(_len > 0); return _vec[0]; }
const AST* last() const { return _vec[_len - 1]; }
@@ -297,7 +314,7 @@ struct ATuple : public AST {
return false;
return true;
}
- bool contains(AST* child) const {
+ bool contains(const AST* child) const {
if (*this == *child) return true;
FOREACHP(const_iterator, p, this)
if (**p == *child || (*p)->contains(child))
@@ -305,7 +322,8 @@ struct ATuple : public AST {
return false;
}
void constrain(TEnv& tenv, Constraints& c) const throw(Error);
- void lift(CEnv& cenv) throw() { FOREACHP(iterator, t, this) (*t)->lift(cenv); }
+ AST* lift(CEnv& cenv, Code& code) throw();
+ AST* depoly(CEnv& cenv, Code& code) throw();
CVal compile(CEnv& cenv) throw() { return NULL; }
@@ -354,63 +372,18 @@ struct AType : public ATuple {
unsigned id;
};
-/// Type substitution
-struct Subst : public list< pair<const AType*,AType*> > {
- Subst(AType* s=0, AType* t=0) { if (s && t) { assert(s != t); push_back(make_pair(s, t)); } }
- static Subst compose(const Subst& delta, const Subst& gamma);
- void add(const AType* from, AType* to) { push_back(make_pair(from, to)); }
- const_iterator find(const AType* t) const {
- for (const_iterator j = begin(); j != end(); ++j)
- if (*j->first == *t)
- return j;
- return end();
- }
- AType* apply(const AType* in) const {
- if (in->kind == AType::EXPR) {
- AType* out = tup<AType>(in->loc, NULL);
- for (ATuple::const_iterator i = in->begin(); i != in->end(); ++i)
- out->push_back(apply((*i)->as<AType*>()));
- return out;
- } else {
- const_iterator i = find(in);
- if (i != end()) {
- AType* out = i->second->as<AType*>();
- if (out->kind == AType::EXPR && !out->concrete())
- out = apply(out->as<AType*>());
- return out;
- } else {
- return new AType(*in);
- }
- }
- }
-};
-
-inline ostream& operator<<(ostream& out, const Subst& s) {
- for (Subst::const_iterator i = s.begin(); i != s.end(); ++i)
- out << i->first << " => " << i->second << endl;
- return out;
-}
-
/// Fn (first-class function with captured lexical bindings)
struct AFn : public ATuple {
+ AFn(const ATuple* exp) : ATuple(*exp) {}
AFn(Cursor c, AST* ast, va_list args) : ATuple(c, ast, args) {}
bool operator==(const AST& rhs) const { return this == &rhs; }
void constrain(TEnv& tenv, Constraints& c) const throw(Error);
AST* cps(TEnv& tenv, AST* cont) const;
- void lift(CEnv& cenv) throw();
+ AST* lift(CEnv& cenv, Code& code) throw();
+ AST* depoly(CEnv& cenv, Code& code) throw();
CVal compile(CEnv& cenv) throw();
const ATuple* prot() const { return (*(begin() + 1))->to<const ATuple*>(); }
ATuple* prot() { return (*(begin() + 1))->to<ATuple*>(); }
- /// System level implementations of this (polymorphic) fn
- struct Impls : public list< pair<AType*, CFunc> > {
- CFunc find(AType* type) const {
- for (const_iterator f = begin(); f != end(); ++f)
- if (*f->first == *type)
- return f->second;
- return NULL;
- }
- };
- Impls impls;
string name;
};
@@ -420,7 +393,8 @@ struct ACall : public ATuple {
ACall(Cursor c, AST* ast, va_list args) : ATuple(c, ast, args) {}
void constrain(TEnv& tenv, Constraints& c) const throw(Error);
AST* cps(TEnv& tenv, AST* cont) const;
- void lift(CEnv& cenv) throw();
+ AST* lift(CEnv& cenv, Code& code) throw();
+ AST* depoly(CEnv& cenv, Code& code) throw();
CVal compile(CEnv& cenv) throw();
};
@@ -442,7 +416,8 @@ struct ADef : public ACall {
AST* body() { return *(begin() + 2); }
void constrain(TEnv& tenv, Constraints& c) const throw(Error);
AST* cps(TEnv& tenv, AST* cont) const;
- void lift(CEnv& cenv) throw();
+ AST* lift(CEnv& cenv, Code& code) throw();
+ AST* depoly(CEnv& cenv, Code& code) throw();
CVal compile(CEnv& cenv) throw();
};
@@ -452,19 +427,26 @@ struct AIf : public ACall {
AIf(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {}
void constrain(TEnv& tenv, Constraints& c) const throw(Error);
AST* cps(TEnv& tenv, AST* cont) const;
+ AST* lift(CEnv& cenv, Code& code) throw();
+ AST* depoly(CEnv& cenv, Code& code) throw();
CVal compile(CEnv& cenv) throw();
};
struct ACons : public ACall {
ACons(const ATuple* exp) : ACall(exp) {}
+ ACons(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {}
void constrain(TEnv& tenv, Constraints& c) const throw(Error);
+ AST* lift(CEnv& cenv, Code& code) throw();
+ AST* depoly(CEnv& cenv, Code& code) throw();
CVal compile(CEnv& cenv) throw();
};
struct ADot : public ACall {
ADot(const ATuple* exp) : ACall(exp) {}
+ ADot(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {}
void constrain(TEnv& tenv, Constraints& c) const throw(Error);
- void lift(CEnv& cenv) throw();
+ AST* lift(CEnv& cenv, Code& code) throw();
+ AST* depoly(CEnv& cenv, Code& code) throw();
CVal compile(CEnv& cenv) throw();
};
@@ -480,6 +462,8 @@ struct APrimitive : public ACall {
}
void constrain(TEnv& tenv, Constraints& c) const throw(Error);
AST* cps(TEnv& tenv, AST* cont) const;
+ AST* lift(CEnv& cenv, Code& code) throw();
+ AST* depoly(CEnv& cenv, Code& code) throw();
CVal compile(CEnv& cenv) throw();
};
@@ -512,7 +496,7 @@ struct PEnv : private map<const string, ASymbol*> {
map<string, MF>::const_iterator i = macros.find(s);
return (i != macros.end()) ? i->second : NULL;
}
- string gensymstr(const char* s="_") { return (format("%s%d") % s % symID++).str(); }
+ string gensymstr(const char* s="_") { return (format("%s_%d") % s % symID++).str(); }
ASymbol* gensym(const char* s="_") { return sym(gensymstr(s)); }
ASymbol* sym(const string& s, Cursor c=Cursor()) {
const const_iterator i = find(s);
@@ -571,17 +555,62 @@ struct PEnv : private map<const string, ASymbol*> {
***************************************************************************/
/// Type constraint
-struct Constraint : public pair<AType*,AType*> {
- Constraint(AType* a, AType* b, Cursor c) : pair<AType*,AType*>(a, b), loc(c) {}
+struct Constraint : public pair<const AType*,const AType*> {
+ Constraint(const AType* a, const AType* b, Cursor c)
+ : pair<const AType*, const AType*>(a, b), loc(c) {}
Cursor loc;
};
+/// Type substitution
+struct Subst : public list<Constraint> {
+ Subst(const AType* s=0, const AType* t=0) {
+ if (s && t) { assert(s != t); push_back(Constraint(s, t, t->loc)); }
+ }
+ static Subst compose(const Subst& delta, const Subst& gamma);
+ void add(const AType* from, const AType* to) { push_back(Constraint(from, to, Cursor())); }
+ const_iterator find(const AType* t) const {
+ for (const_iterator j = begin(); j != end(); ++j)
+ if (*j->first == *t)
+ return j;
+ return end();
+ }
+ const AType* apply(const AType* in) const {
+ if (in->kind == AType::EXPR) {
+ AType* out = tup<AType>(in->loc, NULL);
+ for (ATuple::const_iterator i = in->begin(); i != in->end(); ++i)
+ out->push_back(const_cast<AType*>(apply((*i)->as<AType*>())));
+ return out;
+ } else {
+ const_iterator i = find(in);
+ if (i != end()) {
+ const AType* out = i->second->as<const AType*>();
+ if (out->kind == AType::EXPR && !out->concrete())
+ out = const_cast<AType*>(apply(out->as<const AType*>()));
+ return out;
+ } else {
+ return new AType(*in);
+ }
+ }
+ }
+};
+
+inline ostream& operator<<(ostream& out, const Subst& s) {
+ for (Subst::const_iterator i = s.begin(); i != s.end(); ++i)
+ out << i->first << " => " << i->second << endl;
+ return out;
+}
+
/// Type constraint set
struct Constraints : public list<Constraint> {
Constraints() : list<Constraint>() {}
+ Constraints(const Subst& subst) : list<Constraint>() {
+ FOREACH(Subst::const_iterator, i, subst) {
+ push_back(Constraint(new AType(*i->first), new AType(*i->second), Cursor()));
+ }
+ }
Constraints(const_iterator begin, const_iterator end) : list<Constraint>(begin, end) {}
- void constrain(TEnv& tenv, const AST* o, AType* t);
- Constraints& replace(AType* s, AType* t);
+ void constrain(TEnv& tenv, const AST* o, const AType* t);
+ Constraints replace(const AType* s, const AType* t);
};
inline ostream& operator<<(ostream& out, const Constraints& c) {
@@ -591,7 +620,7 @@ inline ostream& operator<<(ostream& out, const Constraints& c) {
}
/// Type-Time Environment
-struct TEnv : public Env<const ASymbol*, AType*> {
+struct TEnv : public Env<const ASymbol*, const AType*> {
TEnv(PEnv& p)
: penv(p)
, varID(1)
@@ -600,10 +629,10 @@ struct TEnv : public Env<const ASymbol*, AType*> {
{
Object::pool.addRoot(Fn);
}
- AType* fresh(const ASymbol* sym) {
+ const AType* fresh(const ASymbol* sym) {
return def(sym, new AType(sym->loc, varID++));
}
- AType* var(const AST* ast=0) {
+ const AType* var(const AST* ast=0) {
if (!ast)
return new AType(Cursor(), varID++);
@@ -617,12 +646,12 @@ struct TEnv : public Env<const ASymbol*, AType*> {
return (vars[ast] = new AType(ast->loc, varID++));
}
- AType* named(const string& name) {
+ const AType* named(const string& name) {
return *ref(penv.sym(name));
}
- static Subst buildSubst(AType* fnT, const AType& argsT);
+ static Subst buildSubst(const AType* fnT, const AType& argsT);
- typedef map<const AST*, AType*> Vars;
+ typedef map<const AST*, const AType*> Vars;
Vars vars;
PEnv& penv;
@@ -650,20 +679,22 @@ struct Engine {
const ATuple& argsT,
const vector<string> argNames=vector<string>()) = 0;
- virtual void finishFunction(CEnv& cenv, CFunc f, const AType* retT, CVal ret) = 0;
- virtual void eraseFunction(CEnv& cenv, CFunc f) = 0;
- virtual CFunc compileFunction(CEnv& cenv, AFn* fn, const AType& argsT) = 0;
- virtual CVal compileTup(CEnv& cenv, const AType* t, const vector<CVal>& f) = 0;
- virtual CVal compileDot(CEnv& cenv, CVal tup, int32_t index) = 0;
- virtual CVal compileLiteral(CEnv& cenv, AST* lit) = 0;
- virtual CVal compileCall(CEnv& cenv, CFunc f, const vector<CVal>& args) = 0;
- virtual CVal compilePrimitive(CEnv& cenv, APrimitive* prim) = 0;
- virtual CVal compileIf(CEnv& cenv, AIf* aif) = 0;
- virtual CVal compileGlobal(CEnv& cenv, AType* t, const string& sym, CVal val) = 0;
- virtual CVal getGlobal(CEnv& cenv, CVal val) = 0;
- virtual void writeModule(CEnv& cenv, std::ostream& os) = 0;
-
- virtual const string call(CEnv& cenv, CFunc f, AType* retT) = 0;
+ typedef const vector<CVal> ValVec;
+
+ virtual void finishFunction(CEnv& cenv, CFunc f, CVal ret) = 0;
+ virtual void eraseFunction(CEnv& cenv, CFunc f) = 0;
+ virtual CFunc compileFunction(CEnv& cenv, AFn* fn, const AType* type) = 0;
+ virtual CVal compileTup(CEnv& cenv, const AType* t, ValVec& f) = 0;
+ virtual CVal compileDot(CEnv& cenv, CVal tup, int32_t index) = 0;
+ virtual CVal compileLiteral(CEnv& cenv, AST* lit) = 0;
+ virtual CVal compileCall(CEnv& cenv, CFunc f, const AType* fT, ValVec& args) = 0;
+ virtual CVal compilePrimitive(CEnv& cenv, APrimitive* prim) = 0;
+ virtual CVal compileIf(CEnv& cenv, AIf* aif) = 0;
+ virtual CVal compileGlobal(CEnv& cenv, const AType* t, const string& sym, CVal val) = 0;
+ virtual CVal getGlobal(CEnv& cenv, CVal val) = 0;
+ virtual void writeModule(CEnv& cenv, std::ostream& os) = 0;
+
+ virtual const string call(CEnv& cenv, CFunc f, const AType* retT) = 0;
};
Engine* resp_new_llvm_engine();
@@ -683,14 +714,19 @@ struct CEnv {
void push() { code.push(); tenv.push(); vals.push(); }
void pop() { code.pop(); tenv.pop(); vals.pop(); }
void lock(AST* ast) { Object::pool.addRoot(ast); Object::pool.addRoot(type(ast)); }
- AType* type(AST* ast, const Subst& subst = Subst()) const {
+ const AType* type(AST* ast, const Subst& subst = Subst()) const {
ASymbol* sym = ast->to<ASymbol*>();
- if (sym)
- return *tenv.ref(sym);
- assert(tenv.vars[ast]);
- return tsubst.apply(subst.apply(tenv.vars[ast]))->to<AType*>();
+ if (sym) {
+ const AType** rec = tenv.ref(sym);
+ return rec ? *rec : NULL;
+ }
+ const AType* var = tenv.vars[ast];
+ if (var) {
+ return tsubst.apply(subst.apply(var))->to<const AType*>();
+ }
+ return NULL;
}
- void def(const ASymbol* sym, AST* c, AType* t, CVal v) {
+ void def(const ASymbol* sym, AST* c, const AType* t, CVal v) {
code.def(sym, c);
tenv.def(sym, t);
vals.def(sym, v);
@@ -700,6 +736,14 @@ struct CEnv {
AST** rec = code.ref(sym);
return rec ? *rec : ast;
}
+ void setType(AST* ast, const AType* type) {
+ const AType* tvar = tenv.var();
+ tenv.vars.insert(make_pair(ast, tvar));
+ tsubst.add(tvar, type);
+ }
+ void setTypeSameAs(AST* ast, AST* typedAst) {
+ tenv.vars.insert(make_pair(ast, tenv.vars[typedAst]));
+ }
ostream& out;
ostream& err;
@@ -710,8 +754,39 @@ struct CEnv {
Env<const ASymbol*, AST*> code;
+ typedef map<AFn*, CFunc> Impls;
+ Impls impls;
+
+ CFunc findImpl(AFn* fn, const AType* type) {
+ Impls::iterator i = impls.find(fn);
+ return (i != impls.end()) ? i->second : NULL;
+ }
+
+ void addImpl(AFn* fn, CFunc impl) {
+ impls.insert(make_pair(fn, impl));
+ }
+
map<string,string> args;
+ CFunc currentFn; ///< Currently compiling function
+
+ struct FreeVars : public std::vector<ASymbol*> {
+ FreeVars(AFn* f, const std::string& n) : fn(f), implName(n) {}
+ AFn* const fn;
+ const std::string implName;
+ int32_t index(ASymbol* sym) {
+ const_iterator i = find(begin(), end(), sym);
+ if (i != end()) {
+ return i - begin() + 1;
+ } else {
+ push_back(sym);
+ return size();
+ }
+ }
+ };
+ typedef std::stack<FreeVars> LiftStack;
+ LiftStack liftStack;
+
private:
Engine* _engine;
};
generated by cgit v1.2.1 (git 2.18.0) at 2024-06-27 20:42:09 +0000