Horribly broken, may have to rethink.
This commit is contained in:
parent
9937f344dc
commit
3d5c27cb10
19 changed files with 568 additions and 413 deletions
|
|
@ -80,8 +80,8 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
|
|||
&& ( equal( cell_a->payload.string.cdr,
|
||||
cell_b->payload.string.cdr )
|
||||
|| ( end_of_string( cell_a->payload.string.cdr )
|
||||
&& end_of_string( cell_b->payload.string.
|
||||
cdr ) ) );
|
||||
&& end_of_string( cell_b->payload.
|
||||
string.cdr ) ) );
|
||||
break;
|
||||
case INTEGERTV:
|
||||
result =
|
||||
|
|
|
|||
|
|
@ -89,9 +89,9 @@ struct cons_pointer eval_form( struct stack_frame *parent,
|
|||
|
||||
struct cons_pointer result = NIL;
|
||||
struct cons_pointer next_pointer = make_empty_frame( parent_pointer );
|
||||
inc_ref( next_pointer);
|
||||
inc_ref( next_pointer );
|
||||
|
||||
struct stack_frame * next = get_stack_frame(next_pointer);
|
||||
struct stack_frame *next = get_stack_frame( next_pointer );
|
||||
set_reg( next, 0, form );
|
||||
|
||||
result = lisp_eval( next, next_pointer, env );
|
||||
|
|
@ -100,7 +100,7 @@ struct cons_pointer eval_form( struct stack_frame *parent,
|
|||
/* if we're returning an exception, we should NOT free the
|
||||
* stack frame. Corollary is, when we free an exception, we
|
||||
* should free all the frames it's holding on to. */
|
||||
dec_ref(next_pointer);
|
||||
dec_ref( next_pointer );
|
||||
}
|
||||
|
||||
return result;
|
||||
|
|
@ -111,13 +111,15 @@ struct cons_pointer eval_form( struct stack_frame *parent,
|
|||
* and this `env`, and return a list of their values. If the arg passed as
|
||||
* `list` is not in fact a list, return nil.
|
||||
*/
|
||||
struct cons_pointer eval_forms( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer eval_forms( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer,
|
||||
struct cons_pointer list,
|
||||
struct cons_pointer env ) {
|
||||
/* TODO: refactor. This runs up the C stack. */
|
||||
/* TODO: refactor. This runs up the C stack. */
|
||||
return consp( list ) ?
|
||||
make_cons( eval_form( frame, frame_pointer, c_car( list ), env ),
|
||||
eval_forms( frame, frame_pointer, c_cdr( list ), env ) ) : NIL;
|
||||
eval_forms( frame, frame_pointer, c_cdr( list ),
|
||||
env ) ) : NIL;
|
||||
}
|
||||
|
||||
/**
|
||||
|
|
@ -126,7 +128,8 @@ struct cons_pointer eval_forms( struct stack_frame *frame, struct cons_pointer f
|
|||
* (oblist)
|
||||
*/
|
||||
struct cons_pointer
|
||||
lisp_oblist( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) {
|
||||
lisp_oblist( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env ) {
|
||||
return oblist;
|
||||
}
|
||||
|
||||
|
|
@ -159,7 +162,8 @@ struct cons_pointer compose_body( struct stack_frame *frame ) {
|
|||
* @param env the environment in which it is to be intepreted.
|
||||
*/
|
||||
struct cons_pointer
|
||||
lisp_lambda( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) {
|
||||
lisp_lambda( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env ) {
|
||||
return make_lambda( frame->arg[0], compose_body( frame ) );
|
||||
}
|
||||
|
||||
|
|
@ -170,7 +174,8 @@ lisp_lambda( struct stack_frame *frame, struct cons_pointer frame_pointer, struc
|
|||
* @param env the environment in which it is to be intepreted.
|
||||
*/
|
||||
struct cons_pointer
|
||||
lisp_nlambda( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) {
|
||||
lisp_nlambda( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env ) {
|
||||
return make_nlambda( frame->arg[0], compose_body( frame ) );
|
||||
}
|
||||
|
||||
|
|
@ -188,8 +193,8 @@ void log_binding( struct cons_pointer name, struct cons_pointer val ) {
|
|||
* Evaluate a lambda or nlambda expression.
|
||||
*/
|
||||
struct cons_pointer
|
||||
eval_lambda( struct cons_space_object cell, struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env ) {
|
||||
eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer, struct cons_pointer env ) {
|
||||
struct cons_pointer result = NIL;
|
||||
fwprintf( stderr, L"eval_lambda called\n" );
|
||||
|
||||
|
|
@ -216,7 +221,8 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame, struct co
|
|||
struct cons_pointer vals = frame->more;
|
||||
|
||||
for ( int i = args_in_frame - 1; i >= 0; i-- ) {
|
||||
struct cons_pointer val = eval_form( frame, frame_pointer, frame->arg[i], env );
|
||||
struct cons_pointer val =
|
||||
eval_form( frame, frame_pointer, frame->arg[i], env );
|
||||
|
||||
if ( nilp( val ) && nilp( vals ) ) { /* nothing */
|
||||
} else {
|
||||
|
|
@ -248,23 +254,25 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame, struct co
|
|||
* @return the result of evaluating the function with its arguments.
|
||||
*/
|
||||
struct cons_pointer
|
||||
c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) {
|
||||
c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env ) {
|
||||
struct cons_pointer result = NIL;
|
||||
|
||||
/* construct a child frame and within it evaluate the first argument - the
|
||||
* argument in the function position. */
|
||||
/* construct a child frame and within it evaluate the first argument - the
|
||||
* argument in the function position. */
|
||||
struct cons_pointer fn_frame_pointer = make_empty_frame( frame_pointer );
|
||||
inc_ref( fn_frame_pointer);
|
||||
struct stack_frame *fn_frame = get_stack_frame(fn_frame_pointer);
|
||||
inc_ref( fn_frame_pointer );
|
||||
struct stack_frame *fn_frame = get_stack_frame( fn_frame_pointer );
|
||||
|
||||
set_reg( fn_frame, 0, c_car( frame->arg[0] ) );
|
||||
struct cons_pointer fn_pointer = lisp_eval( fn_frame, fn_frame_pointer, env );
|
||||
struct cons_pointer fn_pointer =
|
||||
lisp_eval( fn_frame, fn_frame_pointer, env );
|
||||
|
||||
if ( !exceptionp( result ) ) {
|
||||
/* if we're returning an exception, we should NOT free the
|
||||
* stack frame. Corollary is, when we free an exception, we
|
||||
* should free all the frames it's holding on to. */
|
||||
dec_ref(fn_frame_pointer);
|
||||
dec_ref( fn_frame_pointer );
|
||||
}
|
||||
|
||||
struct cons_space_object fn_cell = pointer2cell( fn_pointer );
|
||||
|
|
@ -280,14 +288,17 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, struct co
|
|||
struct cons_pointer exep = NIL;
|
||||
struct cons_pointer next_pointer =
|
||||
make_stack_frame( frame_pointer, args, env );
|
||||
inc_ref(next_pointer);
|
||||
inc_ref( next_pointer );
|
||||
if ( exceptionp( next_pointer ) ) {
|
||||
result = next_pointer;
|
||||
} else {
|
||||
struct stack_frame *next = get_stack_frame(next_pointer);
|
||||
struct stack_frame *next = get_stack_frame( next_pointer );
|
||||
|
||||
result = ( *fn_cell.payload.function.executable ) ( next, next_pointer, env );
|
||||
dec_ref(next_pointer);
|
||||
result =
|
||||
( *fn_cell.payload.function.executable ) ( next,
|
||||
next_pointer,
|
||||
env );
|
||||
dec_ref( next_pointer );
|
||||
}
|
||||
}
|
||||
break;
|
||||
|
|
@ -296,48 +307,53 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, struct co
|
|||
struct cons_pointer exep = NIL;
|
||||
struct cons_pointer next_pointer =
|
||||
make_stack_frame( frame_pointer, args, env );
|
||||
inc_ref(next_pointer);
|
||||
if ( exceptionp( next_pointer ) ) {
|
||||
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 );
|
||||
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 NLAMBDATV:
|
||||
{
|
||||
struct cons_pointer next_pointer =
|
||||
make_special_frame( frame_pointer, args, env );
|
||||
inc_ref(next_pointer);
|
||||
if ( exceptionp( 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(frame_pointer);
|
||||
result = eval_lambda( fn_cell, next, next_pointer, env );
|
||||
if ( !exceptionp( result ) ) {
|
||||
dec_ref(next_pointer);
|
||||
struct stack_frame *next =
|
||||
get_stack_frame( frame_pointer );
|
||||
result = eval_lambda( fn_cell, next, next_pointer, env );
|
||||
if ( !exceptionp( result ) ) {
|
||||
dec_ref( next_pointer );
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
break;
|
||||
case SPECIALTV:
|
||||
{
|
||||
struct cons_pointer next_pointer =
|
||||
make_special_frame( frame_pointer, args, env );
|
||||
inc_ref(next_pointer);
|
||||
if ( exceptionp( 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(frame_pointer);
|
||||
result = ( *fn_cell.payload.special.executable ) ( next, next_pointer, env );
|
||||
if ( !exceptionp( result ) ) {
|
||||
dec_ref(next_pointer);
|
||||
struct stack_frame *next =
|
||||
get_stack_frame( frame_pointer );
|
||||
result =
|
||||
( *fn_cell.payload.special.executable ) ( next,
|
||||
next_pointer,
|
||||
env );
|
||||
if ( !exceptionp( result ) ) {
|
||||
dec_ref( next_pointer );
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
break;
|
||||
default:
|
||||
|
|
@ -355,7 +371,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, struct co
|
|||
result = throw_exception( message, frame_pointer );
|
||||
}
|
||||
}
|
||||
dec_ref(fn_frame_pointer);
|
||||
dec_ref( fn_frame_pointer );
|
||||
|
||||
return result;
|
||||
}
|
||||
|
|
@ -393,7 +409,8 @@ struct cons_pointer c_type( struct cons_pointer pointer ) {
|
|||
* If a special form, passes the cdr of s_expr to the special form as argument.
|
||||
*/
|
||||
struct cons_pointer
|
||||
lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) {
|
||||
lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env ) {
|
||||
struct cons_pointer result = frame->arg[0];
|
||||
struct cons_space_object cell = pointer2cell( frame->arg[0] );
|
||||
|
||||
|
|
@ -456,7 +473,8 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer, struct
|
|||
* the second argument
|
||||
*/
|
||||
struct cons_pointer
|
||||
lisp_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) {
|
||||
lisp_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env ) {
|
||||
#ifdef DEBUG
|
||||
fputws( L"Apply: ", stderr );
|
||||
dump_frame( stderr, frame_pointer );
|
||||
|
|
@ -484,7 +502,8 @@ lisp_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, struct
|
|||
* this isn't at this stage checked) unevaluated.
|
||||
*/
|
||||
struct cons_pointer
|
||||
lisp_quote( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) {
|
||||
lisp_quote( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env ) {
|
||||
return frame->arg[0];
|
||||
}
|
||||
|
||||
|
|
@ -499,7 +518,8 @@ lisp_quote( struct stack_frame *frame, struct cons_pointer frame_pointer, struct
|
|||
* the namespace in so doing. `namespace` defaults to the value of `oblist`.
|
||||
*/
|
||||
struct cons_pointer
|
||||
lisp_set( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) {
|
||||
lisp_set( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env ) {
|
||||
struct cons_pointer result = NIL;
|
||||
struct cons_pointer namespace =
|
||||
nilp( frame->arg[2] ) ? oblist : frame->arg[2];
|
||||
|
|
@ -512,7 +532,8 @@ lisp_set( struct stack_frame *frame, struct cons_pointer frame_pointer, struct c
|
|||
make_exception( make_cons
|
||||
( c_string_to_lisp_string
|
||||
( "The first argument to `set!` is not a symbol: " ),
|
||||
make_cons( frame->arg[0], NIL ) ), frame_pointer );
|
||||
make_cons( frame->arg[0], NIL ) ),
|
||||
frame_pointer );
|
||||
}
|
||||
|
||||
return result;
|
||||
|
|
@ -529,13 +550,15 @@ lisp_set( struct stack_frame *frame, struct cons_pointer frame_pointer, struct c
|
|||
* the namespace in so doing. `namespace` defaults to the value of `oblist`.
|
||||
*/
|
||||
struct cons_pointer
|
||||
lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) {
|
||||
lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env ) {
|
||||
struct cons_pointer result = NIL;
|
||||
struct cons_pointer namespace =
|
||||
nilp( frame->arg[2] ) ? oblist : frame->arg[2];
|
||||
|
||||
if ( symbolp( frame->arg[0] ) ) {
|
||||
struct cons_pointer val = eval_form( frame, frame_pointer, frame->arg[1], env );
|
||||
struct cons_pointer val =
|
||||
eval_form( frame, frame_pointer, frame->arg[1], env );
|
||||
deep_bind( frame->arg[0], val );
|
||||
result = val;
|
||||
} else {
|
||||
|
|
@ -543,7 +566,8 @@ lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer, s
|
|||
make_exception( make_cons
|
||||
( c_string_to_lisp_string
|
||||
( "The first argument to `set!` is not a symbol: " ),
|
||||
make_cons( frame->arg[0], NIL ) ), frame_pointer );
|
||||
make_cons( frame->arg[0], NIL ) ),
|
||||
frame_pointer );
|
||||
}
|
||||
|
||||
return result;
|
||||
|
|
@ -558,7 +582,8 @@ lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer, s
|
|||
* otherwise returns a new cons cell.
|
||||
*/
|
||||
struct cons_pointer
|
||||
lisp_cons( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) {
|
||||
lisp_cons( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env ) {
|
||||
struct cons_pointer car = frame->arg[0];
|
||||
struct cons_pointer cdr = frame->arg[1];
|
||||
struct cons_pointer result;
|
||||
|
|
@ -582,7 +607,8 @@ lisp_cons( struct stack_frame *frame, struct cons_pointer frame_pointer, struct
|
|||
* strings, and TODO read streams and other things which can be considered as sequences.
|
||||
*/
|
||||
struct cons_pointer
|
||||
lisp_car( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) {
|
||||
lisp_car( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env ) {
|
||||
struct cons_pointer result = NIL;
|
||||
|
||||
if ( consp( frame->arg[0] ) ) {
|
||||
|
|
@ -606,7 +632,8 @@ lisp_car( struct stack_frame *frame, struct cons_pointer frame_pointer, struct c
|
|||
* strings, and TODO read streams and other things which can be considered as sequences.
|
||||
*/
|
||||
struct cons_pointer
|
||||
lisp_cdr( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) {
|
||||
lisp_cdr( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env ) {
|
||||
struct cons_pointer result = NIL;
|
||||
|
||||
if ( consp( frame->arg[0] ) ) {
|
||||
|
|
@ -629,7 +656,8 @@ lisp_cdr( struct stack_frame *frame, struct cons_pointer frame_pointer, struct c
|
|||
* Returns the value associated with key in store, or NIL if not found.
|
||||
*/
|
||||
struct cons_pointer
|
||||
lisp_assoc( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) {
|
||||
lisp_assoc( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env ) {
|
||||
return c_assoc( frame->arg[0], frame->arg[1] );
|
||||
}
|
||||
|
||||
|
|
@ -637,7 +665,8 @@ lisp_assoc( struct stack_frame *frame, struct cons_pointer frame_pointer, struct
|
|||
* (eq a b)
|
||||
* Returns T if a and b are pointers to the same object, else NIL
|
||||
*/
|
||||
struct cons_pointer lisp_eq( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer lisp_eq( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env ) {
|
||||
return eq( frame->arg[0], frame->arg[1] ) ? TRUE : NIL;
|
||||
}
|
||||
|
|
@ -647,7 +676,8 @@ struct cons_pointer lisp_eq( struct stack_frame *frame, struct cons_pointer fram
|
|||
* Returns T if a and b are pointers to structurally identical objects, else NIL
|
||||
*/
|
||||
struct cons_pointer
|
||||
lisp_equal( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) {
|
||||
lisp_equal( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env ) {
|
||||
return equal( frame->arg[0], frame->arg[1] ) ? TRUE : NIL;
|
||||
}
|
||||
|
||||
|
|
@ -658,7 +688,8 @@ lisp_equal( struct stack_frame *frame, struct cons_pointer frame_pointer, struct
|
|||
* is a read stream, then read from that stream, else stdin.
|
||||
*/
|
||||
struct cons_pointer
|
||||
lisp_read( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) {
|
||||
lisp_read( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env ) {
|
||||
FILE *input = stdin;
|
||||
|
||||
if ( readp( frame->arg[0] ) ) {
|
||||
|
|
@ -698,7 +729,8 @@ struct cons_pointer c_reverse( struct cons_pointer arg ) {
|
|||
* (reverse sequence)
|
||||
* Return a sequence like this sequence but with the members in the reverse order.
|
||||
*/
|
||||
struct cons_pointer lisp_reverse( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer lisp_reverse( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env ) {
|
||||
return c_reverse( frame->arg[0] );
|
||||
}
|
||||
|
|
@ -711,9 +743,10 @@ struct cons_pointer lisp_reverse( struct stack_frame *frame, struct cons_pointer
|
|||
* is a write stream, then print to that stream, else stdout.
|
||||
*/
|
||||
struct cons_pointer
|
||||
lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) {
|
||||
lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env ) {
|
||||
#ifdef DEBUG
|
||||
fputws(L"Entering print\n", stderr);
|
||||
fputws( L"Entering print\n", stderr );
|
||||
#endif
|
||||
struct cons_pointer result = NIL;
|
||||
FILE *output = stdout;
|
||||
|
|
@ -741,7 +774,8 @@ lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer, struct
|
|||
* @return As a Lisp string, the tag of the object which is the argument.
|
||||
*/
|
||||
struct cons_pointer
|
||||
lisp_type( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) {
|
||||
lisp_type( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env ) {
|
||||
return c_type( frame->arg[0] );
|
||||
}
|
||||
|
||||
|
|
@ -759,7 +793,8 @@ lisp_type( struct stack_frame *frame, struct cons_pointer frame_pointer, struct
|
|||
* argument.
|
||||
*/
|
||||
struct cons_pointer
|
||||
lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) {
|
||||
lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env ) {
|
||||
struct cons_pointer remaining = frame->more;
|
||||
struct cons_pointer result = NIL;
|
||||
|
||||
|
|
@ -786,7 +821,8 @@ lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer, struct
|
|||
* @return the value of the last form of the first successful clause.
|
||||
*/
|
||||
struct cons_pointer
|
||||
lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) {
|
||||
lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env ) {
|
||||
struct cons_pointer result = NIL;
|
||||
bool done = false;
|
||||
|
||||
|
|
@ -797,11 +833,14 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer, struct
|
|||
|
||||
if ( consp( clause_pointer ) ) {
|
||||
struct cons_space_object cell = pointer2cell( clause_pointer );
|
||||
result = eval_form( frame, frame_pointer, c_car( clause_pointer ), env );
|
||||
result =
|
||||
eval_form( frame, frame_pointer, c_car( clause_pointer ),
|
||||
env );
|
||||
|
||||
if ( !nilp( result ) ) {
|
||||
struct cons_pointer vals =
|
||||
eval_forms( frame, frame_pointer,c_cdr( clause_pointer ), env );
|
||||
eval_forms( frame, frame_pointer, c_cdr( clause_pointer ),
|
||||
env );
|
||||
|
||||
while ( consp( vals ) ) {
|
||||
result = c_car( vals );
|
||||
|
|
@ -814,8 +853,8 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer, struct
|
|||
done = true;
|
||||
} else {
|
||||
result = throw_exception( c_string_to_lisp_string
|
||||
( "Arguments to `cond` must be lists" ),
|
||||
frame_pointer);
|
||||
( "Arguments to `cond` must be lists" ),
|
||||
frame_pointer );
|
||||
}
|
||||
}
|
||||
/* TODO: if there are more than 8 clauses we need to continue into the
|
||||
|
|
@ -835,7 +874,8 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer, struct
|
|||
* pointer to the frame in which the exception occurred.
|
||||
*/
|
||||
struct cons_pointer
|
||||
throw_exception( struct cons_pointer message, struct cons_pointer frame_pointer ) {
|
||||
throw_exception( struct cons_pointer message,
|
||||
struct cons_pointer frame_pointer ) {
|
||||
fwprintf( stderr, L"\nERROR: " );
|
||||
print( stderr, message );
|
||||
struct cons_pointer result = NIL;
|
||||
|
|
@ -861,7 +901,9 @@ throw_exception( struct cons_pointer message, struct cons_pointer frame_pointer
|
|||
* If `message` is itself an exception, returns that instead.
|
||||
*/
|
||||
struct cons_pointer
|
||||
lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) {
|
||||
struct cons_pointer message = frame->arg[0];
|
||||
return exceptionp(message) ? message : make_exception(message, frame->previous);
|
||||
lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env ) {
|
||||
struct cons_pointer message = frame->arg[0];
|
||||
return exceptionp( message ) ? message : make_exception( message,
|
||||
frame->previous );
|
||||
}
|
||||
|
|
|
|||
|
|
@ -60,7 +60,8 @@ struct cons_pointer eval_form( struct stack_frame *parent,
|
|||
* and this `env`, and return a list of their values. If the arg passed as
|
||||
* `list` is not in fact a list, return nil.
|
||||
*/
|
||||
struct cons_pointer eval_forms( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer eval_forms( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer,
|
||||
struct cons_pointer list,
|
||||
struct cons_pointer env );
|
||||
|
||||
|
|
@ -68,19 +69,24 @@ struct cons_pointer eval_forms( struct stack_frame *frame, struct cons_pointer f
|
|||
/*
|
||||
* special forms
|
||||
*/
|
||||
struct cons_pointer lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer lisp_eval( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
struct cons_pointer lisp_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer lisp_apply( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
|
||||
struct cons_pointer
|
||||
lisp_oblist( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env );
|
||||
lisp_oblist( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
|
||||
struct cons_pointer
|
||||
lisp_set( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env );
|
||||
lisp_set( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
|
||||
struct cons_pointer
|
||||
lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env );
|
||||
lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
|
||||
/**
|
||||
* Construct an interpretable function.
|
||||
|
|
@ -89,7 +95,8 @@ lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer, s
|
|||
* @param lexpr the lambda expression to be interpreted;
|
||||
* @param env the environment in which it is to be intepreted.
|
||||
*/
|
||||
struct cons_pointer lisp_lambda( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer lisp_lambda( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
|
||||
/**
|
||||
|
|
@ -99,31 +106,42 @@ struct cons_pointer lisp_lambda( struct stack_frame *frame, struct cons_pointer
|
|||
* @param env the environment in which it is to be intepreted.
|
||||
*/
|
||||
struct cons_pointer
|
||||
lisp_nlambda( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env );
|
||||
lisp_nlambda( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
|
||||
struct cons_pointer lisp_quote( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer lisp_quote( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
|
||||
/*
|
||||
* functions
|
||||
*/
|
||||
struct cons_pointer lisp_cons( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer lisp_cons( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
struct cons_pointer lisp_car( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer lisp_car( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
struct cons_pointer lisp_cdr( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer lisp_cdr( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
struct cons_pointer lisp_assoc( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer lisp_assoc( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
struct cons_pointer lisp_eq( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer lisp_eq( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
struct cons_pointer lisp_equal( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer lisp_equal( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
struct cons_pointer lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer lisp_print( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
struct cons_pointer lisp_read( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer lisp_read( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
struct cons_pointer lisp_reverse( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer lisp_reverse( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
/**
|
||||
* Function: Get the Lisp type of the single argument.
|
||||
|
|
@ -132,7 +150,8 @@ struct cons_pointer lisp_reverse( struct stack_frame *frame, struct cons_pointer
|
|||
* @return As a Lisp string, the tag of the object which is the argument.
|
||||
*/
|
||||
struct cons_pointer
|
||||
lisp_type( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env );
|
||||
lisp_type( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
|
||||
|
||||
/**
|
||||
|
|
@ -146,7 +165,8 @@ lisp_type( struct stack_frame *frame, struct cons_pointer frame_pointer, struct
|
|||
* argument.
|
||||
*/
|
||||
struct cons_pointer
|
||||
lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env );
|
||||
lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
|
||||
/**
|
||||
* Special form: conditional. Each arg is expected to be a list; if the first
|
||||
|
|
@ -158,7 +178,8 @@ lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer, struct
|
|||
* @return the value of the last form of the first successful clause.
|
||||
*/
|
||||
struct cons_pointer
|
||||
lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env );
|
||||
lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
|
||||
/**
|
||||
* Throw an exception.
|
||||
|
|
@ -167,7 +188,8 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer, struct
|
|||
* real `throw_exception`, which does, will be needed.
|
||||
*/
|
||||
struct cons_pointer throw_exception( struct cons_pointer message,
|
||||
struct cons_pointer frame_pointer );
|
||||
struct cons_pointer frame_pointer );
|
||||
|
||||
struct cons_pointer
|
||||
lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env );
|
||||
lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
|
|
|
|||
|
|
@ -119,7 +119,7 @@ struct cons_pointer print( FILE * output, struct cons_pointer pointer ) {
|
|||
case EXCEPTIONTV:
|
||||
fwprintf( output, L"\n%sException: ",
|
||||
print_use_colours ? "\x1B[31m" : "" );
|
||||
dump_stack_trace(output, pointer);
|
||||
dump_stack_trace( output, pointer );
|
||||
break;
|
||||
case FUNCTIONTV:
|
||||
fwprintf( output, L"(Function)" );
|
||||
|
|
@ -133,8 +133,8 @@ struct cons_pointer print( FILE * output, struct cons_pointer pointer ) {
|
|||
case LAMBDATV:
|
||||
print( output, make_cons( c_string_to_lisp_symbol( "lambda" ),
|
||||
make_cons( cell.payload.lambda.args,
|
||||
cell.payload.
|
||||
lambda.body ) ) );
|
||||
cell.payload.lambda.
|
||||
body ) ) );
|
||||
break;
|
||||
case NILTV:
|
||||
fwprintf( output, L"nil" );
|
||||
|
|
@ -142,8 +142,8 @@ struct cons_pointer print( FILE * output, struct cons_pointer pointer ) {
|
|||
case NLAMBDATV:
|
||||
print( output, make_cons( c_string_to_lisp_symbol( "nlambda" ),
|
||||
make_cons( cell.payload.lambda.args,
|
||||
cell.payload.
|
||||
lambda.body ) ) );
|
||||
cell.payload.lambda.
|
||||
body ) ) );
|
||||
break;
|
||||
case RATIOTV:
|
||||
print( output, cell.payload.ratio.dividend );
|
||||
|
|
|
|||
|
|
@ -34,10 +34,11 @@
|
|||
*/
|
||||
|
||||
struct cons_pointer read_number( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer, FILE * input,
|
||||
wint_t initial, bool seen_period );
|
||||
struct cons_pointer frame_pointer,
|
||||
FILE * input, wint_t initial,
|
||||
bool seen_period );
|
||||
struct cons_pointer read_list( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer, FILE * input,
|
||||
struct cons_pointer frame_pointer, FILE * input,
|
||||
wint_t initial );
|
||||
struct cons_pointer read_string( FILE * input, wint_t initial );
|
||||
struct cons_pointer read_symbol( FILE * input, wint_t initial );
|
||||
|
|
@ -55,8 +56,9 @@ struct cons_pointer c_quote( struct cons_pointer arg ) {
|
|||
* treating this initial character as the first character of the object
|
||||
* representation.
|
||||
*/
|
||||
struct cons_pointer read_continuation( struct stack_frame *frame, struct cons_pointer frame_pointer, FILE * input,
|
||||
wint_t initial ) {
|
||||
struct cons_pointer read_continuation( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer,
|
||||
FILE * input, wint_t initial ) {
|
||||
struct cons_pointer result = NIL;
|
||||
|
||||
wint_t c;
|
||||
|
|
@ -76,15 +78,18 @@ struct cons_pointer read_continuation( struct stack_frame *frame, struct cons_po
|
|||
break;
|
||||
case EOF:
|
||||
result = throw_exception( c_string_to_lisp_string
|
||||
( "End of input while reading" ), frame_pointer );
|
||||
( "End of input while reading" ),
|
||||
frame_pointer );
|
||||
break;
|
||||
case '\'':
|
||||
result =
|
||||
c_quote( read_continuation
|
||||
( frame, frame_pointer, input, fgetwc( input ) ) );
|
||||
( frame, frame_pointer, input,
|
||||
fgetwc( input ) ) );
|
||||
break;
|
||||
case '(':
|
||||
result = read_list( frame, frame_pointer, input, fgetwc( input ) );
|
||||
result =
|
||||
read_list( frame, frame_pointer, input, fgetwc( input ) );
|
||||
break;
|
||||
case '"':
|
||||
result = read_string( input, fgetwc( input ) );
|
||||
|
|
@ -93,7 +98,9 @@ struct cons_pointer read_continuation( struct stack_frame *frame, struct cons_po
|
|||
wint_t next = fgetwc( input );
|
||||
ungetwc( next, input );
|
||||
if ( iswdigit( next ) ) {
|
||||
result = read_number( frame, frame_pointer, input, c, false );
|
||||
result =
|
||||
read_number( frame, frame_pointer, input, c,
|
||||
false );
|
||||
} else {
|
||||
result = read_symbol( input, c );
|
||||
}
|
||||
|
|
@ -104,12 +111,15 @@ struct cons_pointer read_continuation( struct stack_frame *frame, struct cons_po
|
|||
wint_t next = fgetwc( input );
|
||||
if ( iswdigit( next ) ) {
|
||||
ungetwc( next, input );
|
||||
result = read_number( frame, frame_pointer, input, c, true );
|
||||
result =
|
||||
read_number( frame, frame_pointer, input, c,
|
||||
true );
|
||||
} else if ( iswblank( next ) ) {
|
||||
/* dotted pair. TODO: this isn't right, we
|
||||
* really need to backtrack up a level. */
|
||||
result =
|
||||
read_continuation( frame, frame_pointer, input, fgetwc( input ) );
|
||||
read_continuation( frame, frame_pointer, input,
|
||||
fgetwc( input ) );
|
||||
} else {
|
||||
read_symbol( input, c );
|
||||
}
|
||||
|
|
@ -117,7 +127,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame, struct cons_po
|
|||
break;
|
||||
default:
|
||||
if ( iswdigit( c ) ) {
|
||||
result = read_number( frame, frame_pointer, input, c, false );
|
||||
result =
|
||||
read_number( frame, frame_pointer, input, c, false );
|
||||
} else if ( iswprint( c ) ) {
|
||||
result = read_symbol( input, c );
|
||||
} else {
|
||||
|
|
@ -140,8 +151,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame, struct cons_po
|
|||
* input stream into a Lisp string, and then convert it to a number.
|
||||
*/
|
||||
struct cons_pointer read_number( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer,
|
||||
FILE * input,
|
||||
struct cons_pointer frame_pointer,
|
||||
FILE * input,
|
||||
wint_t initial, bool seen_period ) {
|
||||
struct cons_pointer result = NIL;
|
||||
int64_t accumulator = 0;
|
||||
|
|
@ -222,17 +233,21 @@ struct cons_pointer read_number( struct stack_frame *frame,
|
|||
* left parenthesis.
|
||||
*/
|
||||
struct cons_pointer read_list( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer,
|
||||
FILE * input, wint_t initial ) {
|
||||
struct cons_pointer frame_pointer,
|
||||
FILE * input, wint_t initial ) {
|
||||
struct cons_pointer result = NIL;
|
||||
if ( initial != ')' ) {
|
||||
#ifdef DEBUG
|
||||
fwprintf( stderr,
|
||||
L"read_list starting '%C' (%d)\n", initial, initial );
|
||||
#endif
|
||||
struct cons_pointer car = read_continuation( frame, frame_pointer, input,
|
||||
initial );
|
||||
result = make_cons( car, read_list( frame, frame_pointer, input, fgetwc( input ) ) );
|
||||
struct cons_pointer car =
|
||||
read_continuation( frame, frame_pointer, input,
|
||||
initial );
|
||||
result =
|
||||
make_cons( car,
|
||||
read_list( frame, frame_pointer, input,
|
||||
fgetwc( input ) ) );
|
||||
}
|
||||
#ifdef DEBUG
|
||||
else {
|
||||
|
|
@ -323,6 +338,7 @@ struct cons_pointer read_symbol( FILE * input, wint_t initial ) {
|
|||
*/
|
||||
struct cons_pointer read( struct
|
||||
stack_frame
|
||||
*frame, struct cons_pointer frame_pointer, FILE * input ) {
|
||||
*frame, struct cons_pointer frame_pointer,
|
||||
FILE * input ) {
|
||||
return read_continuation( frame, frame_pointer, input, fgetwc( input ) );
|
||||
}
|
||||
|
|
|
|||
|
|
@ -15,7 +15,6 @@
|
|||
* read the next object on this input stream and return a cons_pointer to it.
|
||||
*/
|
||||
struct cons_pointer read( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer,
|
||||
FILE * input );
|
||||
struct cons_pointer frame_pointer, FILE * input );
|
||||
|
||||
#endif
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue