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

WArning! this doesn't even build! Half way through reworking eval.

Browse source
This commit is contained in:
Simon Brooke 2017-09-17 20:18:15 +01:00
parent cf1b09c62a
commit b713c1822d
9 changed files with 106 additions and 85 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
src/consspaceobject.c
View file

@ -204,8 +204,8 @@ struct cons_pointer make_symbol( wint_t c, struct cons_pointer tail ) {
*/
struct cons_pointer
make_special( struct cons_pointer src, struct cons_pointer ( *executable )
( struct cons_pointer s_expr,
struct cons_pointer env, struct stack_frame * frame ) ) {
( struct struct stack_frame * frame,
struct cons_pointer env ) ) {
struct cons_pointer pointer = allocate_cell( SPECIALTAG );
struct cons_space_object *cell = &pointer2cell( pointer );

5
src/consspaceobject.h
View file

@ -290,9 +290,8 @@ struct real_payload {
*/
struct special_payload {
struct cons_pointer source;
struct cons_pointer ( *executable ) ( struct cons_pointer s_expr,
struct cons_pointer env,
struct stack_frame * frame );
struct cons_pointer ( *executable ) ( struct stack_frame *,
struct cons_pointer );
};
/**

95
src/lispops.c
View file

@ -72,40 +72,26 @@ struct cons_pointer c_cdr( struct cons_pointer arg ) {
return result;
}
/**
* (apply fn args...)
*
* I'm now confused about whether at this stage I actually need an apply special form,
* and if so how it differs from eval.
*/
struct cons_pointer
lisp_apply( struct cons_pointer args, struct cons_pointer env,
struct stack_frame *frame ) {
struct cons_pointer result = args;
if ( consp( args ) ) {
lisp_eval( args, env, frame );
}
return result;
}
struct cons_pointer
eval_cons( struct cons_pointer s_expr, struct cons_pointer env,
struct stack_frame *my_frame ) {
eval_cons( struct stack_frame *frame, struct cons_pointer env ) {
struct cons_pointer result = NIL;
struct cons_pointer fn_pointer =
lisp_eval( c_car( s_expr ), env, my_frame );
struct stack_frame *fn_frame = make_empty_frame( frame, env );
fn_frame->arg[0] = c_car( frame->arg[0] );
struct cons_pointer fn_pointer = lisp_eval( fn_frame, env );
free_stack_frame( fn_frame );
struct cons_space_object fn_cell = pointer2cell( fn_pointer );
struct cons_pointer args = c_cdr( s_expr );
struct cons_pointer args = c_cdr( frame->arg[0] );
switch ( fn_cell.tag.value ) {
case SPECIALTV:
{
struct stack_frame *frame =
make_special_frame( my_frame, args, env );
result =
( *fn_cell.payload.special.executable ) ( args, env, frame );
struct stack_frame *next = make_special_frame( frame, args, env );
result = ( *fn_cell.payload.special.executable ) ( next, env );
free_stack_frame( next );
}
break;
@ -114,16 +100,9 @@ eval_cons( struct cons_pointer s_expr, struct cons_pointer env,
* actually, this is apply
*/
{
struct cons_space_object function = pointer2cell( fn_pointer );
struct stack_frame *frame =
make_stack_frame( my_frame, args, env );
/*
* the trick: pass the remaining arguments and environment to the
* executable code which is the payload of the function object.
*/
result = ( *fn_cell.payload.function.executable ) ( frame, env );
free_stack_frame( frame );
struct stack_frame *next = make_stack_frame( frame, args, env );
result = ( *fn_cell.payload.special.executable ) ( next, env );
free_stack_frame( next );
}
break;
@ -138,7 +117,7 @@ eval_cons( struct cons_pointer s_expr, struct cons_pointer env,
fn_cell.tag.bytes[3] );
struct cons_pointer message = c_string_to_lisp_string( buffer );
free( buffer );
result = lisp_throw( message, my_frame );
result = lisp_throw( message, frame );
}
}
@ -159,24 +138,23 @@ eval_cons( struct cons_pointer s_expr, struct cons_pointer env,
* If a special form, passes the cdr of s_expr to the special form as argument.
*/
struct cons_pointer
lisp_eval( struct cons_pointer s_expr, struct cons_pointer env,
struct stack_frame *previous ) {
struct cons_pointer result = s_expr;
struct cons_space_object cell = pointer2cell( s_expr );
lisp_eval( struct stack_frame *frame, struct cons_pointer env ) {
struct cons_pointer result = frame->arg[0];
struct cons_space_object cell = pointer2cell( frame->arg[0] );
switch ( cell.tag.value ) {
case CONSTV:
result = eval_cons( s_expr, env, previous );
result = eval_cons( frame, env );
break;
case SYMBOLTV:
{
struct cons_pointer canonical = internedp( s_expr, env );
struct cons_pointer canonical = internedp( frame->arg[0], env );
if ( nilp( canonical ) ) {
struct cons_pointer message =
c_string_to_lisp_string
( "Attempt to take value of unbound symbol." );
result = lisp_throw( message, previous );
result = lisp_throw( message, frame );
} else {
result = c_assoc( canonical, env );
}
@ -194,6 +172,34 @@ lisp_eval( struct cons_pointer s_expr, struct cons_pointer env,
return result;
}
/**
* (apply fn args)
*/
struct cons_pointer
lisp_apply( struct stack_frame *frame, struct cons_pointer env ) {
struct cons_pointer result = NIL;
if ( nilp( frame->arg[1] ) || !nilp( frame->arg[2] ) ) {
result =
lisp_throw( c_string_to_lisp_string( "(apply <function> <args>" ),
frame );
}
struct stack_frame *fn_frame = make_empty_frame( frame, env );
fn_frame->arg[0] = frame->arg[0];
struct cons_pointer fn_pointer = lisp_eval( fn_frame, env );
free_stack_frame( fn_frame );
struct stack_frame *next_frame =
make_special_frame( frame, make_cons( fn_pointer, frame->arg[1] ),
env );
result = eval_cons( next_frame, env );
free_stack_frame( next_frame );
return result;
}
/**
* (quote a)
*
@ -202,8 +208,7 @@ lisp_eval( struct cons_pointer s_expr, struct cons_pointer env,
* this isn't at this stage checked) unevaluated.
*/
struct cons_pointer
lisp_quote( struct cons_pointer args, struct cons_pointer env,
struct stack_frame *frame ) {
lisp_quote( struct stack_frame *frame, struct cons_pointer env ) {
return frame->arg[0];
}

15
src/lispops.h
View file

@ -22,15 +22,12 @@
/*
* special forms
*/
struct cons_pointer lisp_eval( struct cons_pointer args,
struct cons_pointer env,
struct stack_frame *frame );
struct cons_pointer lisp_apply( struct cons_pointer args,
struct cons_pointer env,
struct stack_frame *frame );
struct cons_pointer lisp_quote( struct cons_pointer args,
struct cons_pointer env,
struct stack_frame *frame );
struct cons_pointer lisp_eval( struct stack_frame *frame,
struct cons_pointer env );
struct cons_pointer lisp_apply( struct stack_frame *frame,
struct cons_pointer env );
struct cons_pointer lisp_quote( struct stack_frame *frame,
struct cons_pointer env );
/*
* functions

2
src/peano.c
View file

@ -49,6 +49,7 @@ lisp_add( struct stack_frame *frame, struct cons_pointer env ) {
case REALTV:
d_accumulator += current.payload.real.value;
is_int = false;
break;
default:
lisp_throw( c_string_to_lisp_string( "Cannot add: not a number" ),
frame );
@ -93,6 +94,7 @@ lisp_multiply( struct stack_frame *frame, struct cons_pointer env ) {
case REALTV:
d_accumulator *= arg.payload.real.value;
is_int = false;
break;
default:
lisp_throw( c_string_to_lisp_string
( "Cannot multiply: not a number" ), frame );

2
src/read.c
View file

@ -66,7 +66,7 @@ struct cons_pointer read_continuation( FILE * input, wint_t initial ) {
result = read_string( input, fgetwc( input ) );
break;
default:
if ( iswdigit( c ) ) {
if ( iswdigit( c ) || c == '.' ) {
result = read_number( input, c );
} else if ( iswprint( c ) ) {
result = read_symbol( input, c );

5
src/repl.c
View file

@ -33,7 +33,10 @@ repl( FILE * in_stream, FILE * out_stream, FILE * error_stream,
input.offset );
print( error_stream, input );
struct cons_pointer value = lisp_eval( input, oblist, NULL );
struct stack_frame *frame = make_empty_frame( NIL, oblist );
frame->arg[0] = input;
struct cons_pointer value = lisp_eval( frame, oblist );
free_stack_frame( frame );
// print( out_stream, input );
fwprintf( out_stream, L"\n" );
fwprintf( error_stream, L"\neval {%d,%d}=> ", input.page,

54
src/stack.c
View file

@ -27,16 +27,17 @@
#include "stack.h"
/**
* Allocate a new stack frame with its previous pointer set to this value,
* its arguments set up from these args, evaluated in this env.
* Make an empty stack frame, and return it.
* @param previous the current top-of-stack;
* @param env the environment in which evaluation happens.
* @return the new frame.
*/
struct stack_frame *make_stack_frame( struct stack_frame *previous,
struct cons_pointer args,
struct stack_frame *make_empty_frame( struct stack_frame *previous,
struct cons_pointer env ) {
struct stack_frame *result = malloc( sizeof( struct stack_frame ) );
/*
* TODO: later, pop a frame off a free-list of stack frames
*/
struct stack_frame *result = malloc( sizeof( struct stack_frame ) );
result->previous = previous;
@ -51,6 +52,23 @@ struct stack_frame *make_stack_frame( struct stack_frame *previous,
result->arg[i] = NIL;
}
return result;
}
/**
* Allocate a new stack frame with its previous pointer set to this value,
* its arguments set up from these args, evaluated in this env.
* @param previous the current top-of-stack;
* @args the arguments to load into this frame;
* @param env the environment in which evaluation happens.
* @return the new frame.
*/
struct stack_frame *make_stack_frame( struct stack_frame *previous,
struct cons_pointer args,
struct cons_pointer env ) {
struct stack_frame *result = make_empty_frame( previous, env );
for ( int i = 0; i < args_in_frame && !nilp( args ); i++ ) {
/* iterate down the arg list filling in the arg slots in the
* frame. When there are no more slots, if there are still args,
@ -60,9 +78,13 @@ struct stack_frame *make_stack_frame( struct stack_frame *previous,
/*
* TODO: if we were running on real massively parallel hardware,
* each arg except the first should be handed off to another
* processor to be evaled in parallel
* processor to be evaled in parallel; but see notes here:
* https://github.com/simon-brooke/post-scarcity/wiki/parallelism
*/
result->arg[i] = lisp_eval( cell.payload.cons.car, env, result );
struct stack_frame *arg_frame = make_empty_frame( previous, env );
arg_frame->arg[0] = cell.payload.cons.car;
result->arg[i] = lisp_eval( arg_frame, env );
free_stack_frame( arg_frame );
inc_ref( result->arg[i] );
args = cell.payload.cons.cdr;
@ -87,23 +109,7 @@ struct stack_frame *make_stack_frame( struct stack_frame *previous,
struct stack_frame *make_special_frame( struct stack_frame *previous,
struct cons_pointer args,
struct cons_pointer env ) {
/*
* TODO: later, pop a frame off a free-list of stack frames
*/
struct stack_frame *result = malloc( sizeof( struct stack_frame ) );
result->previous = previous;
/*
* clearing the frame with memset would probably be slightly quicker, but
* this is clear.
*/
result->more = NIL;
result->function = NIL;
for ( int i = 0; i < args_in_frame; i++ ) {
result->arg[i] = NIL;
}
struct stack_frame *result = make_empty_frame( previous, env );
for ( int i = 0; i < args_in_frame && !nilp( args ); i++ ) {
/* iterate down the arg list filling in the arg slots in the

9
src/stack.h
View file

@ -24,6 +24,15 @@
#ifndef __stack_h
#define __stack_h
/**
* Make an empty stack frame, and return it.
* @param previous the current top-of-stack;
* @param env the environment in which evaluation happens.
* @return the new frame.
*/
struct stack_frame *make_empty_frame( struct stack_frame *previous,
struct cons_pointer env );
struct stack_frame *make_stack_frame( struct stack_frame *previous,
struct cons_pointer args,
struct cons_pointer env );