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

#8: Buggy, but a lot of it works.

Browse source
This commit is contained in:
Simon Brooke 2019-02-06 11:17:31 +00:00
parent b6958bbf65
commit 0687b0baeb
6 changed files with 98 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
src/init.c
View file

@ -26,6 +26,7 @@
#include "intern.h"
#include "io.h"
#include "lispops.h"
#include "map.h"
#include "meta.h"
#include "peano.h"
#include "print.h"
@ -196,6 +197,7 @@ int main( int argc, char *argv[] ) {
bind_function( L"eval", &lisp_eval );
bind_function( L"exception", &lisp_exception );
bind_function( L"inspect", &lisp_inspect );
bind_function( L"make-map", &lisp_make_map);
bind_function( L"meta", &lisp_metadata );
bind_function( L"metadata", &lisp_metadata );
bind_function( L"multiply", &lisp_multiply );

42
src/io/print.c
View file

@ -20,9 +20,12 @@
#include "conspage.h"
#include "consspaceobject.h"
#include "integer.h"
#include "intern.h"
#include "map.h"
#include "stack.h"
#include "print.h"
#include "time.h"
#include "vectorspace.h"
/**
* Whether or not we colorise output.
@ -98,7 +101,43 @@ void print_list( URL_FILE * output, struct cons_pointer pointer ) {
} else {
url_fputws( L")", output );
}
}
void print_map( URL_FILE * output, struct cons_pointer pointer) {
if ( vectorpointp( pointer)) {
struct vector_space_object *vso = pointer_to_vso( pointer);
if ( mapp( vso ) ) {
url_fputwc( btowc( '{' ), output );
for ( struct cons_pointer ks = keys(pointer);
!nilp(ks); ks = c_cdr(ks)) {
print( output, c_car(ks));
url_fputwc( btowc( ' ' ), output );
print( output, c_assoc( pointer, c_car(ks)));
if ( !nilp( c_cdr( ks))) {
url_fputws( L", ", output );
}
}
url_fputwc( btowc( '}' ), output );
}
}
}
void print_vso( URL_FILE * output, struct cons_pointer pointer) {
struct vector_space_object *vso =
pointer2cell( pointer ).payload.vectorp.address;
switch ( vso->header.tag.value) {
case MAPTV:
print_map( output, pointer);
break;
// \todo: others.
}
}
/**
@ -217,6 +256,9 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) {
case TRUETV:
url_fwprintf( output, L"t" );
break;
case VECTORPOINTTV:
print_vso( output, pointer);
break;
case WRITETV:
url_fwprintf( output, L"<Output stream>" );
break;

5
src/memory/dump.c
View file

@ -21,6 +21,8 @@
#include "conspage.h"
#include "consspaceobject.h"
#include "debug.h"
#include "intern.h"
#include "map.h"
#include "print.h"
#include "stack.h"
#include "vectorspace.h"
@ -146,6 +148,9 @@ void dump_object( URL_FILE * output, struct cons_pointer pointer ) {
case STACKFRAMETV:
dump_frame( output, pointer );
break;
case MAPTV:
dump_map( output, pointer);
break;
}
}
break;

22
src/memory/map.c
View file

@ -30,7 +30,7 @@ uint32_t get_hash_32(struct cons_pointer f, struct cons_pointer key) {
uint32_t result = 0;
int l = c_length(key);
if (keywordp(key) || stringp(key)) {
if (keywordp(key) || stringp(key) || symbolp( key)) {
if ( l > 0) {
uint32_t buffer[l];
@ -44,7 +44,7 @@ uint32_t get_hash_32(struct cons_pointer f, struct cons_pointer key) {
result = hashword( buffer, l, 0);
}
} else {
fputws(L"Hashing is thud far implemented only for keys and strings.\n", stderr);
fputws(L"Hashing is thus far implemented only for keys, strings and symbols.\n", stderr);
}
return result;
@ -220,6 +220,24 @@ struct cons_pointer assoc_in_map( struct cons_pointer map,
return result;
}
/**
* Function: create a map initialised with key/value pairs from my
* first argument.
*
* * (make-map)
* * (make-map store)
*
* @param frame the stack frame in which the expression is to be interpreted;
* @param frame_pointer a pointer to my stack_frame.
* @param env the environment in which it is to be intepreted.
* @return a new containing all the key/value pairs from store.
*/
struct cons_pointer
lisp_make_map( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer env ) {
return merge_into_map( make_empty_map( NIL), frame->arg[0]);
}
/**
* Dump a map to this stream for debugging
* @param output the stream

4
src/memory/map.h
View file

@ -85,6 +85,10 @@ struct cons_pointer merge_into_map( struct cons_pointer parent,
struct cons_pointer assoc_in_map( struct cons_pointer map,
struct cons_pointer key);
struct cons_pointer lisp_make_map( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer env );
void dump_map( URL_FILE * output, struct cons_pointer map_pointer );
#endif

30
src/ops/intern.c
View file

@ -52,7 +52,7 @@ struct cons_pointer
internedp( struct cons_pointer key, struct cons_pointer store ) {
struct cons_pointer result = NIL;
if ( symbolp( key ) ) {
if ( symbolp( key ) || keywordp( key ) ) {
for ( struct cons_pointer next = store;
nilp( result ) && consp( next );
next = pointer2cell( next ).payload.cons.cdr ) {
@ -74,7 +74,7 @@ internedp( struct cons_pointer key, struct cons_pointer store ) {
debug_print_object( key, DEBUG_BIND );
debug_print( L"` is a ", DEBUG_BIND );
debug_print_object( c_type( key ), DEBUG_BIND );
debug_print( L", not a SYMB", DEBUG_BIND );
debug_print( L", not a KEYW or SYMB", DEBUG_BIND );
}
return result;
@ -113,6 +113,10 @@ struct cons_pointer c_assoc( struct cons_pointer key,
result = assoc_in_map( key, store);
}
debug_print( L"c_assoc returning ", DEBUG_BIND);
debug_print_object( result, DEBUG_BIND);
debug_println( DEBUG_BIND);
return result;
}
@ -125,18 +129,24 @@ struct cons_pointer
struct cons_pointer store ) {
struct cons_pointer result = NIL;
debug_print( L"Binding ", DEBUG_BIND );
debug_print( L"set: binding `", DEBUG_BIND );
debug_print_object( key, DEBUG_BIND );
debug_print( L" to ", DEBUG_BIND );
debug_print( L"` to `", DEBUG_BIND );
debug_print_object( value, DEBUG_BIND );
debug_print( L"` in store ", DEBUG_BIND );
debug_dump_object( store, DEBUG_BIND);
debug_println( DEBUG_BIND );
if (consp(store)) {
if (nilp( store) || consp(store)) {
result = make_cons( make_cons( key, value ), store );
} else if (vectorpointp( store)) {
result = bind_in_map( store, key, value);
}
debug_print( L"set returning ", DEBUG_BIND);
debug_print_object( result, DEBUG_BIND);
debug_println( DEBUG_BIND);
return result;
}
@ -150,11 +160,19 @@ deep_bind( struct cons_pointer key, struct cons_pointer value ) {
debug_print( L"Entering deep_bind\n", DEBUG_BIND );
struct cons_pointer old = oblist;
debug_print( L"deep_bind: 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 );
oblist = set( key, value, oblist );
inc_ref( oblist );
dec_ref( old );
debug_print( L"Leaving deep_bind\n", DEBUG_BIND );
debug_print( L"deep_bind returning ", DEBUG_BIND );
debug_print_object( oblist, DEBUG_BIND );
debug_println( DEBUG_BIND );
return oblist;
}