simon/post-scarcity
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

#8: keywords as functions on associations working

Browse source
This commit is contained in:
Simon Brooke 2019-02-05 11:02:04 +00:00
parent 2bebee6002
commit e7ef82d23f
2 changed files with 45 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
src/ops/intern.c
View file

@ -91,6 +91,12 @@ struct cons_pointer c_assoc( struct cons_pointer key,
struct cons_pointer store ) { struct cons_pointer store ) {
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
debug_print( L"c_assoc; key is `", DEBUG_BIND);
debug_print_object( key, DEBUG_BIND);
debug_print( L"`; store is \n", DEBUG_BIND);
debug_dump_object( store, DEBUG_BIND);
debug_println(DEBUG_BIND);
for ( struct cons_pointer next = store; for ( struct cons_pointer next = store;
consp( next ); next = pointer2cell( next ).payload.cons.cdr ) { consp( next ); next = pointer2cell( next ).payload.cons.cdr ) {
struct cons_space_object entry = struct cons_space_object entry =

71
src/ops/lispops.c
View file

@ -269,8 +269,8 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
* @return the result of evaluating the function with its arguments. * @return the result of evaluating the function with its arguments.
*/ */
struct cons_pointer struct cons_pointer
c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer env ) { struct cons_pointer env ) {
debug_print( L"Entering c_apply\n", DEBUG_EVAL ); debug_print( L"Entering c_apply\n", DEBUG_EVAL );
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
@ -285,38 +285,47 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
switch ( fn_cell.tag.value ) { switch ( fn_cell.tag.value ) {
case EXCEPTIONTV: case EXCEPTIONTV:
/* just pass exceptions straight back */ /* just pass exceptions straight back */
result = fn_pointer; result = fn_pointer;
break; break;
case FUNCTIONTV: case FUNCTIONTV:
{ {
struct cons_pointer exep = NIL; struct cons_pointer exep = NIL;
struct cons_pointer next_pointer = struct cons_pointer next_pointer =
make_stack_frame( frame_pointer, args, env ); make_stack_frame( frame_pointer, args, env );
inc_ref( next_pointer ); inc_ref( next_pointer );
if ( exceptionp( next_pointer ) ) { if ( exceptionp( next_pointer ) ) {
result = next_pointer; result = next_pointer;
} else { } else {
struct stack_frame *next = struct stack_frame *next =
get_stack_frame( next_pointer ); get_stack_frame( next_pointer );
result = result =
( *fn_cell.payload.function.executable ) ( next, ( *fn_cell.payload.function.executable ) ( next,
next_pointer, next_pointer,
env ); env );
dec_ref( next_pointer ); dec_ref( next_pointer );
}
} }
break; }
break;
case KEYTV:
result = c_assoc( fn_pointer,
eval_form(frame,
frame_pointer,
c_car( c_cdr( frame->arg[0])),
env));
break;
case LAMBDATV: case LAMBDATV:
{ {
struct cons_pointer exep = NIL; struct cons_pointer exep = NIL;
struct cons_pointer next_pointer = struct cons_pointer next_pointer =
make_stack_frame( frame_pointer, args, env ); make_stack_frame( frame_pointer, args, env );
inc_ref( next_pointer ); inc_ref( next_pointer );
if ( exceptionp( next_pointer ) ) { if ( exceptionp( next_pointer ) ) {
result = next_pointer; result = next_pointer;
} else { } else {
struct stack_frame *next = struct stack_frame *next =
get_stack_frame( next_pointer ); get_stack_frame( next_pointer );
result = result =
@ -416,9 +425,7 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer,
switch ( cell.tag.value ) { switch ( cell.tag.value ) {
case CONSTV: case CONSTV:
{
result = c_apply( frame, frame_pointer, env ); result = c_apply( frame, frame_pointer, env );
}
break; break;
case SYMBOLTV: case SYMBOLTV: