Map in function position
This commit is contained in:
parent
86ccdfa4be
commit
897d5d2670
|
@ -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 );
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue