Add quote to syntax (currently only a lexeme is quotable, no lists...)

git-svn-id: http://svn.drobilla.net/resp/resp@262 ad02d1e2-f140-0410-9f75-f8b11f17cedd

7 files changed, 63 insertions, 8 deletions

diff --git a/src/c.cpp b/src/c.cpp
index d6d71f3..7f4a563 100644
--- a/src/c.cpp
+++ b/src/c.cpp
@@ -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)                         *