/* Resp: A programming language * Copyright (C) 2008-2009 David Robillard * * Resp is free software: you can redistribute it and/or modify it under * the terms of the GNU Affero General Public License as published by the * Free Software Foundation, either version 3 of the License, or (at your * option) any later version. * * Resp is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General * Public License for more details. * * You should have received a copy of the GNU Affero General Public License * along with Resp. If not, see . */ /** @file * @brief Compile to C */ #include #include #include #include #include #include "resp.hpp" using namespace std; using boost::format; /** C Engine (Compiler only) */ struct CEngine : public Engine { CEngine() : out( "#include \n" "#include \n" "void* __resp_alloc(unsigned size, uint8_t tag);\n\n") { } CFunc compileProt(CEnv& cenv, const string& name, const ATuple* args, const ATuple* type); CFunc startFn(CEnv& cenv, const string& name, const ATuple* args, const ATuple* type); 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& args); CVal compileCast(CEnv& cenv, CVal v, const AST* t); CVal compileCons(CEnv& cenv, const char* tname, const ATuple* type, CVal rtti, const vector& 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 std::string& name, const AST* exp); void writeModule(CEnv& cenv, std::ostream& os); const string call(CEnv& cenv, CFunc f, const AST* retT); private: void pushFnArgs(CEnv& cenv, const ATuple* prot, const ATuple* type, CFunc f); typedef string Type; typedef string Value; struct Function { string returnType; string name; string text; }; inline Value* llVal(CVal v) { return static_cast(v); } inline Function* llFunc(CFunc f) { return static_cast(f); } const Type* llType(const AST* t); std::string out; }; const CEngine::Type* CEngine::llType(const AST* t) { if (t == NULL) { return NULL; } else if (AType::is_name(t)) { const std::string sym(t->as_symbol()->sym()); if (sym == "Nothing") return new string("void"); if (sym == "Bool") return new string("bool"); if (sym == "Int") return new string("int"); if (sym == "Float") return new string("float"); if (sym == "String") 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(); const AST* retT = *i; if (!llType(retT)) return NULL; Type* ret = new Type(*llType(retT) + " (*)("); for (const auto& i : *protT) { const Type* lt = llType(i); if (!lt) return NULL; *ret += *lt; } *ret += ")"; return ret; } else if (AType::is_expr(t) && isupper(t->as_tuple()->fst()->str()[0])) { Type* ret = new Type("struct { void* me; "); for (ATuple::const_iterator i = t->as_tuple()->iter_at(1); i != t->as_tuple()->end(); ++i) { const Type* lt = llType(*i); if (!lt) return NULL; ret->append("; "); ret->append(*lt); } ret->append("}*"); return ret; } throw Error(t->loc, string("Unknown compiled type `") + t->str() + "'"); return NULL; } CVal CEngine::compileCall(CEnv& cenv, CFunc func, const ATuple* funcT, const vector& args) { Value* varname = new string(cenv.penv.gensymstr("x")); Function* f = llFunc(func); out += (format("const %s %s = %s(") % f->returnType % *varname % f->name).str(); for (const auto& i : args) out += *llVal(i); out += ");\n"; return varname; } CVal CEngine::compileCast(CEnv& cenv, CVal v, const AST* t) { return v; } CVal CEngine::compileCons(CEnv& cenv, const char* tname, const ATuple* type, CVal rtti, const vector& fields) { return NULL; } CVal CEngine::compileDot(CEnv& cenv, CVal tup, int32_t index) { return NULL; } CVal CEngine::compileLiteral(CEnv& cenv, const AST* lit) { return new Value(lit->str()); } CVal CEngine::compileString(CEnv& cenv, const char* str) { return new Value(string("\"") + str + "\""); } CType CEngine::compileType(CEnv& cenv, const std::string& name, const AST* expr) { return NULL; } CFunc CEngine::compileProt(CEnv& cenv, const std::string& name, const ATuple* args, const ATuple* type) { return NULL; } CFunc CEngine::startFn(CEnv& cenv, const std::string& name, const ATuple* args, const ATuple* type) { const ATuple* argsT = type->prot(); const AST* retT = type->list_ref(2); vector cprot; for (const auto& i : *argsT) { THROW_IF(!llType(i), Cursor(), string("non-concrete parameter :: ") + i->str()) cprot.push_back(llType(i)); } THROW_IF(!llType(retT), Cursor(), (format("return has non-concrete type `%1%'") % retT->str()).str()); Function* f = new Function(); f->returnType = *llType(retT); f->name = name; f->text += f->returnType + "\n" + f->name + "("; ATuple::const_iterator ai = argsT->begin(); ATuple::const_iterator ni = args->begin(); for (; ai != argsT->end(); ++ai, ++ni) { if (ai != argsT->begin()) f->text += ", "; f->text += *llType(*ai) + " " + (*ni)->as_symbol()->sym(); } f->text += ")\n{\n"; out += f->text; return f; } void CEngine::pushFnArgs(CEnv& cenv, const ATuple* prot, const ATuple* type, CFunc f) { cenv.push(); const ATuple* argsT = type->prot(); // Bind argument values in CEnv vector args; ATuple::const_iterator p = prot->begin(); ATuple::const_iterator pT = argsT->begin(); for (; p != prot->end(); ++p, ++pT) { const Type* lt = llType(*pT); THROW_IF(!lt, (*p)->loc, "untyped parameter\n"); cenv.def((*p)->as_symbol(), *p, (*pT), new string((*p)->str())); } } void CEngine::finishFn(CEnv& cenv, CFunc f, CVal ret, const AST* retT) { out += "return " + *(Value*)ret + ";\n}\n\n"; } void CEngine::eraseFn(CEnv& cenv, CFunc f) { cenv.err << "C backend does not support JIT (eraseFn)" << endl; } CVal CEngine::compileIf(CEnv& cenv, const AST* cond, const AST* then, const AST* aelse) { return NULL; } #if 0 CVal CEngine::compileIf(CEnv& cenv, const ATuple* 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 (ATuple::const_iterator i = aif->iter_at(1); ; ++i, idx += 2) { ATuple::const_iterator next = i; if (++next == aif->end()) break; if (idx > 1) out += "else {\n"; Value* condV = llVal(resp_compile(cenv, *i)); out += (format("if (%s) {\n") % *condV).str(); Value* thenV = llVal(resp_compile(cenv, *next)); out += (format("%s = %s;\n}\n") % *varname % *thenV).str(); } // Emit final else block out += "else {\n"; Value* elseV = llVal(resp_compile(cenv, aif->list_last())); out += (format("%s = %s;\n}\n") % *varname % *elseV).str(); for (size_t i = 1; i < idx / 2; ++i) out += "}"; return varname; } #endif CVal CEngine::compilePrimitive(CEnv& cenv, const ATuple* prim) { ATuple::const_iterator i = prim->begin(); ++i; Value* a = llVal(resp_compile(cenv, *i++)); Value* b = llVal(resp_compile(cenv, *i++)); const string n = prim->fst()->to_symbol()->str(); string op = n; // Convert operator to C operator if they don't match if (n == "=") op = "=="; else if (n == "and") op = "&"; else if (n == "or") op = "|"; else if (n == "xor") op = "^"; op = string(" ") + op + " "; string val("("); val += *a + op + *b; while (i != prim->end()) val += op + *llVal(resp_compile(cenv, *i++)); val += ")"; Value* varname = new string(cenv.penv.gensymstr("x")); out += (format("const %s %s = %s;\n") % *llType(cenv.type(prim)) % *varname % val).str(); return varname; } CVal CEngine::compileGlobalSet(CEnv& cenv, const string& sym, CVal val, const AST* type) { return NULL; } CVal CEngine::compileGlobalGet(CEnv& cenv, const string& sym, CVal val) { return NULL; } void CEngine::writeModule(CEnv& cenv, std::ostream& os) { os << out; } const string CEngine::call(CEnv& cenv, CFunc f, const AST* retT) { cenv.err << "C backend does not support JIT (call)" << endl; return ""; } Engine* resp_new_c_engine() { return new CEngine(); }