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

Setting up medatata works...

Browse source 
And the `inspect` function correctly shows it. However, the `metadata` function segfaults.
This commit is contained in:
Simon Brooke 2019-01-29 18:31:30 +00:00
parent 10098a83bf
commit eb394d153f
16 changed files with 866 additions and 580 deletions
Download patch file Download diff file Expand all files Collapse all files

5
src/ops/equal.c
View file

@ -67,6 +67,7 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
&& equal( cell_a->payload.cons.cdr,
cell_b->payload.cons.cdr );
break;
case KEYTV:
case STRINGTV:
case SYMBOLTV:
/*
@ -80,8 +81,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 =

59
src/ops/lispops.c
View file

@ -47,32 +47,6 @@
* and others I haven't thought of yet.
*/
/**
* Implementation of car in C. If arg is not a cons, does not error but returns nil.
*/
struct cons_pointer c_car( struct cons_pointer arg ) {
struct cons_pointer result = NIL;
if ( consp( arg ) ) {
result = pointer2cell( arg ).payload.cons.car;
}
return result;
}
/**
* Implementation of cdr in C. If arg is not a cons, does not error but returns nil.
*/
struct cons_pointer c_cdr( struct cons_pointer arg ) {
struct cons_pointer result = NIL;
if ( consp( arg ) || stringp( arg ) || symbolp( arg ) ) {
result = pointer2cell( arg ).payload.cons.cdr;
}
return result;
}
/**
* Useful building block; evaluate this single form in the context of this
@ -378,9 +352,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
result = next_pointer;
} else {
result =
( *fn_cell.payload.special.
executable ) ( get_stack_frame( next_pointer ),
next_pointer, env );
( *fn_cell.payload.
special.executable ) ( get_stack_frame
( next_pointer ),
next_pointer, env );
debug_print( L"Special form returning: ", DEBUG_EVAL );
debug_print_object( result, DEBUG_EVAL );
debug_println( DEBUG_EVAL );
@ -411,24 +386,6 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
return result;
}
/**
* Get the Lisp type of the single argument.
* @param pointer a pointer to the object whose type is requested.
* @return As a Lisp string, the tag of the object which is at that pointer.
*/
struct cons_pointer c_type( struct cons_pointer pointer ) {
struct cons_pointer result = NIL;
struct cons_space_object cell = pointer2cell( pointer );
for ( int i = TAGLENGTH - 1; i >= 0; i-- ) {
result = make_string( ( wchar_t ) cell.tag.bytes[i], result );
}
return result;
}
/**
* Function; evaluate the expression which is the first argument in the frame;
* further arguments are ignored.
@ -885,7 +842,7 @@ struct cons_pointer c_reverse( struct cons_pointer arg ) {
result = make_string( o.payload.string.character, result );
break;
case SYMBOLTV:
result = make_symbol( o.payload.string.character, result );
result = make_symbol_or_key( o.payload.string.character, result, SYMBOLTAG );
break;
}
}
@ -1251,13 +1208,13 @@ struct cons_pointer lisp_source( struct stack_frame *frame,
struct cons_pointer env ) {
struct cons_pointer result = NIL;
struct cons_space_object cell = pointer2cell( frame->arg[0] );
struct cons_pointer source_key = c_string_to_lisp_keyword(L"source");
switch ( cell.tag.value ) {
case FUNCTIONTV:
result = cell.payload.function.source;
result = c_assoc( source_key, cell.payload.function.meta);
break;
case SPECIALTV:
result = cell.payload.special.source;
result = c_assoc( source_key, cell.payload.special.meta);
break;
case LAMBDATV:
result = make_cons( c_string_to_lisp_symbol( L"lambda" ),

21
src/ops/lispops.h
View file

@ -19,26 +19,13 @@
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#ifndef __psse_lispops_h
#define __psse_lispops_h
/*
* utilities
*/
/**
* Get the Lisp type of the single argument.
* @param pointer a pointer to the object whose type is requested.
* @return As a Lisp string, the tag of the object which is at that pointer.
*/
struct cons_pointer c_type( struct cons_pointer pointer );
/**
* Implementation of car in C. If arg is not a cons, does not error but returns nil.
*/
struct cons_pointer c_car( struct cons_pointer arg );
/**
* Implementation of cdr in C. If arg is not a cons, does not error but returns nil.
*/
struct cons_pointer c_cdr( struct cons_pointer arg );
struct cons_pointer c_reverse( struct cons_pointer arg );
@ -205,3 +192,5 @@ struct cons_pointer lisp_source( struct stack_frame *frame,
struct cons_pointer lisp_inspect( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer env );
#endif

47
src/ops/meta.c Normal file
View file

@ -0,0 +1,47 @@
/*
* meta.c
*
* Get metadata from a cell which has it.
*
* (c) 2019 Simon Brooke <simon@journeyman.cc>
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#include "conspage.h"
#include "debug.h"
/**
* Function: get metadata describing my first argument.
*
* * (metadata any)
*
* @return a pointer to the metadata of my first argument, or nil if none.
*/
struct cons_pointer lisp_metadata( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer env ) {
debug_print(L"lisp_metadata: entered\n", DEBUG_EVAL);
debug_dump_object(frame->arg[0], DEBUG_EVAL);
struct cons_pointer result = NIL;
struct cons_space_object cell = pointer2cell(frame->arg[0]);
switch( cell.tag.value) {
case FUNCTIONTV:
result = cell.payload.function.meta;
break;
case SPECIALTV:
result = cell.payload.special.meta;
break;
case READTV:
case WRITETV:
result = cell.payload.special.meta;
break;
}
return make_cons(
make_cons(
c_string_to_lisp_keyword( L"type"),
c_type(frame->arg[0])),
result);
// return result;
}

17
src/ops/meta.h Normal file
View file

@ -0,0 +1,17 @@
/*
* meta.h
*
* Get metadata from a cell which has it.
*
* (c) 2019 Simon Brooke <simon@journeyman.cc>
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#ifndef __psse_meta_h
#define __psse_meta_h
struct cons_pointer lisp_metadata( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer env ) ;
#endif

9
src/ops/print.c
View file

@ -35,7 +35,7 @@ int print_use_colours = 0;
* don't print anything but just return.
*/
void print_string_contents( URL_FILE * output, struct cons_pointer pointer ) {
while ( stringp( pointer ) || symbolp( pointer ) ) {
while ( stringp( pointer ) || symbolp( pointer ) || keywordp(pointer)) {
struct cons_space_object *cell = &pointer2cell( pointer );
wchar_t c = cell->payload.string.character;
@ -134,6 +134,13 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) {
dec_ref( s );
}
break;
case KEYTV:
if ( print_use_colours ) {
url_fputws( L"\x1B[1;33m", output );
}
url_fputws( L":", output );
print_string_contents( output, pointer );
break;
case LAMBDATV:{
struct cons_pointer to_print =
make_cons( c_string_to_lisp_symbol( L"lambda" ),

41
src/ops/read.c
View file

@ -45,7 +45,8 @@ struct cons_pointer read_list( struct stack_frame *frame,
struct cons_pointer frame_pointer,
URL_FILE * input, wint_t initial );
struct cons_pointer read_string( URL_FILE * input, wint_t initial );
struct cons_pointer read_symbol( URL_FILE * input, wint_t initial );
struct cons_pointer read_symbol_or_key( URL_FILE * input, char *tag,
wint_t initial );
/**
* quote reader macro in C (!)
@ -110,7 +111,7 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
read_number( frame, frame_pointer, input, c,
false );
} else {
result = read_symbol( input, c );
result = read_symbol_or_key( input, SYMBOLTAG, c );
}
}
break;
@ -129,17 +130,20 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
read_continuation( frame, frame_pointer, input,
url_fgetwc( input ) );
} else {
read_symbol( input, c );
read_symbol_or_key( input, SYMBOLTAG, c );
}
}
break;
//case ':': reserved for keywords and paths
case ':':
result =
read_symbol_or_key( input, KEYTAG, url_fgetwc( input ) );
break;
default:
if ( iswdigit( c ) ) {
result =
read_number( frame, frame_pointer, input, c, false );
} else if ( iswprint( c ) ) {
result = read_symbol( input, c );
result = read_symbol_or_key( input, SYMBOLTAG, c );
} else {
result =
throw_exception( make_cons( c_string_to_lisp_string
@ -321,24 +325,22 @@ struct cons_pointer read_string( URL_FILE * input, wint_t initial ) {
return result;
}
struct cons_pointer read_symbol( URL_FILE * input, wint_t initial ) {
struct cons_pointer read_symbol_or_key( URL_FILE * input, char *tag,
wint_t initial ) {
struct cons_pointer cdr = NIL;
struct cons_pointer result;
switch ( initial ) {
case '\0':
result = make_symbol( initial, NIL );
result = make_symbol_or_key( initial, NIL, tag );
break;
case '"':
/*
* THIS IS NOT A GOOD IDEA, but is legal
*/
result =
make_symbol( initial,
read_symbol( input, url_fgetwc( input ) ) );
break;
case '\'':
/* unwise to allow embedded quotation marks in symbols */
case ')':
case ':':
/*
* symbols may not include right-parenthesis;
* symbols and keywords may not include right-parenthesis
* or colons.
*/
result = NIL;
/*
@ -350,8 +352,11 @@ struct cons_pointer read_symbol( URL_FILE * input, wint_t initial ) {
if ( iswprint( initial )
&& !iswblank( initial ) ) {
result =
make_symbol( initial,
read_symbol( input, url_fgetwc( input ) ) );
make_symbol_or_key( initial,
read_symbol_or_key( input,
tag,
url_fgetwc( input ) ),
tag );
} else {
result = NIL;
/*
@ -362,7 +367,7 @@ struct cons_pointer read_symbol( URL_FILE * input, wint_t initial ) {
break;
}
debug_print( L"read_symbol returning\n", DEBUG_IO );
debug_print( L"read_symbol_or_key returning\n", DEBUG_IO );
debug_dump_object( result, DEBUG_IO );
return result;