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

Compare commits

base: simon:b6480aebd520a8623fb2ce34dfdd842a9f8ae4fa
Branches Tags
simon:master
simon:develop
simon:intern-rewrite
simon:feature-2
simon:feature/all-integers-are-bignums
simon:release/0.0.6
simon:release_0.0.5
..
compare: simon:9eb0d3c5a07a171d3506679d9c1b211712921ed1
Branches Tags
simon:develop
simon:master
simon:intern-rewrite
simon:feature-2
simon:feature/all-integers-are-bignums
simon:release/0.0.6
simon:release_0.0.5

No commits in common. "b6480aebd520a8623fb2ce34dfdd842a9f8ae4fa" and "9eb0d3c5a07a171d3506679d9c1b211712921ed1" have entirely different histories.
b6480aebd5 ... 9eb0d3c5a0

53 changed files with 505 additions and 645 deletions
Download patch file Download diff file Expand all files Collapse all files

10
archive/c/ops/equal.c
View file

@ -272,7 +272,7 @@ bool equal_map_map( struct cons_pointer a, struct cons_pointer b ) {
for ( struct cons_pointer i = keys_a; !nilp( i ); i = c_cdr( i ) ) {
struct cons_pointer key = c_car( i );
if ( !c_equal
if ( !equal
( hashmap_get( a, key, false ),
hashmap_get( b, key, false ) ) ) {
result = false;
@ -331,7 +331,7 @@ bool equal_vector_vector( struct cons_pointer a, struct cons_pointer b ) {
* Deep, and thus expensive, equality: true if these two objects have
* identical structure, else false.
*/
bool c_equal( struct cons_pointer a, struct cons_pointer b ) {
bool equal( struct cons_pointer a, struct cons_pointer b ) {
debug_print( L"\nequal: ", DEBUG_EQUAL );
debug_print_object( a, DEBUG_EQUAL );
debug_print( L" = ", DEBUG_EQUAL );
@ -353,8 +353,8 @@ bool c_equal( struct cons_pointer a, struct cons_pointer b ) {
* structures can be of indefinite extent. It *must* be done by
* iteration (and even that is problematic) */
result =
c_equal( cell_a->payload.cons.car, cell_b->payload.cons.car )
&& c_equal( cell_a->payload.cons.cdr,
equal( cell_a->payload.cons.car, cell_b->payload.cons.car )
&& equal( cell_a->payload.cons.cdr,
cell_b->payload.cons.cdr );
break;
case KEYTV:
@ -401,7 +401,7 @@ bool c_equal( struct cons_pointer a, struct cons_pointer b ) {
* isn't sufficient. So we recurse at least once. */
result = ( wcsncmp( a_buff, b_buff, i ) == 0 )
&& c_equal( c_cdr( a ), c_cdr( b ) );
&& equal( c_cdr( a ), c_cdr( b ) );
}
break;
case VECTORPOINTTV:

2
archive/c/ops/equal.h
View file

@ -31,6 +31,6 @@ bool eq( struct cons_pointer a, struct cons_pointer b );
* Deep, and thus expensive, equality: true if these two objects have
* identical structure, else false.
*/
bool c_equal( struct cons_pointer a, struct cons_pointer b );
bool equal( struct cons_pointer a, struct cons_pointer b );
#endif

4
archive/c/ops/intern.c
View file

@ -334,7 +334,7 @@ struct cons_pointer search_store( struct cons_pointer key,
switch ( get_tag_value( entry_ptr ) ) {
case CONSTV:
if ( c_equal( key, c_car( entry_ptr ) ) ) {
if ( equal( key, c_car( entry_ptr ) ) ) {
result =
return_key ? c_car( entry_ptr )
: c_cdr( entry_ptr );
@ -441,7 +441,7 @@ struct cons_pointer internedp( struct cons_pointer key,
for ( struct cons_pointer pair = c_car( store );
eq( result, NIL ) && !nilp( pair ); pair = c_car( store ) ) {
if ( consp( pair ) ) {
if ( c_equal( c_car( pair ), key ) ) {
if ( equal( c_car( pair ), key ) ) {
// yes, this should be `eq`, but if symbols are correctly
// interned this will work efficiently, and if not it will
// still work.

2
archive/c/ops/lispops.c
View file

@ -987,7 +987,7 @@ lisp_equal( struct stack_frame *frame, struct cons_pointer frame_pointer,
if ( frame->args > 1 ) {
for ( int b = 1; ( truep( result ) ) && ( b < frame->args ); b++ ) {
result =
c_equal( frame->arg[0], fetch_arg( frame, b ) ) ? TRUE : NIL;
equal( frame->arg[0], fetch_arg( frame, b ) ) ? TRUE : NIL;
}
}

44
src/c/io/io.c
View file

@ -114,7 +114,8 @@ char *lisp_string_to_c_string( struct pso_pointer s ) {
if ( stringp( s ) || symbolp( s ) ) {
int len = 0;
for ( struct pso_pointer c = s; !nilp( c ); c = cdr( c ) ) {
for ( struct pso_pointer c = s; !nilp( c );
c = cdr(c)) {
len++;
}
@ -123,7 +124,8 @@ char *lisp_string_to_c_string( struct pso_pointer s ) {
result = calloc( ( len * 4 ) + 1, sizeof( char ) );
int i = 0;
for ( struct pso_pointer c = s; !nilp( c ); c = cdr( c ) ) {
for ( struct pso_pointer c = s; !nilp( c );
c = cdr(c)) {
buffer[i++] = pointer_to_object( c )->payload.string.character;
}
@ -263,10 +265,7 @@ struct pso_pointer get_character( struct pso_pointer read_stream ) {
struct pso_pointer result = nil;
if (readp( read_stream)) {
result =
make_character( url_fgetwc
( pointer_to_object_of_size_class
( read_stream, 2 )->payload.stream.stream ) );
result = make_character( url_fgetwc( pointer_to_object_of_size_class(read_stream, 2)->payload.stream.stream));
}
return result;
@ -280,16 +279,12 @@ struct pso_pointer get_character( struct pso_pointer read_stream ) {
*
* @return `t` on success, else `nil`.
*/
struct pso_pointer push_back_character( struct pso_pointer c,
struct pso_pointer r ) {
struct pso_pointer push_back_character( struct pso_pointer c, struct pso_pointer r) {
struct pso_pointer result = nil;
if (characterp(c) && readp(r)) {
if ( url_ungetwc( ( wint_t )
( pointer_to_object( c )->payload.character.
character ),
pointer_to_object( r )->payload.stream.stream ) >=
0 ) {
if (url_ungetwc( (wint_t)(pointer_to_object(c)->payload.character.character),
pointer_to_object(r)->payload.stream.stream) >= 0) {
result = t;
}
}
@ -309,14 +304,12 @@ struct pso_pointer push_back_character( struct pso_pointer c,
* @return T if the stream was successfully closed, else nil.
*/
struct pso_pointer
lisp_close( struct pso_pointer frame_pointer, struct pso_pointer env ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
lisp_close( struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso_pointer env ) {
struct pso_pointer result = nil;
if ( readp( fetch_arg( frame, 0) ) || writep( fetch_arg( frame, 0) ) ) {
if ( url_fclose
( pointer_to_object( fetch_arg( frame, 0 ) )->payload.
stream.stream )
if ( url_fclose( pointer_to_object( fetch_arg( frame, 0) )->payload.stream.stream )
== 0 ) {
result = t;
}
@ -496,8 +489,8 @@ struct pso_pointer get_default_stream( bool inputp, struct pso_pointer env ) {
* on my stream, if any, else nil.
*/
struct pso_pointer
lisp_open( struct pso_pointer frame_pointer, struct pso_pointer env ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
lisp_open( struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso_pointer env ) {
struct pso_pointer result = nil;
// if ( stringp( fetch_arg( frame, 0) ) ) {
@ -563,8 +556,8 @@ lisp_open( struct pso_pointer frame_pointer, struct pso_pointer env ) {
* on my stream, if any, else nil.
*/
struct pso_pointer
lisp_read_char( struct pso_pointer frame_pointer, struct pso_pointer env ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
lisp_read_char( struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso_pointer env ) {
struct pso_pointer result = nil;
if ( readp( fetch_arg( frame, 0) ) ) {
@ -592,13 +585,12 @@ lisp_read_char( struct pso_pointer frame_pointer, struct pso_pointer env ) {
* on my stream, if any, else nil.
*/
struct pso_pointer
lisp_slurp( struct pso_pointer frame_pointer, struct pso_pointer env ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
lisp_slurp( struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso_pointer env ) {
struct pso_pointer result = nil;
if ( readp( fetch_arg( frame, 0) ) ) {
URL_FILE *stream =
pointer_to_object( fetch_arg( frame, 0 ) )->payload.stream.stream;
URL_FILE *stream = pointer_to_object( fetch_arg( frame, 0) )->payload.stream.stream;
struct pso_pointer cursor = make_string( url_fgetwc( stream ), nil );
result = cursor;

19
src/c/io/io.h
View file

@ -8,8 +8,8 @@
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#ifndef __psse_io_io_h
#define __psse_io_io_h
#ifndef __psse_io_h
#define __psse_io_h
#include <curl/curl.h>
#include "memory/pointer.h"
@ -32,19 +32,22 @@ wint_t url_ungetwc( wint_t wc, URL_FILE * input );
struct pso_pointer get_character( struct pso_pointer read_stream );
struct pso_pointer push_back_character( struct pso_pointer c,
struct pso_pointer r );
struct pso_pointer push_back_character( struct pso_pointer c, struct pso_pointer r);
struct pso_pointer get_default_stream( bool inputp, struct pso_pointer env );
struct pso_pointer
lisp_close( struct pso_pointer frame_pointer, struct pso_pointer env );
lisp_close( struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso_pointer env );
struct pso_pointer
lisp_open( struct pso_pointer frame_pointer, struct pso_pointer env );
lisp_open( struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso_pointer env );
struct pso_pointer
lisp_read_char( struct pso_pointer frame_pointer, struct pso_pointer env );
lisp_read_char( struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso_pointer env );
struct pso_pointer
lisp_slurp( struct pso_pointer frame_pointer, struct pso_pointer env );
lisp_slurp( struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso_pointer env );
char *lisp_string_to_c_string( struct pso_pointer s );
#endif

14
src/c/io/print.c
View file

@ -47,8 +47,7 @@ struct pso_pointer print_list_content( struct pso_pointer p, URL_FILE *output )
result = in_print( object->payload.cons.car, output);
if ( exceptionp( result ) )
break;
if (exceptionp(result)) break;
switch (get_tag_value(object->payload.cons.cdr)) {
case NILTV :
@ -84,8 +83,7 @@ struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) {
url_fputwc( L')', output );
break;
case INTEGERTV :
url_fwprintf( output, L"%d",
( int64_t ) ( object->payload.integer.value ) );
url_fwprintf( output, L"%d", (int64_t)(object->payload.integer.value));
break;
case TRUETV :
url_fputwc( L't', output );
@ -114,15 +112,11 @@ struct pso_pointer print( struct pso_pointer p, struct pso_pointer stream ) {
pointer_to_object( stream )->payload.stream.stream :
file_to_url_file(stdout);
if ( writep( stream ) ) {
inc_ref( stream );
}
if ( writep( stream)) { inc_ref( stream); }
struct pso_pointer result = in_print(p, output);
if ( writep( stream ) ) {
dec_ref( stream );
}
if ( writep( stream)) { dec_ref( stream); }
return result;
}

19
src/c/io/read.c
View file

@ -28,7 +28,6 @@
#include "io/read.h"
#include "memory/node.h"
#include "memory/pointer.h"
#include "memory/pso.h"
#include "memory/pso2.h"
#include "memory/tags.h"
@ -113,7 +112,8 @@ struct pso_pointer read_number( struct pso_pointer frame_pointer,
pointer_to_object( character)->payload.character.character;
URL_FILE * input = pointer_to_object(stream)->payload.stream.stream;
for ( ; iswdigit( c ); c = url_fgetwc( input ) ) {
for ( ; iswdigit( c );
c = url_fgetwc( input ) ){
value = (value * base) + ((int)c - (int)L'0');
}
@ -141,7 +141,8 @@ struct pso_pointer read_symbol( struct pso_pointer frame_pointer,
pointer_to_object( character)->payload.character.character;
URL_FILE * input = pointer_to_object(stream)->payload.stream.stream;
for ( ; iswalnum( c ); c = url_fgetwc( input ) ) {
for ( ; iswalnum( c );
c = url_fgetwc( input ) ){
result = make_string_like_thing(c, result, SYMBOLTAG);
}
@ -190,8 +191,7 @@ struct pso_pointer read( struct pso_pointer frame_pointer,
if (!nilp( readmacro)) {
// invoke the read macro on the stream
} else if (readp( stream) && characterp(character)) {
wchar_t c =
pointer_to_object( character )->payload.character.character;
wchar_t c = pointer_to_object( character)->payload.character.character;
URL_FILE * input = pointer_to_object(stream)->payload.stream.stream;
switch ( c ) {
@ -207,12 +207,10 @@ struct pso_pointer read( struct pso_pointer frame_pointer,
// frame_pointer );
break;
default:
struct pso_pointer next =
make_frame( frame_pointer, stream, readtable,
make_character( c ) );
inc_ref( next );
struct pso_pointer next = make_frame( frame_pointer, stream, readtable, make_character(c));
if ( iswdigit( c ) ) {
result = read_number( next, env );
result =
read_number( next, env );
} else if ( iswalpha( c ) ) {
result = read_symbol( next, env );
} else {
@ -223,7 +221,6 @@ struct pso_pointer read( struct pso_pointer frame_pointer,
// make_string( c, NIL ) ),
// frame_pointer );
}
dec_ref( next );
break;
}
}

25
src/c/io/read.h
View file

@ -1,25 +0,0 @@
/**
* read.h
*
* Read basic Lisp objects..This is :bootstrap layer print; it needs to be
* able to read characters, symbols, integers, lists and dotted pairs. I
* don't think it needs to be able to read anything else. It must, however,
* take a readtable as argument and expand reader macros.
*
*
* (c) 2017 Simon Brooke <simon@journeyman.cc>
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#ifndef __psse_io_read_h
#define __psse_io_read_h
struct pso_pointer read_number( struct pso_pointer frame_pointer,
struct pso_pointer env );
struct pso_pointer read_symbol( struct pso_pointer frame_pointer,
struct pso_pointer env );
struct pso_pointer read( struct pso_pointer frame_pointer,
struct pso_pointer env );
#endif

17
src/c/memory/destroy.c
View file

@ -43,23 +43,16 @@ struct pso_pointer destroy( struct pso_pointer p ) {
inc_ref( f);
switch (get_tag_value(p)) {
case CONSTV:
destroy_cons( f, nil );
break;
case EXCEPTIONTV:
destroy_exception( f, nil );
break;
case CONSTV: destroy_cons(f, nil); break;
case EXCEPTIONTV: destroy_exception(f, nil); break;
case KEYTV :
case STRINGTV:
case SYMBOLTV:
destroy_string( f, nil );
break;
case STACKTV:
destroy_stack_frame( f, nil );
break;
case SYMBOLTV: destroy_string(f, nil); break;
case STACKTV: destroy_stack_frame(f, nil); break;
// TODO: others.
}
dec_ref(f);
return result;
}

2
src/c/memory/node.c
View file

@ -57,7 +57,7 @@ struct pso_pointer initialise_node( uint32_t index ) {
struct pso_pointer result = initialise_memory( index );
if ( c_eq( result, t ) ) {
if ( eq( result, t ) ) {
result = initialise_environment( index );
}

1
src/c/memory/node.h
View file

@ -34,3 +34,4 @@ extern struct pso_pointer t;
struct pso_pointer initialise_node( uint32_t index );
#endif

10
src/c/memory/pointer.c
View file

@ -54,8 +54,7 @@ struct pso2 *pointer_to_object( struct pso_pointer p ) {
struct pso2 *result = NULL;
if ( p.node == node_index ) {
if ( p.page < get_pages_allocated( )
&& p.offset < ( PAGE_BYTES / 8 ) ) {
if (p.page < get_pages_allocated() && p.offset < (PAGE_BYTES / 8)) {
// TODO: that's not really a safe test of whether this is a valid pointer.
union page *pg = pages[p.page];
result = ( struct pso2 * ) &pg->words[p.offset];
@ -86,8 +85,7 @@ struct pso2 *pointer_to_object( struct pso_pointer p ) {
* @return the memory address of the object, provided it is a valid object and
* of the specified size class, else NULL.
*/
struct pso2 *pointer_to_object_of_size_class( struct pso_pointer p,
uint8_t size_class ) {
struct pso2 * pointer_to_object_of_size_class( struct pso_pointer p, uint8_t size_class) {
struct pso2 * result = pointer_to_object( p);
if (result->header.tag.bytes.size_class != size_class) {
@ -105,8 +103,7 @@ struct pso2 *pointer_to_object_of_size_class( struct pso_pointer p,
* exception back from this function. Consequently, if anything goes wrong
* we return NULL. The caller *should* check for that and throw an exception.
*/
struct pso2 *pointer_to_object_with_tag_value( struct pso_pointer p,
uint32_t tag_value ) {
struct pso2 * pointer_to_object_with_tag_value( struct pso_pointer p, uint32_t tag_value) {
struct pso2 * result = pointer_to_object( p);
if ((result->header.tag.value & 0xffffff) != tag_value) {
@ -115,3 +112,4 @@ struct pso2 *pointer_to_object_with_tag_value( struct pso_pointer p,
return result;
}

9
src/c/memory/pointer.h
View file

@ -39,15 +39,12 @@ struct pso_pointer {
};
struct pso_pointer make_pointer( uint32_t node, uint16_t page,
uint16_t offset );
struct pso_pointer make_pointer( uint32_t node, uint16_t page, uint16_t offset);
struct pso2* pointer_to_object( struct pso_pointer pointer);
struct pso2 *pointer_to_object_of_size_class( struct pso_pointer p,
uint8_t size_class );
struct pso2 * pointer_to_object_of_size_class( struct pso_pointer p, uint8_t size_class);
struct pso2 *pointer_to_object_with_tag_value( struct pso_pointer p,
uint32_t tag_value );
struct pso2 * pointer_to_object_with_tag_value( struct pso_pointer p, uint32_t tag_value);
#endif

3
src/c/memory/pso.c
View file

@ -181,8 +181,7 @@ struct pso_pointer free_object( struct pso_pointer p ) {
strncpy( ( char * ) ( obj->header.tag.bytes.mnemonic ), FREETAG,
TAGLENGTH );
#ifdef DEBUG
debug_printf( DEBUG_ALLOC, 0,
L"Freeing object of size class %d at {%d, %d, %d}",
debug_printf( DEBUG_ALLOC, 0, L"Freeing object of size class %d at {%d, %d, %d}",
size_class, p.node, p.page, p.offset);
#endif

3
src/c/memory/pso4.c
View file

@ -13,6 +13,5 @@
#include "memory/pso4.h"
struct pso4* pointer_to_pso4( struct pso_pointer p) {
struct pso4 *result =
( struct pso4 * ) pointer_to_object_of_size_class( p, 4 );
struct pso4* result = (struct pso4*)pointer_to_object_of_size_class( p, 4);
}

5
src/c/memory/tags.c
View file

@ -47,8 +47,7 @@ bool check_tag( struct pso_pointer p, uint32_t v ) {
* @return false otherwise.
*/
bool check_type( struct pso_pointer p, char* s) {
return ( strncmp
( &( pointer_to_object( p )->header.tag.bytes.mnemonic[0] ), s,
TAGLENGTH )
return (strncmp(
&(pointer_to_object(p)->header.tag.bytes.mnemonic[0]), s, TAGLENGTH)
== 0);
}

8
src/c/ops/assoc.c
View file

@ -34,16 +34,18 @@
* return the binding.
*/
struct pso_pointer search( struct pso_pointer key,
struct pso_pointer store, bool return_key ) {
struct pso_pointer store,
bool return_key ) {
struct pso_pointer result = nil;
bool found = false;
if (consp( store)) {
for ( struct pso_pointer cursor = store;
consp( store ) && found == false; cursor = cdr( cursor ) ) {
consp( store) && found == false;
cursor = cdr( cursor)) {
struct pso_pointer pair = car( cursor);
if ( consp( pair ) && c_equal( car( pair ), key ) ) {
if (consp(pair) && equal(car(pair), key)) {
found = true;
result = return_key ? car(pair) : cdr( pair);
}

6
src/c/ops/assoc.h
View file

@ -17,12 +17,12 @@
#include "memory/pointer.h"
struct cons_pointer search( struct pso_pointer key,
struct pso_pointer store, bool return_key );
struct pso_pointer store,
bool return_key );
struct pso_pointer assoc( struct pso_pointer key, struct pso_pointer store);
struct pso_pointer interned( struct pso_pointer key,
struct pso_pointer store );
struct pso_pointer interned(struct pso_pointer key, struct pso_pointer store);
bool internedp(struct pso_pointer key, struct pso_pointer store);
#endif

44
src/c/ops/bind.c
View file

@ -1,44 +0,0 @@
/**
* ops/bind.c
*
* Post Scarcity Software Environment: bind.
*
* Add a binding for a key/value pair to a store -- at this stage, just an
* association list.
*
* (c) 2026 Simon Brooke <simon@journeyman.cc>
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#include "memory/node.h"
#include "memory/pointer.h"
#include "memory/pso.h"
#include "memory/pso4.h"
#include "memory/tags.h"
#include "ops/stack_ops.h"
#include "payloads/cons.h"
#include "payloads/stack.h"
struct pso_pointer bind( struct pso_pointer frame_pointer,
struct pso_pointer env ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer key = fetch_arg( frame, 0 );
struct pso_pointer value = fetch_arg( frame, 1 );
struct pso_pointer store = fetch_arg( frame, 2 );
return cons( cons( key, value ), store );
}
struct pso_pointer c_bind( struct pso_pointer key,
struct pso_pointer value,
struct pso_pointer store ) {
struct pso_pointer result = nil;
struct pso_pointer next = make_frame( nil, key, value, store );
inc_ref( next );
result = bind( next, nil );
dec_ref( next );
return result;
}

25
src/c/ops/bind.h
View file

@ -1,25 +0,0 @@
/**
* ops/bind.h
*
* Post Scarcity Software Environment: bind.
*
* Test for pointer binduality.
*
* (c) 2026 Simon Brooke <simon@journeyman.cc>
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#ifndef __psse_ops_bind_h
#define __psse_ops_bind_h
#include <stdbool.h>
#include "memory/pointer.h"
struct pso_pointer bind( struct pso_pointer frame_pointer,
struct pso_pointer env );
struct pso_pointer c_bind( struct pso_pointer key,
struct pso_pointer value,
struct pso_pointer store );
#endif

25
src/c/ops/eq.c
View file

@ -33,14 +33,14 @@
* @param b another pointer;
* @return `true` if they are the same, else `false`
*/
bool c_eq( struct pso_pointer a, struct pso_pointer b ) {
bool eq( struct pso_pointer a, struct pso_pointer b ) {
return ( a.node == b.node && a.page == b.page && a.offset == b.offset );
}
bool c_equal( struct pso_pointer a, struct pso_pointer b ) {
bool equal( struct pso_pointer a, struct pso_pointer b) {
bool result = false;
if ( c_eq( a, b ) ) {
if ( eq( a, b)) {
result = true;
} else if ( get_tag_value(a) == get_tag_value(b)) {
struct pso2 *oa = pointer_to_object(a);
@ -48,17 +48,15 @@ bool c_equal( struct pso_pointer a, struct pso_pointer b ) {
switch ( get_tag_value(a)) {
case CHARACTERTV :
result =
( oa->payload.character.character ==
ob->payload.character.character );
result = (oa->payload.character.character == ob->payload.character.character);
break;
case CONSTV :
result = ( c_equal( car( a ), car( b ) )
&& c_equal( cdr( a ), cdr( b ) ) );
result = (equal( car(a), car(b)) && equal( cdr(a), cdr(b)));
break;
case INTEGERTV :
result = (oa->payload.integer.value
== ob->payload.integer.value );
==
ob->payload.integer.value);
break;
case KEYTV:
case STRINGTV :
@ -91,10 +89,9 @@ bool c_equal( struct pso_pointer a, struct pso_pointer b ) {
* @param env my environment (ignored).
* @return `t` if all args are pointers to the same object, else `nil`;
*/
struct pso_pointer eq( struct pso_pointer frame_pointer,
struct pso_pointer lisp_eq( struct pso4 *frame,
struct pso_pointer frame_pointer,
struct pso_pointer env ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer result = t;
if ( frame->payload.stack_frame.args > 1 ) {
@ -102,9 +99,11 @@ struct pso_pointer eq( struct pso_pointer frame_pointer,
( truep( result ) ) && ( b < frame->payload.stack_frame.args );
b++ ) {
result =
c_eq( fetch_arg( frame, 0 ), fetch_arg( frame, b ) ) ? t : nil;
eq( fetch_arg( frame, 0 ), fetch_arg( frame, b ) ) ? t : nil;
}
}
return result;
}

7
src/c/ops/eq.h
View file

@ -16,10 +16,11 @@
#include "memory/pointer.h"
#include "memory/pso4.h"
bool c_eq( struct pso_pointer a, struct pso_pointer b );
bool eq( struct pso_pointer a, struct pso_pointer b );
struct pso_pointer eq( struct pso_pointer frame_pointer,
struct pso_pointer lisp_eq( struct pso4 *frame,
struct pso_pointer frame_pointer,
struct pso_pointer env );
bool c_equal( struct pso_pointer a, struct pso_pointer b );
bool equal( struct pso_pointer a, struct pso_pointer b);
#endif

28
src/c/ops/eval.c
View file

@ -10,9 +10,7 @@
*/
#include "memory/pointer.h"
#include "memory/pso.h"
#include "memory/pso2.h"
#include "memory/pso3.h"
#include "memory/pso4.h"
#include "memory/tags.h"
@ -25,8 +23,6 @@
#include "payloads/special.h"
#include "payloads/stack.h"
#include "ops/truth.h"
/**
* @brief Despatch eval based on tag of the form in the first position.
*
@ -35,9 +31,9 @@
* @param env the evaluation environment.
* @return struct pso_pointer
*/
struct pso_pointer lisp_eval( struct pso_pointer frame_pointer,
struct pso_pointer eval_despatch( struct pso4 *frame,
struct pso_pointer frame_pointer,
struct pso_pointer env ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer result = frame->payload.stack_frame.arg[0];
// switch ( get_tag_value( result)) {
@ -59,17 +55,17 @@ struct pso_pointer lisp_eval( struct pso_pointer frame_pointer,
// break;
// }
if ( exceptionp( result ) ) {
struct pso3 *x =
( struct pso3 * ) pointer_to_object_with_tag_value( result,
EXCEPTIONTV );
if ( nilp( x->payload.exception.stack ) ) {
inc_ref( result );
result =
make_exception( x->payload.exception.message, frame_pointer,
result );
return result;
}
struct pso_pointer lisp_eval( struct pso4 *frame,
struct pso_pointer frame_pointer,
struct pso_pointer env ) {
struct pso_pointer result = eval_despatch( frame, frame_pointer, env );
if ( exceptionp( result ) ) {
// todo: if result doesn't have a stack frame, create a new exception wrapping
// result with this stack frame.
}
return result;

20
src/c/ops/reverse.c
View file

@ -38,33 +38,23 @@
struct pso_pointer reverse( struct pso_pointer sequence) {
struct pso_pointer result = nil;
for ( struct pso_pointer cursor = sequence; !nilp( sequence );
cursor = cdr( cursor ) ) {
for (struct pso_pointer cursor = sequence; !nilp( sequence); cursor = cdr(cursor)) {
struct pso2* object = pointer_to_object( cursor);
switch (get_tag_value(cursor)) {
case CONSTV :
result = cons( car(cursor), result);
break;
case KEYTV :
result =
make_string_like_thing( object->payload.string.character,
result, KEYTAG );
result = make_string_like_thing( object->payload.string.character, result, KEYTAG);
break;
case STRINGTV :
result =
make_string_like_thing( object->payload.string.character,
result, STRINGTAG );
result = make_string_like_thing( object->payload.string.character, result, STRINGTAG);
break;
case SYMBOLTV :
result =
make_string_like_thing( object->payload.string.character,
result, SYMBOLTAG );
result = make_string_like_thing( object->payload.string.character, result, SYMBOLTAG);
break;
default :
result =
make_exception( c_string_to_lisp_string
( L"Invalid object in sequence" ), nil,
nil );
result = make_exception( c_string_to_lisp_string(L"Invalid object in sequence"), nil, nil);
goto exit;
break;
}

16
src/c/ops/truth.c
View file

@ -13,7 +13,6 @@
#include "memory/node.h"
#include "memory/pointer.h"
#include "memory/pso4.h"
#include "ops/stack_ops.h"
/**
@ -65,10 +64,9 @@ bool truep( struct pso_pointer p ) {
* @param env the evaluation environment.
* @return `t` if the first argument in this frame is `nil`, else `t`
*/
struct pso_pointer lisp_nilp( struct pso_pointer frame_pointer,
struct pso_pointer lisp_nilp( struct pso4 *frame,
struct pso_pointer frame_pointer,
struct pso_pointer env ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
return ( nilp( fetch_arg( frame, 0 )) ? t : nil );
}
@ -80,10 +78,9 @@ struct pso_pointer lisp_nilp( struct pso_pointer frame_pointer,
* @param env the evaluation environment.
* @return `t` if the first argument in this frame is `t`, else `nil`.
*/
struct pso_pointer lisp_truep( struct pso_pointer frame_pointer,
struct pso_pointer lisp_truep( struct pso4 *frame,
struct pso_pointer frame_pointer,
struct pso_pointer env ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
return ( truep( fetch_arg( frame, 0 ) ) ? t : nil );
}
@ -96,9 +93,8 @@ struct pso_pointer lisp_truep( struct pso_pointer frame_pointer,
* @param env the evaluation environment.
* @return `t` if the first argument in this frame is not `nil`, else `t`.
*/
struct pso_pointer lisp_not( struct pso_pointer frame_pointer,
struct pso_pointer lisp_not( struct pso4 *frame,
struct pso_pointer frame_pointer,
struct pso_pointer env ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
return ( not( fetch_arg( frame, 0 ) ) ? t : nil );
}

9
src/c/ops/truth.h
View file

@ -18,17 +18,20 @@
bool nilp( struct pso_pointer p );
struct pso_pointer lisp_nilp( struct pso_pointer frame_pointer,
struct pso_pointer lisp_nilp( struct pso4 *frame,
struct pso_pointer frame_pointer,
struct pso_pointer env );
bool not( struct pso_pointer p );
struct pso_pointer lisp_not( struct pso_pointer frame_pointer,
struct pso_pointer lisp_not( struct pso4 *frame,
struct pso_pointer frame_pointer,
struct pso_pointer env );
bool truep( struct pso_pointer p );
struct pso_pointer lisp_truep( struct pso_pointer frame_pointer,
struct pso_pointer lisp_truep( struct pso4 *frame,
struct pso_pointer frame_pointer,
struct pso_pointer env );
#endif

3
src/c/payloads/character.c
View file

@ -27,8 +27,7 @@ struct pso_pointer make_character( wint_t c ) {
struct pso_pointer result = allocate( CHARACTERTAG, 2 );
if (!nilp(result)) {
pointer_to_object( result )->payload.character.character =
( wchar_t ) c;
pointer_to_object(result)->payload.character.character = (wchar_t) c;
}
return result;

24
src/c/payloads/cons.c
View file

@ -33,8 +33,11 @@ struct pso_pointer cons( struct pso_pointer car, struct pso_pointer cdr ) {
struct pso_pointer result = allocate( CONSTAG, 2 );
struct pso2 *object = pointer_to_object( result );
object->payload.cons.car = inc_ref( car );
object->payload.cons.cdr = inc_ref( cdr );
object->payload.cons.car = car;
object->payload.cons.cdr = cdr;
inc_ref( car );
inc_ref( cdr );
return result;
}
@ -71,19 +74,15 @@ struct pso_pointer cdr( struct pso_pointer p ) {
struct pso2 *object = pointer_to_object( result );
switch (get_tag_value( p)) {
case CONSTV:
result = object->payload.cons.cdr;
break;
case CONSTV : result = object->payload.cons.cdr; break;
case KEYTV :
case STRINGTV :
case SYMBOLTV :
result = object->payload.string.cdr;
break;
result = object->payload.string.cdr; break;
default :
result =
make_exception( cons
( c_string_to_lisp_string
( L"Invalid type for cdr" ), p ), nil, nil );
result = make_exception(
cons(c_string_to_lisp_string(L"Invalid type for cdr"), p),
nil, nil);
break;
}
@ -99,8 +98,7 @@ struct pso_pointer cdr( struct pso_pointer p ) {
* Lisp calling conventions; one expected arg, the pointer to the cell to
* be destroyed.
*/
struct pso_pointer destroy_cons( struct pso_pointer fp,
struct pso_pointer env ) {
struct pso_pointer destroy_cons( struct pso_pointer fp, struct pso_pointer env) {
if (stackp(fp)) {
struct pso4 *frame = pointer_to_pso4( fp);
struct pso_pointer p = frame->payload.stack_frame.arg[0];

3
src/c/payloads/cons.h
View file

@ -32,7 +32,6 @@ struct pso_pointer cdr( struct pso_pointer cons );
struct pso_pointer cons( struct pso_pointer car, struct pso_pointer cdr );
struct pso_pointer destroy_cons( struct pso_pointer fp,
struct pso_pointer env );
struct pso_pointer destroy_cons( struct pso_pointer fp, struct pso_pointer env);
#endif

3
src/c/payloads/exception.c
View file

@ -17,8 +17,7 @@
#include "payloads/exception.h"
struct pso_pointer make_exception( struct pso_pointer message,
struct pso_pointer frame_pointer,
struct pso_pointer cause ) {
struct pso_pointer frame_pointer, struct pso_pointer cause) {
// TODO: not yet implemented
return nil;
}

3
src/c/payloads/exception.h
View file

@ -25,8 +25,7 @@ struct exception_payload {
};
struct pso_pointer make_exception( struct pso_pointer message,
struct pso_pointer frame_pointer,
struct pso_pointer cause );
struct pso_pointer frame_pointer, struct pso_pointer cause);
struct pso_pointer destroy_exception( struct pso_pointer fp,
struct pso_pointer env);

1
src/c/psse.c
View file

@ -105,6 +105,7 @@ int main( int argc, char *argv[] ) {
fputs( "Failed to initialise node\n", stderr );
exit( 1 );
}
// repl( );
exit( 0 );