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 "io.h"
#include "lispops.h"
#include "map.h"
#include "print.h"
#include "read.h"
#include "stack.h"
#include "vectorspace.h"
/*
* also to create in this section:
@ -288,6 +290,7 @@ struct cons_pointer
/* just pass exceptions straight back */
result = fn_pointer;
break;
case FUNCTIONTV:
{
struct cons_pointer exep = NIL;
@ -326,64 +329,80 @@ struct cons_pointer
if ( exceptionp( next_pointer ) ) {
result = next_pointer;
} else {
struct stack_frame *next =
get_stack_frame( next_pointer );
result =
eval_lambda( fn_cell, next, next_pointer, env );
if ( !exceptionp( result ) ) {
dec_ref( next_pointer );
}
struct stack_frame *next =
get_stack_frame( next_pointer );
result =
eval_lambda( fn_cell, next, next_pointer, env );
if ( !exceptionp( result ) ) {
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;
case NLAMBDATV:
{
struct cons_pointer next_pointer =
make_special_frame( frame_pointer, args, env );
inc_ref( next_pointer );
if ( exceptionp( next_pointer ) ) {
result = next_pointer;
} else {
struct stack_frame *next =
get_stack_frame( next_pointer );
result =
eval_lambda( fn_cell, next, next_pointer, env );
dec_ref( next_pointer );
}
{
struct cons_pointer next_pointer =
make_special_frame( frame_pointer, args, env );
inc_ref( next_pointer );
if ( exceptionp( next_pointer ) ) {
result = next_pointer;
} else {
struct stack_frame *next =
get_stack_frame( next_pointer );
result =
eval_lambda( fn_cell, next, next_pointer, env );
dec_ref( next_pointer );
}
break;
}
break;
case SPECIALTV:
{
struct cons_pointer next_pointer =
make_special_frame( frame_pointer, args, env );
inc_ref( next_pointer );
if ( exceptionp( next_pointer ) ) {
result = next_pointer;
} else {
result =
( *fn_cell.payload.special.
executable ) ( get_stack_frame( next_pointer ),
next_pointer, env );
debug_print( L"Special form returning: ", DEBUG_EVAL );
debug_print_object( result, DEBUG_EVAL );
debug_println( DEBUG_EVAL );
dec_ref( next_pointer );
}
{
struct cons_pointer next_pointer =
make_special_frame( frame_pointer, args, env );
inc_ref( next_pointer );
if ( exceptionp( next_pointer ) ) {
result = next_pointer;
} else {
result =
( *fn_cell.payload.special.
executable ) ( get_stack_frame( next_pointer ),
next_pointer, env );
debug_print( L"Special form returning: ", DEBUG_EVAL );
debug_print_object( result, DEBUG_EVAL );
debug_println( DEBUG_EVAL );
dec_ref( next_pointer );
}
break;
}
break;
default:
{
int bs = sizeof( wchar_t ) * 1024;
wchar_t *buffer = malloc( bs );
memset( buffer, '\0', bs );
swprintf( buffer, bs,
L"Unexpected cell with tag %d (%4.4s) in function position",
fn_cell.tag.value, &fn_cell.tag.bytes[0] );
struct cons_pointer message =
c_string_to_lisp_string( buffer );
free( buffer );
result = throw_exception( message, frame_pointer );
}
{
int bs = sizeof( wchar_t ) * 1024;
wchar_t *buffer = malloc( bs );
memset( buffer, '\0', bs );
swprintf( buffer, bs,
L"Unexpected cell with tag %d (%4.4s) in function position",
fn_cell.tag.value, &fn_cell.tag.bytes[0] );
struct cons_pointer message =
c_string_to_lisp_string( buffer );
free( buffer );
result = throw_exception( message, frame_pointer );
}
}
}