aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/c.cpp37
-rw-r--r--src/compile.cpp20
-rw-r--r--src/constrain.cpp29
-rw-r--r--src/expand.cpp2
-rw-r--r--src/llvm.cpp104
-rw-r--r--src/pprint.cpp7
-rw-r--r--src/repl.cpp29
-rw-r--r--src/resp.hpp48
-rw-r--r--src/simplify.cpp35
9 files changed, 231 insertions, 80 deletions
diff --git a/src/c.cpp b/src/c.cpp
index a00c89b..7d5b125 100644
--- a/src/c.cpp
+++ b/src/c.cpp
@@ -43,18 +43,21 @@ struct CEngine : public Engine {
CFunc startFn(CEnv& cenv, const string& name, const ATuple* args, const ATuple* type);
void pushFnArgs(CEnv& cenv, const ATuple* prot, const ATuple* type, CFunc f);
- void finishFn(CEnv& cenv, CFunc f, CVal ret);
+ void finishFn(CEnv& cenv, CFunc f, CVal ret, const AST* retT);
void eraseFn(CEnv& cenv, CFunc f);
- CVal compileCall(CEnv& cenv, CFunc f, const ATuple* funcT, const vector<CVal>& args);
- CVal compileCons(CEnv& cenv, const ATuple* type, CVal rtti, const vector<CVal>& fields);
- CVal compileDot(CEnv& cenv, CVal tup, int32_t index);
- CVal compileGlobalSet(CEnv& cenv, const string& s, CVal v, const AST* t);
- CVal compileGlobalGet(CEnv& cenv, const string& s, CVal v);
- CVal compileIf(CEnv& cenv, const AST* cond, const AST* then, const AST* aelse);
- CVal compileLiteral(CEnv& cenv, const AST* lit);
- CVal compilePrimitive(CEnv& cenv, const ATuple* prim);
- CVal compileString(CEnv& cenv, const char* str);
+ CVal compileCall(CEnv& cenv, CFunc f, const ATuple* funcT, const vector<CVal>& args);
+ CVal compileCons(CEnv& cenv, const ATuple* type, CVal rtti, const vector<CVal>& fields);
+ CVal compileDot(CEnv& cenv, CVal tup, int32_t index);
+ CVal compileGlobalSet(CEnv& cenv, const string& s, CVal v, const AST* t);
+ CVal compileGlobalGet(CEnv& cenv, const string& s, CVal v);
+ CVal compileIf(CEnv& cenv, const AST* cond, const AST* then, const AST* aelse);
+ CVal compileLiteral(CEnv& cenv, const AST* lit);
+ CVal compilePrimitive(CEnv& cenv, const ATuple* prim);
+ CVal compileString(CEnv& cenv, const char* str);
+ CType compileType(CEnv& cenv, const char* name, const AST* exp);
+
+ CType objectType(CEnv& cenv);
void writeModule(CEnv& cenv, std::ostream& os);
@@ -159,6 +162,18 @@ CEngine::compileString(CEnv& cenv, const char* str)
return new Value(string("\"") + str + "\"");
}
+CType
+CEngine::compileType(CEnv& cenv, const char* name, const AST* expr)
+{
+ return NULL;
+}
+
+CType
+CEngine::objectType(CEnv& cenv)
+{
+ return new string("Object");
+}
+
CFunc
CEngine::startFn(CEnv& cenv, const std::string& name, const ATuple* args, const ATuple* type)
{
@@ -212,7 +227,7 @@ CEngine::pushFnArgs(CEnv& cenv, const ATuple* prot, const ATuple* type, CFunc f)
}
void
-CEngine::finishFn(CEnv& cenv, CFunc f, CVal ret)
+CEngine::finishFn(CEnv& cenv, CFunc f, CVal ret, const AST* retT)
{
out += "return " + *(Value*)ret + ";\n}\n\n";
}
diff --git a/src/compile.cpp b/src/compile.cpp
index 1de8a78..d2f0530 100644
--- a/src/compile.cpp
+++ b/src/compile.cpp
@@ -63,6 +63,7 @@ compile_cons(CEnv& cenv, const ATuple* cons) throw()
List tlist(type);
vector<CVal> fields;
for (ATuple::const_iterator i = cons->iter_at(1); i != cons->end(); ++i) {
+ assert(cenv.type(*i));
tlist.push_back(cenv.type(*i));
fields.push_back(resp_compile(cenv, *i));
}
@@ -97,6 +98,19 @@ compile_def(CEnv& cenv, const ATuple* def) throw()
}
static CVal
+compile_def_type(CEnv& cenv, const ATuple* def) throw()
+{
+ const ASymbol* name = def->frst()->as_tuple()->fst()->as_symbol();
+ cenv.engine()->compileType(cenv, name->sym(), def->frst());
+ for (ATuple::const_iterator i = def->iter_at(2); i != def->end(); ++i) {
+ const ATuple* exp = (*i)->as_tuple();
+ const ASymbol* tag = (*exp->begin())->as_symbol();
+ cenv.engine()->compileType(cenv, tag->sym(), exp);
+ }
+ return NULL;
+}
+
+static CVal
compile_do(CEnv& cenv, const ATuple* ado) throw()
{
CVal retVal = NULL;
@@ -111,7 +125,7 @@ compile_fn(CEnv& cenv, const ATuple* fn) throw()
{
assert(!cenv.currentFn);
- const AST* type = cenv.type(fn);
+ const AST* const type = cenv.type(fn);
CFunc f = cenv.findImpl(fn, type);
if (f)
return f;
@@ -127,7 +141,7 @@ compile_fn(CEnv& cenv, const ATuple* fn) throw()
retVal = resp_compile(cenv, *i);
// Write function conclusion and pop stack frame
- cenv.engine()->finishFn(cenv, f, retVal);
+ cenv.engine()->finishFn(cenv, f, retVal, type->as_tuple()->frrst());
cenv.pop();
cenv.currentFn = NULL;
@@ -204,7 +218,7 @@ resp_compile(CEnv& cenv, const AST* ast) throw()
else if (form == "def")
return compile_def(cenv, call);
else if (form == "def-type")
- return NULL; // FIXME
+ return compile_def_type(cenv, call);
else if (form == "do")
return compile_do(cenv, call);
else if (form == "fn")
diff --git a/src/constrain.cpp b/src/constrain.cpp
index 7530f01..a4a1ad3 100644
--- a/src/constrain.cpp
+++ b/src/constrain.cpp
@@ -83,6 +83,7 @@ static void
constrain_def(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error)
{
THROW_IF(call->list_len() != 3, call->loc, "`def' requires exactly 2 arguments");
+ THROW_IF(!call->frst()->to_symbol(), call->frst()->loc, "`def' name is not a symbol");
const ASymbol* const sym = call->list_ref(1)->as_symbol();
THROW_IF(!sym, call->loc, "`def' has no symbol")
const AST* const body = call->list_ref(2);
@@ -111,9 +112,7 @@ constrain_def_type(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error)
List consT;
consT.push_back(sym);
for (ATuple::const_iterator i = exp->begin(); i != exp->end(); ++i) {
- const ASymbol* sym = (*i)->to_symbol();
- THROW_IF(!sym, (*i)->loc, "type expression element is not a symbol");
- consT.push_back(sym);
+ consT.push_back(*i); // FIXME: ensure symbol, or list of symbol
}
consT.head->loc = exp->loc;
type.push_back(consT);
@@ -260,14 +259,28 @@ constrain_match(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error)
}
static void
+resp_constrain_quoted(TEnv& tenv, Constraints& c, const AST* ast) throw(Error)
+{
+ switch (ast->tag()) {
+ case T_SYMBOL:
+ c.constrain(tenv, ast, tenv.named("Symbol"));
+ return;
+ case T_TUPLE:
+ c.constrain(tenv, ast, tenv.named("List"));
+ FOREACHP(ATuple::const_iterator, i, ast->as_tuple())
+ resp_constrain_quoted(tenv, c, *i);
+ return;
+ default:
+ resp_constrain(tenv, c, ast);
+ }
+}
+
+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;
- }
+ resp_constrain_quoted(tenv, c, call->frst());
+ c.constrain(tenv, call, tenv.var(call->frst()));
}
static void
diff --git a/src/expand.cpp b/src/expand.cpp
index 53a415c..e5e3255 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", "String", "Symbol", "List", 0 };
+ "Bool", "Float", "Int", "Nothing", "String", "Symbol", "List", "Expr", 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/llvm.cpp b/src/llvm.cpp
index 3f48dec..cc4bf47 100644
--- a/src/llvm.cpp
+++ b/src/llvm.cpp
@@ -58,18 +58,21 @@ struct LLVMEngine : public Engine {
CFunc startFn(CEnv& cenv, const string& name, const ATuple* args, const ATuple* type);
void pushFnArgs(CEnv& cenv, const ATuple* prot, const ATuple* type, CFunc f);
- void finishFn(CEnv& cenv, CFunc f, CVal ret);
+ void finishFn(CEnv& cenv, CFunc f, CVal ret, const AST* retT);
void eraseFn(CEnv& cenv, CFunc f);
- CVal compileCall(CEnv& cenv, CFunc f, const ATuple* funcT, const vector<CVal>& args);
- CVal compileCons(CEnv& cenv, const ATuple* type, CVal rtti, const vector<CVal>& fields);
- CVal compileDot(CEnv& cenv, CVal tup, int32_t index);
- CVal compileGlobalSet(CEnv& cenv, const string& s, CVal v, const AST* t);
- CVal compileGlobalGet(CEnv& cenv, const string& s, CVal v);
- CVal compileIf(CEnv& cenv, const AST* cond, const AST* then, const AST* aelse);
- CVal compileLiteral(CEnv& cenv, const AST* lit);
- CVal compilePrimitive(CEnv& cenv, const ATuple* prim);
- CVal compileString(CEnv& cenv, const char* str);
+ CVal compileCall(CEnv& cenv, CFunc f, const ATuple* funcT, const vector<CVal>& args);
+ CVal compileCons(CEnv& cenv, const ATuple* type, CVal rtti, const vector<CVal>& fields);
+ CVal compileDot(CEnv& cenv, CVal tup, int32_t index);
+ CVal compileGlobalSet(CEnv& cenv, const string& s, CVal v, const AST* t);
+ CVal compileGlobalGet(CEnv& cenv, const string& s, CVal v);
+ CVal compileIf(CEnv& cenv, const AST* cond, const AST* then, const AST* aelse);
+ CVal compileLiteral(CEnv& cenv, const AST* lit);
+ CVal compilePrimitive(CEnv& cenv, const ATuple* prim);
+ CVal compileString(CEnv& cenv, const char* str);
+ CType compileType(CEnv& cenv, const char* name, const AST* exp);
+
+ CType objectType(CEnv& cenv);
void writeModule(CEnv& cenv, std::ostream& os);
@@ -91,6 +94,10 @@ private:
IRBuilder<> builder;
Function* alloc;
FunctionPassManager* opt;
+ CType objectT;
+
+ typedef std::map<const std::string, CType> CTypes;
+ CTypes compiledTypes;
unsigned labelIndex;
};
@@ -114,9 +121,17 @@ LLVMEngine::LLVMEngine()
// Declare host provided allocation primitive
std::vector<const Type*> argsT(1, Type::getInt32Ty(context)); // unsigned size
- FunctionType* funcT = FunctionType::get(PointerType::get(Type::getInt8Ty(context), 0), argsT, false);
- alloc = Function::Create(funcT, Function::ExternalLinkage,
- "resp_gc_allocate", module);
+ FunctionType* funcT = FunctionType::get(
+ PointerType::get(Type::getInt8Ty(context), 0), argsT, false);
+ alloc = Function::Create(
+ funcT, Function::ExternalLinkage, "resp_gc_allocate", module);
+
+ // Build Object type (tag only, binary compatible with any constructed thing)
+ vector<const Type*> ctypes;
+ ctypes.push_back(PointerType::get(Type::getInt8Ty(context), NULL)); // RTTI
+ StructType* cObjectT = StructType::get(context, ctypes, false);
+ module->addTypeName("Object", cObjectT);
+ objectT = cObjectT;
}
LLVMEngine::~LLVMEngine()
@@ -141,6 +156,7 @@ LLVMEngine::llType(const AST* t)
if (sym == "Float") return Type::getFloatTy(context);
if (sym == "String") return PointerType::get(Type::getInt8Ty(context), NULL);
if (sym == "Symbol") return PointerType::get(Type::getInt8Ty(context), NULL);
+ if (sym == "Expr") 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();
@@ -209,9 +225,16 @@ LLVMEngine::compileCons(CEnv& cenv, const ATuple* type, CVal rtti, const vector<
if (rtti)
builder.CreateStore((Value*)rtti, builder.CreateStructGEP(structPtr, 0, "rtti"));
size_t i = 1;
- for (vector<CVal>::const_iterator f = fields.begin(); f != fields.end(); ++f, ++i) {
- builder.CreateStore(llVal(*f),
- builder.CreateStructGEP(structPtr, i, (format("tup%1%") % i).str().c_str()));
+ ATuple::const_iterator t = type->iter_at(1);
+ for (vector<CVal>::const_iterator f = fields.begin(); f != fields.end(); ++f, ++i, ++t) {
+ Value* val = llVal(*f);
+ Value* field = builder.CreateStructGEP(
+ structPtr, i, (format("tup%1%") % i).str().c_str());
+
+ if ((*t)->to_tuple())
+ val = builder.CreateBitCast(val, llType(*t), "objPtr");
+
+ builder.CreateStore(val, field);
}
return structPtr;
@@ -245,6 +268,47 @@ LLVMEngine::compileString(CEnv& cenv, const char* str)
return builder.CreateGlobalStringPtr(str);
}
+CType
+LLVMEngine::compileType(CEnv& cenv, const char* name, const AST* expr)
+{
+ CTypes::const_iterator i = compiledTypes.find(name);
+ if (i != compiledTypes.end())
+ return i->second;
+
+ const ATuple* const tup = expr->as_tuple();
+ vector<const Type*> ctypes;
+ ctypes.push_back(PointerType::get(Type::getInt8Ty(context), NULL)); // RTTI
+ for (ATuple::const_iterator i = tup->iter_at(1); i != tup->end(); ++i) {
+ const ATuple* tup = (*i)->to_tuple();
+ const Type* lt = (tup)
+ ? (const Type*)compileType(cenv, tup->fst()->as_symbol()->sym(), *i)
+ : llType(*i);
+ if (!lt)
+ return NULL;
+ ctypes.push_back(lt);
+ }
+
+ Type* structT = StructType::get(context, ctypes, false);
+
+ // Tell LLVM opaqueT and structT are the same (for recursive types)
+ //PATypeHolder opaqueT = OpaqueType::get(context);
+ //((OpaqueType*)opaqueT.get())->refineAbstractTypeTo(structT);
+ //structT = cast<StructType>(opaqueT.get()); // updated potentially invalidated structT
+
+ Type* ret = PointerType::get(structT, 0);
+ module->addTypeName(name, structT);
+
+ compiledTypes.insert(make_pair(name, ret));
+
+ return ret;
+}
+
+CType
+LLVMEngine::objectType(CEnv& cenv)
+{
+ return objectT;
+}
+
CFunc
LLVMEngine::startFn(
CEnv& cenv, const std::string& name, const ATuple* args, const ATuple* type)
@@ -304,9 +368,13 @@ LLVMEngine::pushFnArgs(CEnv& cenv, const ATuple* prot, const ATuple* type, CFunc
}
void
-LLVMEngine::finishFn(CEnv& cenv, CFunc f, CVal ret)
+LLVMEngine::finishFn(CEnv& cenv, CFunc f, CVal ret, const AST* retT)
{
- builder.CreateRet(llVal(ret));
+ if (retT->str() == "Nothing")
+ builder.CreateRetVoid();
+ else
+ builder.CreateRet(builder.CreateBitCast(llVal(ret), llType(retT), "ret"));
+
if (verifyFunction(*static_cast<Function*>(f), llvm::PrintMessageAction)) {
module->dump();
throw Error(Cursor(), "Broken module");
diff --git a/src/pprint.cpp b/src/pprint.cpp
index 15e9f54..4e0d036 100644
--- a/src/pprint.cpp
+++ b/src/pprint.cpp
@@ -37,8 +37,11 @@ newline(ostream& out, unsigned indent)
static inline void
print_annotation(ostream& out, CEnv* cenv, const AST* ast, bool print)
{
- if (print)
- out << " :" << cenv->tsubst.apply(cenv->tenv.var(ast));
+ if (print) {
+ const AST* var = cenv->tenv.var(ast);
+ if (var)
+ out << " :" << cenv->tsubst.apply(var);
+ }
}
ostream&
diff --git a/src/repl.cpp b/src/repl.cpp
index 81035bb..6c9b3cf 100644
--- a/src/repl.cpp
+++ b/src/repl.cpp
@@ -136,7 +136,8 @@ eval(CEnv& cenv, Cursor& cursor, istream& is, bool execute)
Code exprs;
for (Code::const_iterator i = lifted.begin(); i != lifted.end(); ++i) {
const ATuple* call = (*i)->to_tuple();
- if (call && is_form(call, "def") && is_form(call->list_ref(2), "fn")) {
+ if (call && ( (is_form(call, "def-type"))
+ || (is_form(call, "def") && is_form(call->frrst(), "fn")))) {
val = resp_compile(cenv, call);
} else {
const ATuple* tup = (*i)->to_tuple();
@@ -146,27 +147,25 @@ eval(CEnv& cenv, Cursor& cursor, istream& is, bool execute)
}
}
- const AST* type = cenv.type(exprs.back());
- const ATuple* fnT = tup(cursor, cenv.tenv.Fn, new ATuple(cursor), type, 0);
-
- // Create function for top-level of program
- f = cenv.engine()->startFn(cenv, "main", new ATuple(cursor), fnT);
+ if (!exprs.empty()) {
+ const AST* type = cenv.type(exprs.back());
+ const ATuple* fnT = tup(cursor, cenv.tenv.Fn, new ATuple(cursor), type, 0);
- // Compile expressions (other than function definitions) into it
- for (Code::const_iterator i = exprs.begin(); i != exprs.end(); ++i)
- val = resp_compile(cenv, *i);
+ // Create function for program containing all expressions except definitions
+ f = cenv.engine()->startFn(cenv, "main", new ATuple(cursor), fnT);
+ for (Code::const_iterator i = exprs.begin(); i != exprs.end(); ++i)
+ val = resp_compile(cenv, *i);
+ cenv.engine()->finishFn(cenv, f, val, type);
- // Finish compilation
- cenv.engine()->finishFn(cenv, f, val);
+ // Call and print result
+ callPrintCollect(cenv, f, ast, type, execute);
+ }
if (cenv.args.find("-S") != cenv.args.end()) {
cenv.engine()->writeModule(cenv, cenv.out);
return 0;
}
- // Call and print result
- callPrintCollect(cenv, f, ast, type, execute);
-
} catch (Error& e) {
cenv.err << e.what() << endl;
return 1;
@@ -200,7 +199,7 @@ repl(CEnv& cenv)
try {
// Create function for this repl loop
f = cenv.engine()->startFn(cenv, replFnName, new ATuple(cursor), fnT);
- cenv.engine()->finishFn(cenv, f, resp_compile(cenv, ast));
+ cenv.engine()->finishFn(cenv, f, resp_compile(cenv, ast), type);
callPrintCollect(cenv, f, ast, type, true);
if (cenv.args.find("-d") != cenv.args.end())
cenv.engine()->writeModule(cenv, cenv.out);
diff --git a/src/resp.hpp b/src/resp.hpp
index acf7725..57880f5 100644
--- a/src/resp.hpp
+++ b/src/resp.hpp
@@ -71,8 +71,9 @@ struct Error {
* Backend Types *
***************************************************************************/
-typedef void* CVal; ///< Compiled value (opaque)
-typedef void* CFunc; ///< Compiled function (opaque)
+typedef const void* CType; ///< Compiled type (opaque)
+typedef void* CVal; ///< Compiled value (opaque)
+typedef void* CFunc; ///< Compiled function (opaque)
/***************************************************************************
@@ -205,9 +206,12 @@ struct ATuple : public AST {
ATuple(const AST* fst, const ATuple* rst, Cursor c=Cursor())
: AST(T_TUPLE, c), _fst(fst), _rst(rst) {}
- const AST* fst() const { return _fst; }
- const ATuple* rst() const { return _rst; }
- bool empty() const { return _fst == 0 && _rst ==0; }
+ inline const AST* fst() const { return _fst; }
+ inline const ATuple* rst() const { return _rst; }
+ inline const AST* frst() const { return _rst->_fst; }
+ inline const AST* frrst() const { return _rst->_rst->_fst; }
+
+ bool empty() const { return _fst == 0 && _rst ==0; }
size_t list_len() const {
size_t ret = 0;
@@ -272,7 +276,7 @@ private:
const ATuple* _rst;
};
-inline ATuple* tup(Cursor c, AST* ast, ...) {
+inline ATuple* tup(Cursor c, const AST* ast, ...) {
ATuple* const head = new ATuple(ast, 0, c);
if (!ast)
return head;
@@ -468,6 +472,7 @@ ostream& operator<<(ostream& out, const Env<V>& env) {
/// Parse Time Environment (really just a symbol table)
struct PEnv : private map<const string, const char*> {
PEnv() : symID(0) {}
+ ~PEnv() { FOREACHP(const_iterator, i, this) free(const_cast<char*>(i->second)); }
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()) {
@@ -580,6 +585,8 @@ struct TEnv : public Env<const AST*> {
, Closure(penv.sym("Closure"))
, Dots(penv.sym("..."))
, Fn(penv.sym("Fn"))
+ , List(penv.sym("List"))
+ , Empty(penv.sym("Empty"))
, Tup(penv.sym("Tup"))
, U(penv.sym("U"))
{
@@ -616,6 +623,8 @@ struct TEnv : public Env<const AST*> {
ASymbol* Closure;
ASymbol* Dots;
ASymbol* Fn;
+ ASymbol* List;
+ ASymbol* Empty;
ASymbol* Tup;
ASymbol* U;
};
@@ -643,18 +652,21 @@ struct Engine {
const ATuple* type,
CFunc f) = 0;
- virtual void finishFn(CEnv& cenv, CFunc f, CVal ret) = 0;
- virtual void eraseFn(CEnv& cenv, CFunc f) = 0;
-
- virtual CVal compileCall(CEnv& cenv, CFunc f, const ATuple* fT, CVals& args) = 0;
- virtual CVal compileCons(CEnv& cenv, const ATuple* t, CVal rtti, CVals& f) = 0;
- virtual CVal compileDot(CEnv& cenv, CVal tup, int32_t index) = 0;
- virtual CVal compileGlobalSet(CEnv& cenv, const string& s, CVal v, const AST* t) = 0;
- virtual CVal compileGlobalGet(CEnv& cenv, const string& s, CVal v) = 0;
- virtual CVal compileIf(CEnv& cenv, const AST* cond, const AST* then, const AST* aelse) = 0;
- virtual CVal compileLiteral(CEnv& cenv, const AST* lit) = 0;
- virtual CVal compilePrimitive(CEnv& cenv, const ATuple* prim) = 0;
- virtual CVal compileString(CEnv& cenv, const char* str) = 0;
+ virtual void finishFn(CEnv& cenv, CFunc f, CVal ret, const AST* retT) = 0;
+ virtual void eraseFn(CEnv& cenv, CFunc f) = 0;
+
+ virtual CVal compileCall(CEnv& cenv, CFunc f, const ATuple* fT, CVals& args) = 0;
+ virtual CVal compileCons(CEnv& cenv, const ATuple* t, CVal rtti, CVals& f) = 0;
+ virtual CVal compileDot(CEnv& cenv, CVal tup, int32_t index) = 0;
+ virtual CVal compileGlobalSet(CEnv& cenv, const string& s, CVal v, const AST* t) = 0;
+ virtual CVal compileGlobalGet(CEnv& cenv, const string& s, CVal v) = 0;
+ virtual CVal compileIf(CEnv& cenv, const AST* cond, const AST* then, const AST* aelse) = 0;
+ virtual CVal compileLiteral(CEnv& cenv, const AST* lit) = 0;
+ virtual CVal compilePrimitive(CEnv& cenv, const ATuple* prim) = 0;
+ virtual CVal compileString(CEnv& cenv, const char* str) = 0;
+ virtual CType compileType(CEnv& cenv, const char* name, const AST* exp) = 0;
+
+ virtual CType objectType(CEnv& cenv) = 0;
virtual void writeModule(CEnv& cenv, std::ostream& os) = 0;
diff --git a/src/simplify.cpp b/src/simplify.cpp
index 0c839f7..e27049a 100644
--- a/src/simplify.cpp
+++ b/src/simplify.cpp
@@ -145,17 +145,44 @@ simplify_let(CEnv& cenv, const ATuple* call) throw()
return copy;
}
+static inline const AST*
+simplify_list_elem(CEnv& cenv, const ATuple* node, const AST* type)
+{
+ if (!node) {
+ const AST* empty = new ATuple(cenv.tenv.Empty, 0, Cursor());
+ cenv.setType(empty, type);
+ return empty;
+ }
+
+ assert(cenv.type(node->fst()));
+
+ const AST* const fst = tup(Cursor(), cenv.type(node->fst()), node->fst(), 0);
+ const AST* const rst = simplify_list_elem(cenv, node->rst(), type);
+ assert(node->fst());
+ assert(rst);
+ List cons(node->loc, cenv.tenv.List, fst, rst, 0);
+ cenv.setType(fst, tup(Cursor(), cenv.penv.sym("Expr"), 0));
+ cenv.setType(cons, type);
+ return cons;
+}
+
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)
+ switch (call->frst()->tag()) {
+ case T_SYMBOL:
+ // Symbols remain quoted so they are not interpreted as variables
return call;
+ case T_TUPLE: {
+ // Lists are transformed into nested conses
+ const ATuple* const list = call->frst()->as_tuple();
+ return simplify_list_elem(cenv, list,
+ tup(Cursor(), cenv.tenv.List, cenv.penv.sym("Expr"), 0));
+ }
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);
+ return call->frst();
}
}
generated by cgit v1.2.1 (git 2.18.0) at 2025-01-30 06:09:18 +0000