piumarta
/
parsimony
1
0
Fork 0
Code Issues 0 Pull Requests 0 Releases 1 Wiki Activity
AST
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
85 Commits
1 Branch
249 KiB
 
 
 
 
Tree: 6905791c60
Branches Tags
${ item.name }
Create branch ${ searchTerm }
from '6905791c60'
${ noResults }
parsimony/parse.leg

1575 lines
54 KiB
Raw Blame History

%{
/* 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(assignAdd) _DO(assignSub) _DO(assignMul) _DO(assignDiv) _DO(assignMod) \
_DO(assignBitor) _DO(assignBitxor) _DO(assignBitand) _DO(assignShleft) _DO(assignShright) \
_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(setMemberAdd) _DO(setMemberSub) _DO(setMemberMul) _DO(setMemberDiv) _DO(setMemberMod) \
_DO(setMemberBitor) _DO(setMemberBitxor) _DO(setMemberBitand) _DO(setMemberShleft) _DO(setMemberShright) \
_DO(setIndexAdd) _DO(setIndexSub) _DO(setIndexMul) _DO(setIndexDiv) _DO(setIndexMod) \
_DO(setIndexBitor) _DO(setIndexBitxor) _DO(setIndexBitand) _DO(setIndexShleft) _DO(setIndexShright) \
_DO(return) _DO(break) _DO(continue)
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,
};
typedef struct jb_record
{
sigjmp_buf jb;
oop result;
struct jb_record *next;
} jb_record;
jb_record *jbs= NULL;
void jbsCheck(char *msg)
{
if (NULL == jbs) {
fprintf(stderr, "\n%s\n", msg);
exit(1);
}
}
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)
#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 newObject(oop proto)
{
oop map = makeMap();
map_set(map, __proto___symbol, proto);
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");
}
}
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(int value)
{
oop integer = newObject(integer_proto);
map_set(integer, value_symbol, makeInteger(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 newSetMap(oop proto, oop map, oop key, oop value)
{
oop obj = newObject(proto);
map_set(obj, map_symbol, map);
map_set(obj, key_symbol, key);
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 func = newObject(func_proto);
map_set(func, name_symbol, name);
map_set(func, param_symbol, param);
map_set(func, body_symbol, body);
return func;
}
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;
}
// 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) {
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 == object) {
return map_set(object, key, value);
}
}
return map_set(obj, key, value);
}
oop fold(oop ast);
#define YYSTYPE oop
YYSTYPE yylval;
void error(char *text)
{
fprintf(stderr, "\nSyntax error near: %s\n", text);
exit(1);
}
%}
start = - ( e:stmt { yylval = e }
| !. { yylval = 0 }
| error
)
error = eol* < (!eol .)* eol* (!eol .)* > { error(yytext) }
stmt = e:exp SEMICOLON* { $$ = e }
| s:block { $$ = newBlock(s) }
exp = VAR l:IDENT ASSIGN e:exp { $$ = newDeclaration(l, e) }
| VAR l:IDENT { $$ = newDeclaration(l, null) }
| FUN l:IDENT p:paramList e:stmt { $$ = newFunc(l, p, e) }
| FUN p:paramList e:stmt { $$ = newFunc(null, p, e) }
| 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() }
| l:IDENT
( ASSIGN e:exp { $$ = newBinary(assign_proto, l, e) }
| ASSIGNADD e:exp { $$ = newBinary(assignAdd_proto, l, e) }
| ASSIGNSUB e:exp { $$ = newBinary(assignSub_proto, l, e) }
| ASSIGNMUL e:exp { $$ = newBinary(assignMul_proto, l, e) }
| ASSIGNDIV e:exp { $$ = newBinary(assignDiv_proto, l, e) }
| ASSIGNMOD e:exp { $$ = newBinary(assignMod_proto, l, e) }
| ASSIGNBITOR e:exp { $$ = newBinary(assignBitor_proto , l, e) }
| ASSIGNBITXOR e:exp { $$ = newBinary(assignBitxor_proto, l, e) }
| ASSIGNBITAND e:exp { $$ = newBinary(assignBitand_proto, l, e) }
| ASSIGNSHLEFT e:exp { $$ = newBinary(assignShleft_proto , l, e) }
| ASSIGNSHRIGHT e:exp { $$ = newBinary(assignShright_proto, l, e) }
)
| l:postfix DOT i:IDENT
( ASSIGN e:exp { $$ = newSetMap(setMember_proto, l, i, e) }
| ASSIGNADD e:exp { $$ = newSetMap(setMemberAdd_proto, l, i, e) }
| ASSIGNSUB e:exp { $$ = newSetMap(setMemberSub_proto, l, i, e) }
| ASSIGNMUL e:exp { $$ = newSetMap(setMemberMul_proto, l, i, e) }
| ASSIGNDIV e:exp { $$ = newSetMap(setMemberDiv_proto, l, i, e) }
| ASSIGNMOD e:exp { $$ = newSetMap(setMemberMod_proto, l, i, e) }
| ASSIGNBITOR e:exp { $$ = newSetMap(setMemberBitor_proto, l, i, e) }
| ASSIGNBITXOR e:exp { $$ = newSetMap(setMemberBitxor_proto, l, i, e) }
| ASSIGNBITAND e:exp { $$ = newSetMap(setMemberBitand_proto, l, i, e) }
| ASSIGNSHLEFT e:exp { $$ = newSetMap(setMemberShleft_proto, l, i, e) }
| ASSIGNSHRIGHT e:exp { $$ = newSetMap(setMemberShright_proto, l, i, e) }
)
| l:postfix LBRAC i:exp RBRAC
( ASSIGN e:exp { $$ = newSetMap(setIndex_proto, l, i, e) }
| ASSIGNADD e:exp { $$ = newSetMap(setIndexAdd_proto, l, i, e) }
| ASSIGNSUB e:exp { $$ = newSetMap(setIndexSub_proto, l, i, e) }
| ASSIGNMUL e:exp { $$ = newSetMap(setIndexMul_proto, l, i, e) }
| ASSIGNDIV e:exp { $$ = newSetMap(setIndexDiv_proto, l, i, e) }
| ASSIGNMOD e:exp { $$ = newSetMap(setIndexMod_proto, l, i, e) }
| ASSIGNBITOR e:exp { $$ = newSetMap(setIndexBitor_proto, l, i, e) }
| ASSIGNBITXOR e:exp { $$ = newSetMap(setIndexBitxor_proto, l, i, e) }
| ASSIGNBITAND e:exp { $$ = newSetMap(setIndexBitand_proto, l, i, e) }
| ASSIGNSHLEFT e:exp { $$ = newSetMap(setIndexShleft_proto, l, i, e) }
| ASSIGNSHRIGHT e:exp { $$ = newSetMap(setIndexShright_proto, l, i, e) }
)
| c:cond { $$ = c }
block = LCB m:makeMap
( s:stmt { map_append(m, s) }
) *
RCB { $$ = m }
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) }
| 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 = newCall(i, a) }
| PLUSPLUS { i = newPostIncrement(i) }
| MINUSMINUS { i = newPostDecrement(i) }
) * { $$ = i }
assignOp = ASSIGN
| ASSIGNADD
| ASSIGNSUB
| ASSIGNMUL
| ASSIGNDIV
| ASSIGNMOD
| ASSIGNBITOR
| ASSIGNBITXOR
| ASSIGNBITAND
| ASSIGNSHLEFT
| ASSIGNSHRIGHT
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 { $$ = n }
| s:STRING { $$ = newString(s) }
| s:symbol { $$ = s }
| m:map { $$ = newMap(m) }
| NULL { $$ = null }
| i:IDENT { $$ = newGetVariable(i) }
| LPAREN i:exp RPAREN { $$ = i }
STRING = SQUOTE < (!SQUOTE char)* > SQUOTE { $$ = makeString(unescape(yytext)) }
| 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:IDENT COLON v:exp { map_set(m, k, v) }
( COMMA k:IDENT COLON v:exp { map_set(m, k, v) }
) *
) ?
RCB { $$ = m }
makeMap= { $$ = makeMap() }
- = (blank | comment)*
blank = space | eol
space = [ \t]
eol = "\n""\r"* | "\r""\n"*
comment = "//" ( ![\n\r] . )*
| "/*" ( !"*/" . )* "*/"
keyword = FUN | VAR | SWITCH | CASE | DEFAULT | DO | FOR | WHILE | IF | ELSE | NULL | RETURN | BREAK | CONTINUE
IDENT = !keyword < [a-zA-Z_][a-zA-Z0-9_]* > - { $$ = intern(yytext) }
NUMBER = '0b' < [01]+ > - { $$ = newInteger(strtol(yytext, 0, 2)) }
| '0x' < [0-9a-fA-F]+ > - { $$ = newInteger(strtol(yytext, 0, 16)) }
| '0' < [0-7]+ > - { $$ = newInteger(strtol(yytext, 0, 8)) }
| < [0-9]+ > - { $$ = newInteger(strtol(yytext, 0, 10)) }
FUN = 'fun' ![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_] -
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 = '.' -
LCB = '{' -
RCB = '}' -
LBRAC = '[' -
RBRAC = ']' -
LPAREN = '(' -
RPAREN = ')' -
DQUOTE = '"' -
SQUOTE = "'" -
%%
;
int isFalse(oop obj)
{
return obj == null || (isInteger(obj) && (0 == getInteger(obj)));
}
int isTrue(oop obj)
{
return !isFalse(obj);
}
oop map_zip(oop keys, oop values)
{
assert(is(Map, keys));
assert(is(Map, values));
oop map= makeMap();
for (int i= 0; map_hasIntegerKey(keys, i) && map_hasIntegerKey(values, i); ++i) {
oop key = get(keys, Map, elements)[i].value;
oop value = get(values, Map, elements)[i].value;
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;
}
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 evalArgs(oop scope, oop args);
oop eval(oop scope, oop ast)
{
if (opt_v) {
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));
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_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: {
oop result = jbs->result;
jbRecPop();
jbsCheck("return outside a function");
jbs->result = result;
siglongjmp(jbs->jb, j_return);
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: {
oop result = jbs->result;
jbRecPop();
jbsCheck("return outside a function");
jbs->result = result;
siglongjmp(jbs->jb, j_return);
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: {
oop result = jbs->result;
jbRecPop();
jbsCheck("return outside a function");
jbs->result = result;
siglongjmp(jbs->jb, j_return);
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:;
}
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: {
oop result = jbs->result;
jbRecPop();
jbsCheck("return outside a function");
jbs->result = result;
siglongjmp(jbs->jb, j_return);
assert(0);
}
case j_break: {
jbRecPop();
return null;
}
case j_continue: {
jbRecPop();
jbsCheck("continue outside a loop");
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);
}
return result;
}
case t_assign: {
oop lhs = map_get(ast, lhs_symbol);
oop rhs = eval(scope, map_get(ast, rhs_symbol));
return setVariable(scope, lhs, 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 func = makeFunction(NULL, param, body, scope);
if (opt_v) {
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("cannot call ");
println(func);
exit(1);
}
oop args = evalArgs(scope, map_get(ast, args_symbol));
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) {
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: {
fprintf(stderr, "\nbreak outside of a loop\n");
exit(1);
}
case j_continue: {
fprintf(stderr, "\ncontinue outside of a loop\n");
exit(1);
}
}
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) {
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: {
fprintf(stderr, "\nbreak outside of a loop\n");
exit(1);
}
case j_continue: {
fprintf(stderr, "\ncontinue outside of a loop\n");
exit(1);
}
}
oop result = eval(localScope, get(func, Function, body));
jbRecPop();
return result;
}
case t_return: {
jbsCheck("return outside a function");
jbs->result = eval(scope, map_get(ast, value_symbol));
siglongjmp(jbs->jb, j_return);
}
case t_break: {
jbsCheck("break outside a loop");
siglongjmp(jbs->jb, j_break);
}
case t_continue: {
jbsCheck("continue outside a loop");
siglongjmp(jbs->jb, j_continue);
}
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 value = eval(scope, map_get(ast, value_symbol));
return map_set(map, key, value);
}
# define SETMEMBEROP(OPERATION, OPERATOR) \
case t_setMember##OPERATION: { \
oop map = eval(scope, map_get(ast, map_symbol)); \
oop key = map_get(ast, key_symbol); \
oop value = eval(scope, map_get(ast, value_symbol)); \
return map_set(map, key, makeInteger(getInteger(getVariable(map, key)) OPERATOR getInteger(value))); \
}
SETMEMBEROP(Add, +);
SETMEMBEROP(Sub, -);
SETMEMBEROP(Mul, *);
SETMEMBEROP(Div, /);
SETMEMBEROP(Mod, %);
SETMEMBEROP(Bitor, |);
SETMEMBEROP(Bitxor, ^);
SETMEMBEROP(Bitand, &);
SETMEMBEROP(Shleft, <<);
SETMEMBEROP(Shright, >>);
# undef SETMEMBEROP
case t_getIndex: {
oop map = eval(scope, map_get(ast, map_symbol));
oop key = eval(scope, map_get(ast, key_symbol));
return map_get(map, key);
}
case t_setIndex: {
oop map = eval(scope, map_get(ast, map_symbol));
oop key = eval(scope, map_get(ast, key_symbol));
oop value = eval(scope, map_get(ast, value_symbol));
return map_set(map, key, value);
}
# define SETINDEXOP(OPERATION, OPERATOR) \
case t_setIndex##OPERATION: { \
oop map = eval(scope, map_get(ast, map_symbol)); \
oop key = eval(scope, map_get(ast, key_symbol)); \
oop value = eval(scope, map_get(ast, value_symbol)); \
return map_set(map, key, makeInteger(getInteger(getVariable(map, key)) OPERATOR getInteger(value))); \
}
SETINDEXOP(Add, +);
SETINDEXOP(Sub, -);
SETINDEXOP(Mul, *);
SETINDEXOP(Div, /);
SETINDEXOP(Mod, %);
SETINDEXOP(Bitor, |);
SETINDEXOP(Bitxor, ^);
SETINDEXOP(Bitand, &);
SETINDEXOP(Shleft, <<);
SETINDEXOP(Shright, >>);
# undef SETINDEXOP
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 ASSIGNOP(OPERATION, OPERATOR) \
case t_assign##OPERATION: { \
oop lhs = map_get(ast, lhs_symbol); \
oop rhs = eval(scope, map_get(ast, rhs_symbol)); \
oop result = makeInteger(getInteger(eval(scope, lhs)) OPERATOR getInteger(rhs)); \
return setVariable(scope, lhs, result); \
}
ASSIGNOP(Add, +);
ASSIGNOP(Sub, -);
ASSIGNOP(Mul, *);
ASSIGNOP(Div, /);
ASSIGNOP(Mod, %);
ASSIGNOP(Bitor, |);
ASSIGNOP(Bitxor, ^);
ASSIGNOP(Bitand, &);
ASSIGNOP(Shleft, <<);
ASSIGNOP(Shright, >>);
# undef ASSIGNOP
# 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, + );
BINARY(sub, - );
BINARY(mul, * );
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_length(oop params)
{
if (map_hasIntegerKey(params, 0)) {
oop arg= get(params, Map, elements)[0].value;
switch (getType(arg)) {
case String: return makeInteger(strlen(get(arg, String, value)));
case Symbol: return makeInteger(strlen(get(arg, Symbol, name)));
case Map: return makeInteger(map_size(arg));
default: break;
}
}
return null;
}
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: {
fprintf(stderr, "\nbreak outside of a loop\n");
exit(1);
}
case j_continue: {
fprintf(stderr, "\ncontinue outside of a loop\n");
exit(1);
}
}
oop result= eval(localScope, get(func, Function, body));
jbRecPop();
return result;
}
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 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;
}
int main(int argc, char **argv)
{
# if (USE_GC)
GC_INIT();
# endif
while (argc-- > 1) {
++argv;
if (!strcmp(*argv, "-v")) ++opt_v;
else {
fprintf(stderr, "unknown option: %s\n", *argv);
}
}
symbol_table = makeMap();
globals = makeMap();
map_set(globals, intern("exit") , makeFunction(prim_exit, null, null, globals));
map_set(globals, intern("keys") , makeFunction(prim_keys, null, null, globals));
map_set(globals, intern("length"), makeFunction(prim_length, null, null, globals));
map_set(globals, intern("print") , makeFunction(prim_print, null, null, globals));
map_set(globals, intern("invoke"), makeFunction(prim_invoke, null, null, globals));
map_set(globals, intern("clone") , makeFunction(prim_clone, null, null, globals));
#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
while (yyparse()) {
if (!yylval) break; // EOF
if (opt_v) println(yylval);
println(eval(globals, yylval));
}
return 0;
(void)yyAccept;
}
// Local Variables:
// indent-tabs-mode: nil
// End: