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

Not really making progress.

Browse source
This commit is contained in:
Simon Brooke 2018-12-30 19:07:07 +00:00
parent 02fe5669d8
commit e7dffcad2c
6 changed files with 66 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

60
src/ops/lispops.c
View file

@ -1035,18 +1035,21 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
* are not visible. So copy changes made in the oblist into the enviroment.
* TODO: the whole process of resolving symbol values needs to be revisited
* when we get onto namespaces. */
struct cons_pointer cursor = oblist;
while ( !nilp( cursor ) && !eq( cursor, old_oblist ) ) {
debug_print
( L"lisp_repl: copying new oblist binding into REPL environment:\n",
DEBUG_REPL );
debug_print_object( c_car( cursor ), DEBUG_REPL );
debug_println( DEBUG_REPL );
if ( !eq( oblist, old_oblist ) ) {
struct cons_pointer cursor = oblist;
new_env = make_cons( c_car( cursor ), new_env );
cursor = c_cdr( cursor );
while ( !nilp( cursor ) && !eq( cursor, old_oblist ) ) {
debug_print
( L"lisp_repl: copying new oblist binding into REPL environment:\n",
DEBUG_REPL );
debug_print_object( c_car( cursor ), DEBUG_REPL );
debug_println( DEBUG_REPL );
new_env = make_cons( c_car( cursor ), new_env );
cursor = c_cdr( cursor );
}
old_oblist = oblist;
}
old_oblist = oblist;
println( os );
@ -1079,3 +1082,40 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
return expr;
}
/**
* (source object)
*
* Function.
* Return the source code of the object, if it is an executable
* and has source code.
*/
struct cons_pointer lisp_source( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer env ) {
struct cons_pointer result = NIL;
struct cons_space_object cell = pointer2cell( frame->arg[0] );
switch ( cell.tag.value ) {
case FUNCTIONTV:
result = cell.payload.function.source;
break;
case SPECIALTV:
result = cell.payload.special.source;
break;
case LAMBDATV:
result = make_cons( c_string_to_lisp_symbol( L"lambda" ),
make_cons( cell.payload.lambda.args,
cell.payload.lambda.body ) );
break;
case NLAMBDATV:
result = make_cons( c_string_to_lisp_symbol( L"nlambda" ),
make_cons( cell.payload.lambda.args,
cell.payload.lambda.body ) );
break;
}
// TODO: suffers from premature GC, and I can't see why!
inc_ref( result );
return result;
}

4
src/ops/lispops.h
View file

@ -197,3 +197,7 @@ struct cons_pointer throw_exception( struct cons_pointer message,
struct cons_pointer
lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer env );
struct cons_pointer lisp_source( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer env );

7
src/ops/read.c
View file

@ -275,6 +275,9 @@ struct cons_pointer read_string( FILE * input, wint_t initial ) {
result = make_string( initial, NIL );
break;
case '"':
/* making a string of the null character means we can have an empty
* string. Just returning NIL here would make an empty string
* impossible. */
result = make_string( '\0', NIL );
break;
default:
@ -302,9 +305,9 @@ struct cons_pointer read_symbol( FILE * input, wint_t initial ) {
break;
case ')':
/*
* unquoted strings may not include right-parenthesis
* symbols may not include right-parenthesis
*/
result = make_symbol( '\0', NIL );
result = NIL;
/*
* push back the character read
*/