aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorDavid Robillard <d@drobilla.net>2010-12-02 19:36:27 +0000
committerDavid Robillard <d@drobilla.net>2010-12-02 19:36:27 +0000
commit58daa5a8568ee0cc780bad8575e61447be64c77d (patch)
treec01db2cc46346282926a73c820eed113805529ac /src
parent1b61928f542f1c54ac67791f382b20b39927eac5 (diff)
downloadresp-58daa5a8568ee0cc780bad8575e61447be64c77d.tar.gz
resp-58daa5a8568ee0cc780bad8575e61447be64c77d.tar.bz2
resp-58daa5a8568ee0cc780bad8575e61447be64c77d.zip
Remove ACall subclasses.
git-svn-id: http://svn.drobilla.net/resp/resp@282 ad02d1e2-f140-0410-9f75-f8b11f17cedd
Diffstat (limited to 'src')
-rw-r--r--src/c.cpp10
-rw-r--r--src/compile.cpp12
-rw-r--r--src/constrain.cpp112
-rw-r--r--src/cps.cpp2
-rw-r--r--src/lift.cpp35
-rw-r--r--src/llvm.cpp12
-rw-r--r--src/parse.cpp48
-rw-r--r--src/repl.cpp6
-rw-r--r--src/resp.cpp32
-rw-r--r--src/resp.hpp59
10 files changed, 156 insertions, 172 deletions
diff --git a/src/c.cpp b/src/c.cpp
index 7cd72da..c099452 100644
--- a/src/c.cpp
+++ b/src/c.cpp
@@ -158,7 +158,7 @@ struct CEngine : public Engine {
CVal compileDot(CEnv& cenv, CVal tup, int32_t index);
CVal compileLiteral(CEnv& cenv, const AST* lit);
CVal compileString(CEnv& cenv, const char* str);
- CVal compilePrimitive(CEnv& cenv, const APrimitive* prim);
+ CVal compilePrimitive(CEnv& cenv, const ACall* prim);
CVal compileIf(CEnv& cenv, const ACall* aif);
CVal compileMatch(CEnv& cenv, const ACall* match);
CVal compileGlobal(CEnv& cenv, const AType* type, const string& sym, CVal val);
@@ -235,8 +235,8 @@ CEngine::compileIf(CEnv& cenv, const ACall* aif)
Value* varname = new string(cenv.penv.gensymstr("if"));
out += (format("%s %s;\n") % *llType(cenv.type(aif)) % *varname).str();
size_t idx = 1;
- for (AIf::const_iterator i = aif->iter_at(1); ; ++i, idx += 2) {
- AIf::const_iterator next = i;
+ for (ATuple::const_iterator i = aif->iter_at(1); ; ++i, idx += 2) {
+ ATuple::const_iterator next = i;
if (++next == aif->end())
break;
@@ -268,9 +268,9 @@ CEngine::compileMatch(CEnv& cenv, const ACall* match)
}
CVal
-CEngine::compilePrimitive(CEnv& cenv, const APrimitive* prim)
+CEngine::compilePrimitive(CEnv& cenv, const ACall* prim)
{
- APrimitive::const_iterator i = prim->begin();
+ ATuple::const_iterator i = prim->begin();
++i;
Value* a = llVal(resp_compile(cenv, *i++));
diff --git a/src/compile.cpp b/src/compile.cpp
index 9f9168a..cf777f8 100644
--- a/src/compile.cpp
+++ b/src/compile.cpp
@@ -118,7 +118,7 @@ compile_cons(CEnv& cenv, const ACall* cons) throw()
AType* type = new AType(const_cast<ASymbol*>(cons->head()->as<const ASymbol*>()), NULL, Cursor());
TList tlist(type);
vector<CVal> fields;
- for (ACons::const_iterator i = cons->iter_at(1); i != cons->end(); ++i) {
+ for (ATuple::const_iterator i = cons->iter_at(1); i != cons->end(); ++i) {
tlist.push_back(const_cast<AType*>(cenv.type(*i)));
fields.push_back(resp_compile(cenv, *i));
}
@@ -159,10 +159,6 @@ resp_compile(CEnv& cenv, const AST* ast) throw()
if (fn)
return compile_fn(cenv, fn);
- const APrimitive* prim = ast->to<const APrimitive*>();
- if (prim)
- return cenv.engine()->compilePrimitive(cenv, prim);
-
const AType* type = ast->to<const AType*>();
if (type)
return compile_type(cenv, type);
@@ -171,7 +167,9 @@ resp_compile(CEnv& cenv, const AST* ast) throw()
if (call) {
const ASymbol* const sym = call->head()->to<const ASymbol*>();
const std::string form = sym ? sym->cppstr : "";
- if (form == "def")
+ if (is_primitive(cenv.penv, call))
+ return cenv.engine()->compilePrimitive(cenv, ast->as<const ACall*>());
+ else if (form == "def")
return compile_def(cenv, call);
else if (form == "if")
return cenv.engine()->compileIf(cenv, call);
@@ -189,7 +187,7 @@ resp_compile(CEnv& cenv, const AST* ast) throw()
return compile_call(cenv, call);
}
- cenv.err << "Attempt to compile unknown type" << endl;
+ cenv.err << "Attempt to compile unknown type: " << ast << endl;
assert(false);
return NULL;
}
diff --git a/src/constrain.cpp b/src/constrain.cpp
index 4e507c9..cb7b700 100644
--- a/src/constrain.cpp
+++ b/src/constrain.cpp
@@ -90,11 +90,11 @@ AFn::constrain(TEnv& tenv, Constraints& c) const throw(Error)
// Add internal definitions to environment frame
for (++i; i != end(); ++i) {
- const AST* exp = *i;
- const ADef* def = exp->to<const ADef*>();
- if (def) {
- const ASymbol* sym = def->list_ref(1)->as<const ASymbol*>();
- THROW_IF(defs.count(sym) != 0, def->loc,
+ const AST* exp = *i;
+ const ACall* call = exp->to<const ACall*>();
+ if (call && is_form(call, "def")) {
+ const ASymbol* sym = call->list_ref(1)->as<const ASymbol*>();
+ THROW_IF(defs.count(sym) != 0, call->loc,
(format("`%1%' defined twice") % sym->str()).str());
defs.insert(sym);
frame.push_back(make_pair(sym, (AType*)NULL));
@@ -296,38 +296,10 @@ constrain_call(TEnv& tenv, Constraints& c, const ACall* call) throw(Error)
c.constrain(tenv, call, retT);
}
-void
-ACall::constrain(TEnv& tenv, Constraints& c) const throw(Error)
-{
- const ASymbol* const sym = head()->to<const ASymbol*>();
- if (!sym) {
- constrain_call(tenv, c, this);
- return;
- }
-
- const std::string form = sym->cppstr;
- if (form == "def")
- constrain_def(tenv, c, this);
- else if (form == "def-type")
- constrain_def_type(tenv, c, this);
- else if (form == "match")
- constrain_match(tenv, c, this);
- else if (form == "if")
- constrain_if(tenv, c, this);
- else if (form == "cons" || isupper(form[0]))
- constrain_cons(tenv, c, this);
- else if (form == ".")
- constrain_dot(tenv, c, this);
- else if (form == "quote")
- constrain_quote(tenv, c, this);
- else
- constrain_call(tenv, c, this);
-}
-
-void
-APrimitive::constrain(TEnv& tenv, Constraints& c) const throw(Error)
+static void
+constrain_primitive(TEnv& tenv, Constraints& c, const ACall* call) throw(Error)
{
- const string n = head()->to<const ASymbol*>()->str();
+ const string n = call->head()->to<const ASymbol*>()->str();
enum { ARITHMETIC, BINARY, LOGICAL, COMPARISON } type;
if (n == "+" || n == "-" || n == "*" || n == "/")
type = ARITHMETIC;
@@ -338,44 +310,74 @@ APrimitive::constrain(TEnv& tenv, Constraints& c) const throw(Error)
else if (n == "=" || n == "!=" || n == ">" || n == ">=" || n == "<" || n == "<=")
type = COMPARISON;
else
- throw Error(loc, (format("unknown primitive `%1%'") % n).str());
+ throw Error(call->loc, (format("unknown primitive `%1%'") % n).str());
- ATuple::const_iterator i = begin();
+ ATuple::const_iterator i = call->begin();
- for (++i; i != end(); ++i)
+ for (++i; i != call->end(); ++i)
(*i)->constrain(tenv, c);
- i = begin();
+ i = call->begin();
const AType* var = NULL;
switch (type) {
case ARITHMETIC:
- if (list_len() < 3)
- throw Error(loc, (format("`%1%' requires at least 2 arguments") % n).str());
- for (++i; i != end(); ++i)
- c.constrain(tenv, *i, tenv.var(this));
+ if (call->list_len() < 3)
+ throw Error(call->loc, (format("`%1%' requires at least 2 arguments") % n).str());
+ for (++i; i != call->end(); ++i)
+ c.constrain(tenv, *i, tenv.var(call));
break;
case BINARY:
- if (list_len() != 3)
- throw Error(loc, (format("`%1%' requires exactly 2 arguments") % n).str());
- c.constrain(tenv, *++i, tenv.var(this));
- c.constrain(tenv, *++i, tenv.var(this));
+ if (call->list_len() != 3)
+ throw Error(call->loc, (format("`%1%' requires exactly 2 arguments") % n).str());
+ c.constrain(tenv, *++i, tenv.var(call));
+ c.constrain(tenv, *++i, tenv.var(call));
break;
case LOGICAL:
- if (list_len() != 3)
- throw Error(loc, (format("`%1%' requires exactly 2 arguments") % n).str());
- c.constrain(tenv, this, tenv.named("Bool"));
+ if (call->list_len() != 3)
+ throw Error(call->loc, (format("`%1%' requires exactly 2 arguments") % n).str());
+ c.constrain(tenv, call, tenv.named("Bool"));
c.constrain(tenv, *++i, tenv.named("Bool"));
c.constrain(tenv, *++i, tenv.named("Bool"));
break;
case COMPARISON:
- if (list_len() != 3)
- throw Error(loc, (format("`%1%' requires exactly 2 arguments") % n).str());
+ if (call->list_len() != 3)
+ throw Error(call->loc, (format("`%1%' requires exactly 2 arguments") % n).str());
var = tenv.var(*++i);
- c.constrain(tenv, this, tenv.named("Bool"));
+ c.constrain(tenv, call, tenv.named("Bool"));
c.constrain(tenv, *++i, var);
break;
default:
- throw Error(loc, (format("unknown primitive `%1%'") % n).str());
+ throw Error(call->loc, (format("unknown primitive `%1%'") % n).str());
+ }
+}
+
+void
+ACall::constrain(TEnv& tenv, Constraints& c) const throw(Error)
+{
+ const ASymbol* const sym = head()->to<const ASymbol*>();
+ if (!sym) {
+ constrain_call(tenv, c, this);
+ return;
}
+
+ const std::string form = sym->cppstr;
+ if (is_primitive(tenv.penv, this))
+ constrain_primitive(tenv, c, this);
+ else if (form == "def")
+ constrain_def(tenv, c, this);
+ else if (form == "def-type")
+ constrain_def_type(tenv, c, this);
+ else if (form == "match")
+ constrain_match(tenv, c, this);
+ else if (form == "if")
+ constrain_if(tenv, c, this);
+ else if (form == "cons" || isupper(form[0]))
+ constrain_cons(tenv, c, this);
+ else if (form == ".")
+ constrain_dot(tenv, c, this);
+ else if (form == "quote")
+ constrain_quote(tenv, c, this);
+ else
+ constrain_call(tenv, c, this);
}
diff --git a/src/cps.cpp b/src/cps.cpp
index aed7c33..6f14d97 100644
--- a/src/cps.cpp
+++ b/src/cps.cpp
@@ -104,7 +104,7 @@ ACall::cps(TEnv& tenv, AST* cont) const
ACall* ret = tup<ACall>(loc, 0);
FOREACHP(const_iterator, i, this)
ret->push_back((*i));
- if (!to<const APrimitive*>())
+ if (!is_primitive(this))
ret->push_back(cont);
return ret;
}
diff --git a/src/lift.cpp b/src/lift.cpp
index aea8b0d..c24832f 100644
--- a/src/lift.cpp
+++ b/src/lift.cpp
@@ -40,7 +40,7 @@ lift_symbol(CEnv& cenv, Code& code, ASymbol* sym) throw()
const int32_t index = cenv.liftStack.top().index(sym);
// Replace symbol with code to access free variable from closure
- return tup<ADot>(sym->loc, cenv.penv.sym("."),
+ return tup<ACall>(sym->loc, cenv.penv.sym("."),
cenv.penv.sym("_me"),
new ALiteral<int32_t>(index, Cursor()),
NULL);
@@ -97,13 +97,13 @@ lift_fn(CEnv& cenv, Code& code, AFn* fn) throw()
// Create definition for implementation fn
ASymbol* implName = cenv.penv.sym(impl->name);
- ADef* def = tup<ADef>(fn->loc, cenv.penv.sym("def"), implName, impl, NULL);
+ ACall* def = tup<ACall>(fn->loc, cenv.penv.sym("def"), implName, impl, NULL);
code.push_back(def);
AType* implT = new AType(*type); // Type of the implementation function
TList tupT(fn->loc, cenv.tenv.Tup, cenv.tenv.var(), NULL);
TList consT(fn->loc, cenv.tenv.Tup, implT, NULL);
- List<ACons, AST> cons(fn->loc, cenv.penv.sym("Closure"), implName, NULL);
+ List<ACall, AST> cons(fn->loc, cenv.penv.sym("Closure"), implName, NULL);
implT->list_ref(1) = implProtT;
@@ -155,14 +155,14 @@ lift_call(CEnv& cenv, Code& code, ACall* call) throw()
* closure as the first parameter:
* (_impl (Fn _impl ...) ...)
*/
- ACons* closure = copy.head->list_ref(0)->as<ACons*>();
+ ATuple* closure = copy.head->list_ref(0)->as<ATuple*>();
ASymbol* implSym = closure->list_ref(1)->as<ASymbol*>();
const AType* implT = cenv.type(cenv.resolve(implSym));
copy.push_front(implSym);
copyT = implT->list_ref(2)->as<const AType*>();
} else {
// Call to a closure, prepend code to access implementation function
- ADot* getFn = tup<ADot>(call->loc, cenv.penv.sym("."),
+ ACall* getFn = tup<ACall>(call->loc, cenv.penv.sym("."),
copy.head->head(),
new ALiteral<int32_t>(0, Cursor()), NULL);
const AType* calleeT = cenv.type(copy.head->head());
@@ -189,10 +189,10 @@ lift_def(CEnv& cenv, Code& code, ACall* def) throw()
c->name = sym->str();
assert(def->list_ref(1)->to<const ASymbol*>());
- List<ADef, AST> copy;
+ List<ACall, AST> copy;
copy.push_back(def->head());
copy.push_back(resp_lift(cenv, code, def->list_ref(1)));
- for (ADef::iterator t = def->iter_at(2); t != def->end(); ++t)
+ for (ATuple::iterator t = def->iter_at(2); t != def->end(); ++t)
copy.push_back(resp_lift(cenv, code, *t));
cenv.setTypeSameAs(copy, def);
@@ -207,11 +207,10 @@ lift_def(CEnv& cenv, Code& code, ACall* def) throw()
return copy;
}
-template<typename T>
static AST*
lift_builtin_call(CEnv& cenv, Code& code, ACall* call) throw()
{
- List<T, AST> copy;
+ List<ACall, AST> copy;
copy.push_back(call->head());
// Lift all arguments
@@ -233,29 +232,27 @@ resp_lift(CEnv& cenv, Code& code, AST* ast) throw()
if (fn)
return lift_fn(cenv, code, fn);
- APrimitive* const prim = ast->to<APrimitive*>();
- if (prim)
- return lift_builtin_call<APrimitive>(cenv, code, prim);
-
ACall* const call = ast->to<ACall*>();
if (call) {
const ASymbol* const sym = call->head()->to<const ASymbol*>();
const std::string form = sym ? sym->cppstr : "";
- if (form == "def")
+ if (is_primitive(cenv.penv, call))
+ return lift_builtin_call(cenv, code, call);
+ else if (form == "def")
return lift_def(cenv, code, call);
else if (form == "if")
- return lift_builtin_call<AIf>(cenv, code, call);
+ return lift_builtin_call(cenv, code, call);
else if (form == "cons" || isupper(form[0]))
- return lift_builtin_call<ACons>(cenv, code, call);
+ return lift_builtin_call(cenv, code, call);
else if (form == ".")
- return lift_builtin_call<ADot>(cenv, code, call);
+ return lift_builtin_call(cenv, code, call);
else if (form == "quote")
- return lift_builtin_call<AQuote>(cenv, code, call);
+ return lift_builtin_call(cenv, code, call);
else if (form == "match" || form == "def-type")
return call; // FIXME
else
return lift_call(cenv, code, call);
}
-
+
return ast;
}
diff --git a/src/llvm.cpp b/src/llvm.cpp
index 29c09ee..4019f9c 100644
--- a/src/llvm.cpp
+++ b/src/llvm.cpp
@@ -196,7 +196,7 @@ struct LLVMEngine : public Engine {
CVal compileDot(CEnv& cenv, CVal tup, int32_t index);
CVal compileLiteral(CEnv& cenv, const AST* lit);
CVal compileString(CEnv& cenv, const char* str);
- CVal compilePrimitive(CEnv& cenv, const APrimitive* prim);
+ CVal compilePrimitive(CEnv& cenv, const ACall* prim);
CVal compileIf(CEnv& cenv, const ACall* aif);
CVal compileMatch(CEnv& cenv, const ACall* match);
CVal compileGlobal(CEnv& cenv, const AType* type, const string& sym, CVal val);
@@ -360,8 +360,8 @@ LLVMEngine::compileIf(CEnv& cenv, const ACall* aif)
BasicBlock* nextBB = NULL;
Branches branches;
size_t idx = 1;
- for (AIf::const_iterator i = aif->iter_at(1); ; ++i, idx += 2) {
- AIf::const_iterator next = i;
+ for (ATuple::const_iterator i = aif->iter_at(1); ; ++i, idx += 2) {
+ ATuple::const_iterator next = i;
if (++next == aif->end())
break;
@@ -416,7 +416,7 @@ LLVMEngine::compileMatch(CEnv& cenv, const ACall* match)
Branches branches;
size_t idx = 1;
- for (AMatch::const_iterator i = match->iter_at(2); i != match->end(); ++idx) {
+ for (ATuple::const_iterator i = match->iter_at(2); i != match->end(); ++idx) {
const AST* pat = *i++;
const AST* body = *i++;
const ASymbol* sym = pat->to<const ATuple*>()->head()->as<const ASymbol*>();
@@ -457,9 +457,9 @@ LLVMEngine::compileMatch(CEnv& cenv, const ACall* match)
}
CVal
-LLVMEngine::compilePrimitive(CEnv& cenv, const APrimitive* prim)
+LLVMEngine::compilePrimitive(CEnv& cenv, const ACall* prim)
{
- APrimitive::const_iterator i = prim->begin();
+ ATuple::const_iterator i = prim->begin();
LLVMEngine* engine = reinterpret_cast<LLVMEngine*>(cenv.engine());
bool isFloat = cenv.type(*++i)->str() == "Float";
diff --git a/src/parse.cpp b/src/parse.cpp
index 3aa5b74..83a4934 100644
--- a/src/parse.cpp
+++ b/src/parse.cpp
@@ -58,7 +58,7 @@ PEnv::parse(const AST* exp)
return h->func(*this, exp, h->arg); // Parse special form
if (isupper(form->c_str()[0])) // Call constructor (any uppercase symbol)
- return parseTuple<ACons>(*this, tup);
+ return parseTuple<ACall>(*this, tup);
}
return parseTuple<ACall>(*this, tup); // Parse regular call
@@ -129,11 +129,10 @@ macDef(PEnv& penv, const AST* exp)
* Parser Functions *
***************************************************************************/
-template<typename C>
inline AST*
parseCall(PEnv& penv, const AST* exp, void* arg)
{
- return parseTuple<C>(penv, exp->to<const ATuple*>());
+ return parseTuple<ACall>(penv, exp->to<const ATuple*>());
}
template<typename T>
@@ -165,7 +164,7 @@ parseQuote(PEnv& penv, const AST* exp, void* arg)
THROW_IF(texp->list_len() != 2, exp->loc, "`quote' requires exactly 1 argument");
const ALexeme* quotee = texp->list_ref(1)->to<const ALexeme*>();
THROW_IF(!quotee, exp->loc, "`quote' argument is not a lexeme");
- AQuote* ret = tup<AQuote>(texp->loc, penv.sym("quote"), quotee, NULL);
+ ACall* ret = tup<ACall>(texp->loc, penv.sym("quote"), quotee, NULL);
return ret;
}
@@ -174,7 +173,6 @@ parseQuote(PEnv& penv, const AST* exp, void* arg)
* Language Definition *
***************************************************************************/
-/// Set up language
void
initLang(PEnv& penv, TEnv& tenv)
{
@@ -199,25 +197,27 @@ initLang(PEnv& penv, TEnv& tenv)
// Special forms
penv.reg(true, "fn", PEnv::Handler(parseFn));
penv.reg(true, "quote", PEnv::Handler(parseQuote));
- penv.reg(true, "if", PEnv::Handler(parseCall<AIf>));
- penv.reg(true, ".", PEnv::Handler(parseCall<ADot>));
- penv.reg(true, "def", PEnv::Handler(parseCall<ADef>));
- penv.reg(true, "def-type", PEnv::Handler(parseCall<ADefType>));
- penv.reg(true, "match", PEnv::Handler(parseCall<AMatch>));
+ penv.reg(true, "if", PEnv::Handler(parseCall));
+ penv.reg(true, ".", PEnv::Handler(parseCall));
+ penv.reg(true, "def", PEnv::Handler(parseCall));
+ penv.reg(true, "def-type", PEnv::Handler(parseCall));
+ penv.reg(true, "match", PEnv::Handler(parseCall));
// Numeric primitives
- penv.reg(true, "+", PEnv::Handler(parseCall<APrimitive>));
- penv.reg(true, "-", PEnv::Handler(parseCall<APrimitive>));
- penv.reg(true, "*", PEnv::Handler(parseCall<APrimitive>));
- penv.reg(true, "/", PEnv::Handler(parseCall<APrimitive>));
- penv.reg(true, "%", PEnv::Handler(parseCall<APrimitive>));
- penv.reg(true, "and", PEnv::Handler(parseCall<APrimitive>));
- penv.reg(true, "or", PEnv::Handler(parseCall<APrimitive>));
- penv.reg(true, "xor", PEnv::Handler(parseCall<APrimitive>));
- penv.reg(true, "=", PEnv::Handler(parseCall<APrimitive>));
- penv.reg(true, "!=", PEnv::Handler(parseCall<APrimitive>));
- penv.reg(true, ">", PEnv::Handler(parseCall<APrimitive>));
- penv.reg(true, ">=", PEnv::Handler(parseCall<APrimitive>));
- penv.reg(true, "<", PEnv::Handler(parseCall<APrimitive>));
- penv.reg(true, "<=", PEnv::Handler(parseCall<APrimitive>));
+ penv.primitives.insert("+");
+ penv.primitives.insert("-");
+ penv.primitives.insert("*");
+ penv.primitives.insert("/");
+ penv.primitives.insert("%");
+ penv.primitives.insert("and");
+ penv.primitives.insert("or");
+ penv.primitives.insert("xor");
+ penv.primitives.insert("=");
+ penv.primitives.insert("!=");
+ penv.primitives.insert(">");
+ penv.primitives.insert(">=");
+ penv.primitives.insert("<");
+ penv.primitives.insert("<=");
+ FOREACH (PEnv::Primitives::const_iterator, i, penv.primitives)
+ penv.reg(true, *i, PEnv::Handler(parseCall));
}
diff --git a/src/repl.cpp b/src/repl.cpp
index 923c26d..15e263f 100644
--- a/src/repl.cpp
+++ b/src/repl.cpp
@@ -114,9 +114,9 @@ eval(CEnv& cenv, Cursor& cursor, istream& is, bool execute)
// Compile top-level (lifted) functions
Code exprs;
for (Code::const_iterator i = lifted.begin(); i != lifted.end(); ++i) {
- const ADef* def = (*i)->to<const ADef*>();
- if (def && def->list_ref(2)->to<const AFn*>()) {
- val = resp_compile(cenv, def);
+ const ACall* call = (*i)->to<const ACall*>();
+ if (call && is_form(call, "def") && is_form(call->list_ref(2), "fn")) {
+ val = resp_compile(cenv, call);
} else {
assert(*i);
ATuple* tup = (*i)->to<ATuple*>();
diff --git a/src/resp.cpp b/src/resp.cpp
index 96df3b7..c1684e2 100644
--- a/src/resp.cpp
+++ b/src/resp.cpp
@@ -28,6 +28,38 @@ using namespace std;
GC Object::pool(8 * 1024 * 1024);
+bool
+is_form(const AST* ast, const std::string& form)
+{
+ const AFn* fn = ast->to<const AFn*>();
+ if (fn)
+ return form == "fn";
+
+ const ACall* call = ast->to<const ACall*>();
+ if (!call)
+ return false;
+
+ const ASymbol* const sym = call->head()->to<const ASymbol*>();
+ if (!sym)
+ return false;
+
+ return sym->cppstr == form;
+}
+
+bool
+is_primitive(const PEnv& penv, const AST* ast)
+{
+ const ACall* call = ast->to<const ACall*>();
+ if (!call)
+ return false;
+
+ const ASymbol* const sym = call->head()->to<const ASymbol*>();
+ if (!sym)
+ return false;
+
+ return penv.primitives.find(sym->cppstr) != penv.primitives.end();
+}
+
int
print_usage(char* name, bool error)
{
diff --git a/src/resp.hpp b/src/resp.hpp
index d9c85fe..dd5987a 100644
--- a/src/resp.hpp
+++ b/src/resp.hpp
@@ -544,57 +544,6 @@ struct ACall : public ATuple {
void constrain(TEnv& tenv, Constraints& c) const throw(Error);
};
-/// Definition special form, e.g. "(def x 2)"
-struct ADef : public ACall {
- ADef(const ATuple* exp) : ACall(exp) {}
- ADef(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {}
- ADef(AST* first, AST* rest, Cursor c) : ACall(first, rest, c) {}
-};
-
-struct ADefType : public ACall {
- ADefType(const ATuple* exp) : ACall(exp) {}
- ADefType(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {}
- ADefType(AST* first, AST* rest, Cursor c) : ACall(first, rest, c) {}
-};
-
-struct AMatch : public ACall {
- AMatch(const ATuple* exp) : ACall(exp) {}
- AMatch(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {}
- AMatch(AST* first, AST* rest, Cursor c) : ACall(first, rest, c) {}
-};
-
-/// Conditional special form, e.g. "(if cond thenexp elseexp)"
-struct AIf : public ACall {
- AIf(const ATuple* exp) : ACall(exp) {}
- AIf(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {}
- AIf(AST* first, AST* rest, Cursor c) : ACall(first, rest, c) {}
-};
-
-struct ACons : public ACall {
- ACons(const ATuple* exp) : ACall(exp) {}
- ACons(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {}
- ACons(AST* first, AST* rest, Cursor c) : ACall(first, rest, c) {}
-};
-
-struct ADot : public ACall {
- ADot(const ATuple* exp) : ACall(exp) {}
- ADot(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {}
- ADot(AST* first, AST* rest, Cursor c) : ACall(first, rest, c) {}
-};
-
-/// Primitive (builtin arithmetic function), e.g. "(+ 2 3)"
-struct APrimitive : public ACall {
- APrimitive(const ATuple* exp) : ACall(exp) {}
- APrimitive(AST* first, AST* rest, Cursor c) : ACall(first, rest, c) {}
- void constrain(TEnv& tenv, Constraints& c) const throw(Error);
-};
-
-struct AQuote : public ACall {
- AQuote(const ATuple* exp) : ACall(exp) {}
- AQuote(AST* first, AST* rest, Cursor c) : ACall(first, rest, c) {}
- AQuote(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {}
-};
-
/***************************************************************************
* Parser: S-Expressions (SExp) -> AST Nodes (AST) *
@@ -637,6 +586,10 @@ struct PEnv : private map<const string, ASymbol*> {
}
}
AST* parse(const AST* exp);
+
+ typedef std::set<std::string> Primitives;
+ Primitives primitives;
+
unsigned symID;
};
@@ -785,7 +738,7 @@ struct Engine {
virtual CVal compileLiteral(CEnv& cenv, const AST* lit) = 0;
virtual CVal compileString(CEnv& cenv, const char* str) = 0;
virtual CVal compileCall(CEnv& cenv, CFunc f, const AType* fT, ValVec& args) = 0;
- virtual CVal compilePrimitive(CEnv& cenv, const APrimitive* prim) = 0;
+ virtual CVal compilePrimitive(CEnv& cenv, const ACall* prim) = 0;
virtual CVal compileIf(CEnv& cenv, const ACall* aif) = 0;
virtual CVal compileMatch(CEnv& cenv, const ACall* match) = 0;
virtual CVal compileGlobal(CEnv& cenv, const AType* t, const string& sym, CVal val) = 0;
@@ -906,5 +859,7 @@ int eval(CEnv& cenv, Cursor& cursor, istream& is, bool execute);
int repl(CEnv& cenv);
AST* resp_lift(CEnv& cenv, Code& code, AST* ast) throw();
CVal resp_compile(CEnv& cenv, const AST* ast) throw();
+bool is_form(const AST* ast, const std::string& form);
+bool is_primitive(const PEnv& penv, const AST* ast);
#endif // RESP_HPP