Map in function position

This commit is contained in:
Simon Brooke 2019-02-07 13:57:37 +00:00
parent 86ccdfa4be
commit 897d5d2670

View file

@ -33,9 +33,11 @@
#include "intern.h" #include "intern.h"
#include "io.h" #include "io.h"
#include "lispops.h" #include "lispops.h"
#include "map.h"
#include "print.h" #include "print.h"
#include "read.h" #include "read.h"
#include "stack.h" #include "stack.h"
#include "vectorspace.h"
/* /*
* also to create in this section: * also to create in this section:
@ -288,6 +290,7 @@ struct cons_pointer
/* 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;
@ -326,64 +329,80 @@ struct cons_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 =
eval_lambda( fn_cell, next, next_pointer, env ); eval_lambda( fn_cell, next, next_pointer, env );
if ( !exceptionp( result ) ) { if ( !exceptionp( result ) ) {
dec_ref( next_pointer ); dec_ref( next_pointer );
}
} }
} }
}
break;
case VECTORPOINTTV:
switch ( pointer_to_vso(fn_pointer)->header.tag.value) {
case MAPTV:
/* \todo: if arg[0] is a CONS, treat it as a path */
result = c_assoc( eval_form(frame,
frame_pointer,
c_car( c_cdr( frame->arg[0])),
env),
fn_pointer);
break; break;
}
break;
case NLAMBDATV: case NLAMBDATV:
{ {
struct cons_pointer next_pointer = struct cons_pointer next_pointer =
make_special_frame( frame_pointer, args, env ); make_special_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 =
eval_lambda( fn_cell, next, next_pointer, env ); eval_lambda( fn_cell, next, next_pointer, env );
dec_ref( next_pointer ); dec_ref( next_pointer );
}
} }
break; }
break;
case SPECIALTV: case SPECIALTV:
{ {
struct cons_pointer next_pointer = struct cons_pointer next_pointer =
make_special_frame( frame_pointer, args, env ); make_special_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 {
result = result =
( *fn_cell.payload.special. ( *fn_cell.payload.special.
executable ) ( get_stack_frame( next_pointer ), executable ) ( get_stack_frame( next_pointer ),
next_pointer, env ); next_pointer, env );
debug_print( L"Special form returning: ", DEBUG_EVAL ); debug_print( L"Special form returning: ", DEBUG_EVAL );
debug_print_object( result, DEBUG_EVAL ); debug_print_object( result, DEBUG_EVAL );
debug_println( DEBUG_EVAL ); debug_println( DEBUG_EVAL );
dec_ref( next_pointer ); dec_ref( next_pointer );
}
} }
break; }
break;
default: default:
{ {
int bs = sizeof( wchar_t ) * 1024; int bs = sizeof( wchar_t ) * 1024;
wchar_t *buffer = malloc( bs ); wchar_t *buffer = malloc( bs );
memset( buffer, '\0', bs ); memset( buffer, '\0', bs );
swprintf( buffer, bs, swprintf( buffer, bs,
L"Unexpected cell with tag %d (%4.4s) in function position", L"Unexpected cell with tag %d (%4.4s) in function position",
fn_cell.tag.value, &fn_cell.tag.bytes[0] ); fn_cell.tag.value, &fn_cell.tag.bytes[0] );
struct cons_pointer message = struct cons_pointer message =
c_string_to_lisp_string( buffer ); c_string_to_lisp_string( buffer );
free( buffer ); free( buffer );
result = throw_exception( message, frame_pointer ); result = throw_exception( message, frame_pointer );
} }
} }
} }