/* 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 Parsing (build a code AST from a textual AST) */ #include "resp.hpp" using namespace std; const ATuple* parseTuple(PEnv& penv, const ATuple* e) { List 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(T_INT32, strtol(s.c_str(), NULL, 10), exp->loc); else return new ALiteral(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(T_BOOL, true, exp->loc); } else if (lex->cppstr == "#f") { return new ALiteral(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(T_BOOL, *reinterpret_cast(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 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(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 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 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 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)); }