aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Makefile1
-rw-r--r--src/c.cpp288
-rw-r--r--src/llvm.cpp15
-rw-r--r--src/repl.cpp12
-rw-r--r--src/tuplr.cpp21
-rw-r--r--src/tuplr.hpp3
6 files changed, 316 insertions, 24 deletions
diff --git a/Makefile b/Makefile
index 42f034d..ca1963d 100644
--- a/Makefile
+++ b/Makefile
@@ -17,6 +17,7 @@ builddir:
mkdir -p build
OBJECTS = \
+ build/c.o \
build/compile.o \
build/constrain.o \
build/cps.o \
diff --git a/src/c.cpp b/src/c.cpp
new file mode 100644
index 0000000..94831de
--- /dev/null
+++ b/src/c.cpp
@@ -0,0 +1,288 @@
+/* Tuplr: A programming language
+ * Copyright (C) 2008-2009 David Robillard <dave@drobilla.net>
+ *
+ * Tuplr 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.
+ *
+ * Tuplr 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 Tuplr. If not, see <http://www.gnu.org/licenses/>.
+ */
+
+/** @file
+ * @brief Compile to C
+ */
+
+#include <map>
+#include <sstream>
+#include <boost/format.hpp>
+#include "tuplr.hpp"
+
+using namespace std;
+using boost::format;
+
+typedef string Type;
+typedef string Value;
+
+struct Function {
+ string returnType;
+ string name;
+ string text;
+};
+
+static inline Value* llVal(CValue v) { return static_cast<Value*>(v); }
+static inline Function* llFunc(CFunction f) { return static_cast<Function*>(f); }
+
+static const Type*
+llType(const AType* t)
+{
+ if (t->kind == AType::PRIM) {
+ if (t->at(0)->str() == "Nothing") return new string("void");
+ if (t->at(0)->str() == "Bool") return new string("bool");
+ if (t->at(0)->str() == "Int") return new string("int");
+ if (t->at(0)->str() == "Float") return new string("float");
+ throw Error(t->loc, string("Unknown primitive type `") + t->str() + "'");
+ } else if (t->kind == AType::EXPR && t->at(0)->str() == "Fn") {
+ const AType* retT = t->at(2)->as<const AType*>();
+ if (!llType(retT))
+ return NULL;
+
+ Type* ret = new Type(*llType(retT) + " (*)(");
+ const ATuple* prot = t->at(1)->to<const ATuple*>();
+ for (size_t i = 0; i < prot->size(); ++i) {
+ const AType* at = prot->at(i)->to<const AType*>();
+ const Type* lt = llType(at);
+ if (!lt)
+ return NULL;
+ *ret += *lt;
+ }
+ *ret += ")";
+
+ return ret;
+ }
+ return NULL; // non-primitive type
+}
+
+
+/***************************************************************************
+ * LLVM Engine *
+ ***************************************************************************/
+
+struct CEngine : public Engine {
+ CEngine()
+ : out(
+ "#include <stdint.h>\n"
+ "#include <stdbool.h>\n"
+ "void* tuplr_gc_allocate(unsigned size, uint8_t tag);\n\n");
+ {
+ }
+
+ CFunction startFunction(CEnv& cenv,
+ const std::string& name, const AType* retT, const ATuple& argsT,
+ const vector<string> argNames)
+ {
+ vector<const Type*> cprot;
+ FOREACH(ATuple::const_iterator, i, argsT) {
+ AType* at = (*i)->as<AType*>();
+ THROW_IF(!llType(at), Cursor(), string("non-concrete parameter :: ")
+ + at->str())
+ cprot.push_back(llType(at));
+ }
+
+ THROW_IF(!llType(retT), Cursor(), "return has non-concrete type");
+
+ Function* f = new Function();
+ f->returnType = *llType(retT);
+ f->name = name;
+ f->text += f->returnType + "\n" + f->name + "(";
+ for (size_t i = 0; i != argsT.size(); ++i) {
+ if (i > 0)
+ f->text += ", ";
+ f->text += *llType(argsT.at(i)->as<const AType*>()) + " " + argNames.at(i);
+ }
+ f->text += ")\n{\n";
+
+ out += f->text;
+ return f;
+ }
+
+ void finishFunction(CEnv& cenv, CFunction f, const AType* retT, CValue ret) {
+ out += "return " + *(Value*)ret + ";\n}\n\n";
+ }
+
+ void eraseFunction(CEnv& cenv, CFunction f) {
+ cenv.err << "C backend does not support JIT (eraseFunction)" << endl;
+ }
+
+ CValue compileCall(CEnv& cenv, CFunction func, const vector<CValue>& 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();
+ FOREACH(vector<CValue>::const_iterator, i, args)
+ out += *llVal(*i);
+ out += ");\n";
+ return varname;
+ }
+
+ void liftCall(CEnv& cenv, AFn* fn, const AType& argsT);
+
+ CValue compileLiteral(CEnv& cenv, AST* lit);
+ CValue compilePrimitive(CEnv& cenv, APrimitive* prim);
+ CValue compileIf(CEnv& cenv, AIf* aif);
+
+ void writeModule(CEnv& cenv, std::ostream& os) {
+ os << out;
+ }
+
+ const string call(CEnv& cenv, CFunction f, AType* retT) {
+ cenv.err << "C backend does not support JIT (call)" << endl;
+ return "";
+ }
+
+ std::string out;
+};
+
+Engine*
+tuplr_new_c_engine()
+{
+ return new CEngine();
+}
+
+/***************************************************************************
+ * Code Generation *
+ ***************************************************************************/
+
+CValue
+CEngine::compileLiteral(CEnv& cenv, AST* lit)
+{
+ return new Value(lit->str());
+}
+
+void
+CEngine::liftCall(CEnv& cenv, AFn* fn, const AType& argsT)
+{
+ TEnv::GenericTypes::const_iterator gt = cenv.tenv.genericTypes.find(fn);
+ assert(gt != cenv.tenv.genericTypes.end());
+ CEngine* engine = reinterpret_cast<CEngine*>(cenv.engine());
+ AType* genericType = new AType(*gt->second);
+ AType* thisType = genericType;
+ Subst argsSubst;
+
+ // Build and apply substitution to get concrete type for this call
+ if (!genericType->concrete()) {
+ argsSubst = cenv.tenv.buildSubst(genericType, argsT);
+ thisType = argsSubst.apply(genericType)->as<AType*>();
+ }
+
+ THROW_IF(!thisType->concrete(), fn->loc,
+ string("call has non-concrete type %1%\n") + thisType->str());
+
+ Object::pool.addRoot(thisType);
+ if (fn->impls.find(thisType))
+ return;
+
+ ATuple* protT = thisType->at(1)->as<ATuple*>();
+
+ vector<string> argNames;
+ for (size_t i = 0; i < fn->prot()->size(); ++i)
+ argNames.push_back(fn->prot()->at(i)->str());
+
+ // Write function declaration
+ const string name = (fn->name == "") ? cenv.penv.gensymstr("_fn") : fn->name;
+ Function* f = llFunc(cenv.engine()->startFunction(cenv, name,
+ thisType->at(thisType->size()-1)->to<AType*>(),
+ *protT, argNames));
+
+ cenv.push();
+ Subst oldSubst = cenv.tsubst;
+ cenv.tsubst = Subst::compose(cenv.tsubst, Subst::compose(argsSubst, fn->subst));
+
+ // Bind argument values in CEnv
+ vector<Value*> args;
+ AFn::const_iterator p = fn->prot()->begin();
+ size_t i = 0;
+ for (; p != fn->prot()->end(); ++p, ++i) {
+ AType* t = protT->at(i)->as<AType*>();
+ const Type* lt = llType(t);
+ THROW_IF(!lt, fn->loc, "untyped parameter\n");
+ cenv.def((*p)->as<ASymbol*>(), *p, t, new string(fn->prot()->at(i)->str()));
+ }
+
+ // Write function body
+ try {
+ // Define value first for recursion
+ cenv.precompile(fn, f);
+ fn->impls.push_back(make_pair(thisType, f));
+ CValue retVal = NULL;
+ for (size_t i = 2; i < fn->size(); ++i)
+ retVal = cenv.compile(fn->at(i));
+ cenv.engine()->finishFunction(cenv, f, cenv.type(fn->at(fn->size() - 1)), retVal);
+ } catch (Error& e) {
+ cenv.pop();
+ throw e;
+ }
+ cenv.tsubst = oldSubst;
+ cenv.pop();
+}
+
+CValue
+CEngine::compileIf(CEnv& cenv, AIf* aif)
+{
+ CEngine* engine = reinterpret_cast<CEngine*>(cenv.engine());
+ Value* varname = new string(cenv.penv.gensymstr("if"));
+ out += (format("%s %s;\n") % *llType(cenv.type(aif)) % *varname).str();
+ for (size_t i = 1; i < aif->size() - 1; i += 2) {
+ if (i > 1)
+ out += "else {\n";
+
+ Value* condV = llVal(cenv.compile(aif->at(i)));
+ out += (format("if (%s) {\n") % *condV).str();
+
+ Value* thenV = llVal(cenv.compile(aif->at(i + 1)));
+ out += (format("%s = %s;\n}\n") % *varname % *thenV).str();
+ }
+
+ // Emit final else block
+ out += "else {\n";
+ Value* elseV = llVal(cenv.compile(aif->at(aif->size() - 1)));
+ out += (format("%s = %s;\n}\n") % *varname % *elseV).str();
+
+ for (size_t i = 1; i < (aif->size() - 1) / 2; ++i)
+ out += "}";
+
+ return varname;
+}
+
+CValue
+CEngine::compilePrimitive(CEnv& cenv, APrimitive* prim)
+{
+ CEngine* engine = reinterpret_cast<CEngine*>(cenv.engine());
+ Value* a = llVal(cenv.compile(prim->at(1)));
+ Value* b = llVal(cenv.compile(prim->at(2)));
+ const string n = prim->at(0)->to<ASymbol*>()->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;
+ for (size_t i = 3; i < prim->size(); ++i)
+ val += op + *llVal(cenv.compile(prim->at(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;
+}
diff --git a/src/llvm.cpp b/src/llvm.cpp
index e2f7f1a..9e519a7 100644
--- a/src/llvm.cpp
+++ b/src/llvm.cpp
@@ -16,11 +16,7 @@
*/
/** @file
- * @brief Compile AST to LLVM IR
- *
- * Compilation pass functions (lift/compile) that require direct use of LLVM
- * specific things are implemented here. Generic compilation pass functions
- * are implemented in compile.cpp.
+ * @brief Compile to LLVM IR
*/
#include <map>
@@ -64,11 +60,10 @@ llType(const AType* t)
const ATuple* prot = t->at(1)->to<const ATuple*>();
for (size_t i = 0; i < prot->size(); ++i) {
const AType* at = prot->at(i)->to<const AType*>();
- const Type* lt = llType(at);
- if (lt)
- cprot.push_back(lt);
- else
+ const Type* lt = llType(at);
+ if (!lt)
return NULL;
+ cprot.push_back(lt);
}
FunctionType* fT = FunctionType::get(llType(retT), cprot, false);
@@ -159,7 +154,7 @@ struct LLVMEngine : public Engine {
return builder.CreateCall(llFunc(f), llArgs.begin(), llArgs.end());
}
- void liftCall(CEnv& cenv, AFn* fn, const AType& argsT);
+ void liftCall(CEnv& cenv, AFn* fn, const AType& argsT);
CValue compileLiteral(CEnv& cenv, AST* lit);
CValue compilePrimitive(CEnv& cenv, APrimitive* prim);
diff --git a/src/repl.cpp b/src/repl.cpp
index fc7b6ec..24b0acf 100644
--- a/src/repl.cpp
+++ b/src/repl.cpp
@@ -28,7 +28,7 @@ using namespace std;
/// Compile and evaluate code from @a is
int
-eval(CEnv& cenv, const string& name, istream& is)
+eval(CEnv& cenv, const string& name, istream& is, bool execute)
{
AST* result = NULL;
AType* resultType = NULL;
@@ -74,11 +74,15 @@ eval(CEnv& cenv, const string& name, istream& is)
for (list< pair<AST*, AST*> >::const_iterator i = exprs.begin(); i != exprs.end(); ++i)
val = cenv.compile(i->second);
- // Finish and call it
+ // Finish compilation
cenv.engine()->finishFunction(cenv, f, resultType, val);
- cenv.out << cenv.engine()->call(cenv, f, resultType);
+
+ // Call it
+ if (execute)
+ cenv.out << cenv.engine()->call(cenv, f, resultType);
}
- cenv.out << " : " << resultType << endl;
+ if (execute)
+ cenv.out << " : " << resultType << endl;
Object::pool.collect(Object::pool.roots());
diff --git a/src/tuplr.cpp b/src/tuplr.cpp
index 481885c..867897d 100644
--- a/src/tuplr.cpp
+++ b/src/tuplr.cpp
@@ -35,13 +35,13 @@ print_usage(char* name, bool error)
os << "Usage: " << name << " [OPTION]... [FILE]..." << endl;
os << "Evaluate and/or compile Tuplr code" << endl;
os << endl;
- os << " -h Display this help and exit" << endl;
- os << " -r Enter REPL after evaluating files" << endl;
- os << " -p Pretty-print input only" << endl;
- os << " -g Debug (disable optimisation)" << endl;
- os << " -d Dump assembly output" << endl;
- os << " -e EXPRESSION Evaluate EXPRESSION" << endl;
- os << " -o FILE Write output to FILE" << endl;
+ os << " -h Display this help and exit" << endl;
+ os << " -r Enter REPL after evaluating files" << endl;
+ os << " -p Pretty-print input only" << endl;
+ os << " -g Debug (disable optimisation)" << endl;
+ os << " -d Dump assembly output" << endl;
+ os << " -e EXPRESSION Evaluate EXPRESSION" << endl;
+ os << " -o FILE Compile output to FILE (don't run)" << endl;
return error ? 1 : 0;
}
@@ -80,6 +80,8 @@ main(int argc, char** argv)
if (backend_name == "llvm")
engine = tuplr_new_llvm_engine();
+ else if (backend_name == "c")
+ engine = tuplr_new_c_engine();
if (!engine) {
std::cerr << "Unable to open backend " << backend_name << std::endl;
@@ -95,6 +97,7 @@ main(int argc, char** argv)
int ret = 0;
a = args.find("-o");
+ bool batch = a != args.end();
const string output = (a != args.end()) ? a->second : "";
if (args.find("-p") != args.end()) {
@@ -111,13 +114,13 @@ main(int argc, char** argv)
a = args.find("-e");
if (a != args.end()) {
istringstream is(a->second);
- ret = eval(*cenv, "(command line)", is);
+ ret = eval(*cenv, "(command line)", is, !batch);
}
for (list<string>::iterator f = files.begin(); f != files.end(); ++f) {
ifstream is(f->c_str());
if (is.good()) {
- ret = ret | eval(*cenv, *f, is);
+ ret = ret | eval(*cenv, *f, is, !batch);
} else {
cerr << argv[0] << ": " << *f << ": " << strerror(errno) << endl;
++ret;
diff --git a/src/tuplr.hpp b/src/tuplr.hpp
index c3c30c4..c31e000 100644
--- a/src/tuplr.hpp
+++ b/src/tuplr.hpp
@@ -640,6 +640,7 @@ struct Engine {
};
Engine* tuplr_new_llvm_engine();
+Engine* tuplr_new_c_engine();
/// Compile-Time Environment
struct CEnv {
@@ -692,7 +693,7 @@ private:
void pprint(std::ostream& out, const AST* ast);
void initLang(PEnv& penv, TEnv& tenv);
-int eval(CEnv& cenv, const string& name, istream& is);
+int eval(CEnv& cenv, const string& name, istream& is, bool execute);
int repl(CEnv& cenv);
#endif // TUPLR_HPP
generated by cgit v1.2.1 (git 2.18.0) at 2024-06-22 10:43:22 +0000