piumarta
/
javascrypt
zrcadlo https://github.com/mtardy/javascrypt.git
1
0
Rozštěpit 0
Zdrojový kód Úkoly 0 Vydání 1 Wiki Aktivita
Nelze vybrat více než 25 témat Téma musí začínat písmenem nebo číslem, může obsahovat pomlčky („-“) a může být dlouhé až 35 znaků.
151 Revize
1 Větev
1.9 MiB
 
 
 
 
Strom: 6e9df129dd
Větve Značky
${ item.name }
Vytvořit větev ${ searchTerm }
z „6e9df129dd“
${ noResults }
javascrypt/parse.leg

2386 řádky
80 KiB
Surový Blame Historie

%{
/* compile: leg -o parse.c parse.leg
* cc -o parse parse.c
*
* run: echo "3+4" | ./parse
*/
#include <stdarg.h>
#include <math.h>
#define DO_PROTOS() \
_DO(If) _DO(While) _DO(Do) _DO(For) _DO(ForIn) _DO(Switch) _DO(Call) \
_DO(Invoke) _DO(Func) _DO(Block) _DO(Declaration) _DO(Assign) \
_DO(Map) _DO(Symbol) _DO(Integer) _DO(Float) _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(Slice) \
_DO(Return) _DO(Break) _DO(Continue) _DO(Throw) _DO(Try) \
_DO(Quasiquote) _DO(Unquote) _DO(Unsplice) _DO(Splice)
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;
#define jbRecPush() \
struct jb_record jbrec; \
jbrec.next= jbs; \
jbs= &jbrec
#define jbRecPop() \
assert(jbs == &jbrec); \
jbs= jbrec.next
// 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__) \
_DO(start) _DO(stop)
#define _DO(NAME) oop NAME##_symbol;
DO_SYMBOLS()
#undef _DO
#define _DO(NAME) oop NAME##_proto;
DO_PROTOS()
#undef _DO
int opt_g= 0;
int opt_v= 0;
oop mrAST= &_null;
void printBacktrace(oop top);
void runtimeError(char *fmt, ...);
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 = 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) {
runtimeError("Undefined: %s", printString(key));
}
}
return map_get(object, key);
}
oop getMember(oop object, oop key)
{
while (!map_hasKey(object, key)) {
object = map_get(object, __proto___symbol);
if (null == object) {
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 getProperty(oop object, oop key)
{
if (!map_hasKey(object, key)) {
runtimeError("Undefined: .%s", printString(key));
}
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 newForIn(oop name, oop expression, oop body)
{
oop obj= newObject(ForIn_proto);
map_set(obj, name_symbol, name);
map_set(obj, expression_symbol, expression);
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;
}
oop newFloat(oop value)
{
oop obj = newObject(Float_proto);
map_set(obj, value_symbol, value);
return obj;
}
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 scope, oop this, oop func, oop args, oop ast);
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 newSlice(oop value, oop start, oop stop)
{
oop obj= newObject(Slice_proto);
map_set(obj, value_symbol, value);
map_set(obj, start_symbol, start);
map_set(obj, stop_symbol, stop);
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;
}
#define YY_INPUT(buf, result, max_size) \
{ \
int yyc= feof(inputStack->file) ? EOF : 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:exp ';' { yylval = e }
| 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:ident IN e:exp RPAREN s:stmt { $$ = newForIn(i, e, s) }
| 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(globals, globals, l, a, a)) }
| c:cond { $$ = c }
ident = l:IDENT { $$ = l }
| AT n:value { $$ = 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, eval(globals, 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 }
| NEGATE 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) }
| 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 e1:exp COLON e2:exp RBRAC !assignOp { i = newSlice(i, e1, e2) }
| LBRAC e1:exp COLON RBRAC !assignOp { i = newSlice(i, e1, null) }
| LBRAC COLON e2:exp RBRAC !assignOp { i = newSlice(i, null, e2) }
| LBRAC COLON RBRAC !assignOp { i = newSlice(i, null, null) }
| LBRAC p:exp RBRAC !assignOp { i = newGetMap(GetIndex_proto, i, p) }
| a:argumentList { i = (null != getSyntax(1, i)) ? apply(globals, globals, getSyntax(1, i), a, i) : newCall(i, a) }
| PLUSPLUS { i = newPostIncrement(i) }
| MINUSMINUS { i = newPostDecrement(i) }
) * { $$ = i }
paramList = LPAREN m:makeMap
( p:parameter { map_append(m, p) }
( COMMA p:parameter { map_append(m, p) }
) *
) ?
RPAREN { $$ = m }
parameter = ATAT p:value { $$ = newUnary(Unsplice_proto, p) }
| p:ident { $$ = p }
argumentList = LPAREN m:makeMap
( a:argument { map_append(m, a) }
( COMMA a:argument { map_append(m, a) }
) *
) ?
RPAREN { $$ = m }
argument = ATAT e:value { $$ = newUnary(Unsplice_proto, e) }
| MULTI e:exp { $$ = newUnary(Splice_proto, e) }
| e:exp { $$ = e }
value = BACKTICK n:value { $$ = newUnary(Quasiquote_proto, n) }
| AT n:value { $$ = newUnary(Unquote_proto, n) }
| n:FLOAT { $$ = newFloat(n) }
| n:integer { $$ = 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:argument { map_append(m, v) }
( COMMA v:argument { map_append(m, v) }
) *
) ?
RBRAC { $$ = m }
makeMap = { $$ = makeMap() }
key = IDENT | integer
- = (blank | comment)*
blank = space | eol
space = [ \t]
eol = ( "\n""\r"*
| "\r""\n"*
) { inputStack->lineNumber++ }
comment = "//" ( ![\n\r] . )*
| "/*" ( !"*/" (eol | .) )* "*/"
keyword = FUN | SYNTAX | VAR | SWITCH | CASE | DEFAULT | DO | FOR | IN | WHILE | IF | ELSE | NULL | RETURN | BREAK | CONTINUE
| THROW | TRY | CATCH | FINALLY
IDENT = !keyword < [a-zA-Z_][a-zA-Z0-9_]* > - { $$ = intern(yytext) }
integer = i:INTEGER { $$ = i }
| '-' i:integer { $$ = makeInteger(-getInteger(i)) }
INTEGER = '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]) }
FLOAT = < [-+]* [0-9]+ '.' [0-9]* ('e'[-+]*[0-9]+)? > - { $$ = makeFloat(strtold(yytext, 0)) }
| < [-+]* [0-9]* '.' [0-9]+ ('e'[-+]*[0-9]+)? > - { $$ = makeFloat(strtold(yytext, 0)) }
| < [-+]* [0-9]+ ('e'[-+]*[0-9]+) > - { $$ = makeFloat(strtold(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_] -
IN = 'in' ![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 = '-' ![-=] -
NEGATE = '-' ![-=0-9.] -
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 = '@' ![@] -
ATAT = '@@' ![@] -
LCB = '{' -
RCB = '}' -
LBRAC = '[' -
RBRAC = ']' -
LPAREN = '(' -
RPAREN = ')' -
DQUOTE = '"'
SQUOTE = "'"
%%
;
oop map_zip(oop map, oop keys, oop values)
{
assert(is(Map, map));
assert(is(Map, keys));
assert(is(Map, values));
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 Float:
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;
}
case Function: {
oop fun= malloc(sizeof(*obj));
memcpy(fun, obj, sizeof(*obj));
return fun;
}
}
return obj;
}
struct Call
{
oop ast, function;
};
DECLARE_BUFFER(struct Call, CallArray);
CallArray backtrace= BUFFER_INITIALISER;
struct Call CallArray_pop(CallArray *oa)
{ assert(oa->position > 0);
return oa->contents[--oa->position];
}
void trace(oop ast, oop func)
{
CallArray_append(&backtrace, (struct Call){ ast, func });
}
void untrace(oop ast)
{
struct Call top= CallArray_pop(&backtrace); assert(top.ast == ast);
}
void printLocation(oop ast)
{
fflush(stdout);
if (!is(Map, ast)) return;
char *fileName = get (map_get(ast, __file___symbol), String, value);
int lineNumber = getInteger(map_get(ast, __line___symbol) );
fprintf(stderr, "%s:%i", fileName, lineNumber);
}
void printlnLocation(oop ast)
{
fflush(stdout);
if (!is(Map, ast)) return;
printLocation(ast);
fprintf(stderr, "\n");
}
void printBacktrace(oop top)
{
fflush(stdout);
printLocation(top);
while (CallArray_position(&backtrace) > 0) {
struct Call call= CallArray_pop(&backtrace);
if (is(Map, call.ast) && Call_proto == map_get(call.ast, __proto___symbol)) {
oop name= get(call.function, Function, name);
if (null != name) {
printf(" in ");
if (get(call.function, Function, primitive)) printf("primitive ");
else printf("function ");
println(get(call.function, Function, name));
}
}
else {
printf("\n");
}
printLocation(call.ast);
}
printf("\n");
}
void runtimeError(char *fmt, ...)
{
fflush(stdout);
va_list ap;
va_start(ap, fmt);
fprintf(stderr, "\n");
vfprintf(stderr, fmt, ap);
fprintf(stderr, "\n");
va_end(ap);
printBacktrace(mrAST);
exit(1);
}
#define TYPESIG(L, R) L*NTYPES+R
#define CASE(L, R) case TYPESIG(L, R)
oop addOperation(oop lhs, oop rhs)
{
switch (TYPESIG(getType(lhs), getType(rhs))) {
CASE(Integer, Integer): return makeInteger(getInteger(lhs) + getInteger(rhs));
CASE(Integer, Float ): return makeFloat(getInteger(lhs) + get(rhs, Float, _value));
CASE(Float , Integer): return makeFloat(get(lhs, Float, _value) + getInteger(rhs));
CASE(Float , Float ): return makeFloat(get(lhs, Float, _value) + get(rhs, Float, _value));
CASE(String , String ): return string_concat(lhs, rhs);
}
runtimeError("addition between two incompatible types");
return NULL; // to prevent: control may reach end of non-void function
}
oop subOperation(oop lhs, oop rhs)
{
switch (TYPESIG(getType(lhs), getType(rhs))) {
CASE(Integer, Integer): return makeInteger(getInteger(lhs) - getInteger(rhs));
CASE(Integer, Float ): return makeFloat(getInteger(lhs) - get(rhs, Float, _value));
CASE(Float , Integer): return makeFloat(get(lhs, Float, _value) - getInteger(rhs));
CASE(Float , Float ): return makeFloat(get(lhs, Float, _value) - get(rhs, Float, _value));
}
runtimeError("substraction between two incompatible types");
return NULL; // to prevent: control may reach end of non-void function
}
oop mulOperation(oop lhs, oop rhs)
{
switch (TYPESIG(getType(lhs), getType(rhs))) {
CASE(Integer, Integer): return makeInteger(getInteger(lhs) * getInteger(rhs));
CASE(Integer, Float ): return makeFloat(getInteger(lhs) * get(rhs, Float, _value));
CASE(Float , Integer): return makeFloat(get(lhs, Float, _value) * getInteger(rhs));
CASE(Float , Float ): return makeFloat(get(lhs, Float, _value) * get(rhs, Float, _value));
CASE(String , Integer): return string_mul(lhs, rhs);
CASE(Integer, String ): return string_mul(rhs, lhs);
}
runtimeError("multiplication between two incompatible types");
return NULL; // to prevent: control may reach end of non-void function
}
oop divOperation(oop lhs, oop rhs)
{
switch (TYPESIG(getType(lhs), getType(rhs))) {
CASE(Integer, Integer): return makeInteger(getInteger(lhs) / getInteger(rhs));
CASE(Integer, Float ): return makeFloat(getInteger(lhs) / get(rhs, Float, _value));
CASE(Float , Integer): return makeFloat(get(lhs, Float, _value) / getInteger(rhs));
CASE(Float , Float ): return makeFloat(get(lhs, Float, _value) / get(rhs, Float, _value));
}
runtimeError("division between two incompatible types");
return NULL; // to prevent: control may reach end of non-void function
}
oop modOperation(oop lhs, oop rhs)
{
switch (TYPESIG(getType(lhs), getType(rhs))) {
CASE(Integer, Integer): return makeInteger(getInteger(lhs) % getInteger(rhs));
CASE(Float , Float ): return makeFloat(fmodl(get(lhs, Float, _value), get(rhs, Float, _value)));
}
runtimeError("modulo between two incompatible types");
return NULL; // to prevent: control may reach end of non-void function
}
#undef TYPESIG
#undef CASE
oop expandUnquotes(oop scope, oop ast)
{
if (!is(Map, ast)) return clone(ast);
if (Unquote_proto == map_get(ast, __proto___symbol)) return eval(scope, map_get(ast, rhs_symbol));
if (Unsplice_proto == map_get(ast, __proto___symbol)) runtimeError("@@ outside of array expression");
oop map= makeMap();
if (map_isArray(ast)) {
for (size_t i= 0; i < map_size(ast); ++i) {
struct Pair *pair= &get(ast, Map, elements)[i];
if (!is(Map, pair->value)) {
map_append(map, clone(pair->value));
continue;
}
oop proto= map_get(pair->value, __proto___symbol);
if (Unquote_proto == proto) {
map_append(map, eval(scope, map_get(pair->value, rhs_symbol)));
continue;
}
if (Unsplice_proto == proto) {
oop sub= eval(scope, map_get(pair->value, rhs_symbol));
if (is(Map, sub) && (Map_proto == map_get(sub, __proto___symbol))) sub= map_get(sub, value_symbol);
if (!map_isArray(sub)) runtimeError("cannot splice non-array: %s", printString(sub));
for (size_t j= 0; j < map_size(sub); ++j)
map_append(map, get(sub, Map, elements)[j].value);
continue;
}
map_append(map, expandUnquotes(scope, pair->value));
}
}
else {
for (size_t i= 0; i < map_size(ast); ++i) {
struct Pair *pair= &get(ast, Map, elements)[i];
oop key= expandUnquotes(scope, pair->key);
if (!is(Map, pair->value)) {
map_set(map, key, clone(pair->value));
continue;
}
if (__proto___symbol == key)
map_set(map, key, pair->value);
else
map_set(map, key, expandUnquotes(scope, pair->value));
}
}
return map;
}
oop applyOperator(oop op, oop lhs, oop rhs)
{
if (null != op) { assert(is(Symbol, op));
switch (get(op, Symbol, prototype)) {
case t_Add: return addOperation(lhs, rhs);
case t_Sub: return subOperation(lhs, rhs);
case t_Mul: return mulOperation(lhs, rhs);
case t_Div: return divOperation(lhs, rhs);
case t_Mod: return modOperation(lhs, 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 freeScopes= 0; // pool of free scopes
oop fixScope(oop scope) // prevent this scope and its parents from being recycled
{ assert(is(Map, scope));
oop tmp= scope;
while (is(Map, tmp) && (0 == (tmp->Map.flags & MAP_ENCLOSED))) {
tmp->Map.flags |= MAP_ENCLOSED;
tmp= map_get(tmp, __proto___symbol);
}
return scope;
}
oop newScope(oop parent)
{
if (0 == freeScopes) freeScopes= makeMap();
oop scope= freeScopes; assert(is(Map, scope));
freeScopes= freeScopes->Map.pool;
scope->Map.size= 0;
map_set(scope, __proto___symbol, parent);
return scope;
}
void delScope(oop scope)
{ assert(is(Map, scope));
if (scope->Map.flags & MAP_ENCLOSED) {
printf("IGNORE %p\n", scope);
return;
}
scope->Map.pool= freeScopes;
freeScopes= scope;
}
oop evalArgs(oop scope, oop args);
oop apply(oop scope, oop this, oop func, oop args, oop ast)
{
assert(is(Function, func));
if (NULL != get(func, Function, primitive)) {
return get(func, Function, primitive)(scope, args);
}
oop param = get(func, Function, param);
oop localScope = newScope(get(func, Function, parentScope));
map_zip(localScope, param, args);
map_set(localScope, this_symbol, this);
map_set(localScope, __arguments___symbol, args);
jbRecPush();
trace(ast, func);
int jbt = sigsetjmp(jbs->jb, 0);
switch (jbt) {
case j_return: {
untrace(ast);
delScope(localScope);
oop result = jbs->result;
jbRecPop();
return result;
}
case j_break: {
delScope(localScope);
runtimeError("break outside of a loop or switch");
}
case j_continue: {
delScope(localScope);
runtimeError("continue outside of a loop");
}
case j_throw: {
untrace(ast);
delScope(localScope);
oop res= jbs->result;
jbRecPop();
jbs->result= res;
siglongjmp(jbs->jb, j_throw);
}
}
oop result= eval(localScope, get(func, Function, body));
untrace(ast);
delScope(localScope);
jbRecPop();
return result;
}
oop eval(oop scope, oop ast)
{
if (opt_v > 3) {
printf("EVAL: ");
println(ast);
}
switch(getType(ast)) {
case Undefined:
case Integer:
case Float:
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_Unsplice: {
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 = newScope(scope);
jbRecPush();
int jbt = sigsetjmp(jbs->jb, 0);
switch (jbt) {
case j_return:
case j_throw: {
delScope(localScope);
oop result = jbs->result;
jbRecPop();
assert(jbs);
jbs->result = result;
siglongjmp(jbs->jb, jbt);
assert(0);
}
case j_break: {
delScope(localScope);
jbRecPop();
return result;
}
case j_continue: {
goto restart_for;
}
}
for (eval(localScope, initialise); isTrue(eval(localScope, condition)); eval(localScope, update)) {
result= eval(localScope, body);
restart_for:;
}
delScope(localScope);
jbRecPop();
return result;
}
case t_ForIn: {
oop expr = eval(scope, map_get(ast, expression_symbol)); if (!is(Map, expr)) return null;
oop name = map_get(ast, name_symbol ) ;
oop body = map_get(ast, body_symbol ) ;
oop result = null;
oop localScope = newScope(scope);
jbRecPush();
int jbt = sigsetjmp(jbs->jb, 0);
switch (jbt) {
case j_return:
case j_throw: {
delScope(localScope);
oop result = jbs->result;
jbRecPop();
assert(jbs);
jbs->result = result;
siglongjmp(jbs->jb, jbt);
assert(0);
}
case j_break: {
delScope(localScope);
jbRecPop();
return result;
}
case j_continue: {
goto restart_forin;
}
}
for (size_t i= 0; i < map_size(expr); ++i) {
map_set(localScope, name, get(expr, Map, elements)[i].key);
result= eval(localScope, body);
restart_forin:;
}
delScope(localScope);
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(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, fixScope(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)) {
printf("\ncannot call %s\n", printString(func));
printBacktrace(ast);
exit(1);
}
oop args = map_get(ast, args_symbol);
if (isFalse(get(func, Function, fixed))) {
args = evalArgs(scope, args);
}
return apply(scope, globals, func, args, ast);
}
case t_Invoke: {
oop this = eval(scope, map_get(ast, this_symbol));
oop func = map_get(ast, name_symbol); assert(is(Symbol, func));
func = getVariable(this, func);
if (!is(Function, func)) {
printf("\ncannot invoke %s\n", printString(func));
printBacktrace(ast);
exit(1);
}
oop args = map_get(ast, args_symbol);
if (isFalse(get(func, Function, fixed))) {
args = evalArgs(scope, args);
}
return apply(scope, this, func, args, ast);
}
case t_Splice: {
runtimeError("* outside of argument list");
}
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= newScope(scope);
setVariable(localScope, exception, res);
jbRecPush();
jbt= sigsetjmp(jbs->jb, 0);
if (0 == jbt) {
eval(localScope, catch);
delScope(localScope);
jbRecPop();
return eval(scope, finally);
}
delScope(localScope);
// 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 = newScope(scope);
while ((index = makeInteger(i)), map_hasKey(statements, index)) {
statement = map_get(statements, index);
res = eval(localScope, statement);
i++;
}
delScope(localScope);
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 getMember(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(op, getProperty(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 (!isInteger(key)) {
runtimeError("non-integer index");
}
ssize_t i= getInteger(key);
size_t len= string_size(map);
if (i < 0) i+= len;
if (i < 0 || i >= len) {
runtimeError("GetIndex out of bounds on String");
}
return makeInteger(get(map, String, value)[i]);
case Map:
if (isInteger(key) && getInteger(key) < 0) {
size_t size= map_size(map);
if (size > 0 && map_hasIntegerKey(map, size - 1)) {
key= makeInteger(getInteger(key) + size);
}
}
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 bounds on String");
}
get(map, String, value)[getInteger(key)] = getInteger(value);
return value;
case Map:
if (null != op) value= applyOperator(op, map_get(map, key), value);
return map_set(map, key, value);
default:
runtimeError("SetIndex on non Map or String");
}
}
case t_Slice: {
oop pre= eval(scope, map_get(ast, value_symbol));
oop start= eval(scope, map_get(ast, start_symbol));
oop stop= eval(scope, map_get(ast, stop_symbol));
ssize_t first= start == null ? 0 : getInteger(start);
if (start == null) {
start= makeInteger(0);
}
switch (getType(pre)) {
case String: {
ssize_t last= stop == null ? string_size(pre) : getInteger(stop);
oop res= string_slice(pre, first, last);
if (NULL == res) {
runtimeError("index out of bounds");
}
return res;
}
case Map: {
ssize_t last= stop == null ? map_size(pre) : getInteger(stop);
oop res= map_slice(pre, first, last);
if (NULL == res) {
runtimeError("index out of bounds");
}
return res;
}
}
runtimeError("slicing a non-String or non-Map");
}
case t_Symbol:
case t_Integer:
case t_Float:
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 RELATION(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(oopcmp(lhs, rhs) OPERATOR 0); \
}
# 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)); \
}
# define BINARYOP(NAME, FUNCPREFIX) \
case t_##NAME: { \
oop lhs = eval(scope, map_get(ast, lhs_symbol)); \
oop rhs = eval(scope, map_get(ast, rhs_symbol)); \
return FUNCPREFIX##Operation(lhs, rhs); \
}
BINARY(Bitor, | );
BINARY(Bitxor, ^ );
BINARY(Bitand, & );
RELATION(Equal, ==);
RELATION(Noteq, !=);
RELATION(Less, < );
RELATION(Lesseq, <=);
RELATION(Greatereq, >=);
RELATION(Greater, > );
BINARY(Shleft, <<);
BINARY(Shright, >>);
BINARYOP(Add, add);
BINARYOP(Mul, mul);
BINARYOP(Sub, sub);
BINARYOP(Div, div);
BINARYOP(Mod, mod);
# undef BINARYOP
# undef BINARY
# undef RELATION
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 scope, 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 scope, 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_allKeys(oop scope, oop params)
{
if (map_hasIntegerKey(params, 0)) {
oop arg= get(params, Map, elements)[0].value;
if (is(Map, arg)) return map_allKeys(arg);
}
return null;
}
oop prim_values(oop scope, 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_allValues(oop scope, oop params)
{
if (map_hasIntegerKey(params, 0)) {
oop arg= get(params, Map, elements)[0].value;
if (is(Map, arg)) return map_allValues(arg);
}
return null;
}
oop prim_length(oop scope, 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;
}
oop prim_apply(oop scope, 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(scope, globals, func, args, mrAST);
}
oop prim_invoke(oop scope, 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;
return apply(scope, this, func, args, mrAST);
}
oop prim_clone(oop scope, oop params)
{
if (map_hasIntegerKey(params, 0)) return clone(get(params, Map, elements)[0].value);
return null;
}
oop prim_print(oop scope, 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 evalArgs(oop scope, oop asts)
{
oop args= makeMap();
size_t nargs= map_size(asts);
for (size_t i= 0; i < nargs; ++i) {
oop ast= get(asts, Map, elements)[i].value;
if (is(Map, ast) && (Splice_proto == map_get(ast, __proto___symbol))) {
oop splice= eval(scope, map_get(ast, rhs_symbol));
if (!is(Map, splice)) map_append(args, splice);
else {
size_t nsplice= map_size(splice);
for (size_t j= 0; j < nsplice; ++j) {
map_append(args, get(splice, Map, elements)[j].value);
}
}
}
else {
map_append(args, eval(scope, ast));
}
}
return args;
}
oop AST= NULL;
void readEvalPrint(oop scope, char *fileName)
{
inputStackPush(fileName);
input_t *top= inputStack;
jbRecPush();
jb_record *jtop= jbs;
int jbt= sigsetjmp(jbs->jb, 0);
if (0 == jbt) {
while (yyparse()) {
if (opt_v > 1) printf("%s:%i: ", get(inputStack->name, String, value), inputStack->lineNumber);
if (!yylval) {
fclose(inputStack->file);
if (top == inputStack) break;
inputStackPop();
assert(inputStack);
continue;
} // EOF
if (opt_v > 1) println(yylval);
oop res = eval(scope, yylval);
if (opt_v > 0) println(res);
assert(jbs == jtop);
}
assert(inputStack);
inputStackPop();
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: runtimeError("unhandled exception: %s", printString(res));
}
}
oop prim_import(oop scope, 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(scope, file);
}
return null;
}
oop prim_String(oop scope, oop params)
{
if (!map_hasIntegerKey(params, 0)) return makeString("");
oop arg= get(params, Map, elements)[0].value;
switch (getType(arg)) {
case Undefined: {
return makeString("");
}
case Integer: {
int repeat= getInteger(arg);
if (!map_hasIntegerKey(params, 1)) {
return makeStringFromChar('\0', repeat);
}
char c= getInteger(get(params, Map, elements)[1].value);
return makeStringFromChar(c, repeat);
}
case String: {
return clone(arg);
}
case Map: {
if (map_isArray(arg)) {
size_t len= map_size(arg);
char *str= malloc(sizeof(char) * len + 1);
for (size_t i=0; i < len; ++i) {
str[i]= getInteger(get(arg, Map, elements)[i].value);
}
return makeStringFrom(str, len);
}
}
case Symbol: {
return makeString(get(arg, Symbol, name));
}
}
runtimeError("cannot make string from: %s", printString(arg));
return NULL;
}
oop prim_Symbol(oop scope, oop params)
{
oop arg= null;
if (map_hasIntegerKey(params, 0)) {
arg= get(params, Map, elements)[0].value;
switch (getType(arg)) {
case Integer: {
if (map_hasIntegerKey(params, 1)) {
int repeat= getInteger(arg);
char c= getInteger(get(params, Map, elements)[1].value);
return makeSymbolFromChar(c, repeat);
}
break;
}
case String: {
return makeSymbol(get(arg, String, value));
}
case Map: {
if (map_isArray(arg)) {
size_t len= map_size(arg);
char *str= malloc(sizeof(char) * len + 1);
for (size_t i=0; i < len; ++i) {
str[i]= getInteger(get(arg, Map, elements)[i].value);
}
return makeSymbolFrom(str);
}
}
case Symbol: {
return arg;
}
}
}
runtimeError("cannot make symbol from: %s", printString(arg));
return NULL;
}
oop prim_Integer(oop scope, oop params)
{
oop arg= null;
if (map_hasIntegerKey(params, 0)) {
arg= get(params, Map, elements)[0].value;
switch (getType(arg)) {
case Undefined: {
return makeInteger(0);
}
case Integer: {
return arg;
}
case String: {
if (!map_hasIntegerKey(params, 1)) {
return makeInteger(strtoll(get(arg, String, value), NULL, 0));
}
int base= getInteger(get(params, Map, elements)[1].value);
if (base > 36 || base < 2) {
runtimeError("base must be between 2 and 36 inclusive");
}
return makeInteger(strtoll(get(arg, String, value), NULL, base));
}
}
}
runtimeError("cannot make integer from: %s", printString(arg));
return NULL;
}
oop prim_Map(oop scope, oop params)
{
if (!map_hasIntegerKey(params, 0)) return makeMap();
oop arg= get(params, Map, elements)[0].value;
switch (getType(arg)) {
case Undefined: {
return makeMap();
}
case Integer: {
return makeMapCapacity(getInteger(arg));
}
case Map: {
return clone(arg);
}
}
runtimeError("cannot make map from: %s", printString(arg));
return NULL;
}
oop prim_Array(oop scope, oop params)
{
if (!map_hasIntegerKey(params, 0)) return makeMap();
oop arg= get(params, Map, elements)[0].value;
switch (getType(arg)) {
case Undefined: {
return makeMap();
}
case Integer: {
int repeat= getInteger(arg);
oop array= NULL;
if (map_hasIntegerKey(params, 1)) {
array= makeArrayFromElement(get(params, Map, elements)[1].value, repeat);
} else {
array= makeArrayFromElement(null, repeat);
}
return array;
}
case Symbol: {
return makeArrayFromString(get(arg, Symbol, name));
}
case String: {
return makeArrayFromString(get(arg, String, value));
}
case Map: {
return clone(arg);
}
}
runtimeError("cannot make array from: %s", printString(arg));
return NULL;
}
oop prim_Function(oop scope, oop params)
{
oop arg= null;
if (map_hasIntegerKey(params, 0)) {
arg= get(params, Map, elements)[0].value;
switch (getType(arg)) {
case Function: {
if (isTrue(get(arg, Function, fixed))) {
oop unfix= clone(arg);
set(unfix, Function, fixed, makeInteger(0));
return unfix;
} else {
return clone(arg);
}
}
case Map: {
if (map_hasIntegerKey(params, 1) && map_hasIntegerKey(params, 2) && map_hasIntegerKey(params, 3)) {
oop param= arg;
oop body= get(params, Map, elements)[1].value;
oop parentScope= get(params, Map, elements)[2].value;
oop name= get(params, Map, elements)[3].value;
if (is(Map, body) && is(Map, parentScope) && is(Map, name)) {
return makeFunction(NULL, name, param, body, parentScope, makeInteger(0));
}
}
}
}
}
runtimeError("cannot make function from: %s", printString(arg));
return NULL;
}
oop prim_Syntax(oop scope, oop params)
{
oop arg= null;
if (map_hasIntegerKey(params, 0)) {
arg= get(params, Map, elements)[0].value;
switch (getType(arg)) {
case Function: {
if (isFalse(get(arg, Function, fixed))) {
oop fix= clone(arg);
set(fix, Function, fixed, makeInteger(1));
return fix;
} else {
return clone(arg);
}
}
case Map: {
if (map_hasIntegerKey(params, 1) && map_hasIntegerKey(params, 2) && map_hasIntegerKey(params, 3)) {
oop param= arg;
oop body= get(params, Map, elements)[1].value;
oop parentScope= get(params, Map, elements)[2].value;
oop name= get(params, Map, elements)[3].value;
if (is(Map, body) && is(Map, parentScope) && is(Map, name)) {
return makeFunction(NULL, name, param, body, parentScope, makeInteger(1));
}
}
}
}
}
runtimeError("cannot make syntax from: %s", printString(arg));
return NULL;
}
oop prim_scope(oop scope, oop params)
{
return fixScope(scope);
}
#include <sys/resource.h>
oop prim_microseconds(oop scope, oop params)
{
struct rusage ru;
getrusage(RUSAGE_SELF, &ru);
return makeInteger(ru.ru_utime.tv_sec * 1000*1000 + ru.ru_utime.tv_usec);
}
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("allKeys" ), makeFunction(prim_allKeys, intern("allKeys" ), null, null, globals, null));
map_set(globals, intern("values" ), makeFunction(prim_values, intern("values" ), null, null, globals, null));
map_set(globals, intern("allValues" ), makeFunction(prim_allValues, intern("allValues" ), 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("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("microseconds"), makeFunction(prim_microseconds, intern("microseconds"), null, null, globals, null));
map_set(globals, intern("String" ), makeFunction(prim_String , intern("String" ), null, null, globals, null));
map_set(globals, intern("Integer" ), makeFunction(prim_Integer , intern("Integer" ), null, null, globals, null));
map_set(globals, intern("Symbol" ), makeFunction(prim_Symbol , intern("Symbol" ), null, null, globals, null));
map_set(globals, intern("Map" ), makeFunction(prim_Map , intern("Map" ), null, null, globals, null));
map_set(globals, intern("Array" ), makeFunction(prim_Array , intern("Array" ), null, null, globals, null));
map_set(globals, intern("Function" ), makeFunction(prim_Function , intern("Function" ), null, null, globals, null));
map_set(globals, intern("Syntax" ), makeFunction(prim_Syntax , intern("Syntax" ), null, null, globals, null));
map_set(globals, intern("scope"), makeFunction(prim_scope, intern("scope"), 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
fixScope(globals);
int repled = 0;
while (argc-- > 1) {
++argv;
if (!strcmp(*argv, "-g")) ++opt_g;
else if (!strcmp(*argv, "-v")) ++opt_v;
else if (!strcmp(*argv, "-")) {
readEvalPrint(globals, NULL);
repled= 1;
}
else {
readEvalPrint(globals, *argv);
repled= 1;
}
}
if (!repled) {
readEvalPrint(globals, NULL);
}
if (opt_g) {
if (nalloc < 1024) printf("[GC: %lli bytes allocated]\n", nalloc );
else if (nalloc < 1024*1024) printf("[GC: %lli kB allocated]\n", nalloc / 1024 );
else if (nalloc < 1024*1024*1024) printf("[GC: %.2f MB allocated]\n", (double)nalloc / ( 1024*1024));
else printf("[GC: %.2f GB allocated]\n", (double)nalloc / (1024*1024*1024));
}
return 0;
(void)yyAccept;
}
// Local Variables:
// indent-tabs-mode: nil
// End: