Pārlūkot izejas kodu

Add quasiquote and unquote mechanism, add 'syntax' fixed functions and use oop as functions name

pull/8/head
mtardy pirms 4 gadiem
vecāks
revīzija
07f07570db
2 mainītis faili ar 164 papildinājumiem un 80 dzēšanām
  1. +9
    -6
      object.c
  2. +155
    -74
      parse.leg

+ 9
- 6
object.c Parādīt failu

@ -91,10 +91,11 @@ typedef oop (*primitive_t)(oop params);
struct Function {
type_t type;
primitive_t primitive;
char *name;
oop name;
oop body;
oop param;
oop parentScope;
oop fixed;
};
// usefull for map's elements
@ -159,7 +160,7 @@ oop _checkType(oop ptr, type_t type, char *file, int line)
return ptr;
}
// added parens around e/makexpansion to protect assignment
// added parens around expansion to protect assignment
#define get(PTR, TYPE, FIELD) (_checkType(PTR, TYPE, __FILE__, __LINE__)->TYPE.FIELD)
#define set(PTR, TYPE, FIELD, VALUE) (_checkType(PTR, TYPE, __FILE__, __LINE__)->TYPE.FIELD = VALUE)
@ -219,15 +220,16 @@ oop makeSymbol(char *name)
return newSymb;
}
oop makeFunction(primitive_t primitive, char * name, oop param, oop body, oop parentScope)
oop makeFunction(primitive_t primitive, oop name, oop param, oop body, oop parentScope, oop fixed)
{
oop newFunc = memcheck(malloc(sizeof(union object)));
newFunc->type = Function;
newFunc->Function.primitive = primitive;
newFunc->Function.name = memcheck(strdup(name));
newFunc->Function.name = name;
newFunc->Function.param = param;
newFunc->Function.body = body;
newFunc->Function.parentScope = parentScope;
newFunc->Function.fixed = fixed;
return newFunc;
}
@ -467,10 +469,11 @@ void print(oop ast)
return;
case Function:
if (get(ast, Function, primitive) == NULL) {
printf("Function:%s", get(ast, Function, name));
printf("Function:");
} else {
printf("Primitive:%s@%p", get(ast, Function, name), get(ast, Function, primitive));
printf("Primitive:");
}
print(get(ast, Function, name));
return;
case Map:
map_print(ast, 0);

+ 155
- 74
parse.leg Parādīt failu

