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

Things working much better now. assoc works. Currently printing of

Browse source 
string-like-things does not work, but I suspect that's shallow.
This commit is contained in:
Simon Brooke 2026-04-18 15:44:14 +01:00
parent 02a4bc3e28
commit 9a0f186f29
13 changed files with 400 additions and 38 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/c/debug.c
View file

@ -143,7 +143,7 @@ void debug_print_object( struct pso_pointer pointer, int level, int indent ) {
if ( level & verbosity ) {
URL_FILE *ustderr = file_to_url_file( stderr );
fwide( stderr, 1 );
in_print( pointer, ustderr );
in_write( pointer, ustderr, PRINT_VARIANT_PRINT );
free( ustderr );
}
#endif

16
src/c/io/io.c
View file

@ -89,7 +89,7 @@ struct pso_pointer lisp_io_out;
struct pso_pointer lisp_stdout;
/**
* @brief bound to the Lisp symbol representing C_IO_log in initialisation.
* @brief bound to the Lisp symbol representing C_IO_LOG in initialisation.
*/
struct pso_pointer lisp_io_log;
@ -99,6 +99,11 @@ struct pso_pointer lisp_io_log;
*/
struct pso_pointer lisp_stderr;
/**
* @brief bound to the Lisp symbol representing C_IO_PROMPT in initialisation
*/
struct pso_pointer lisp_io_prompt;
/**
* Allow a one-character unget facility. This may not be enough - we may need
* to allocate a buffer.
@ -147,11 +152,16 @@ struct pso_pointer initialise_default_streams( struct pso_pointer env ) {
lisp_io_in = c_string_to_lisp_symbol( C_IO_IN );
lisp_io_out = c_string_to_lisp_symbol( C_IO_OUT );
lisp_io_log = c_string_to_lisp_symbol( C_IO_LOG );
lisp_io_prompt = c_string_to_lisp_symbol( C_IO_PROMPT );
debug_print( L"In initialise_default_streams; environment is: ", DEBUG_IO,
0 );
debug_print_object( env, DEBUG_IO, 0 );
env =
c_bind( lisp_io_prompt, c_string_to_lisp_string( INITIAL_PROMPT ),
env );
lisp_stdin = lock_object( make_read_stream( file_to_url_file( stdin ),
c_cons( c_cons
( c_string_to_lisp_keyword
@ -367,8 +377,8 @@ struct pso_pointer push_back_character( struct pso_pointer c,
if ( characterp( c ) && readp( r ) ) {
if ( url_ungetwc( ( wint_t )
( pointer_to_object( c )->payload.character.
character ),
( pointer_to_object( c )->payload.
character.character ),
pointer_to_object( r )->payload.stream.stream ) >=
0 ) {
result = t;

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

@ -33,6 +33,11 @@ extern struct pso_pointer lisp_stdin;
extern struct pso_pointer lisp_stdout;
extern struct pso_pointer lisp_stderr;
#define INITIAL_PROMPT L"psse ]"
#define C_IO_PROMPT L"*prompt*"
extern struct pso_pointer lisp_io_prompt;
URL_FILE *file_to_url_file( FILE * f );
wint_t url_fgetwc( URL_FILE * input );
wint_t url_ungetwc( wint_t wc, URL_FILE * input );

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

@ -11,6 +11,7 @@
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#include <stdbool.h>
#include <ctype.h>
#include <stdint.h>
#include <stdio.h>
@ -26,6 +27,7 @@
#include "io/fopen.h"
#include "io/io.h"
#include "io/print.h"
#include "memory/node.h"
#include "memory/pointer.h"
@ -33,22 +35,26 @@
#include "memory/pso2.h"
#include "memory/tags.h"
#include "ops/string_ops.h"
#include "payloads/character.h"
#include "payloads/cons.h"
#include "payloads/exception.h"
#include "payloads/integer.h"
#include "ops/truth.h"
struct pso_pointer in_print( struct pso_pointer p, URL_FILE * output );
struct pso_pointer in_write( struct pso_pointer p, URL_FILE * output,
bool escape );
struct pso_pointer print_string_like_thing( struct pso_pointer p,
URL_FILE *output ) {
URL_FILE *output, bool escape ) {
switch ( get_tag_value( p ) ) {
case KEYTV:
url_fputwc( L':', output );
break;
case STRINGTV:
url_fputwc( L'"', output );
if ( !escape )
url_fputwc( L'"', output );
break;
}
@ -61,18 +67,20 @@ struct pso_pointer print_string_like_thing( struct pso_pointer p,
}
if ( stringp( p ) ) {
url_fputwc( L'"', output );
if ( !escape )
url_fputwc( L'"', output );
}
}
struct pso_pointer print_list_content( struct pso_pointer p, URL_FILE *output ) {
struct pso_pointer print_list_content( struct pso_pointer p, URL_FILE *output,
bool escape ) {
struct pso_pointer result = nil;
if ( consp( p ) ) {
for ( ; consp( p ); p = c_cdr( p ) ) {
struct pso2 *object = pointer_to_object( p );
result = in_print( object->payload.cons.car, output );
result = in_write( object->payload.cons.car, output, escape );
if ( exceptionp( result ) )
break;
@ -85,7 +93,8 @@ struct pso_pointer print_list_content( struct pso_pointer p, URL_FILE *output )
break;
default:
url_fputws( L" . ", output );
result = in_print( object->payload.cons.cdr, output );
result =
in_write( object->payload.cons.cdr, output, escape );
}
}
} else {
@ -95,7 +104,18 @@ struct pso_pointer print_list_content( struct pso_pointer p, URL_FILE *output )
return result;
}
struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) {
/**
* This is kind of modelled after the implementation of PRIN* variants on page
* 383 of the aluminium book. It is the inner workings of all PRIN* functions.
*
* @param p pointer to the object to print.
* @param output stream to print to.
* @param escape if true, print everything so that it can be read by the Lisp
* reader; otherwise, print it appropriately for human readers.
* @return p on success, exception on failure.
*/
struct pso_pointer in_write( struct pso_pointer p, URL_FILE *output,
bool escape ) {
struct pso2 *object = pointer_to_object( p );
struct pso_pointer result = nil;
@ -107,7 +127,7 @@ struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) {
break;
case CONSTV:
url_fputwc( L'(', output );
result = print_list_content( p, output );
result = print_list_content( p, output, escape );
url_fputwc( L')', output );
break;
case INTEGERTV:
@ -117,7 +137,7 @@ struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) {
case KEYTV:
case STRINGTV:
case SYMBOLTV:
print_string_like_thing( p, output );
print_string_like_thing( p, output, escape );
break;
case NILTV:
url_fputws( L"nil", output );
@ -126,7 +146,7 @@ struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) {
case WRITETV:
url_fwprintf( output, L"<%s stream: ",
v == READTV ? "read" : "write" );
in_print( object->payload.stream.meta, output );
in_write( object->payload.stream.meta, output, escape );
url_fputwc( L'>', output );
break;
case TRUETV:
@ -143,13 +163,19 @@ struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) {
}
/**
* @brief Simple print for bootstrap layer.
* This is kind of modelled after the implementation of PRIN* variants on page
* 383 of the aluminium book. It is the inner workings of all PRIN* functions.
*
* @param p pointer to the object to print.
* @param stream if a pointer to an open write stream, print to there.
* @return struct pso_pointer `nil`, or an exception if some erroe occurred.
* @param output stream to print to.
* @param escape if true, print everything so that it can be read by the Lisp
* reader; otherwise, print it appropriately for human readers.
* @param nl_before if true, print a newline *before* printing `p`.
* @param nl_after if true, print a newline *after* printing `p`; else a space.
* @return p on success, exception on failure.
*/
struct pso_pointer c_print( struct pso_pointer p, struct pso_pointer stream ) {
struct pso_pointer write( struct pso_pointer p, struct pso_pointer stream,
bool escape, bool nl_before, bool nl_after ) {
struct pso_pointer result = p;
URL_FILE *output = writep( stream )
? pointer_to_object( stream )->payload.stream.stream
@ -158,10 +184,38 @@ struct pso_pointer c_print( struct pso_pointer p, struct pso_pointer stream ) {
if ( writep( stream ) ) {
inc_ref( stream );
result = in_print( p, output );
if ( nl_before )
url_fputwc( L'\n', output );
result = in_write( p, output, true );
url_fputwc( nl_after ? L'\n' : L' ', output );
dec_ref( stream );
} else {
result =
make_exception( c_string_to_lisp_string
( L"Bad write stream passed to write." ), nil, nil,
nil );
}
return result;
}
/**
* @brief Simple print for bootstrap layer.
*
* @param p pointer to the object to print.
* @param stream if a pointer to an open write stream, print to there.
* @return struct pso_pointer `nil`, or an exception if some erroe occurred.
*/
struct pso_pointer c_print( struct pso_pointer p, struct pso_pointer stream ) {
return write( p, stream, true, true, false );
}
/**
* @brief princ is pretty much like print except things are printed `unescaped`
*/
struct pso_pointer c_princ( struct pso_pointer p, struct pso_pointer stream ) {
return write( p, stream, false, true, false );
}

9
src/c/io/print.h
View file

@ -13,10 +13,17 @@
#ifndef __psse_io_print_h
#define __psse_io_print_h
#include <stdbool.h>
#include "io/fopen.h"
struct pso_pointer c_print( struct pso_pointer p, struct pso_pointer stream );
struct pso_pointer c_princ( struct pso_pointer p, struct pso_pointer stream );
struct pso_pointer in_print( struct pso_pointer p, URL_FILE * output );
#define PRINT_VARIANT_PRINT 0
#define PRINT_VARIANT_PRIN1 1
#define PRINT_VARIANT_PRINC 2
struct pso_pointer in_write( struct pso_pointer p, URL_FILE * output,
bool variant );
#endif

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

@ -55,7 +55,7 @@ struct pso_pointer destroy( struct pso_pointer p ) {
destroy_string( f, nil );
break;
case STACKTV:
destroy_stack_frame( f, nil );
// destroy_stack_frame( f, nil );
break;
// TODO: others.
}

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

@ -14,7 +14,9 @@
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#include <math.h>
#include <stdbool.h>
#include <stdint.h>
#include <stdlib.h>
#include <string.h>
@ -92,10 +94,15 @@ struct pso_pointer allocate( char *tag, uint8_t size_class ) {
return result;
}
uint32_t payload_size( struct pso2 *object ) {
int payload_size( struct pso2 *object ) {
// TODO: Unit tests DEFINITELY needed!
return ( ( 1 << object->header.tag.bytes.size_class ) -
sizeof( struct pso_header ) );
int sc = object->header.tag.bytes.size_class;
int hs = sizeof( struct pso_header ) / sizeof( uint64_t );
int p = pow( 2, sc );
int result = abs( p - hs );
return result;
}
/**
@ -190,8 +197,8 @@ struct pso_pointer lock_object( struct pso_pointer pointer ) {
struct pso_pointer free_object( struct pso_pointer p ) {
struct pso_pointer result = nil;
struct pso2 *obj = pointer_to_object( p );
uint32_t array_size = payload_size( obj );
uint8_t size_class = obj->header.tag.bytes.size_class;
uint32_t array_size = ( uint32_t ) payload_size( obj );
uint8_t size_class = ( obj->header.tag.bytes.size_class );
result = destroy( p );

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

@ -41,7 +41,7 @@ bool c_eq( struct pso_pointer a, struct pso_pointer b ) {
}
bool c_equal( struct pso_pointer a, struct pso_pointer b ) {
bool result = false;
bool result = true;
if ( c_eq( a, b ) ) {
result = true;
@ -66,15 +66,19 @@ bool c_equal( struct pso_pointer a, struct pso_pointer b ) {
case KEYTV:
case STRINGTV:
case SYMBOLTV:
while ( !nilp( a ) && !nilp( b ) ) {
while ( result && !nilp( a ) && !nilp( b ) ) {
if ( pointer_to_object( a )->payload.string.character ==
pointer_to_object( b )->payload.string.character ) {
a = c_cdr( a );
b = c_cdr( b );
} else {
result = false;
}
}
result = nilp( a ) && nilp( b );
result = result && nilp( a ) && nilp( b );
break;
default:
result = false;
}
}

5
src/c/ops/repl.c
View file

@ -47,7 +47,7 @@ void int_handler( int dummy ) {
/**
* Very simple read/eval/print loop for bootstrapping.
*/
void c_repl( ) {
void c_repl( bool show_prompt ) {
signal( SIGINT, int_handler );
debug_print( L"Entered repl\n", DEBUG_REPL, 0 );
@ -68,6 +68,9 @@ void c_repl( ) {
while ( readp( input_stream ) &&
!url_feof( stream_get_url_file( input_stream ) ) ) {
if ( show_prompt )
c_princ( c_assoc( lisp_io_prompt, env ), output_stream );
/* bottom of stack */
struct pso_pointer frame_pointer = make_frame( 1, nil, input_stream );

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

@ -50,7 +50,7 @@ struct pso_pointer c_cons( struct pso_pointer car, struct pso_pointer cdr ) {
*/
struct pso_pointer c_car( struct pso_pointer cons ) {
struct pso_pointer result = nil;
struct pso2 *object = pointer_to_object( result );
struct pso2 *object = pointer_to_object( cons );
if ( consp( cons ) ) {
result = object->payload.cons.car;

14
src/c/psse.c
View file

@ -125,12 +125,16 @@ int main( int argc, char *argv[] ) {
exit( 1 );
}
c_print( c_cons( c_string_to_lisp_keyword( L"a" ),
( c_cons( c_string_to_lisp_keyword( L"b" ),
c_cons( c_string_to_lisp_keyword( L"c" ),
nil ) ) ) ), lisp_stdout );
if ( show_prompt ) {
fwprintf( stdout,
L"Post-scarcity Software Environment version %s\n'%s'\n\n",
VERSION, VERSION_CODENAME );
fputws
( L"Licensed under GPL version 2.0, or, at your option, any later version\n\n",
stdout );
}
// c_repl();
c_repl( show_prompt );
exit( 0 );
}

2
src/c/version.h
View file

@ -3,9 +3,9 @@
*
* Just the version number. There's DEFINITELY a better way to do this!
*
*
* (c) 2026 Simon Brooke <simon@journeyman.cc>
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#define VERSION "0.1.0-SNAPSHOT"
#define VERSION_CODENAME "A Momentary Lapse Of Sanity"