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

#8: compiles, but most tests fail.

Browse source
This commit is contained in:
Simon Brooke 2019-02-05 13:46:46 +00:00
parent e7ef82d23f
commit b6958bbf65
9 changed files with 1360 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

35
src/ops/intern.c
View file

@ -24,6 +24,7 @@
#include "debug.h"
#include "equal.h"
#include "lispops.h"
#include "map.h"
#include "print.h"
/**
@ -88,7 +89,7 @@ internedp( struct cons_pointer key, struct cons_pointer store ) {
* of that key from the store; otherwise return NIL.
*/
struct cons_pointer c_assoc( struct cons_pointer key,
struct cons_pointer store ) {
struct cons_pointer store ) {
struct cons_pointer result = NIL;
debug_print( L"c_assoc; key is `", DEBUG_BIND);
@ -97,15 +98,19 @@ struct cons_pointer c_assoc( struct cons_pointer key,
debug_dump_object( store, DEBUG_BIND);
debug_println(DEBUG_BIND);
for ( struct cons_pointer next = store;
consp( next ); next = pointer2cell( next ).payload.cons.cdr ) {
struct cons_space_object entry =
pointer2cell( pointer2cell( next ).payload.cons.car );
if (consp(store)) {
for ( struct cons_pointer next = store;
consp( next ); next = pointer2cell( next ).payload.cons.cdr ) {
struct cons_space_object entry =
pointer2cell( pointer2cell( next ).payload.cons.car );
if ( equal( key, entry.payload.cons.car ) ) {
result = entry.payload.cons.cdr;
break;
if ( equal( key, entry.payload.cons.car ) ) {
result = entry.payload.cons.cdr;
break;
}
}
} else if (vectorpointp( store)) {
result = assoc_in_map( key, store);
}
return result;
@ -116,15 +121,23 @@ struct cons_pointer c_assoc( struct cons_pointer key,
* with this key/value pair added to the front.
*/
struct cons_pointer
set( struct cons_pointer key, struct cons_pointer value,
struct cons_pointer store ) {
set( struct cons_pointer key, struct cons_pointer value,
struct cons_pointer store ) {
struct cons_pointer result = NIL;
debug_print( L"Binding ", DEBUG_BIND );
debug_print_object( key, DEBUG_BIND );
debug_print( L" to ", DEBUG_BIND );
debug_print_object( value, DEBUG_BIND );
debug_println( DEBUG_BIND );
return make_cons( make_cons( key, value ), store );
if (consp(store)) {
result = make_cons( make_cons( key, value ), store );
} else if (vectorpointp( store)) {
result = bind_in_map( store, key, value);
}
return result;
}
/**

16
src/ops/lispops.c
View file

@ -716,6 +716,22 @@ lisp_cdr( struct stack_frame *frame, struct cons_pointer frame_pointer,
return result;
}
/**
* Function: return, as an integer, the length of the sequence indicated by
* the first argument, or zero if it is not a sequence.
*
* * (length any)
*
* @param frame my stack_frame.
* @param frame_pointer a pointer to my stack_frame.
* @param env my environment (ignored).
* @return the length of `any`, if it is a sequence, or zero otherwise.
*/
struct cons_pointer lisp_length( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer env ) {
return make_integer( c_length( frame->arg[0]), NIL);
}
/**
* Function; look up the value of a `key` in a `store`.
*

4
src/ops/lispops.h
View file

@ -85,7 +85,9 @@ lisp_set_shriek( 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 );
struct cons_pointer lisp_length( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer env );
/**
* Construct an interpretable special form.
*