/* Resp: A programming language
* Copyright (C) 2008-2009 David Robillard <dave@drobilla.net>
*
* 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 <http://www.gnu.org/licenses/>.
*/
/** @file
* @brief Parsing (build a code AST from a textual AST)
*/
#include "resp.hpp"
using namespace std;
const ATuple*
parseTuple(PEnv& penv, const ATuple* e)
{
List<ATuple, const AST> ret;
FOREACHP(ATuple::const_iterator, i, e)
ret.push_back(penv.parse(*i));
return ret.head;
}
const AST*
PEnv::parse(const AST* exp)
{
const ATuple* tup = exp->to_tuple();
if (tup) {
THROW_IF(tup->empty(), exp->loc, "Call to empty list");
const ALexeme* form = tup->head()->to_lexeme();
if (form) {
if (isupper(form->cppstr.c_str()[0])) // Call constructor (any uppercase symbol)
return parseTuple(*this, tup);
const PEnv::Handler* h = handler(form->cppstr);
if (h)
return h->func(*this, exp, h->arg); // Parse special form
}
return parseTuple(*this, tup); // Parse regular call
}
const ALexeme* lex = exp->to_lexeme();
assert(lex);
if (isdigit(lex->cppstr[0])) {
const std::string& s = lex->cppstr;
if (s.find('.') == string::npos)
return new ALiteral<int32_t>(T_INT32, strtol(s.c_str(), NULL, 10), exp->loc);
else
return new ALiteral<float>(T_FLOAT, strtod(s.c_str(), NULL), exp->loc);
} else if (lex->cppstr[0] == '\"') {
return new AString(exp->loc, lex->cppstr.substr(1, lex->cppstr.length() - 2));
} else if (lex->cppstr == "#t") {
return new ALiteral<bool>(T_BOOL, true, exp->loc);
} else if (lex->cppstr == "#f") {
return new ALiteral<bool>(T_BOOL, false, exp->loc);
}
return sym(lex->cppstr, exp->loc);
}
/***************************************************************************
* Parser Functions *
***************************************************************************/
inline const AST*
parseCall(PEnv& penv, const AST* exp, void* arg)
{
return parseTuple(penv, exp->to_tuple());
}
inline const AST*
parseBool(PEnv& penv, const AST* exp, void* arg)
{
return new ALiteral<bool>(T_BOOL, *reinterpret_cast<bool*>(arg), exp->loc);
}
inline const AST*
parseFn(PEnv& penv, const AST* exp, void* arg)
{
const ATuple* texp = exp->to_tuple();
ATuple::const_iterator a = texp->begin();
THROW_IF(++a == texp->end(), exp->loc, "Unexpected end of `fn' form");
const ATuple* prot = parseTuple(penv, (*a++)->to_tuple());
List<ATuple, const AST> ret(new ATuple(penv.sym("fn"), NULL, Cursor()));
ret.push_back(prot);
while (a != texp->end())
ret.push_back(penv.parse(*a++));
ret.head->loc = exp->loc;
return new ATuple(*ret.head);
}
inline const AST*
parseQuote(PEnv& penv, const AST* exp, void* arg)
{
const ATuple* texp = exp->to_tuple();
THROW_IF(texp->list_len() != 2, exp->loc, "`quote' requires exactly 1 argument");
const ALexeme* quotee = texp->list_ref(1)->to_lexeme();
THROW_IF(!quotee, exp->loc, "`quote' argument is not a lexeme");
ATuple* ret = tup<ATuple>(texp->loc, penv.sym("quote"), quotee, NULL);
return ret;
}
inline const AST*
parseDef(PEnv& penv, const AST* exp, void* arg)
{
const ATuple* tup = exp->as_tuple();
ATuple::const_iterator i = tup->begin();
THROW_IF(i == tup->end(), tup->loc, "Unexpected end of `def' form");
const AST* arg1 = *(++i);
THROW_IF(i == tup->end(), arg1->loc, "Unexpected end of `def' form");
if (arg1->to_lexeme()) {
return parseCall(penv, exp, arg);
} else {
// (def (f x) y) => (def f (fn (x) y))
const ATuple* pat = arg1->to_tuple();
List<ATuple, const AST> argsExp;
ATuple::const_iterator j = pat->begin();
for (++j; j != pat->end(); ++j)
argsExp.push_back(*j);
argsExp.head->loc = exp->loc;
const AST* body = *(++i);
List<ATuple, const AST> fnExp;
fnExp.push_back(new ALexeme(exp->loc, "fn"));
fnExp.push_back(argsExp.head);
for (; i != tup->end(); ++i)
fnExp.push_back(*i);
fnExp.head->loc = body->loc;
List<ATuple, const AST> ret;
ret.push_back(tup->head());
ret.push_back(pat->head());
ret.push_back(fnExp.head);
ret.head->loc = exp->loc;
return parseCall(penv, ret.head, arg);
}
}
/***************************************************************************
* Language Definition *
***************************************************************************/
void
initLang(PEnv& penv, TEnv& tenv)
{
// Types
tenv.def(penv.sym("Bool"), new AType(penv.sym("Bool"), AType::PRIM));
tenv.def(penv.sym("Float"), new AType(penv.sym("Float"), AType::PRIM));
tenv.def(penv.sym("Int"), new AType(penv.sym("Int"), AType::PRIM));
tenv.def(penv.sym("Lexeme"), new AType(penv.sym("Lexeme"), AType::PRIM));
tenv.def(penv.sym("Nothing"), new AType(penv.sym("Nothing"), AType::PRIM));
tenv.def(penv.sym("Quote"), new AType(penv.sym("Quote"), AType::PRIM));
tenv.def(penv.sym("String"), new AType(penv.sym("String"), AType::PRIM));
// Special forms
penv.reg(".", PEnv::Handler(parseCall));
penv.reg("def", PEnv::Handler(parseDef));
penv.reg("def-type", PEnv::Handler(parseCall));
penv.reg("fn", PEnv::Handler(parseFn));
penv.reg("if", PEnv::Handler(parseCall));
penv.reg("match", PEnv::Handler(parseCall));
penv.reg("quote", PEnv::Handler(parseQuote));
// Numeric primitives
penv.primitives.insert("+");
penv.primitives.insert("-");
penv.primitives.insert("*");
penv.primitives.insert("/");
penv.primitives.insert("%");
penv.primitives.insert("and");
penv.primitives.insert("or");
penv.primitives.insert("xor");
penv.primitives.insert("=");
penv.primitives.insert("!=");
penv.primitives.insert(">");
penv.primitives.insert(">=");
penv.primitives.insert("<");
penv.primitives.insert("<=");
FOREACH (PEnv::Primitives::const_iterator, i, penv.primitives)
penv.reg(*i, PEnv::Handler(parseCall));
}