2003-10-30 16:18:40 +00:00
|
|
|
#include <sstream>
|
|
|
|
|
|
|
|
#include <sys/types.h>
|
|
|
|
#include <sys/stat.h>
|
2003-10-31 11:22:56 +00:00
|
|
|
#include <fcntl.h>
|
2003-10-30 16:18:40 +00:00
|
|
|
#include <unistd.h>
|
|
|
|
|
2003-10-29 16:05:03 +00:00
|
|
|
extern "C" {
|
|
|
|
#include <sglr.h>
|
|
|
|
#include <asfix2.h>
|
|
|
|
}
|
|
|
|
|
|
|
|
#include "parser.hh"
|
|
|
|
#include "shared.hh"
|
2003-10-30 16:18:40 +00:00
|
|
|
#include "fix-expr.hh"
|
2003-10-29 16:05:03 +00:00
|
|
|
#include "expr.hh"
|
|
|
|
#include "parse-table.h"
|
|
|
|
|
|
|
|
|
2003-10-31 11:22:56 +00:00
|
|
|
/* Cleanup cleans up an imploded parse tree into an actual abstract
|
|
|
|
syntax tree that we can evaluate. It removes quotes around
|
|
|
|
strings, converts integer literals into actual integers, and
|
|
|
|
absolutises paths relative to the directory containing the input
|
|
|
|
file. */
|
2003-10-30 16:18:40 +00:00
|
|
|
struct Cleanup : TermFun
|
|
|
|
{
|
|
|
|
string basePath;
|
|
|
|
|
|
|
|
virtual ATerm operator () (ATerm e)
|
|
|
|
{
|
2003-11-16 17:46:31 +00:00
|
|
|
ATMatcher m;
|
|
|
|
string s;
|
2003-10-30 16:18:40 +00:00
|
|
|
|
2003-11-16 17:46:31 +00:00
|
|
|
if (atMatch(m, e) >> "Str" >> s) {
|
2003-10-30 16:18:40 +00:00
|
|
|
return ATmake("Str(<str>)",
|
2003-11-16 17:46:31 +00:00
|
|
|
string(s, 1, s.size() - 2).c_str());
|
2003-10-30 16:18:40 +00:00
|
|
|
}
|
|
|
|
|
2003-11-16 17:46:31 +00:00
|
|
|
if (atMatch(m, e) >> "Path" >> s) {
|
|
|
|
if (s[0] != '/')
|
|
|
|
s = basePath + "/" + s;
|
|
|
|
return ATmake("Path(<str>)", canonPath(s).c_str());
|
2003-10-30 16:18:40 +00:00
|
|
|
}
|
|
|
|
|
2003-11-16 17:46:31 +00:00
|
|
|
if (atMatch(m, e) >> "Int" >> s) {
|
2003-10-30 16:18:40 +00:00
|
|
|
istringstream s2(s);
|
|
|
|
int n;
|
|
|
|
s2 >> n;
|
|
|
|
return ATmake("Int(<int>)", n);
|
|
|
|
}
|
|
|
|
|
2003-11-16 17:46:31 +00:00
|
|
|
if (atMatch(m, e) >> "Bool" >> "true")
|
2003-11-02 17:36:15 +00:00
|
|
|
return ATmake("Bool(True)");
|
|
|
|
|
2003-11-16 17:46:31 +00:00
|
|
|
if (atMatch(m, e) >> "Bool" >> "false")
|
2003-11-02 17:36:15 +00:00
|
|
|
return ATmake("Bool(False)");
|
|
|
|
|
2003-11-16 17:46:31 +00:00
|
|
|
if (atMatch(m, e) >> "ExprNil")
|
2003-11-03 11:59:35 +00:00
|
|
|
return (ATerm) ATempty;
|
|
|
|
|
2003-11-16 17:46:31 +00:00
|
|
|
ATerm e1;
|
|
|
|
ATermList e2;
|
|
|
|
if (atMatch(m, e) >> "ExprCons" >> e1 >> e2)
|
|
|
|
return (ATerm) ATinsert(e2, e1);
|
2003-11-03 11:59:35 +00:00
|
|
|
|
2003-10-30 16:18:40 +00:00
|
|
|
return e;
|
|
|
|
}
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
|
|
Expr parseExprFromFile(Path path)
|
2003-10-29 16:05:03 +00:00
|
|
|
{
|
2003-10-30 16:18:40 +00:00
|
|
|
#if 0
|
2003-10-29 16:05:03 +00:00
|
|
|
/* Perhaps this is already an imploded parse tree? */
|
|
|
|
Expr e = ATreadFromNamedFile(path.c_str());
|
|
|
|
if (e) return e;
|
2003-10-30 16:18:40 +00:00
|
|
|
#endif
|
|
|
|
|
|
|
|
/* If `path' refers to a directory, append `/default.fix'. */
|
|
|
|
struct stat st;
|
|
|
|
if (stat(path.c_str(), &st))
|
|
|
|
throw SysError(format("getting status of `%1%'") % path);
|
|
|
|
if (S_ISDIR(st.st_mode))
|
|
|
|
path = canonPath(path + "/default.fix");
|
2003-10-29 16:05:03 +00:00
|
|
|
|
|
|
|
/* Initialise the SDF libraries. */
|
|
|
|
static bool initialised = false;
|
|
|
|
static ATerm parseTable = 0;
|
|
|
|
static language lang = 0;
|
|
|
|
|
|
|
|
if (!initialised) {
|
|
|
|
PT_initMEPTApi();
|
|
|
|
PT_initAsFix2Api();
|
|
|
|
SGinitParser(ATfalse);
|
|
|
|
|
|
|
|
ATprotect(&parseTable);
|
|
|
|
parseTable = ATreadFromBinaryString(
|
|
|
|
(char *) fixParseTable, sizeof fixParseTable);
|
|
|
|
if (!parseTable)
|
|
|
|
throw Error(format("cannot construct parse table term"));
|
|
|
|
|
|
|
|
ATprotect(&lang);
|
|
|
|
lang = ATmake("Fix");
|
|
|
|
if (!SGopenLanguageFromTerm(
|
|
|
|
(char *) programId.c_str(), lang, parseTable))
|
|
|
|
throw Error(format("cannot open language"));
|
|
|
|
|
|
|
|
SG_STARTSYMBOL_ON();
|
|
|
|
SG_OUTPUT_ON();
|
|
|
|
SG_ASFIX2ME_ON();
|
|
|
|
SG_AMBIGUITY_ERROR_ON();
|
2003-11-10 11:00:38 +00:00
|
|
|
SG_FILTER_OFF();
|
2003-10-29 16:05:03 +00:00
|
|
|
|
|
|
|
initialised = true;
|
|
|
|
}
|
|
|
|
|
2003-10-31 11:22:56 +00:00
|
|
|
/* Read the input file. We can't use SGparseFile() because it's
|
|
|
|
broken, so we read the input ourselves and call
|
|
|
|
SGparseString(). */
|
|
|
|
AutoCloseFD fd = open(path.c_str(), O_RDONLY);
|
|
|
|
if (fd == -1) throw SysError(format("opening `%1%'") % path);
|
|
|
|
|
|
|
|
if (fstat(fd, &st) == -1)
|
|
|
|
throw SysError(format("statting `%1%'") % path);
|
|
|
|
|
|
|
|
char text[st.st_size + 1];
|
|
|
|
readFull(fd, (unsigned char *) text, st.st_size);
|
|
|
|
text[st.st_size] = 0;
|
|
|
|
|
|
|
|
/* Parse it. */
|
|
|
|
ATerm result = SGparseString(lang, "Expr", text);
|
2003-10-29 16:05:03 +00:00
|
|
|
if (!result)
|
|
|
|
throw SysError(format("parse failed in `%1%'") % path);
|
|
|
|
if (SGisParseError(result))
|
|
|
|
throw Error(format("parse error in `%1%': %2%")
|
2003-11-16 17:46:31 +00:00
|
|
|
% path % result);
|
2003-10-29 16:05:03 +00:00
|
|
|
|
2003-10-31 11:22:56 +00:00
|
|
|
/* Implode it. */
|
2003-10-29 16:05:03 +00:00
|
|
|
PT_ParseTree tree = PT_makeParseTreeFromTerm(result);
|
|
|
|
if (!tree)
|
|
|
|
throw Error(format("cannot create parse tree"));
|
|
|
|
|
|
|
|
ATerm imploded = PT_implodeParseTree(tree,
|
|
|
|
ATtrue,
|
|
|
|
ATtrue,
|
|
|
|
ATtrue,
|
|
|
|
ATtrue,
|
|
|
|
ATtrue,
|
|
|
|
ATtrue,
|
|
|
|
ATfalse,
|
|
|
|
ATtrue,
|
|
|
|
ATtrue,
|
|
|
|
ATtrue,
|
|
|
|
ATfalse);
|
|
|
|
if (!imploded)
|
|
|
|
throw Error(format("cannot implode parse tree"));
|
|
|
|
|
2003-11-03 10:21:30 +00:00
|
|
|
debug(format("imploded parse tree of `%1%': %2%")
|
2003-11-16 17:46:31 +00:00
|
|
|
% path % imploded);
|
2003-11-03 10:21:30 +00:00
|
|
|
|
2003-10-31 11:22:56 +00:00
|
|
|
/* Finally, clean it up. */
|
2003-10-30 16:18:40 +00:00
|
|
|
Cleanup cleanup;
|
|
|
|
cleanup.basePath = dirOf(path);
|
|
|
|
return bottomupRewrite(cleanup, imploded);
|
2003-10-29 16:05:03 +00:00
|
|
|
}
|