diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/c.cpp | 2 | ||||
| -rw-r--r-- | src/compile.cpp | 16 | ||||
| -rw-r--r-- | src/constrain.cpp | 13 | ||||
| -rw-r--r-- | src/expand.cpp | 2 | ||||
| -rw-r--r-- | src/lift.cpp | 2 | ||||
| -rw-r--r-- | src/llvm.cpp | 5 | ||||
| -rw-r--r-- | src/simplify.cpp | 16 |
7 files changed, 52 insertions, 4 deletions
@@ -89,7 +89,7 @@ CEngine::llType(const AST* t) if (sym == "Int") return new string("int"); if (sym == "Float") return new string("float"); if (sym == "String") return new string("char*"); - if (sym == "Quote") return new string("char*"); + if (sym == "Symbol") return new string("char*"); } else if (is_form(t, "Fn")){ ATuple::const_iterator i = t->as_tuple()->begin(); const ATuple* protT = (*++i)->to_tuple(); diff --git a/src/compile.cpp b/src/compile.cpp index 393084e..756e90d 100644 --- a/src/compile.cpp +++ b/src/compile.cpp @@ -43,7 +43,7 @@ compile_literal_symbol(CEnv& cenv, const ASymbol* sym) throw() if (existing) { return *existing; } else { - CVal compiled = cenv.engine()->compileString(cenv, (string("__T_") + sym->sym()).c_str()); + CVal compiled = cenv.engine()->compileString(cenv, sym->sym()); cenv.vals.def(sym, compiled); return compiled; } @@ -147,6 +147,18 @@ compile_if(CEnv& cenv, const ATuple* aif) throw() } static CVal +compile_quote(CEnv& cenv, const ATuple* quote) throw() +{ + switch (quote->list_ref(1)->tag()) { + case T_SYMBOL: + return compile_literal_symbol(cenv, quote->list_ref(1)->as_symbol()); + default: + assert(false); + return NULL; + } +} + +static CVal compile_call(CEnv& cenv, const ATuple* call) throw() { CFunc f = resp_compile(cenv, call->head()); @@ -199,6 +211,8 @@ resp_compile(CEnv& cenv, const AST* ast) throw() return compile_fn(cenv, call); else if (form == "if") return compile_if(cenv, call); + else if (form == "quote") + return compile_quote(cenv, call); else return compile_call(cenv, call); } diff --git a/src/constrain.cpp b/src/constrain.cpp index 4bd6c08..f65ad8f 100644 --- a/src/constrain.cpp +++ b/src/constrain.cpp @@ -260,6 +260,17 @@ constrain_match(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) } static void +constrain_quote(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) +{ + THROW_IF(call->list_len() != 2, call->loc, "`quote' requires exactly 1 argument"); + switch (call->list_ref(1)->tag()) { + case T_TUPLE: c.constrain(tenv, call, tenv.named("List")); return; + case T_SYMBOL: c.constrain(tenv, call, tenv.named("Symbol")); return; + default: return; + } +} + +static void constrain_call(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) { const AST* const head = call->head(); @@ -370,6 +381,8 @@ constrain_list(TEnv& tenv, Constraints& c, const ATuple* tup) throw(Error) constrain_let(tenv, c, tup); else if (form == "match") constrain_match(tenv, c, tup); + else if (form == "quote") + constrain_quote(tenv, c, tup); else constrain_call(tenv, c, tup); } diff --git a/src/expand.cpp b/src/expand.cpp index eb508f1..f0fed33 100644 --- a/src/expand.cpp +++ b/src/expand.cpp @@ -113,7 +113,7 @@ initLang(PEnv& penv, TEnv& tenv) { // Types const char* types[] = { - "Bool", "Float", "Int", "Nothing", "Quote", "String", "Symbol", 0 }; + "Bool", "Float", "Int", "Nothing", "String", "Symbol", "List", 0 }; for (const char** t = types; *t; ++t) { const ASymbol* sym = penv.sym(*t); tenv.def(sym, sym); // FIXME: define to NULL? diff --git a/src/lift.cpp b/src/lift.cpp index 201d40f..1991eb5 100644 --- a/src/lift.cpp +++ b/src/lift.cpp @@ -271,6 +271,8 @@ resp_lift(CEnv& cenv, Code& code, const AST* ast) throw() return lift_fn(cenv, code, call); else if (form == "if") return lift_args(cenv, code, call); + else if (form == "quote") + return call; else return lift_call(cenv, code, call); } diff --git a/src/llvm.cpp b/src/llvm.cpp index 4c8ff2a..cb2d6c1 100644 --- a/src/llvm.cpp +++ b/src/llvm.cpp @@ -140,7 +140,7 @@ LLVMEngine::llType(const AST* t) if (sym == "Int") return Type::getInt32Ty(context); if (sym == "Float") return Type::getFloatTy(context); if (sym == "String") return PointerType::get(Type::getInt8Ty(context), NULL); - if (sym == "Quote") return PointerType::get(Type::getInt8Ty(context), NULL); + if (sym == "Symbol") return PointerType::get(Type::getInt8Ty(context), NULL); } else if (is_form(t, "Fn")) { ATuple::const_iterator i = t->as_tuple()->begin(); const ATuple* protT = (*++i)->to_tuple(); @@ -466,6 +466,9 @@ LLVMEngine::call(CEnv& cenv, CFunc f, const AST* retT) } } ss << "\""; + } else if (retT->str() == "Symbol") { + const std::string s(((char* (*)())fp)()); + ss << s; } else if (t != Type::getVoidTy(context)) { ss << ((void* (*)())fp)(); } else { diff --git a/src/simplify.cpp b/src/simplify.cpp index 397c2b7..63b5fd6 100644 --- a/src/simplify.cpp +++ b/src/simplify.cpp @@ -145,6 +145,20 @@ simplify_let(CEnv& cenv, const ATuple* call) throw() return copy; } +static const AST* +simplify_quote(CEnv& cenv, const ATuple* call) throw() +{ + switch (call->list_ref(1)->tag()) { + case T_SYMBOL: case T_TUPLE: + // Symbols and lists remain quoted (because semantics differ) + return call; + default: + // Other literals (e.g. numbers, strings) are self-evaluating, so the + // quote can be removed, e.g. (quote 3) => 3 + return call->list_ref(1); + } +} + const AST* resp_simplify(CEnv& cenv, const AST* ast) throw() { @@ -161,6 +175,8 @@ resp_simplify(CEnv& cenv, const AST* ast) throw() return simplify_if(cenv, list); else if (form == "let") return simplify_let(cenv, list); + else if (form == "quote") + return simplify_quote(cenv, list); else return simplify_list(cenv, list); } |