Du kannst nicht mehr als 25 Themen auswählen
Themen müssen entweder mit einem Buchstaben oder einer Ziffer beginnen. Sie können Bindestriche („-“) enthalten und bis zu 35 Zeichen lang sein.
1980 Zeilen
64 KiB
1980 Zeilen
64 KiB
%{
|
|
|
|
/* compile: leg -o parse.c parse.leg
|
|
* cc -o parse parse.c
|
|
*
|
|
* run: echo "3+4" | ./parse
|
|
*/
|
|
|
|
#define DO_PROTOS() \
|
|
_DO(If) _DO(While) _DO(Do) _DO(For) _DO(Switch) _DO(Call) _DO(Invoke) _DO(Func) _DO(Block) \
|
|
_DO(Declaration) _DO(Assign) \
|
|
_DO(Map) _DO(Symbol) _DO(Integer) _DO(String) \
|
|
_DO(Logor) _DO(Logand) _DO(Bitor) _DO(Bitxor) _DO(Bitand) \
|
|
_DO(Equal) _DO(Noteq) _DO(Less) _DO(Lesseq) _DO(Greater) _DO(Greatereq) _DO(Shleft) _DO(Shright) \
|
|
_DO(Add) _DO(Sub) _DO(Mul) _DO(Div) _DO(Mod) _DO(Not) _DO(Neg) _DO(Com) \
|
|
_DO(PreIncVariable) _DO(PreIncMember) _DO(PreIncIndex) \
|
|
_DO(PostIncVariable) _DO(PostIncMember) _DO(PostIncIndex) \
|
|
_DO(PreDecVariable) _DO(PreDecMember) _DO(PreDecIndex) \
|
|
_DO(PostDecVariable) _DO(PostDecMember) _DO(PostDecIndex) \
|
|
_DO(GetVariable) _DO(GetMember) _DO(SetMember) _DO(GetIndex) _DO(SetIndex) \
|
|
_DO(Return) _DO(Break) _DO(Continue) _DO(Throw) _DO(Try) \
|
|
_DO(Quasiquote) _DO(Unquote)
|
|
|
|
typedef enum {
|
|
t_UNDEFINED=0,
|
|
#define _DO(NAME) t_##NAME,
|
|
DO_PROTOS()
|
|
#undef _DO
|
|
} proto_t;
|
|
|
|
#define SYMBOL_PAYLOAD proto_t prototype;
|
|
|
|
#include "object.c"
|
|
|
|
#include <setjmp.h>
|
|
|
|
enum jb_t {
|
|
j_return = 1,
|
|
j_break,
|
|
j_continue,
|
|
j_throw,
|
|
};
|
|
|
|
typedef struct jb_record
|
|
{
|
|
sigjmp_buf jb;
|
|
oop result;
|
|
struct jb_record *next;
|
|
} jb_record;
|
|
|
|
jb_record *jbs= NULL;
|
|
|
|
jb_record *jbRecPush() {
|
|
jb_record *newJbRec = memcheck(malloc(sizeof(jb_record)));
|
|
newJbRec->result = null;
|
|
newJbRec->next = jbs;
|
|
jbs = newJbRec;
|
|
return newJbRec;
|
|
}
|
|
|
|
jb_record *jbRecPop() {
|
|
assert(jbs);
|
|
jb_record *head = jbs;
|
|
jbs = head->next;
|
|
return head;
|
|
}
|
|
|
|
|
|
// this is the global scope
|
|
oop globals= 0;
|
|
|
|
#define DO_SYMBOLS() \
|
|
DO_PROTOS() _DO(__proto__) _DO(__name__) _DO(__default__) _DO(__arguments__) \
|
|
_DO(name) _DO(body) _DO(param) _DO(key) _DO(value) _DO(condition) _DO(consequent) _DO(alternate) \
|
|
_DO(lhs) _DO(rhs) _DO(scope) _DO(args) _DO(expression) _DO(labels) _DO(statements) _DO(initialise) \
|
|
_DO(update) _DO(this) _DO(fixed) _DO(operator) _DO(map) _DO(func) \
|
|
_DO(try) _DO(catch) _DO(finally) _DO(exception) \
|
|
_DO(__line__) _DO(__file__)
|
|
|
|
#define _DO(NAME) oop NAME##_symbol;
|
|
DO_SYMBOLS()
|
|
#undef _DO
|
|
|
|
#define _DO(NAME) oop NAME##_proto;
|
|
DO_PROTOS()
|
|
#undef _DO
|
|
|
|
int opt_v= 0;
|
|
oop mrAST= null;
|
|
|
|
typedef struct input_t
|
|
{
|
|
oop name;
|
|
FILE *file;
|
|
struct input_t *next;
|
|
int lineNumber;
|
|
} input_t;
|
|
|
|
input_t *inputStack= NULL;
|
|
|
|
void inputStackPush(char *name) {
|
|
FILE *file = stdin;
|
|
if (NULL != name) {
|
|
file= fopen(name, "rb");
|
|
if (NULL == file) {
|
|
perror(name);
|
|
exit(1);
|
|
}
|
|
} else {
|
|
name= "<stdin>";
|
|
}
|
|
input_t *input = memcheck(malloc(sizeof(input_t)));
|
|
input->name= makeString(name);
|
|
input->lineNumber= 1;
|
|
input->file= file;
|
|
input->next= inputStack;
|
|
inputStack= input;
|
|
return;
|
|
}
|
|
|
|
input_t *inputStackPop(void) {
|
|
assert(inputStack);
|
|
input_t *first= inputStack;
|
|
inputStack= first->next;
|
|
return first;
|
|
}
|
|
|
|
int isFalse(oop obj)
|
|
{
|
|
return obj == null || (isInteger(obj) && (0 == getInteger(obj)));
|
|
}
|
|
|
|
int isTrue(oop obj)
|
|
{
|
|
return !isFalse(obj);
|
|
}
|
|
|
|
oop newObject(oop proto)
|
|
{
|
|
oop map = makeMap();
|
|
map_set(map, __proto___symbol, proto);
|
|
// set context (file and line) for runtime error msg
|
|
map_set(map, __line___symbol, makeInteger(inputStack->lineNumber));
|
|
map_set(map, __file___symbol, inputStack->name);
|
|
return map;
|
|
}
|
|
|
|
void printObjectName(oop object)
|
|
{
|
|
assert(is(Map, object));
|
|
oop name = map_get(object, __name___symbol);
|
|
if (name != null) {
|
|
println(name);
|
|
return;
|
|
}
|
|
|
|
oop proto = map_get(object, __proto___symbol);
|
|
if (proto != null) {
|
|
printObjectName(proto);
|
|
} else {
|
|
fprintf(stderr, "\nThis map has no name\n");
|
|
}
|
|
}
|
|
|
|
// this always creates the key in "object"
|
|
oop newVariable(oop object, oop key, oop value)
|
|
{
|
|
map_set(object, key, value);
|
|
return value;
|
|
}
|
|
|
|
// this looks in object and everything in the __proto__ chain until it finds the key
|
|
oop getVariable(oop object, oop key)
|
|
{
|
|
while (!map_hasKey(object, key)) {
|
|
object = map_get(object, __proto___symbol);
|
|
if (null == object) {
|
|
printf("\nUndefined: ");
|
|
println(key);
|
|
exit(1);
|
|
return null;
|
|
}
|
|
}
|
|
return map_get(object, key);
|
|
}
|
|
|
|
// this follows the __proto__ chain until it finds the key, if it fails it behaves like newMember
|
|
oop setVariable(oop object, oop key, oop value)
|
|
{
|
|
oop obj= object;
|
|
while (!map_hasKey(obj, key)) {
|
|
obj= map_get(obj, __proto___symbol);
|
|
if (null == obj) {
|
|
return map_set(object, key, value);
|
|
}
|
|
}
|
|
return map_set(obj, key, value);
|
|
}
|
|
|
|
oop getMember(oop object, oop key)
|
|
{
|
|
if (!map_hasKey(object, key)) {
|
|
printf("\nUndefined: .");
|
|
println(key);
|
|
exit(1);
|
|
return null;
|
|
}
|
|
return map_get(object, key);
|
|
}
|
|
|
|
oop newMap(oop value)
|
|
{
|
|
oop map = newObject(Map_proto);
|
|
map_set(map, value_symbol, value);
|
|
return map;
|
|
}
|
|
|
|
oop newDeclaration(oop name, oop exp)
|
|
{
|
|
oop declaration = newObject(Declaration_proto);
|
|
map_set(declaration, lhs_symbol, name);
|
|
map_set(declaration, rhs_symbol, exp);
|
|
return declaration;
|
|
}
|
|
|
|
oop newIf(oop cond, oop cons, oop alt)
|
|
{
|
|
oop obj = newObject(If_proto);
|
|
map_set(obj, condition_symbol, cond);
|
|
map_set(obj, consequent_symbol, cons);
|
|
map_set(obj, alternate_symbol, alt);
|
|
return obj;
|
|
}
|
|
|
|
oop newWhile(oop cond, oop body)
|
|
{
|
|
oop obj = newObject(While_proto);
|
|
map_set(obj, condition_symbol, cond);
|
|
map_set(obj, body_symbol, body);
|
|
return obj;
|
|
}
|
|
|
|
oop newDo(oop body, oop cond)
|
|
{
|
|
oop obj= newObject(Do_proto);
|
|
map_set(obj, body_symbol, body);
|
|
map_set(obj, condition_symbol, cond);
|
|
return obj;
|
|
}
|
|
|
|
oop newFor(oop init, oop cond, oop step, oop body)
|
|
{
|
|
oop obj= newObject(For_proto);
|
|
map_set(obj, initialise_symbol, init);
|
|
map_set(obj, condition_symbol, cond);
|
|
map_set(obj, update_symbol, step);
|
|
map_set(obj, body_symbol, body);
|
|
return obj;
|
|
}
|
|
|
|
oop newSwitch(oop expression, oop labels, oop statements)
|
|
{
|
|
oop obj= newObject(Switch_proto);
|
|
map_set(obj, expression_symbol, expression);
|
|
map_set(obj, labels_symbol, labels);
|
|
map_set(obj, statements_symbol, statements);
|
|
return obj;
|
|
}
|
|
|
|
// take char *name or oop already interned?
|
|
oop newSymbol(oop name)
|
|
{
|
|
oop symbol = newObject(Symbol_proto);
|
|
// what is the less confusing, name or value? maybe another word like identifier?
|
|
map_set(symbol, value_symbol, name);
|
|
return symbol;
|
|
}
|
|
|
|
oop newInteger(oop value)
|
|
{
|
|
oop integer = newObject(Integer_proto);
|
|
map_set(integer, value_symbol, value);
|
|
return integer;
|
|
}
|
|
|
|
int digitValue(int c)
|
|
{
|
|
if (c < '0') return -1;
|
|
if ('a' <= c && c <= 'z') c -= ('a' - 'A'); // tolower(c)
|
|
if ('9' < c && c < 'A') return -1;
|
|
if ('Z' < c) return -1;
|
|
if (c >= 'A') c -= ('A' - 10); else c -= '0';
|
|
return c;
|
|
}
|
|
|
|
int isradix(int r, int c)
|
|
{
|
|
c= digitValue(c);
|
|
return 0 <= c && c < r;
|
|
}
|
|
|
|
char *unescape(char *s)
|
|
{
|
|
char *t= strdup(s);
|
|
int in= 0, out= 0, c= 0;
|
|
while (0 != (c= t[in++])) {
|
|
if ('\\' == c && 0 != (c= t[in])) {
|
|
++in;
|
|
switch (c) {
|
|
case 'a': c= '\a'; break;
|
|
case 'b': c= '\b'; break;
|
|
case 'e': c= '\e'; break;
|
|
case 'f': c= '\f'; break;
|
|
case 'n': c= '\n'; break;
|
|
case 'r': c= '\r'; break;
|
|
case 't': c= '\t'; break;
|
|
case 'v': c= '\v'; break;
|
|
case '0'...'7': {
|
|
c -= '0';
|
|
if (isradix(8, t[in])) c= c * 8 + t[in++] - '0';
|
|
if (isradix(8, t[in])) c= c * 8 + t[in++] - '0';
|
|
break;
|
|
}
|
|
case 'x': {
|
|
c= 0;
|
|
if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]);
|
|
if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]);
|
|
break;
|
|
}
|
|
case 'u': {
|
|
c= 0;
|
|
if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]);
|
|
if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]);
|
|
if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]);
|
|
if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]);
|
|
break;
|
|
}
|
|
}
|
|
}
|
|
t[out++]= c;
|
|
}
|
|
t[out]= 0;
|
|
return t;
|
|
}
|
|
|
|
oop newString(oop str)
|
|
{ assert(is(String, str));
|
|
oop string = newObject(String_proto);
|
|
map_set(string, value_symbol, str);
|
|
return string;
|
|
}
|
|
|
|
oop newPreIncrement(oop rhs)
|
|
{ assert(is(Map, rhs));
|
|
oop proto= map_get(rhs, __proto___symbol); assert(null != proto);
|
|
oop name= map_get(proto, __name___symbol); assert(null != name);
|
|
proto_t type= get(name, Symbol, prototype);
|
|
switch (type) {
|
|
case t_GetVariable: proto= PreIncVariable_proto; break;
|
|
case t_GetMember: proto= PreIncMember_proto; break;
|
|
case t_GetIndex: proto= PreIncIndex_proto; break;
|
|
default: {
|
|
printf("\nNon-lvalue after ++: ");
|
|
println(rhs);
|
|
exit(1);
|
|
}
|
|
}
|
|
map_set(rhs, __proto___symbol, proto);
|
|
return rhs;
|
|
}
|
|
|
|
oop newPostIncrement(oop rhs)
|
|
{ assert(is(Map, rhs));
|
|
oop proto= map_get(rhs, __proto___symbol); assert(null != proto);
|
|
oop name= map_get(proto, __name___symbol); assert(null != name);
|
|
proto_t type= get(name, Symbol, prototype);
|
|
switch (type) {
|
|
case t_GetVariable: proto= PostIncVariable_proto; break;
|
|
case t_GetMember: proto= PostIncMember_proto; break;
|
|
case t_GetIndex: proto= PostIncIndex_proto; break;
|
|
default: {
|
|
printf("\nNon-lvalue before ++: ");
|
|
println(rhs);
|
|
exit(1);
|
|
}
|
|
}
|
|
map_set(rhs, __proto___symbol, proto);
|
|
return rhs;
|
|
}
|
|
|
|
oop newPreDecrement(oop rhs)
|
|
{ assert(is(Map, rhs));
|
|
oop proto= map_get(rhs, __proto___symbol); assert(null != proto);
|
|
oop name= map_get(proto, __name___symbol); assert(null != name);
|
|
proto_t type= get(name, Symbol, prototype);
|
|
switch (type) {
|
|
case t_GetVariable: proto= PreDecVariable_proto; break;
|
|
case t_GetMember: proto= PreDecMember_proto; break;
|
|
case t_GetIndex: proto= PreDecIndex_proto; break;
|
|
default: {
|
|
printf("\nNon-lvalue after ++: ");
|
|
println(rhs);
|
|
exit(1);
|
|
}
|
|
}
|
|
map_set(rhs, __proto___symbol, proto);
|
|
return rhs;
|
|
}
|
|
|
|
oop newPostDecrement(oop rhs)
|
|
{ assert(is(Map, rhs));
|
|
oop proto= map_get(rhs, __proto___symbol); assert(null != proto);
|
|
oop name= map_get(proto, __name___symbol); assert(null != name);
|
|
proto_t type= get(name, Symbol, prototype);
|
|
switch (type) {
|
|
case t_GetVariable: proto= PostDecVariable_proto; break;
|
|
case t_GetMember: proto= PostDecMember_proto; break;
|
|
case t_GetIndex: proto= PostDecIndex_proto; break;
|
|
default: {
|
|
printf("\nNon-lvalue before ++: ");
|
|
println(rhs);
|
|
exit(1);
|
|
}
|
|
}
|
|
map_set(rhs, __proto___symbol, proto);
|
|
return rhs;
|
|
}
|
|
|
|
oop newUnary(oop proto, oop rhs)
|
|
{
|
|
oop obj = newObject(proto);
|
|
map_set(obj, rhs_symbol, rhs);
|
|
return obj;
|
|
}
|
|
|
|
oop newBinary(oop proto, oop lhs, oop rhs)
|
|
{
|
|
oop obj = newObject(proto);
|
|
map_set(obj, lhs_symbol, lhs);
|
|
map_set(obj, rhs_symbol, rhs);
|
|
return obj;
|
|
}
|
|
|
|
oop newAssign(oop proto, oop lhs, oop operator, oop rhs)
|
|
{
|
|
oop obj = newObject(proto);
|
|
map_set(obj, lhs_symbol, lhs);
|
|
map_set(obj, operator_symbol, operator);
|
|
map_set(obj, rhs_symbol, rhs);
|
|
return obj;
|
|
}
|
|
|
|
oop newSetMap(oop proto, oop map, oop key, oop operator, oop value)
|
|
{
|
|
oop obj = newObject(proto);
|
|
map_set(obj, map_symbol, map);
|
|
map_set(obj, key_symbol, key);
|
|
map_set(obj, operator_symbol, operator);
|
|
map_set(obj, value_symbol, value);
|
|
return obj;
|
|
}
|
|
|
|
oop newGetMap(oop proto, oop map, oop key)
|
|
{
|
|
oop obj = newObject(proto);
|
|
map_set(obj, map_symbol, map);
|
|
map_set(obj, key_symbol, key);
|
|
return obj;
|
|
}
|
|
|
|
oop newGetVariable(oop name)
|
|
{
|
|
oop id= newObject(GetVariable_proto);
|
|
map_set(id, key_symbol, name);
|
|
return id;
|
|
}
|
|
|
|
oop newFunc(oop name, oop param, oop body, oop fixed)
|
|
{
|
|
oop func = newObject(Func_proto);
|
|
map_set(func, name_symbol, name);
|
|
map_set(func, param_symbol, param);
|
|
map_set(func, body_symbol, body);
|
|
map_set(func, fixed_symbol, fixed);
|
|
return func;
|
|
}
|
|
|
|
oop apply(oop func, oop args);
|
|
|
|
oop getSyntaxId(int n, oop key)
|
|
{
|
|
oop val = map_get(globals, key);
|
|
if (!is(Function, val)) return null;
|
|
oop fix = get(val, Function, fixed);
|
|
if (!isInteger(fix)) return null;
|
|
if (n != getInteger(fix)) return null;
|
|
return val;
|
|
}
|
|
|
|
oop getSyntax(int n, oop func)
|
|
{
|
|
if (map_get(func, __proto___symbol) != GetVariable_proto) return null;
|
|
oop key = map_get(func, key_symbol);
|
|
return getSyntaxId(n, key);
|
|
}
|
|
|
|
oop newCall(oop func, oop args)
|
|
{
|
|
oop call = newObject(Call_proto);
|
|
map_set(call, func_symbol, func);
|
|
map_set(call, args_symbol, args);
|
|
return call;
|
|
}
|
|
|
|
oop newInvoke(oop this, oop name, oop args)
|
|
{
|
|
oop obj = newObject(Invoke_proto);
|
|
map_set(obj, this_symbol, this);
|
|
map_set(obj, name_symbol, name);
|
|
map_set(obj, args_symbol, args);
|
|
return obj;
|
|
}
|
|
|
|
oop newBlock(oop statements)
|
|
{
|
|
oop obj = newObject(Block_proto);
|
|
map_set(obj, statements_symbol, statements);
|
|
return obj;
|
|
}
|
|
|
|
oop newReturn(oop exp)
|
|
{
|
|
oop obj = newObject(Return_proto);
|
|
map_set(obj, value_symbol, exp);
|
|
return obj;
|
|
}
|
|
|
|
oop newBreak(void)
|
|
{
|
|
oop obj = newObject(Break_proto);
|
|
return obj;
|
|
}
|
|
|
|
oop newContinue(void)
|
|
{
|
|
oop obj = newObject(Continue_proto);
|
|
return obj;
|
|
}
|
|
|
|
oop newTry(oop try, oop exception, oop catch, oop finally)
|
|
{
|
|
oop obj = newObject(Try_proto);
|
|
map_set(obj, try_symbol, try);
|
|
map_set(obj, exception_symbol, exception);
|
|
map_set(obj, catch_symbol, catch);
|
|
map_set(obj, finally_symbol, finally);
|
|
return obj;
|
|
}
|
|
|
|
oop fold(oop ast);
|
|
|
|
#define YY_INPUT(buf, result, max_size) \
|
|
{ \
|
|
int yyc= getc(inputStack->file); \
|
|
result= (EOF == yyc) ? 0 : (*(buf)= yyc, 1); \
|
|
}
|
|
|
|
#define YYSTYPE oop
|
|
|
|
YYSTYPE yylval;
|
|
|
|
int errorLine= 1;
|
|
|
|
void syntaxError(char *text)
|
|
{
|
|
fprintf(stderr, "\nSyntax error in %s near line %i:\n%s\n", get(inputStack->name, String, value), errorLine, text);
|
|
exit(1);
|
|
}
|
|
|
|
oop eval(oop scope, oop ast);
|
|
|
|
struct _yycontext;
|
|
|
|
int yyparsefrom(int (*yystart)(struct _yycontext *yy));
|
|
|
|
%}
|
|
|
|
start = - ( IMPORT s:STRING { yylval = null; inputStackPush(get(s, String, value)) }
|
|
| e:stmt { yylval = e }
|
|
| !. { yylval = 0 }
|
|
| error
|
|
)
|
|
|
|
error = { errorLine= inputStack->lineNumber }
|
|
eol* < (!eol .)* eol* (!eol .)* > { syntaxError(yytext) }
|
|
|
|
stmt = e:exp SEMICOLON* { $$ = e }
|
|
| s:block { $$ = s }
|
|
|
|
block = LCB m:makeMap
|
|
( s:stmt { map_append(m, s) }
|
|
) *
|
|
RCB { $$ = newBlock(m) }
|
|
|
|
exp = VAR l:ident ASSIGN e:exp { $$ = newDeclaration(l, e) }
|
|
| VAR l:IDENT { $$ = newDeclaration(l, null) }
|
|
| FUN l:IDENT p:paramList e:block { $$ = newFunc(l, p, e, null) }
|
|
| FUN p:paramList e:block { $$ = newFunc(null, p, e, null) }
|
|
| SYNTAX l:IDENT p:paramList q:IDENT e:block { $$ = (map_append(p, q), newFunc(l, p, e, makeInteger(2))) }
|
|
| SYNTAX p:paramList q:IDENT e:block { $$ = (map_append(p, q), newFunc(null, p, e, makeInteger(2))) }
|
|
| SYNTAX l:IDENT p:paramList e:block { $$ = newFunc(l, p, e, makeInteger(1)) }
|
|
| SYNTAX p:paramList e:block { $$ = newFunc(null, p, e, makeInteger(1)) }
|
|
| IF LPAREN c:exp RPAREN t:stmt ELSE f:stmt { $$ = newIf(c, t, f ) }
|
|
| IF LPAREN c:exp RPAREN t:stmt { $$ = newIf(c, t, null) }
|
|
| WHILE LPAREN c:exp RPAREN s:stmt { $$ = newWhile(c, s) }
|
|
| DO s:stmt WHILE LPAREN c:exp RPAREN { $$ = newDo(s, c) }
|
|
| FOR LPAREN i:stmt c:stmt u:exp RPAREN s:stmt { $$ = newFor(i, c, u, s) }
|
|
| s:switch { $$ = s }
|
|
| RETURN e:exp { $$ = newReturn(e) }
|
|
| RETURN { $$ = newReturn(null) }
|
|
| BREAK { $$ = newBreak() }
|
|
| CONTINUE { $$ = newContinue() }
|
|
| THROW e:exp { $$ = newUnary(Throw_proto, e) }
|
|
| t:try { $$ = t }
|
|
| l:IDENT o:assignOp e:exp { $$ = newAssign(Assign_proto, l, o, e) }
|
|
| l:postfix DOT i:IDENT o:assignOp e:exp { $$ = newSetMap(SetMember_proto, l, i, o, e) }
|
|
| l:postfix LBRAC i:exp RBRAC o:assignOp e:exp { $$ = newSetMap(SetIndex_proto, l, i, o, e) }
|
|
| l:syntax2 a:argumentList s:block { $$ = (map_append(a, s), apply(l, a)) }
|
|
| c:cond { $$ = c }
|
|
|
|
ident = l:IDENT { $$ = l }
|
|
| AT n:prefix { $$ = newUnary(Unquote_proto, n) }
|
|
|
|
syntax2 = < [a-zA-Z_][a-zA-Z0-9_]* >
|
|
&{ null != getSyntaxId(2, intern(yytext)) } - { $$ = getSyntaxId(2, intern(yytext)) }
|
|
|
|
try = TRY t:stmt i:null c:null f:null
|
|
( CATCH LPAREN i:IDENT RPAREN c:stmt ) ?
|
|
( FINALLY f:stmt ) ? { $$ = newTry(t, i, c, f) }
|
|
|
|
null = { $$ = null }
|
|
|
|
assignOp = ASSIGN { $$= null }
|
|
| ASSIGNADD { $$= Add_symbol }
|
|
| ASSIGNSUB { $$= Sub_symbol }
|
|
| ASSIGNMUL { $$= Mul_symbol }
|
|
| ASSIGNDIV { $$= Div_symbol }
|
|
| ASSIGNMOD { $$= Mod_symbol }
|
|
| ASSIGNBITOR { $$= Bitor_symbol }
|
|
| ASSIGNBITXOR { $$= Bitxor_symbol }
|
|
| ASSIGNBITAND { $$= Bitand_symbol }
|
|
| ASSIGNSHLEFT { $$= Shleft_symbol }
|
|
| ASSIGNSHRIGHT { $$= Shright_symbol }
|
|
|
|
switch = SWITCH LPAREN e:exp RPAREN
|
|
LCB statements:makeMap labels:makeMap
|
|
( CASE l:exp COLON { map_set(labels, fold(l), makeInteger(map_size(statements))) }
|
|
| DEFAULT COLON { map_set(labels, __default___symbol, makeInteger(map_size(statements))) }
|
|
| s:stmt { map_append(statements, s) }
|
|
)*
|
|
RCB { $$= newSwitch(e, labels, statements) }
|
|
|
|
cond = c:logor QUERY t:exp COLON f:cond { $$ = newIf(c, t, f) }
|
|
| logor
|
|
|
|
logor = l:logand
|
|
( LOGOR r:logand { l = newBinary(Logor_proto, l, r) }
|
|
)* { $$ = l }
|
|
|
|
logand = l:bitor
|
|
( LOGAND r:bitor { l = newBinary(Logand_proto, l, r) }
|
|
)* { $$ = l }
|
|
|
|
bitor = l:bitxor
|
|
( BITOR r:bitxor { l = newBinary(Bitor_proto, l, r) }
|
|
)* { $$ = l }
|
|
|
|
bitxor = l:bitand
|
|
( BITXOR r:bitand { l = newBinary(Bitxor_proto, l, r) }
|
|
)* { $$ = l }
|
|
|
|
bitand = l:eq
|
|
( BITAND r:eq { l = newBinary(Bitand_proto, l, r) }
|
|
)* { $$ = l }
|
|
|
|
eq = l:ineq
|
|
( EQUAL r:ineq { l = newBinary(Equal_proto, l, r) }
|
|
| NOTEQ r:ineq { l = newBinary(Noteq_proto, l, r) }
|
|
)* { $$ = l }
|
|
|
|
ineq = l:shift
|
|
( LESS r:shift { l = newBinary(Less_proto, l, r) }
|
|
| LESSEQ r:shift { l = newBinary(Lesseq_proto, l, r) }
|
|
| GREATEREQ r:shift { l = newBinary(Greatereq_proto, l, r) }
|
|
| GREATER r:shift { l = newBinary(Greater_proto, l, r) }
|
|
)* { $$ = l }
|
|
|
|
shift = l:sum
|
|
( SHLEFT r:sum { l = newBinary(Shleft_proto, l, r) }
|
|
| SHRIGHT r:sum { l = newBinary(Shright_proto, l, r) }
|
|
)* { $$ = l }
|
|
|
|
sum = l:prod
|
|
( PLUS r:prod { l = newBinary(Add_proto, l, r) }
|
|
| MINUS r:prod { l = newBinary(Sub_proto, l, r) }
|
|
)* { $$ = l }
|
|
|
|
prod = l:prefix
|
|
( MULTI r:prefix { l = newBinary(Mul_proto, l, r) }
|
|
| DIVIDE r:prefix { l = newBinary(Div_proto, l, r) }
|
|
| MODULO r:prefix { l = newBinary(Mod_proto, l, r) }
|
|
)* { $$ = l }
|
|
|
|
prefix = PLUS n:prefix { $$= n }
|
|
| MINUS n:prefix { $$= newUnary(Neg_proto, n) }
|
|
| TILDE n:prefix { $$= newUnary(Com_proto, n) }
|
|
| PLING n:prefix { $$= newUnary(Not_proto, n) }
|
|
| PLUSPLUS n:prefix { $$= newPreIncrement(n) }
|
|
| MINUSMINUS n:prefix { $$= newPreDecrement(n) }
|
|
| BACKTICK n:prefix { $$ = newUnary(Quasiquote_proto, n) }
|
|
| AT n:prefix { $$ = newUnary(Unquote_proto, n) }
|
|
| n:postfix { $$= n }
|
|
|
|
postfix = i:value ( DOT s:IDENT a:argumentList { i = newInvoke(i, s, a) }
|
|
| DOT s:IDENT !assignOp { i = newGetMap(GetMember_proto, i, s) }
|
|
| LBRAC p:exp RBRAC !assignOp { i = newGetMap(GetIndex_proto, i, p) }
|
|
| a:argumentList { i = (null != getSyntax(1, i)) ? apply(getSyntax(1, i), a) : newCall(i, a) }
|
|
| PLUSPLUS { i = newPostIncrement(i) }
|
|
| MINUSMINUS { i = newPostDecrement(i) }
|
|
) * { $$ = i }
|
|
|
|
paramList = LPAREN m:makeMap
|
|
( i:IDENT { map_append(m, i) }
|
|
( COMMA i:IDENT { map_append(m, i) }
|
|
) *
|
|
) ?
|
|
RPAREN { $$ = m }
|
|
|
|
argumentList = LPAREN m:makeMap
|
|
( e:exp { map_append(m, e) }
|
|
( COMMA e:exp { map_append(m, e) }
|
|
) *
|
|
) ?
|
|
RPAREN { $$ = m }
|
|
|
|
value = n:NUMBER { $$ = newInteger(n) }
|
|
| s:string { $$ = newString(s) }
|
|
| s:symbol { $$ = s }
|
|
| m:map { $$ = newMap(m) }
|
|
| NULL { $$ = null }
|
|
| i:IDENT { $$ = newGetVariable(i) }
|
|
| LPAREN i:stmt RPAREN { $$ = i }
|
|
|
|
string = s:STRING - { $$ = s }
|
|
|
|
STRING = DQUOTE < (!DQUOTE char)* > DQUOTE { $$ = makeString(unescape(yytext)) }
|
|
|
|
char = '\\' . | .
|
|
|
|
symbol = HASH ( i:IDENT { $$ = newSymbol(i) }
|
|
| i:string { $$ = newSymbol(intern(get(i, String, value))) }
|
|
)
|
|
|
|
map = LCB m:makeMap
|
|
( k:key COLON v:exp { map_set(m, k, v) }
|
|
( COMMA k:key COLON v:exp { map_set(m, k, v) }
|
|
) *
|
|
) ?
|
|
RCB { $$ = m }
|
|
| LBRAC m:makeMap
|
|
( v:exp { map_append(m, v) }
|
|
( COMMA v:exp { map_append(m, v) }
|
|
) *
|
|
) ?
|
|
RBRAC { $$ = m }
|
|
|
|
makeMap = { $$ = makeMap() }
|
|
|
|
key = IDENT | NUMBER
|
|
|
|
- = (blank | comment)*
|
|
|
|
blank = space | eol
|
|
space = [ \t]
|
|
eol = ( "\n""\r"*
|
|
| "\r""\n"*
|
|
) { inputStack->lineNumber++ }
|
|
|
|
comment = "//" ( ![\n\r] . )*
|
|
| "/*" ( !"*/" . )* "*/"
|
|
|
|
keyword = FUN | SYNTAX | VAR | SWITCH | CASE | DEFAULT | DO | FOR | WHILE | IF | ELSE | NULL | RETURN | BREAK | CONTINUE
|
|
| THROW | TRY | CATCH | FINALLY
|
|
|
|
IDENT = !keyword < [a-zA-Z_][a-zA-Z0-9_]* > - { $$ = intern(yytext) }
|
|
|
|
NUMBER = '0b' < [01]+ > - { $$ = makeInteger(strtol(yytext, 0, 2)) }
|
|
| '0x' < [0-9a-fA-F]+ > - { $$ = makeInteger(strtol(yytext, 0, 16)) }
|
|
| '0' < [0-7]+ > - { $$ = makeInteger(strtol(yytext, 0, 8)) }
|
|
| < [0-9]+ > - { $$ = makeInteger(strtol(yytext, 0, 10)) }
|
|
| SQUOTE < (!SQUOTE char) > SQUOTE - { $$ = makeInteger(unescape(yytext)[0]) }
|
|
|
|
FUN = 'fun' ![a-zA-Z0-9_] -
|
|
SYNTAX = 'syntax' ![a-zA-Z0-9_] -
|
|
VAR = 'var' ![a-zA-Z0-9_] -
|
|
SWITCH = 'switch' ![a-zA-Z0-9_] -
|
|
CASE = 'case' ![a-zA-Z0-9_] -
|
|
DEFAULT = 'default' ![a-zA-Z0-9_] -
|
|
DO = 'do' ![a-zA-Z0-9_] -
|
|
FOR = 'for' ![a-zA-Z0-9_] -
|
|
WHILE = 'while' ![a-zA-Z0-9_] -
|
|
IF = 'if' ![a-zA-Z0-9_] -
|
|
ELSE = 'else' ![a-zA-Z0-9_] -
|
|
NULL = 'null' ![a-zA-Z0-9_] -
|
|
RETURN = 'return' ![a-zA-Z0-9_] -
|
|
BREAK = 'break' ![a-zA-Z0-9_] -
|
|
CONTINUE = 'continue' ![a-zA-Z0-9_] -
|
|
THROW = 'throw' ![a-zA-Z0-9_] -
|
|
TRY = 'try' ![a-zA-Z0-9_] -
|
|
CATCH = 'catch' ![a-zA-Z0-9_] -
|
|
FINALLY = 'finally' ![a-zA-Z0-9_] -
|
|
IMPORT = 'import' ![a-zA-Z0-9_] -
|
|
HASH = '#' -
|
|
LOGOR = '||' -
|
|
LOGAND = '&&' -
|
|
BITOR = '|' ![|=] -
|
|
BITXOR = '^' ![=] -
|
|
BITAND = '&' ![&=] -
|
|
EQUAL = '==' -
|
|
NOTEQ = '!=' -
|
|
LESS = '<' ![<=] -
|
|
LESSEQ = '<=' -
|
|
GREATEREQ = '>=' -
|
|
GREATER = '>' ![>=] -
|
|
SHLEFT = '<<' ![=] -
|
|
SHRIGHT = '>>' ![=] -
|
|
PLUS = '+' ![+=] -
|
|
MINUS = '-' ![-=] -
|
|
PLUSPLUS = '++' -
|
|
MINUSMINUS = '--' -
|
|
TILDE = '~' -
|
|
PLING = '!' ![=] -
|
|
MULTI = '*' ![=] -
|
|
DIVIDE = '/' ![/=] -
|
|
MODULO = '%' ![=] -
|
|
ASSIGN = '=' ![=] -
|
|
ASSIGNADD = '+=' -
|
|
ASSIGNSUB = '-=' -
|
|
ASSIGNMUL = '*=' -
|
|
ASSIGNDIV = '/=' -
|
|
ASSIGNMOD = '%=' -
|
|
ASSIGNBITOR ='|=' -
|
|
ASSIGNBITXOR='^=' -
|
|
ASSIGNBITAND='&=' -
|
|
ASSIGNSHLEFT='<<=' -
|
|
ASSIGNSHRIGHT='>>=' -
|
|
QUERY = '?' -
|
|
COLON = ':' -
|
|
SEMICOLON = ';' -
|
|
COMMA = ',' -
|
|
DOT = '.' -
|
|
BACKTICK= '`' -
|
|
AT = '@' -
|
|
LCB = '{' -
|
|
RCB = '}' -
|
|
LBRAC = '[' -
|
|
RBRAC = ']' -
|
|
LPAREN = '(' -
|
|
RPAREN = ')' -
|
|
DQUOTE = '"'
|
|
SQUOTE = "'"
|
|
|
|
%%
|
|
;
|
|
|
|
|
|
oop map_zip(oop keys, oop values)
|
|
{
|
|
assert(is(Map, keys));
|
|
assert(is(Map, values));
|
|
oop map= makeMap();
|
|
size_t sk= map_size(keys), sv= map_size(values);
|
|
if (sk < sv) sk= sv;
|
|
for (size_t i= 0; i < sk; ++i) {
|
|
oop key = i < sk && map_hasIntegerKey(keys, i) ? get(keys, Map, elements)[i].value : makeInteger(i);
|
|
oop value = i < sv && map_hasIntegerKey(values, i) ? get(values, Map, elements)[i].value : null;
|
|
map_set(map, key, value);
|
|
}
|
|
return map;
|
|
}
|
|
|
|
oop clone(oop obj)
|
|
{
|
|
switch(getType(obj)) {
|
|
case Undefined:
|
|
case Integer:
|
|
case Function:
|
|
case Symbol:
|
|
return obj;
|
|
case String:
|
|
return makeString(get(obj, String, value));
|
|
case Map: {
|
|
struct Pair *elements= malloc(sizeof(struct Pair) * get(obj, Map, capacity));
|
|
memcpy(elements, get(obj, Map, elements), sizeof(struct Pair) * get(obj, Map, capacity));
|
|
oop map= malloc(sizeof(*obj));
|
|
memcpy(map, obj, sizeof(*obj));
|
|
set(map, Map, elements, elements);
|
|
return map;
|
|
}
|
|
}
|
|
return obj;
|
|
}
|
|
|
|
void runtimeError(char *msg)
|
|
{
|
|
char *fileName= get(map_get(mrAST, __file___symbol), String, value);
|
|
fprintf(stderr, "\nRuntime error in %s near line %i:\nError: %s\n", fileName, getInteger(map_get(mrAST, __line___symbol)), msg);
|
|
exit(1);
|
|
}
|
|
|
|
oop addOperation(oop ast, oop lhs, oop rhs)
|
|
{
|
|
if (getType(lhs) == Integer && getType(rhs) == Integer) {
|
|
return makeInteger(getInteger(lhs) + getInteger(rhs));
|
|
} else if (getType(lhs) == String && getType(rhs) == String) {
|
|
return string_concat(lhs, rhs);
|
|
} else {
|
|
runtimeError("addition between two incompatible types");
|
|
assert(0); // to prevent: control may reach end of non-void function
|
|
}
|
|
}
|
|
|
|
oop mulOperation(oop ast, oop lhs, oop rhs)
|
|
{
|
|
if (getType(lhs) == Integer && getType(rhs) == Integer) {
|
|
return makeInteger(getInteger(lhs) * getInteger(rhs));
|
|
} else if (getType(lhs) == String && getType(rhs) == Integer) {
|
|
return string_mul(lhs, rhs);
|
|
} else if (getType(lhs) == Integer && getType(rhs) == String) {
|
|
return string_mul(rhs, lhs);
|
|
} else {
|
|
runtimeError("multiplication between two incompatible types");
|
|
assert(0);
|
|
}
|
|
}
|
|
|
|
oop expandUnquotes(oop scope, oop obj)
|
|
{
|
|
obj = clone(obj);
|
|
if (!is(Map, obj)) {
|
|
return obj;
|
|
}
|
|
if (map_get(obj, __proto___symbol) == Unquote_proto) {
|
|
return eval(scope, map_get(obj, rhs_symbol));
|
|
}
|
|
for (size_t i= 0; i < map_size(obj); ++i) {
|
|
struct Pair *pair= &get(obj, Map, elements)[i];
|
|
if (__proto___symbol != pair->key) {
|
|
pair->value= expandUnquotes(scope, pair->value);
|
|
}
|
|
}
|
|
return obj;
|
|
}
|
|
|
|
oop fold(oop ast)
|
|
{
|
|
if (is(Map, ast)) {
|
|
oop proto= map_get(ast, __proto___symbol);
|
|
if (null != proto) {
|
|
proto_t proto_number= get(map_get(proto, __name___symbol), Symbol, prototype);
|
|
switch (proto_number) {
|
|
case t_Integer:
|
|
case t_String:
|
|
case t_Symbol: {
|
|
return map_get(ast, value_symbol);
|
|
}
|
|
case t_Logor: {
|
|
oop lhs= map_get(ast, lhs_symbol);
|
|
oop rhs= map_get(ast, rhs_symbol);
|
|
if (isTrue(fold(lhs))) return makeInteger(1);
|
|
if (isTrue(fold(rhs))) return makeInteger(1);
|
|
return makeInteger(0);
|
|
}
|
|
case t_Logand: {
|
|
oop lhs= map_get(ast, lhs_symbol);
|
|
oop rhs= map_get(ast, rhs_symbol);
|
|
if (isFalse(fold(lhs))) return makeInteger(0);
|
|
if (isFalse(fold(rhs))) return makeInteger(0);
|
|
return makeInteger(1);
|
|
}
|
|
# define BINARY(NAME, OPERATOR) \
|
|
case t_##NAME: { \
|
|
oop lhs= fold(map_get(ast, lhs_symbol)); \
|
|
oop rhs= fold(map_get(ast, rhs_symbol)); \
|
|
return makeInteger(getInteger(lhs) OPERATOR getInteger(rhs)); \
|
|
}
|
|
BINARY(Bitor, | );
|
|
BINARY(Bitxor, ^ );
|
|
BINARY(Bitand, & );
|
|
BINARY(Equal, ==);
|
|
BINARY(Noteq, !=);
|
|
BINARY(Less, < );
|
|
BINARY(Lesseq, <=);
|
|
BINARY(Greatereq, >=);
|
|
BINARY(Greater, > );
|
|
BINARY(Shleft, <<);
|
|
BINARY(Shright, >>);
|
|
BINARY(Add, + );
|
|
BINARY(Sub, - );
|
|
BINARY(Mul, * );
|
|
BINARY(Div, / );
|
|
BINARY(Mod, % );
|
|
# undef BINARY
|
|
# define UNARY(NAME, OPERATOR) \
|
|
case t_##NAME: { \
|
|
oop rhs = fold(map_get(ast, rhs_symbol)); \
|
|
return makeInteger(OPERATOR getInteger(rhs)); \
|
|
}
|
|
UNARY(Not, !);
|
|
UNARY(Neg, -);
|
|
UNARY(Com, ~);
|
|
# undef UNARY
|
|
default:
|
|
break;
|
|
}
|
|
}
|
|
}
|
|
printf("illegal value in constant expression: ");
|
|
println(ast);
|
|
assert(0);
|
|
return null;
|
|
}
|
|
|
|
oop applyOperator(oop ast, oop op, oop lhs, oop rhs)
|
|
{
|
|
if (null != op) { assert(is(Symbol, op));
|
|
switch (get(op, Symbol, prototype)) {
|
|
case t_Add: return addOperation(ast, lhs, rhs);
|
|
case t_Sub: return makeInteger(getInteger(lhs) - getInteger(rhs));
|
|
case t_Mul: return mulOperation(ast, lhs, rhs);
|
|
case t_Div: return makeInteger(getInteger(lhs) / getInteger(rhs));
|
|
case t_Mod: return makeInteger(getInteger(lhs) % getInteger(rhs));
|
|
case t_Bitor: return makeInteger(getInteger(lhs) | getInteger(rhs));
|
|
case t_Bitxor: return makeInteger(getInteger(lhs) ^ getInteger(rhs));
|
|
case t_Bitand: return makeInteger(getInteger(lhs) & getInteger(rhs));
|
|
case t_Shleft: return makeInteger(getInteger(lhs) << getInteger(rhs));
|
|
case t_Shright: return makeInteger(getInteger(lhs) >> getInteger(rhs));
|
|
default: {
|
|
fprintf(stderr, "\nIllegal operator %i\n", get(op, Symbol, prototype));
|
|
exit(1);
|
|
}
|
|
}
|
|
}
|
|
return rhs;
|
|
}
|
|
|
|
oop evalArgs(oop scope, oop args);
|
|
|
|
oop eval(oop scope, oop ast)
|
|
{
|
|
if (opt_v > 3) {
|
|
printf("EVAL: ");
|
|
println(ast);
|
|
}
|
|
|
|
switch(getType(ast)) {
|
|
case Undefined:
|
|
case Integer:
|
|
case String:
|
|
case Function:
|
|
return ast;
|
|
case Symbol:
|
|
return getVariable(scope, ast);
|
|
case Map:
|
|
break;
|
|
}
|
|
|
|
assert(is(Map, ast));
|
|
|
|
mrAST= ast;
|
|
|
|
oop proto = map_get(ast, __proto___symbol);
|
|
if (proto == null) {
|
|
return ast;
|
|
}
|
|
// proto_number is the enum version of the proto symbol
|
|
proto_t proto_number = get(map_get(proto, __name___symbol), Symbol, prototype);
|
|
switch (proto_number) {
|
|
case t_UNDEFINED: {
|
|
assert(0);
|
|
return 0;
|
|
}
|
|
case t_Map: {
|
|
oop map= clone(map_get(ast, value_symbol));
|
|
for (size_t i= 0; i < map_size(map); ++i) {
|
|
struct Pair *pair= &get(map, Map, elements)[i];
|
|
pair->value= eval(scope, pair->value);
|
|
}
|
|
return map;
|
|
}
|
|
case t_Quasiquote: {
|
|
oop obj = map_get(ast, rhs_symbol);
|
|
return expandUnquotes(scope, obj);
|
|
}
|
|
case t_Unquote: {
|
|
runtimeError("@ outside of `");
|
|
}
|
|
case t_Declaration: {
|
|
oop lhs = map_get(ast, lhs_symbol);
|
|
oop rhs = eval(scope, map_get(ast, rhs_symbol));
|
|
return newVariable(scope, lhs, rhs);
|
|
}
|
|
case t_If: {
|
|
oop condition = map_get(ast, condition_symbol );
|
|
oop consequent = map_get(ast, consequent_symbol);
|
|
oop alternate = map_get(ast, alternate_symbol );
|
|
return eval(scope, isTrue(eval(scope, condition)) ? consequent : alternate);
|
|
}
|
|
case t_While: {
|
|
oop condition = map_get(ast, condition_symbol );
|
|
oop body = map_get(ast, body_symbol);
|
|
oop result = null;
|
|
|
|
jbRecPush();
|
|
int jbt = sigsetjmp(jbs->jb, 0);
|
|
switch (jbt) {
|
|
case j_return:
|
|
case j_throw: {
|
|
oop result = jbs->result;
|
|
jbRecPop();
|
|
assert(jbs);
|
|
jbs->result = result;
|
|
siglongjmp(jbs->jb, jbt);
|
|
assert(0);
|
|
}
|
|
case j_break: {
|
|
jbRecPop();
|
|
return null;
|
|
}
|
|
case j_continue: {
|
|
break;
|
|
}
|
|
}
|
|
|
|
while (isTrue(eval(scope, condition))) result= eval(scope, body);
|
|
jbRecPop();
|
|
return result;
|
|
}
|
|
case t_Do: {
|
|
oop body = map_get(ast, body_symbol);
|
|
oop condition = map_get(ast, condition_symbol );
|
|
oop result = null;
|
|
|
|
jbRecPush();
|
|
int jbt = sigsetjmp(jbs->jb, 0);
|
|
switch (jbt) {
|
|
case j_return:
|
|
case j_throw: {
|
|
oop result = jbs->result;
|
|
jbRecPop();
|
|
assert(jbs);
|
|
jbs->result = result;
|
|
siglongjmp(jbs->jb, jbt);
|
|
assert(0);
|
|
}
|
|
case j_break: {
|
|
jbRecPop();
|
|
return null;
|
|
}
|
|
case j_continue: {
|
|
goto restart_do;
|
|
}
|
|
}
|
|
|
|
do {
|
|
result= eval(scope, body);
|
|
restart_do:;
|
|
} while (isTrue(eval(scope, condition)));
|
|
jbRecPop();
|
|
return result;
|
|
}
|
|
case t_For: {
|
|
oop initialise = map_get(ast, initialise_symbol );
|
|
oop condition = map_get(ast, condition_symbol );
|
|
oop update = map_get(ast, update_symbol );
|
|
oop body = map_get(ast, body_symbol);
|
|
oop result = null;
|
|
oop localScope = newObject(scope);
|
|
|
|
jbRecPush();
|
|
int jbt = sigsetjmp(jbs->jb, 0);
|
|
switch (jbt) {
|
|
case j_return:
|
|
case j_throw: {
|
|
oop result = jbs->result;
|
|
jbRecPop();
|
|
assert(jbs);
|
|
jbs->result = result;
|
|
siglongjmp(jbs->jb, jbt);
|
|
assert(0);
|
|
}
|
|
case j_break: {
|
|
jbRecPop();
|
|
return null;
|
|
}
|
|
case j_continue: {
|
|
goto restart_for;
|
|
}
|
|
}
|
|
|
|
for (eval(localScope, initialise); isTrue(eval(localScope, condition)); eval(localScope, update)) {
|
|
result= eval(localScope, body);
|
|
restart_for:;
|
|
}
|
|
jbRecPop();
|
|
return result;
|
|
}
|
|
case t_Switch: {
|
|
oop expression = map_get(ast, expression_symbol );
|
|
oop labels = map_get(ast, labels_symbol );
|
|
oop statements = map_get(ast, statements_symbol );
|
|
oop result = eval(scope, expression);
|
|
oop label = map_get(labels, result);
|
|
if (null == label) label= map_get(labels, __default___symbol);
|
|
if (null == label) return result;
|
|
assert(isInteger(label));
|
|
int limit= map_size(statements);
|
|
|
|
jbRecPush();
|
|
int jbt = sigsetjmp(jbs->jb, 0);
|
|
switch (jbt) {
|
|
case j_return:
|
|
case j_throw: {
|
|
oop result = jbs->result;
|
|
jbRecPop();
|
|
assert(jbs);
|
|
jbs->result = result;
|
|
siglongjmp(jbs->jb, jbt);
|
|
assert(0);
|
|
}
|
|
case j_break: {
|
|
jbRecPop();
|
|
return null;
|
|
}
|
|
case j_continue: {
|
|
jbRecPop();
|
|
assert(jbs);
|
|
siglongjmp(jbs->jb, j_continue);
|
|
assert(0);
|
|
}
|
|
}
|
|
|
|
for (int i= getInteger(label); i < limit; ++i) {
|
|
assert(map_hasIntegerKey(statements, i));
|
|
result= eval(scope, get(statements, Map, elements)[i].value);
|
|
}
|
|
jbRecPop();
|
|
return result;
|
|
}
|
|
case t_Assign: {
|
|
oop lhs = map_get(ast, lhs_symbol);
|
|
oop op = map_get(ast, operator_symbol);
|
|
oop rhs = eval(scope, map_get(ast, rhs_symbol));
|
|
if (null != op) rhs= applyOperator(ast, op, getVariable(scope, lhs), rhs);
|
|
setVariable(scope, lhs, rhs);
|
|
if (is(Function, rhs) && null == get(rhs, Function, name)) {
|
|
set(rhs, Function, name, lhs);
|
|
}
|
|
return rhs;
|
|
}
|
|
case t_Func: {
|
|
oop name = map_get(ast, name_symbol);
|
|
oop param = map_get(ast, param_symbol);
|
|
oop body = map_get(ast, body_symbol);
|
|
oop fixed = map_get(ast, fixed_symbol);
|
|
oop func = makeFunction(NULL, name, param, body, scope, fixed);
|
|
if (opt_v > 4) {
|
|
printf("funcscope: ");
|
|
println(scope);
|
|
printf("globalScope: ");
|
|
println(scope);
|
|
}
|
|
if (name != null) newVariable(scope, name, func);
|
|
return func;
|
|
}
|
|
case t_Call: {
|
|
oop func = eval(scope, map_get(ast, func_symbol));
|
|
if (!is(Function, func)) {
|
|
// TODO better error printing
|
|
// Please search for ISSUE1 in parse.leg
|
|
printf("cannot call ");
|
|
println(func);
|
|
exit(1);
|
|
}
|
|
|
|
oop args = map_get(ast, args_symbol);
|
|
if (isFalse(get(func, Function, fixed))) {
|
|
args = evalArgs(scope, args);
|
|
}
|
|
if (get(func, Function, primitive) == NULL) {
|
|
oop param = get(func, Function, param);
|
|
oop localScope = map_zip(param, args);
|
|
map_set(localScope, __arguments___symbol, args);
|
|
map_set(localScope, __proto___symbol, get(func, Function, parentScope));
|
|
if (opt_v > 4) {
|
|
printf("parentScope: ");
|
|
println(get(func, Function, parentScope));
|
|
printf("localScope: ");
|
|
println(localScope);
|
|
}
|
|
|
|
jbRecPush();
|
|
int jbt = sigsetjmp(jbs->jb, 0);
|
|
switch (jbt) {
|
|
case j_return: {
|
|
oop result = jbs->result;
|
|
jbRecPop();
|
|
return result;
|
|
}
|
|
case j_break: {
|
|
runtimeError("break outside of a loop");
|
|
}
|
|
case j_continue: {
|
|
runtimeError("continue outside of a loop");
|
|
}
|
|
case j_throw: {
|
|
oop res= jbs->result;
|
|
jbRecPop();
|
|
jbs->result= res;
|
|
siglongjmp(jbs->jb, j_throw);
|
|
}
|
|
}
|
|
|
|
oop result = eval(localScope, get(func, Function, body));
|
|
jbRecPop();
|
|
return result;
|
|
}
|
|
return get(func, Function, primitive)(args);
|
|
}
|
|
case t_Invoke: {
|
|
// this is what differs from t_call
|
|
oop this = eval(scope, map_get(ast, this_symbol));
|
|
oop func = getVariable(this, map_get(ast, name_symbol));
|
|
if (!is(Function, func)) {
|
|
printf("cannot invoke ");
|
|
println(func);
|
|
exit(1);
|
|
}
|
|
|
|
oop args = evalArgs(scope, map_get(ast, args_symbol));
|
|
if (NULL != get(func, Function, primitive)) {
|
|
return get(func, Function, primitive)(args);
|
|
}
|
|
oop param = get(func, Function, param);
|
|
oop localScope = map_zip(param, args);
|
|
// and set this in the local scope
|
|
map_set(localScope, this_symbol, this);
|
|
map_set(localScope, __arguments___symbol, args);
|
|
map_set(localScope, __proto___symbol, get(func, Function, parentScope));
|
|
if (opt_v > 4) {
|
|
printf("parentScope: ");
|
|
println(get(func, Function, parentScope));
|
|
printf("localScope: ");
|
|
println(localScope);
|
|
}
|
|
|
|
jbRecPush();
|
|
int jbt = sigsetjmp(jbs->jb, 0);
|
|
switch (jbt) {
|
|
case j_return: {
|
|
oop result = jbs->result;
|
|
jbRecPop();
|
|
return result;
|
|
}
|
|
case j_break: {
|
|
runtimeError("break outside of a loop");
|
|
}
|
|
case j_continue: {
|
|
runtimeError("continue outside of a loop");
|
|
}
|
|
case j_throw: {
|
|
oop res= jbs->result;
|
|
jbRecPop();
|
|
jbs->result= res;
|
|
siglongjmp(jbs->jb, j_throw);
|
|
}
|
|
}
|
|
|
|
oop result = eval(localScope, get(func, Function, body));
|
|
jbRecPop();
|
|
return result;
|
|
}
|
|
|
|
case t_Return: {
|
|
assert(jbs);
|
|
jbs->result = eval(scope, map_get(ast, value_symbol));
|
|
siglongjmp(jbs->jb, j_return);
|
|
}
|
|
case t_Break: {
|
|
assert(jbs);
|
|
siglongjmp(jbs->jb, j_break);
|
|
}
|
|
case t_Continue: {
|
|
assert(jbs);
|
|
siglongjmp(jbs->jb, j_continue);
|
|
}
|
|
case t_Throw: {
|
|
assert(jbs);
|
|
jbs->result = eval(scope, map_get(ast, rhs_symbol));
|
|
siglongjmp(jbs->jb, j_throw);
|
|
}
|
|
case t_Try: {
|
|
oop try = map_get(ast, try_symbol);
|
|
oop exception = map_get(ast, exception_symbol);
|
|
oop catch = map_get(ast, catch_symbol);
|
|
oop finally = map_get(ast, finally_symbol);
|
|
|
|
jbRecPush();
|
|
int jbt = sigsetjmp(jbs->jb, 0);
|
|
if (0 == jbt) {
|
|
oop res = eval(scope, try);
|
|
jbRecPop();
|
|
eval(scope, finally);
|
|
return res;
|
|
}
|
|
oop res= jbs->result;
|
|
jbRecPop();
|
|
// something happend in the try block
|
|
if (j_throw == jbt) {
|
|
assert(jbs);
|
|
jbs->result= res;
|
|
|
|
if (null == catch) {
|
|
return eval(scope, finally);
|
|
}
|
|
oop localScope= newObject(scope);
|
|
setVariable(localScope, exception, res);
|
|
|
|
jbRecPush();
|
|
jbt= sigsetjmp(jbs->jb, 0);
|
|
if (0 == jbt) {
|
|
eval(localScope, catch);
|
|
jbRecPop();
|
|
return eval(scope, finally);
|
|
}
|
|
// something happend in the catch block
|
|
res= jbs->result;
|
|
jbRecPop();
|
|
}
|
|
eval(scope, finally);
|
|
assert(jbs);
|
|
jbs->result= res;
|
|
siglongjmp(jbs->jb, jbt);
|
|
}
|
|
case t_Block: {
|
|
oop statements = map_get(ast, statements_symbol);
|
|
int i = 0;
|
|
oop index;
|
|
oop statement, res;
|
|
oop localScope = newObject(scope);
|
|
while ((index = makeInteger(i)), map_hasKey(statements, index)) {
|
|
statement = map_get(statements, index);
|
|
res = eval(localScope, statement);
|
|
i++;
|
|
}
|
|
return res;
|
|
}
|
|
case t_GetVariable: {
|
|
return getVariable(scope, map_get(ast, key_symbol));
|
|
}
|
|
case t_GetMember: {
|
|
oop map = eval(scope, map_get(ast, map_symbol));
|
|
oop key = map_get(ast, key_symbol);
|
|
return getVariable(map, key);
|
|
}
|
|
case t_SetMember: {
|
|
oop map = eval(scope, map_get(ast, map_symbol));
|
|
oop key = map_get(ast, key_symbol);
|
|
oop op = map_get(ast, operator_symbol);
|
|
oop value = eval(scope, map_get(ast, value_symbol));
|
|
if (null != op) value= applyOperator(ast, op, getMember(map, key), value);
|
|
if (is(Function, value) && null == get(value, Function, name)) {
|
|
set(value, Function, name, key);
|
|
}
|
|
return map_set(map, key, value);
|
|
}
|
|
case t_GetIndex: {
|
|
oop map = eval(scope, map_get(ast, map_symbol));
|
|
oop key = eval(scope, map_get(ast, key_symbol));
|
|
switch (getType(map)) {
|
|
case String:
|
|
if (getInteger(key) >= get(map, String, size)) {
|
|
runtimeError("GetIndex out of range on String");
|
|
}
|
|
return makeInteger(unescape(get(map, String, value))[getInteger(key)]);
|
|
case Map:
|
|
return map_get(map, key);
|
|
default:
|
|
runtimeError("GetIndex on non Map or String");
|
|
}
|
|
}
|
|
case t_SetIndex: {
|
|
oop map = eval(scope, map_get(ast, map_symbol));
|
|
oop key = eval(scope, map_get(ast, key_symbol));
|
|
oop op = map_get(ast, operator_symbol);
|
|
oop value = eval(scope, map_get(ast, value_symbol));
|
|
switch (getType(map)) {
|
|
case String:
|
|
if (getInteger(key) >= get(map, String, size)) {
|
|
runtimeError("SetIndex out of range on String");
|
|
}
|
|
get(map, String, value)[getInteger(key)] = getInteger(value);
|
|
return value;
|
|
case Map:
|
|
if (null != op) value= applyOperator(ast, op, map_get(map, key), value);
|
|
return map_set(map, key, value);
|
|
default:
|
|
runtimeError("SetIndex on non Map or String");
|
|
}
|
|
|
|
}
|
|
case t_Symbol:
|
|
case t_Integer:
|
|
case t_String: {
|
|
return map_get(ast, value_symbol);
|
|
}
|
|
case t_Logor: {
|
|
oop lhs = map_get(ast, lhs_symbol);
|
|
oop rhs = map_get(ast, rhs_symbol);
|
|
if (isTrue(eval(scope, lhs))) return makeInteger(1);
|
|
if (isTrue(eval(scope, rhs))) return makeInteger(1);
|
|
return makeInteger(0);
|
|
}
|
|
case t_Logand: {
|
|
oop lhs = map_get(ast, lhs_symbol);
|
|
oop rhs = map_get(ast, rhs_symbol);
|
|
if (isFalse(eval(scope, lhs))) return makeInteger(0);
|
|
if (isFalse(eval(scope, rhs))) return makeInteger(0);
|
|
return makeInteger(1);
|
|
}
|
|
# define BINARY(NAME, OPERATOR) \
|
|
case t_##NAME: { \
|
|
oop lhs = eval(scope, map_get(ast, lhs_symbol)); \
|
|
oop rhs = eval(scope, map_get(ast, rhs_symbol)); \
|
|
return makeInteger(getInteger(lhs) OPERATOR getInteger(rhs)); \
|
|
}
|
|
BINARY(Bitor, | );
|
|
BINARY(Bitxor, ^ );
|
|
BINARY(Bitand, & );
|
|
BINARY(Equal, ==);
|
|
BINARY(Noteq, !=);
|
|
BINARY(Less, < );
|
|
BINARY(Lesseq, <=);
|
|
BINARY(Greatereq, >=);
|
|
BINARY(Greater, > );
|
|
BINARY(Shleft, <<);
|
|
BINARY(Shright, >>);
|
|
// BINARY(Add, + );
|
|
case t_Add: {
|
|
oop lhs = eval(scope, map_get(ast, lhs_symbol));
|
|
oop rhs = eval(scope, map_get(ast, rhs_symbol));
|
|
return addOperation(ast, lhs, rhs);
|
|
}
|
|
BINARY(Sub, - );
|
|
// BINARY(Mul, * );
|
|
case t_Mul: {
|
|
oop lhs = eval(scope, map_get(ast, lhs_symbol));
|
|
oop rhs = eval(scope, map_get(ast, rhs_symbol));
|
|
return mulOperation(ast, lhs, rhs);
|
|
}
|
|
BINARY(Div, / );
|
|
BINARY(Mod, % );
|
|
# undef BINARY
|
|
case t_Not: {
|
|
oop rhs = eval(scope, map_get(ast, rhs_symbol));
|
|
return makeInteger(isFalse(rhs));
|
|
}
|
|
# define UNARY(NAME, OPERATOR) \
|
|
case t_##NAME: { \
|
|
oop rhs = eval(scope, map_get(ast, rhs_symbol)); \
|
|
return makeInteger(OPERATOR getInteger(rhs)); \
|
|
}
|
|
UNARY(Neg, -);
|
|
UNARY(Com, ~);
|
|
# undef UNARY
|
|
case t_PreIncVariable: {
|
|
oop key= map_get(ast, key_symbol);
|
|
oop val= getVariable(scope, key);
|
|
val= makeInteger(getInteger(val) + 1);
|
|
return setVariable(scope, key, val);
|
|
}
|
|
case t_PreDecVariable: {
|
|
oop key= map_get(ast, key_symbol);
|
|
oop val= getVariable(scope, key);
|
|
val= makeInteger(getInteger(val) - 1);
|
|
return setVariable(scope, key, val);
|
|
}
|
|
case t_PreIncMember: {
|
|
oop map= eval(scope, map_get(ast, map_symbol));
|
|
oop key= map_get(ast, key_symbol);
|
|
oop val= map_get(map, key);
|
|
val= makeInteger(getInteger(val) + 1);
|
|
return map_set(map, key, val);
|
|
}
|
|
case t_PreDecMember: {
|
|
oop map= eval(scope, map_get(ast, map_symbol));
|
|
oop key= map_get(ast, key_symbol);
|
|
oop val= map_get(map, key);
|
|
val= makeInteger(getInteger(val) - 1);
|
|
return map_set(map, key, val);
|
|
}
|
|
case t_PreIncIndex: {
|
|
oop map= eval(scope, map_get(ast, map_symbol));
|
|
oop key= eval(scope, map_get(ast, key_symbol));
|
|
oop val= map_get(map, key);
|
|
val= makeInteger(getInteger(val) + 1);
|
|
return map_set(map, key, val);
|
|
}
|
|
case t_PreDecIndex: {
|
|
oop map= eval(scope, map_get(ast, map_symbol));
|
|
oop key= eval(scope, map_get(ast, key_symbol));
|
|
oop val= map_get(map, key);
|
|
val= makeInteger(getInteger(val) - 1);
|
|
return map_set(map, key, val);
|
|
}
|
|
case t_PostIncVariable: {
|
|
oop key= map_get(ast, key_symbol);
|
|
oop val= getVariable(scope, key);
|
|
oop inc= makeInteger(getInteger(val) + 1);
|
|
setVariable(scope, key, inc);
|
|
return val;
|
|
}
|
|
case t_PostDecVariable: {
|
|
oop key= map_get(ast, key_symbol);
|
|
oop val= getVariable(scope, key);
|
|
oop inc= makeInteger(getInteger(val) - 1);
|
|
setVariable(scope, key, inc);
|
|
return val;
|
|
}
|
|
case t_PostIncMember: {
|
|
oop map= eval(scope, map_get(ast, map_symbol));
|
|
oop key= map_get(ast, key_symbol);
|
|
oop val= map_get(map, key);
|
|
oop inc= makeInteger(getInteger(val) + 1);
|
|
map_set(map, key, inc);
|
|
return val;
|
|
}
|
|
case t_PostDecMember: {
|
|
oop map= eval(scope, map_get(ast, map_symbol));
|
|
oop key= map_get(ast, key_symbol);
|
|
oop val= map_get(map, key);
|
|
oop inc= makeInteger(getInteger(val) - 1);
|
|
map_set(map, key, inc);
|
|
return val;
|
|
}
|
|
case t_PostIncIndex: {
|
|
oop map= eval(scope, map_get(ast, map_symbol));
|
|
oop key= eval(scope, map_get(ast, key_symbol));
|
|
oop val= map_get(map, key);
|
|
oop inc= makeInteger(getInteger(val) + 1);
|
|
map_set(map, key, inc);
|
|
return val;
|
|
}
|
|
case t_PostDecIndex: {
|
|
oop map= eval(scope, map_get(ast, map_symbol));
|
|
oop key= eval(scope, map_get(ast, key_symbol));
|
|
oop val= map_get(map, key);
|
|
oop inc= makeInteger(getInteger(val) - 1);
|
|
map_set(map, key, inc);
|
|
return val;
|
|
}
|
|
}
|
|
printf("EVAL ");
|
|
println(ast);
|
|
assert(0);
|
|
return null;
|
|
}
|
|
|
|
oop prim_exit(oop params)
|
|
{
|
|
int status= 0;
|
|
if (map_hasIntegerKey(params, 0)) {
|
|
oop arg= get(params, Map, elements)[0].value;
|
|
if (isInteger(arg)) status= getInteger(arg);
|
|
}
|
|
exit(status);
|
|
}
|
|
|
|
oop prim_keys(oop params)
|
|
{
|
|
if (map_hasIntegerKey(params, 0)) {
|
|
oop arg= get(params, Map, elements)[0].value;
|
|
if (is(Map, arg)) return map_keys(arg);
|
|
}
|
|
return null;
|
|
}
|
|
|
|
oop prim_values(oop params)
|
|
{
|
|
if (map_hasIntegerKey(params, 0)) {
|
|
oop arg= get(params, Map, elements)[0].value;
|
|
if (is(Map, arg)) return map_values(arg);
|
|
}
|
|
return null;
|
|
}
|
|
|
|
oop prim_length(oop params)
|
|
{
|
|
if (map_hasIntegerKey(params, 0)) {
|
|
oop arg= get(params, Map, elements)[0].value;
|
|
switch (getType(arg)) {
|
|
case String: return makeInteger(string_size(arg));
|
|
case Symbol: return makeInteger(strlen(get(arg, Symbol, name)));
|
|
case Map: return makeInteger(map_size(arg));
|
|
default: break;
|
|
}
|
|
}
|
|
return null;
|
|
}
|
|
|
|
// TODO
|
|
// ISSUE1: how can I handle the "cannot invoke " with nice printing the func name and its args
|
|
// it would be really nice to have a toString() function (that would be directly used in print())
|
|
// but it seems that it's really complicated to write a toString() for integer, function and maps...
|
|
// please see the draft line 490 in object.c
|
|
|
|
// ISSUE2: how can I tackle the 2 fprintf(stderr, "\nbreak/continue oustide of a loop\n") in prim_invoke and prim_apply
|
|
// in this situation it seems that I don't have access to any AST
|
|
oop prim_invoke(oop params)
|
|
{
|
|
oop this= null; if (map_hasIntegerKey(params, 0)) this= get(params, Map, elements)[0].value;
|
|
oop func= null; if (map_hasIntegerKey(params, 1)) func= get(params, Map, elements)[1].value;
|
|
oop args= null; if (map_hasIntegerKey(params, 2)) args= get(params, Map, elements)[2].value;
|
|
if (!is(Function, func)) {
|
|
printf("cannot invoke ");
|
|
println(func);
|
|
exit(1);
|
|
}
|
|
if (NULL != get(func, Function, primitive)) {
|
|
return get(func, Function, primitive)(args);
|
|
}
|
|
oop param = get(func, Function, param);
|
|
oop localScope = map_zip(param, args);
|
|
map_set(localScope, this_symbol, this);
|
|
map_set(localScope, __arguments___symbol, args);
|
|
map_set(localScope, __proto___symbol, get(func, Function, parentScope));
|
|
jbRecPush();
|
|
int jbt = sigsetjmp(jbs->jb, 0);
|
|
switch (jbt) {
|
|
case j_return: {
|
|
oop result = jbs->result;
|
|
jbRecPop();
|
|
return result;
|
|
}
|
|
case j_break: {
|
|
runtimeError("break outside of a loop or switch");
|
|
}
|
|
case j_continue: {
|
|
runtimeError("continue oustide of a loop");
|
|
}
|
|
case j_throw: {
|
|
oop res= jbs->result;
|
|
jbRecPop();
|
|
jbs->result= res;
|
|
siglongjmp(jbs->jb, j_throw);
|
|
}
|
|
}
|
|
oop result= eval(localScope, get(func, Function, body));
|
|
jbRecPop();
|
|
return result;
|
|
}
|
|
|
|
oop apply(oop func, oop args)
|
|
{
|
|
if (!is(Function, func)) {
|
|
printf("cannot apply ");
|
|
println(func);
|
|
exit(1);
|
|
}
|
|
if (NULL != get(func, Function, primitive)) {
|
|
return get(func, Function, primitive)(args);
|
|
}
|
|
oop param = get(func, Function, param);
|
|
oop localScope = map_zip(param, args);
|
|
map_set(localScope, __arguments___symbol, args);
|
|
map_set(localScope, __proto___symbol, get(func, Function, parentScope));
|
|
jbRecPush();
|
|
int jbt = sigsetjmp(jbs->jb, 0);
|
|
switch (jbt) {
|
|
case j_return: {
|
|
oop result = jbs->result;
|
|
jbRecPop();
|
|
return result;
|
|
}
|
|
case j_break: {
|
|
runtimeError("break outside of a loop or switch");
|
|
}
|
|
case j_continue: {
|
|
runtimeError("continue outside of a loop");
|
|
}
|
|
case j_throw: {
|
|
oop res= jbs->result;
|
|
jbRecPop();
|
|
jbs->result= res;
|
|
siglongjmp(jbs->jb, j_throw);
|
|
}
|
|
}
|
|
oop result= eval(localScope, get(func, Function, body));
|
|
jbRecPop();
|
|
return result;
|
|
}
|
|
|
|
oop prim_apply(oop params) {
|
|
oop func= null; if (map_hasIntegerKey(params, 0)) func= get(params, Map, elements)[0].value;
|
|
oop args= null; if (map_hasIntegerKey(params, 1)) args= get(params, Map, elements)[1].value;
|
|
return apply(func, args);
|
|
}
|
|
|
|
oop prim_clone(oop params)
|
|
{
|
|
if (map_hasIntegerKey(params, 0)) return clone(get(params, Map, elements)[0].value);
|
|
return null;
|
|
}
|
|
|
|
oop prim_print(oop params)
|
|
{
|
|
assert(is(Map, params));
|
|
for (int i= 0; map_hasIntegerKey(params, i); ++i) {
|
|
print(get(params, Map, elements)[i].value);
|
|
}
|
|
return params;
|
|
}
|
|
|
|
oop prim_println(oop params)
|
|
{
|
|
oop res= prim_print(params);
|
|
printf("\n");
|
|
return res;
|
|
}
|
|
|
|
oop evalArgs(oop scope, oop args)
|
|
{
|
|
int i = 0;
|
|
oop params = makeMap();
|
|
oop index;
|
|
while ((index = makeInteger(i)), map_hasKey(args, index)) {
|
|
map_set(params, index, eval(scope, map_get(args, index)));
|
|
i++;
|
|
}
|
|
return params;
|
|
}
|
|
|
|
oop AST= NULL;
|
|
|
|
void readEvalPrint(char *fileName) {
|
|
inputStackPush(fileName);
|
|
jbRecPush();
|
|
jb_record *jtop= jbs;
|
|
int jbt= sigsetjmp(jbs->jb, 0);
|
|
|
|
if (0 == jbt) {
|
|
while (inputStack && yyparse()) {
|
|
if (opt_v > 1) printf("%s:%i: ", get(inputStack->name, String, value), inputStack->lineNumber);
|
|
if (!yylval) {
|
|
fclose(inputStack->file);
|
|
inputStackPop();
|
|
continue;
|
|
} // EOF
|
|
if (opt_v > 1) println(yylval);
|
|
oop res = eval(globals, yylval);
|
|
if (opt_v > 0) println(res);
|
|
assert(jbs == jtop);
|
|
}
|
|
jbRecPop();
|
|
return;
|
|
}
|
|
|
|
assert(jbs == jtop);
|
|
oop res = jbs->result;
|
|
jbRecPop();
|
|
switch (jbt) {
|
|
case j_return:
|
|
runtimeError("return outside of a function");
|
|
case j_break:
|
|
runtimeError("break outside of a loop or switch");
|
|
case j_continue:
|
|
runtimeError("continue outside of a loop");
|
|
case j_throw:
|
|
printf("\nunhandled exception: ");
|
|
println(res);
|
|
exit(1);
|
|
}
|
|
}
|
|
|
|
oop prim_import(oop params)
|
|
{
|
|
if (map_hasIntegerKey(params, 0)) {
|
|
char *file= get(get(params, Map, elements)[0].value, String, value);
|
|
if (yyctx->__pos < yyctx->__limit) {
|
|
yyctx->__limit--;
|
|
ungetc(yyctx->__buf[yyctx->__limit], inputStack->file);
|
|
}
|
|
readEvalPrint(file);
|
|
}
|
|
return null;
|
|
}
|
|
|
|
#include <sys/resource.h>
|
|
|
|
oop prim_millis(oop params)
|
|
{
|
|
struct rusage ru;
|
|
getrusage(RUSAGE_SELF, &ru);
|
|
return makeInteger(ru.ru_utime.tv_sec * 1000 + ru.ru_utime.tv_usec / 1000);
|
|
}
|
|
|
|
int main(int argc, char **argv)
|
|
{
|
|
# if (USE_GC)
|
|
GC_INIT();
|
|
# endif
|
|
|
|
symbol_table= makeMap();
|
|
globals= makeMap();
|
|
|
|
map_set(globals, intern("exit") , makeFunction(prim_exit, intern("exit"), null, null, globals, null));
|
|
map_set(globals, intern("keys") , makeFunction(prim_keys, intern("keys"), null, null, globals, null));
|
|
map_set(globals, intern("values") , makeFunction(prim_values, intern("values"), null, null, globals, null));
|
|
map_set(globals, intern("length") , makeFunction(prim_length, intern("length"), null, null, globals, null));
|
|
map_set(globals, intern("print") , makeFunction(prim_print, intern("print"), null, null, globals, null));
|
|
map_set(globals, intern("println"), makeFunction(prim_println, intern("println"), null, null, globals, null));
|
|
map_set(globals, intern("invoke") , makeFunction(prim_invoke, intern("invoke"), null, null, globals, null));
|
|
map_set(globals, intern("apply") , makeFunction(prim_apply, intern("apply"), null, null, globals, null));
|
|
map_set(globals, intern("clone") , makeFunction(prim_clone, intern("clone"), null, null, globals, null));
|
|
map_set(globals, intern("import") , makeFunction(prim_import, intern("import"), null, null, globals, null));
|
|
map_set(globals, intern("millis") , makeFunction(prim_millis, intern("millis"), null, null, globals, null));
|
|
|
|
#define _DO(NAME) NAME##_symbol=intern(#NAME);
|
|
DO_SYMBOLS()
|
|
#undef _DO
|
|
|
|
#define _DO(NAME) set(NAME##_symbol, Symbol, prototype, t_##NAME);
|
|
DO_PROTOS()
|
|
#undef _DO
|
|
|
|
#define _DO(NAME) NAME##_proto=makeMap(); map_set(NAME##_proto, __name___symbol, NAME##_symbol);
|
|
DO_PROTOS()
|
|
#undef _DO
|
|
|
|
AST = makeMap();
|
|
map_set(globals, intern("AST"), AST);
|
|
#define _DO(NAME) map_set(AST, NAME##_symbol, NAME##_proto);
|
|
DO_PROTOS()
|
|
#undef _DO
|
|
|
|
int repled = 0;
|
|
while (argc-- > 1) {
|
|
++argv;
|
|
if (!strcmp(*argv, "-v")) ++opt_v;
|
|
else if (!strcmp(*argv, "-")) {
|
|
readEvalPrint(NULL);
|
|
repled= 1;
|
|
}
|
|
else {
|
|
readEvalPrint(*argv);
|
|
repled= 1;
|
|
}
|
|
}
|
|
if (!repled) {
|
|
readEvalPrint(NULL);
|
|
}
|
|
|
|
return 0;
|
|
|
|
(void)yyAccept;
|
|
}
|
|
|
|
// Local Variables:
|
|
// indent-tabs-mode: nil
|
|
// End:
|