aboutsummaryrefslogtreecommitdiffstats
path: root/tuplr.hpp
diff options
context:
space:
mode:
Diffstat (limited to 'tuplr.hpp')
-rw-r--r--tuplr.hpp96
1 files changed, 57 insertions, 39 deletions
diff --git a/tuplr.hpp b/tuplr.hpp
index 4d714d4..72c01f3 100644
--- a/tuplr.hpp
+++ b/tuplr.hpp
@@ -84,8 +84,8 @@ template<typename K, typename V>
struct Env : public list< vector< pair<K,V> > > {
typedef vector< pair<K,V> > Frame;
Env() : list<Frame>(1) {}
- void push(Frame f=Frame()) { list<Frame>::push_front(f); }
- void pop() { assert(!this->empty()); list<Frame>::pop_front(); }
+ virtual void push(Frame f=Frame()) { list<Frame>::push_front(f); }
+ virtual void pop() { assert(!this->empty()); list<Frame>::pop_front(); }
const V& def(const K& k, const V& v) {
for (typename Frame::iterator b = this->begin()->begin(); b != this->begin()->end(); ++b)
if (b->first == k)
@@ -112,6 +112,9 @@ struct Env : public list< vector< pair<K,V> > > {
assert(addr);
typename Env::iterator f = this->begin();
for (unsigned u = 1; u < addr.up; ++u, ++f) { assert(f != this->end()); }
+ if (!(f->size() > addr.over - 1)) {
+ std::cerr << "WTF: " << addr << " : " << this->size() << "." << f->size() << endl;
+ }
assert(f->size() > addr.over - 1);
return (*f)[addr.over - 1].second;
}
@@ -155,7 +158,7 @@ struct AST {
virtual ~AST() {}
virtual bool operator==(const AST& o) const = 0;
virtual bool contains(const AST* child) const { return false; }
- virtual void constrain(TEnv& tenv, Constraints& c) {}
+ virtual void constrain(TEnv& tenv, Constraints& c) const {}
virtual void lift(CEnv& cenv) {}
string str() const { ostringstream ss; ss << this; return ss.str(); }
Cursor loc;
@@ -172,7 +175,7 @@ struct ALiteral : public AST {
const ALiteral<VT>* r = dynamic_cast<const ALiteral<VT>*>(&rhs);
return (r && (val == r->val));
}
- void constrain(TEnv& tenv, Constraints& c);
+ void constrain(TEnv& tenv, Constraints& c) const;
CValue compile(CEnv& cenv);
const VT val;
};
@@ -180,10 +183,9 @@ struct ALiteral : public AST {
/// Symbol, e.g. "a"
struct ASymbol : public AST {
bool operator==(const AST& rhs) const { return this == &rhs; }
- void lookup(TEnv& tenv);
- void constrain(TEnv& tenv, Constraints& c);
+ void constrain(TEnv& tenv, Constraints& c) const;
CValue compile(CEnv& cenv);
- LAddr addr;
+ mutable LAddr addr;
private:
friend class PEnv;
ASymbol(const string& s, Cursor c) : AST(c), cppstr(s) {}
@@ -225,7 +227,7 @@ struct ATuple : public AST, public vector<AST*> {
return true;
return false;
}
- void constrain(TEnv& tenv, Constraints& c);
+ void constrain(TEnv& tenv, Constraints& c) const;
CValue compile(CEnv& cenv) { throw Error("tuple compiled"); }
};
@@ -287,16 +289,15 @@ struct Funcs : public list< pair<AType*, CFunction> > {
/// Closure (first-class function with captured lexical bindings)
struct AClosure : public ATuple {
AClosure(Cursor c, ASymbol* fn, ATuple* p, const string& n="")
- : ATuple(c, fn, p, NULL), type(0), subst(0), name(n) {}
+ : ATuple(c, fn, p, NULL), subst(0), name(n) {}
bool operator==(const AST& rhs) const { return this == &rhs; }
- void constrain(TEnv& tenv, Constraints& c);
+ void constrain(TEnv& tenv, Constraints& c) const;
void lift(CEnv& cenv);
- void liftPoly(CEnv& cenv, const vector<AType*>& argsT);
+ void liftCall(CEnv& cenv, const vector<AType*>& argsT);
CValue compile(CEnv& cenv);
ATuple* prot() const { return dynamic_cast<ATuple*>(at(1)); }
- AType* type;
- Funcs funcs;
- Subst* subst;
+ Funcs funcs;
+ mutable Subst* subst;
private:
string name;
};
@@ -304,7 +305,7 @@ private:
/// Function call/application, e.g. "(func arg1 arg2)"
struct ACall : public ATuple {
ACall(const SExp& e, const ATuple& t) : ATuple(t, e.loc) {}
- void constrain(TEnv& tenv, Constraints& c);
+ void constrain(TEnv& tenv, Constraints& c) const;
void lift(CEnv& cenv);
CValue compile(CEnv& cenv);
};
@@ -313,7 +314,7 @@ struct ACall : public ATuple {
struct ADefinition : public ACall {
ADefinition(const SExp& e, const ATuple& t) : ACall(e, t) {}
ASymbol* sym() const { return dynamic_cast<ASymbol*>(at(1)); }
- void constrain(TEnv& tenv, Constraints& c);
+ void constrain(TEnv& tenv, Constraints& c) const;
void lift(CEnv& cenv);
CValue compile(CEnv& cenv);
};
@@ -321,14 +322,14 @@ struct ADefinition : public ACall {
/// Conditional special form, e.g. "(if cond thenexp elseexp)"
struct AIf : public ACall {
AIf(const SExp& e, const ATuple& t) : ACall(e, t) {}
- void constrain(TEnv& tenv, Constraints& c);
+ void constrain(TEnv& tenv, Constraints& c) const;
CValue compile(CEnv& cenv);
};
/// Primitive (builtin arithmetic function), e.g. "(+ 2 3)"
struct APrimitive : public ACall {
APrimitive(const SExp& e, const ATuple& t) : ACall(e, t) {}
- void constrain(TEnv& tenv, Constraints& c);
+ void constrain(TEnv& tenv, Constraints& c) const;
CValue compile(CEnv& cenv);
};
@@ -336,7 +337,7 @@ struct APrimitive : public ACall {
struct AConsCall : public ACall {
AConsCall(const SExp& e, const ATuple& t) : ACall(e, t) {}
AType* functionType(CEnv& cenv);
- void constrain(TEnv& tenv, Constraints& c);
+ void constrain(TEnv& tenv, Constraints& c) const;
void lift(CEnv& cenv);
CValue compile(CEnv& cenv);
static Funcs funcs;
@@ -345,14 +346,14 @@ struct AConsCall : public ACall {
/// Car special form, e.g. "(car p)"
struct ACarCall : public ACall {
ACarCall(const SExp& e, const ATuple& t) : ACall(e, t) {}
- void constrain(TEnv& tenv, Constraints& c);
+ void constrain(TEnv& tenv, Constraints& c) const;
CValue compile(CEnv& cenv);
};
/// Cdr special form, e.g. "(cdr p)"
struct ACdrCall : public ACall {
ACdrCall(const SExp& e, const ATuple& t) : ACall(e, t) {}
- void constrain(TEnv& tenv, Constraints& c);
+ void constrain(TEnv& tenv, Constraints& c) const;
CValue compile(CEnv& cenv);
};
@@ -432,7 +433,7 @@ inline ostream& operator<<(ostream& out, const Constraints& c) {
}
struct Subst : public map<const AType*,AType*> {
- Subst(AType* s=0, AType* t=0) { if (s && t) insert(make_pair(s, t)); }
+ Subst(AType* s=0, AType* t=0) { if (s && t) { assert(s != t); insert(make_pair(s, t)); } }
static Subst compose(const Subst& delta, const Subst& gamma);
AST* apply(AST* ast) const {
AType* in = dynamic_cast<AType*>(ast);
@@ -443,9 +444,13 @@ struct Subst : public map<const AType*,AType*> {
out->push_back(apply(in->at(i)));
return out;
} else {
- const_iterator i;
- while ((i = find(in)) != end())
+ Subst copy(*this);
+ iterator i;
+ while ((i = copy.find(in)) != copy.end()) {
+ cerr << "IN: " << in << endl;
in = i->second;
+ copy.erase(i);
+ }
return in;
}
}
@@ -460,11 +465,15 @@ struct TEnv : public Env<const AST*,AType*> {
return def(sym, new AType(varID++, LAddr(), sym->loc));
}
AType* var(const AST* ast=0) {
+ /*GenericTypes::iterator g = genericTypes.find(dynamic_casdt<AClosure*>(ast));
+ if (g != vars.end())
+ return g->second;*/
+
const ASymbol* sym = dynamic_cast<const ASymbol*>(ast);
if (sym)
return deref(lookup(sym));
- map<const AST*, AType*>::iterator v = vars.find(ast);
+ Vars::iterator v = vars.find(ast);
if (v != vars.end())
return v->second;
@@ -479,10 +488,13 @@ struct TEnv : public Env<const AST*,AType*> {
}
static Subst unify(const Constraints& c);
- map<const AST*, AType*> vars;
- PEnv& penv;
- Constraints constraints;
- unsigned varID;
+ typedef map<const AST*, AType*> Vars;
+ typedef map<const AClosure*, AType*> GenericTypes;
+ Vars vars;
+ GenericTypes genericTypes;
+ PEnv& penv;
+ Constraints constraints;
+ unsigned varID;
};
@@ -512,17 +524,23 @@ struct CEnv {
return tenv.deref(sym->addr);
return dynamic_cast<AType*>(tsubst.apply(subst.apply(tenv.vars[ast])));
}
+ void def(ASymbol* sym, AST* c, AType* t, CValue v) {
+ code.def(sym, c);
+ tenv.def(sym, t);
+ vals.def(sym, v);
+ }
- ostream& out;
- ostream& err;
- PEnv& penv;
- TEnv& tenv;
- Code code;
- Vals vals;
-
- unsigned symID;
- CFunction alloc;
- Subst tsubst;
+ ostream& out;
+ ostream& err;
+ PEnv& penv;
+ TEnv& tenv;
+ Code code;
+ Vals vals;
+
+
+ unsigned symID;
+ CFunction alloc;
+ Subst tsubst;
private:
struct PImpl; ///< Private Implementation
generated by cgit v1.2.1 (git 2.18.0) at 2025-03-03 18:02:30 +0000