diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/c.cpp | 5 | ||||
| -rw-r--r-- | src/compile.cpp | 16 | ||||
| -rw-r--r-- | src/constrain.cpp | 7 | ||||
| -rw-r--r-- | src/lift.cpp | 6 | ||||
| -rw-r--r-- | src/llvm.cpp | 4 | ||||
| -rw-r--r-- | src/parse.cpp | 24 | ||||
| -rw-r--r-- | src/resp.hpp | 9 |
7 files changed, 63 insertions, 8 deletions
@@ -49,6 +49,9 @@ llType(const AType* t) if (t->head()->str() == "Bool") return new string("bool"); if (t->head()->str() == "Int") return new string("int"); if (t->head()->str() == "Float") return new string("float"); + if (t->head()->str() == "String") return new string("char*"); + if (t->head()->str() == "Quote") return new string("char*"); + if (t->head()->str() == "Lexeme") return new string("char*"); throw Error(t->loc, string("Unknown primitive type `") + t->str() + "'"); } else if (t->kind == AType::EXPR && t->head()->str() == "Fn") { AType::const_iterator i = t->begin(); @@ -201,7 +204,7 @@ CEngine::compileLiteral(CEnv& cenv, AST* lit) CVal CEngine::compileString(CEnv& cenv, const char* str) { - return new Value(str); + return new Value(string("\"") + str + "\""); } CFunc diff --git a/src/compile.cpp b/src/compile.cpp index f5a4128..31fa889 100644 --- a/src/compile.cpp +++ b/src/compile.cpp @@ -38,6 +38,12 @@ AString::compile(CEnv& cenv) throw() } CVal +AQuote::compile(CEnv& cenv) throw() +{ + return (*(begin() + 1))->compile(cenv); +} + +CVal ALexeme::compile(CEnv& cenv) throw() { return cenv.engine()->compileString(cenv, c_str()); @@ -112,6 +118,16 @@ ACons::compile(CEnv& cenv) throw() } CVal +ATuple::compile(CEnv& cenv) throw() +{ + const AType* type = cenv.type(this); + vector<CVal> fields; + for (const_iterator i = begin(); i != end(); ++i) + fields.push_back((*i)->compile(cenv)); + return cenv.engine()->compileTup(cenv, type, fields); +} + +CVal ADot::compile(CEnv& cenv) throw() { const_iterator i = begin(); diff --git a/src/constrain.cpp b/src/constrain.cpp index 969e87d..13bb9e8 100644 --- a/src/constrain.cpp +++ b/src/constrain.cpp @@ -46,6 +46,13 @@ ALexeme::constrain(TEnv& tenv, Constraints& c) const throw(Error) } void +AQuote::constrain(TEnv& tenv, Constraints& c) const throw(Error) +{ + c.constrain(tenv, this, tenv.named("Quote")); + (*(begin() + 1))->constrain(tenv, c); +} + +void ASymbol::constrain(TEnv& tenv, Constraints& c) const throw(Error) { const AType** ref = tenv.ref(this); diff --git a/src/lift.cpp b/src/lift.cpp index 2c20aa8..3dd0297 100644 --- a/src/lift.cpp +++ b/src/lift.cpp @@ -49,6 +49,12 @@ ASymbol::lift(CEnv& cenv, Code& code) throw() } AST* +AQuote::lift(CEnv& cenv, Code& code) throw() +{ + return this; +} + +AST* ATuple::lift(CEnv& cenv, Code& code) throw() { ATuple* ret = new ATuple(*this); diff --git a/src/llvm.cpp b/src/llvm.cpp index 043b5fc..9ca6e46 100644 --- a/src/llvm.cpp +++ b/src/llvm.cpp @@ -94,6 +94,8 @@ struct LLVMEngine : public Engine { if (t->head()->str() == "Int") return Type::getInt32Ty(context); if (t->head()->str() == "Float") return Type::getFloatTy(context); if (t->head()->str() == "String") return PointerType::get(Type::getInt8Ty(context), NULL); + if (t->head()->str() == "Quote") return PointerType::get(Type::getInt8Ty(context), NULL); + if (t->head()->str() == "Lexeme") return PointerType::get(Type::getInt8Ty(context), NULL); throw Error(t->loc, string("Unknown primitive type `") + t->str() + "'"); } else if (t->kind == AType::EXPR && t->head()->str() == "Fn") { AType::const_iterator i = t->begin(); @@ -230,6 +232,8 @@ struct LLVMEngine : public Engine { ss << "\""; } else if (retT->head()->str() == "Lexeme") { ss << ((char* (*)())fp)(); + } else if (retT->head()->str() == "Quote") { + ss << "(quote " << ((char* (*)())fp)() << ")"; } else if (t != Type::getVoidTy(context)) { ss << ((void* (*)())fp)(); } else { diff --git a/src/parse.cpp b/src/parse.cpp index 20d0816..2c59c56 100644 --- a/src/parse.cpp +++ b/src/parse.cpp @@ -92,6 +92,16 @@ parseFn(PEnv& penv, const AST* exp, void* arg) return ret; } +inline AST* +parseQuote(PEnv& penv, const AST* exp, void* arg) +{ + const ATuple* texp = exp->to<const ATuple*>(); + THROW_IF(texp->size() != 2, exp->loc, "`quote' requires exactly 1 argument"); + const AST* quotee = (*(texp->begin() + 1))->to<ALexeme*>(); + THROW_IF(!quotee, exp->loc, "`quote' argument is not a lexeme"); + return new AQuote(texp); +} + /*************************************************************************** * Language Definition * @@ -108,7 +118,8 @@ initLang(PEnv& penv, TEnv& tenv) tenv.def(penv.sym("Float"), new AType(penv.sym("Float"))); tenv.def(penv.sym("String"), new AType(penv.sym("String"))); tenv.def(penv.sym("Lexeme"), new AType(penv.sym("Lexeme"))); - + tenv.def(penv.sym("Quote"), new AType(penv.sym("Quote"))); + // Literals static bool trueVal = true; static bool falseVal = false; @@ -119,11 +130,12 @@ initLang(PEnv& penv, TEnv& tenv) penv.defmac("def", macDef); // Special forms - penv.reg(true, "fn", PEnv::Handler(parseFn)); - penv.reg(true, "if", PEnv::Handler(parseCall<AIf>)); - penv.reg(true, "cons", PEnv::Handler(parseCall<ACons>)); - penv.reg(true, ".", PEnv::Handler(parseCall<ADot>)); - penv.reg(true, "def", PEnv::Handler(parseCall<ADef>)); + 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, "cons", PEnv::Handler(parseCall<ACons>)); + penv.reg(true, ".", PEnv::Handler(parseCall<ADot>)); + penv.reg(true, "def", PEnv::Handler(parseCall<ADef>)); // Numeric primitives penv.reg(true, "+", PEnv::Handler(parseCall<APrimitive>)); diff --git a/src/resp.hpp b/src/resp.hpp index a76aed7..4be28bd 100644 --- a/src/resp.hpp +++ b/src/resp.hpp @@ -329,7 +329,7 @@ struct ATuple : public AST { AST* lift(CEnv& cenv, Code& code) throw(); AST* depoly(CEnv& cenv, Code& code) throw(); - CVal compile(CEnv& cenv) throw() { return NULL; } + CVal compile(CEnv& cenv) throw(); private: size_t _len; @@ -473,6 +473,13 @@ struct APrimitive : public ACall { CVal compile(CEnv& cenv) throw(); }; +struct AQuote : public ACall { + AQuote(const ATuple* exp) : ACall(exp) {} + void constrain(TEnv& tenv, Constraints& c) const throw(Error); + AST* lift(CEnv& cenv, Code& code) throw(); + CVal compile(CEnv& cenv) throw(); +}; + /*************************************************************************** * Parser: S-Expressions (SExp) -> AST Nodes (AST) * |