@ -24,7 +24,7 @@
_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) \
_DO(literal)
_DO(quasiquote) _DO(unquote)
typedef enum {
t_UNDEFINED=0,
@ -85,7 +85,7 @@ oop globals= 0;
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(update) _DO(this) _DO(fixed)
#define _DO(NAME) oop NAME##_symbol;
DO_SYMBOLS()
@ -97,6 +97,16 @@ DO_PROTOS()
int opt_v = 0;
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();
@ -121,6 +131,38 @@ void printObjectName(oop object)
}
}
// 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 newMap(oop value)
{
oop map = newObject(map_proto);
@ -378,17 +420,27 @@ oop newGetVariable(oop name)
return id;
}
oop newFunc(oop name, oop param, oop body)
oop newFunc(oop name, oop param, oop body, oop fixed)
{
oop func = newObject(func_proto);
map_set(func, name_symbol, name);
map_set(func, param_symbol, param);
map_set(func, body_symbol, body);
map_set(func, fixed_symbol, fixed);
return func;
}
oop apply(oop func, oop args);
oop newCall(oop func, oop args)
{
if (map_get(func, __proto___symbol) == getVariable_proto) {
oop key = map_get(func, key_symbol);
oop val = getVariable(globals, key);
if (is(Function, val) && isTrue(get(val, Function, fixed))) {
return apply(val, args);
}
}
oop call = newObject(call_proto);
map_set(call, func_symbol, func);
map_set(call, args_symbol, args);
@ -430,45 +482,6 @@ oop newContinue(void)
return obj;
}
oop newLiteral(oop exp)
{
oop obj = newObject(literal_proto);
map_set(obj, value_symbol, exp);
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
@ -497,8 +510,10 @@ stmt = e:exp SEMICOLON* { $$ = e }
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) }
| FUN l:IDENT p:paramList e:stmt { $$ = newFunc(l, p, e, null) }
| FUN p:paramList e:stmt { $$ = newFunc(null, p, e, null) }
| SYNTAX l:IDENT p:paramList e:stmt { $$ = newFunc(l, p, e, makeInteger(1)) }
| SYNTAX p:paramList e:stmt { $$ = 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) }
@ -509,7 +524,7 @@ exp = VAR l:IDENT ASSIGN e:exp { $$ = newDeclarati
| RETURN { $$ = newReturn(null) }
| BREAK { $$ = newBreak() }
| CONTINUE { $$ = newContinue() }
| l:IDENT
| 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) }
@ -522,7 +537,7 @@ exp = VAR l:IDENT ASSIGN e:exp { $$ = newDeclarati
| ASSIGNSHLEFT e:exp { $$ = newBinary(assignShleft_proto , l, e) }
| ASSIGNSHRIGHT e:exp { $$ = newBinary(assignShright_proto, l, e) }
)
| l:postfix DOT i:IDENT
| 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) }
@ -535,7 +550,7 @@ exp = VAR l:IDENT ASSIGN e:exp { $$ = newDeclarati
| ASSIGNSHLEFT e:exp { $$ = newSetMap(setMemberShleft_proto, l, i, e) }
| ASSIGNSHRIGHT e:exp { $$ = newSetMap(setMemberShright_proto, l, i, e) }
)
| l:postfix LBRAC i:exp RBRAC
| 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) }
@ -620,6 +635,8 @@ prefix = PLUS n:prefix { $$= n }
| PLING n:prefix { $$= newUnary(not_proto, n) }
| PLUSPLUS n:prefix { $$= newPreIncrement(n) }
| MINUSMINUS n:prefix { $$= newPreDecrement(n) }
| BACKTICK n:prefix { $$ = newUnary(quasiquote_proto, n) }
| AT n:prefix { $$ = newUnary(unquote_proto, n) }
| n:postfix { $$= n }
postfix = i:value ( DOT s:IDENT a:argumentList { i = newInvoke(i, s, a) }
@ -630,7 +647,7 @@ postfix = i:value ( DOT s:IDENT a:argumentList { i = newInvoke(
| MINUSMINUS { i = newPostDecrement(i) }
) * { $$ = i }
assignOp = ASSIGN
assignOp = ASSIGN
| ASSIGNADD
| ASSIGNSUB
| ASSIGNMUL
@ -640,7 +657,7 @@ assignOp = ASSIGN
| ASSIGNBITXOR
| ASSIGNBITAND
| ASSIGNSHLEFT
| ASSIGNSHRIGHT
| ASSIGNSHRIGHT
paramList = LPAREN m:makeMap
( i:IDENT { map_append(m, i) }
@ -663,8 +680,6 @@ value = n:NUMBER { $$ = n }
| NULL { $$ = null }
| i:IDENT { $$ = newGetVariable(i) }
| LPAREN i:exp RPAREN { $$ = i }
| BACKTICK e:exp { $$ = newLiteral(e) }
| AT e:exp { $$ = eval(globals, e) }
STRING = SQUOTE < (!SQUOTE char)* > SQUOTE { $$ = makeString(unescape(yytext)) }
| DQUOTE < (!DQUOTE char)* > DQUOTE { $$ = makeString(unescape(yytext)) }
@ -693,7 +708,7 @@ eol = "\n""\r"* | "\r""\n"*
comment = "//" ( ![\n\r] . )*
| "/*" ( !"*/" . )* "*/"
keyword = FUN | VAR | SWITCH | CASE | DEFAULT | DO | FOR | WHILE | IF | ELSE | NULL | RETURN | BREAK | CONTINUE
keyword = FUN | SYNTAX | VAR | SWITCH | CASE | DEFAULT | DO | FOR | WHILE | IF | ELSE | NULL | RETURN | BREAK | CONTINUE
IDENT = !keyword < [a-zA-Z_][a-zA-Z0-9_]* > - { $$ = intern(yytext) }
@ -703,6 +718,7 @@ NUMBER = '0b' < [01]+ > - { $$ = newInteger(strtol(
| < [0-9]+ > - { $$ = newInteger(strtol(yytext, 0, 10)) }
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_] -
@ -769,16 +785,6 @@ 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));
@ -814,6 +820,22 @@ oop clone(oop obj)
return obj;
}
oop expandUnquotes(oop scope, oop obj)
{
obj = clone(obj);
if (!is(Map, obj)) {
return obj;
}
if (map_get(obj, __proto___symbol) == unquote_proto) {
return eval(scope, map_get(obj, rhs_symbol));
}
for (size_t i= 0; i < map_size(obj); ++i) {
struct Pair *pair= &get(obj, Map, elements)[i];
pair->value= expandUnquotes(scope, pair->value);
}
return obj;
}
oop fold(oop ast)
{
if (is(Map, ast)) {
@ -925,9 +947,13 @@ oop eval(oop scope, oop ast)
}
return map;
}
case t_literal: {
oop obj = map_get(ast, value_symbol);
return obj;
case t_quasiquote: {
oop obj = map_get(ast, rhs_symbol);
return expandUnquotes(scope, obj);
}
case t_unquote: {
fprintf(stderr, "\n@ outside of `\n");
exit(1);
}
case t_declaration: {
oop lhs = map_get(ast, lhs_symbol);
@ -1078,13 +1104,18 @@ oop eval(oop scope, oop ast)
case t_assign: {
oop lhs = map_get(ast, lhs_symbol);
oop rhs = eval(scope, map_get(ast, rhs_symbol));
return setVariable(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 func = makeFunction(NULL, get(name, Symbol, name), param, body, scope);
oop fixed = map_get(ast, fixed_symbol);
oop func = makeFunction(NULL, name, param, body, scope, fixed);
if (opt_v) {
printf("funcscope: ");
println(scope);
@ -1102,7 +1133,10 @@ oop eval(oop scope, oop ast)
exit(1);
}
oop args = evalArgs(scope, map_get(ast, args_symbol));
oop args = map_get(ast, args_symbol);
if (isFalse(get(func, Function, fixed))) {
args = evalArgs(scope, args);
}
if (get(func, Function, primitive) == NULL) {
oop param = get(func, Function, param);
oop localScope = map_zip(param, args);
@ -1227,6 +1261,9 @@ oop eval(oop scope, oop ast)
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));
if (is(Function, value) && null == get(value, Function, name)) {
set(value, Function, name, key);
}
return map_set(map, key, value);
}
# define SETMEMBEROP(OPERATION, OPERATOR) \
@ -1514,6 +1551,48 @@ oop prim_invoke(oop params)
return result;
}
oop apply(oop func, oop args)
{
if (!is(Function, func)) {
printf("cannot apply ");
println(func);
exit(1);
}
if (NULL != get(func, Function, primitive)) {
return get(func, Function, primitive)(args);
}
oop param = get(func, Function, param);
oop localScope = map_zip(param, args);
map_set(localScope, __arguments___symbol, args);
map_set(localScope, __proto___symbol, get(func, Function, parentScope));
jbRecPush();
int jbt = sigsetjmp(jbs->jb, 0);
switch (jbt) {
case j_return: {
oop result = jbs->result;
jbRecPop();
return result;
}
case j_break: {
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_apply(oop params) {
oop func= null; if (map_hasIntegerKey(params, 0)) func= get(params, Map, elements)[0].value;
oop args= null; if (map_hasIntegerKey(params, 1)) args= get(params, Map, elements)[1].value;
return apply(func, args);
}
oop prim_clone(oop params)
{
if (map_hasIntegerKey(params, 0)) return clone(get(params, Map, elements)[0].value);
@ -1558,12 +1637,14 @@ int main(int argc, char **argv)
symbol_table = makeMap();
globals = makeMap();
map_set(globals, intern("exit") , makeFunction(prim_exit, "exit", null, null, globals));
map_set(globals, intern("keys") , makeFunction(prim_keys, "keys", null, null, globals));
map_set(globals, intern("length"), makeFunction(prim_length, "length", null, null, globals));
map_set(globals, intern("print") , makeFunction(prim_print, "print", null, null, globals));
map_set(globals, intern("invoke"), makeFunction(prim_invoke, "invoke", null, null, globals));
map_set(globals, intern("clone") , makeFunction(prim_clone, "clone", null, null, globals));
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("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));
#define _DO(NAME) NAME##_symbol=intern(#NAME);
DO_SYMBOLS()

Notiek ielāde…
Atcelt
Saglabāt