Still doesn't compile, but I think excellent progress.
This commit is contained in:
parent
dbeb99759a
commit
aac4669a3d
34 changed files with 1128 additions and 673 deletions
|
|
@ -35,3 +35,4 @@ struct pso_pointer lisp_bind( struct pso_pointer frame_pointer ) {
|
|||
|
||||
return cons( make_frame( 2, frame_pointer, binding, store ) );
|
||||
}
|
||||
|
||||
|
|
|
|||
114
src/c/ops/cond.c
Normal file
114
src/c/ops/cond.c
Normal file
|
|
@ -0,0 +1,114 @@
|
|||
|
||||
/**
|
||||
* @brief evaluate a single cond clause; if the test part succeeds return a
|
||||
* pair whose car is t and whose cdr is the value of the action part
|
||||
*/
|
||||
#include "debug.h"
|
||||
|
||||
#include "memory/node.h"
|
||||
#include "memory/pointer.h"
|
||||
#include "memory/pso2.h"
|
||||
#include "memory/tags.h"
|
||||
|
||||
#include "ops/progn.h"
|
||||
#include "ops/stack_ops.h"
|
||||
#include "ops/truth.h"
|
||||
|
||||
#include "payloads/cons.h"
|
||||
#include "payloads/exception.h"
|
||||
|
||||
/**
|
||||
* if the car of a consp evaluates to non-nil, the clause succeeded and the
|
||||
* cond expression must conclude, even if the result of the clause is nil.
|
||||
*
|
||||
* Therefore this funtion will
|
||||
* @return nil if the test failed;
|
||||
* @return a pair `(t . <value>)` if the test succeeded.
|
||||
*/
|
||||
struct pso_pointer eval_cond_clause( struct pso_pointer clause,
|
||||
struct pso4 *frame,
|
||||
struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env ) {
|
||||
struct pso_pointer result = nil;
|
||||
|
||||
#ifdef DEBUG
|
||||
debug_print( L"\n\tCond clause: ", DEBUG_EVAL, 0 );
|
||||
debug_print_object( clause, DEBUG_EVAL, 0 );
|
||||
debug_println( DEBUG_EVAL);
|
||||
#endif
|
||||
|
||||
if ( consp( clause ) ) {
|
||||
struct pso_pointer val =
|
||||
eval_form( frame, frame_pointer, c_car( clause ),
|
||||
env );
|
||||
|
||||
if ( !c_nilp( val ) ) {
|
||||
result =
|
||||
cons( t,
|
||||
c_progn( frame, frame_pointer, c_cdr( clause ), env ) );
|
||||
|
||||
#ifdef DEBUG
|
||||
debug_print( L"\n\t\tCond clause ", DEBUG_EVAL, 0 );
|
||||
debug_print_object( clause, DEBUG_EVAL, 0 );
|
||||
debug_print( L" succeeded; returning: ", DEBUG_EVAL, 0 );
|
||||
debug_print_object( result, DEBUG_EVAL, 0 );
|
||||
debug_println( DEBUG_EVAL);
|
||||
} else {
|
||||
debug_print( L"\n\t\tCond clause ", DEBUG_EVAL, 0 );
|
||||
debug_print_object( clause, DEBUG_EVAL, 0 );
|
||||
debug_print( L" failed.\n", DEBUG_EVAL, 0 );
|
||||
#endif
|
||||
}
|
||||
} else {
|
||||
result = throw_exception( c_string_to_lisp_symbol( frame_pointer, L"cond" ),
|
||||
c_string_to_lisp_string
|
||||
(frame_pointer, L"Arguments to `cond` must be lists" ),
|
||||
frame_pointer );
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
/**
|
||||
* Special form: conditional. Each `clause` is expected to be a list; if the first
|
||||
* item in such a list evaluates to non-nil, the remaining items in that list
|
||||
* are evaluated in turn and the value of the last returned. If no arg `clause`
|
||||
* has a first element which evaluates to non nil, then nil is returned.
|
||||
*
|
||||
* * (cond clauses...)
|
||||
*
|
||||
* @param frame my stack frame.
|
||||
* @param frame_pointer a pointer to my pso4.
|
||||
* @param env the environment in which arguments will be evaluated.
|
||||
* @return the value of the last expression of the first successful `clause`.
|
||||
*/
|
||||
struct pso_pointer
|
||||
lisp_cond( struct pso4 *frame, struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env ) {
|
||||
struct pso_pointer result = nil;
|
||||
bool done = false;
|
||||
|
||||
for ( int i = 0; ( i < frame->payload.stack_frame.args ) && !done; i++ ) {
|
||||
struct pso_pointer clause_pointer = fetch_arg( frame, i );
|
||||
|
||||
// TODO: WHOOPS! This isn't right. If the test of a cond clause
|
||||
// evaluates to non-nil, but the last form of the clause evaluates
|
||||
// to nil, the form still succeeded and we should still exit `cond`.
|
||||
//
|
||||
|
||||
result = eval_cond_clause( clause_pointer, frame, frame_pointer, env );
|
||||
|
||||
if ( !c_nilp( result ) && c_truep( c_car( result ) ) ) {
|
||||
result = c_cdr( result );
|
||||
done = true;
|
||||
break;
|
||||
}
|
||||
}
|
||||
#ifdef DEBUG
|
||||
debug_print( L"\tCond returning: ", DEBUG_EVAL, 0 );
|
||||
debug_print_object( result, DEBUG_EVAL, 0 );
|
||||
debug_println( DEBUG_EVAL);
|
||||
#endif
|
||||
|
||||
return result;
|
||||
}
|
||||
140
src/c/ops/dump.c
Normal file
140
src/c/ops/dump.c
Normal file
|
|
@ -0,0 +1,140 @@
|
|||
/*
|
||||
* dump.c
|
||||
*
|
||||
* Dump representations of both cons space and vector space objects.
|
||||
*
|
||||
*
|
||||
* (c) 2018 Simon Brooke <simon@journeyman.cc>
|
||||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
/*
|
||||
* wide characters
|
||||
*/
|
||||
#include <wchar.h>
|
||||
#include <wctype.h>
|
||||
|
||||
#include "memory/pso2.h"
|
||||
#include "memory/tags.h"
|
||||
#include "io/print.h"
|
||||
|
||||
#include "payloads/lambda.h"
|
||||
|
||||
|
||||
void dump_string_cell( URL_FILE *output, wchar_t *prefix,
|
||||
struct pso_pointer pointer ) {
|
||||
struct pso2 *cell = pointer_to_object( pointer );
|
||||
if ( cell->payload.string.character == 0 ) {
|
||||
url_fwprintf( output,
|
||||
L"\t\t%ls cell: termination; next at page %d offset %d, count %u\n",
|
||||
prefix,
|
||||
cell->payload.string.cdr.page,
|
||||
cell->payload.string.cdr.offset, cell->header.count );
|
||||
} else {
|
||||
url_fwprintf( output,
|
||||
L"\t\t%ls cell: character '%lc' (%d) with hash %d; next at page %d offset %d, count %u\n",
|
||||
prefix,
|
||||
( wint_t ) cell->payload.string.character,
|
||||
cell->payload.string.character,
|
||||
cell->payload.string.hash,
|
||||
cell->payload.string.cdr.page,
|
||||
cell->payload.string.cdr.offset, cell->header.count );
|
||||
url_fwprintf( output, L"\t\t value: " );
|
||||
print( output, pointer );
|
||||
url_fwprintf( output, L"\n" );
|
||||
}
|
||||
}
|
||||
|
||||
/**
|
||||
* dump the object at this pso_pointer to this output stream.
|
||||
*/
|
||||
void dump_object( URL_FILE *output, struct pso_pointer pointer ) {
|
||||
struct pso2 *cell = pointer_to_object( pointer );
|
||||
url_fwprintf( output, L"\t%3.3s (%d) at page %d, offset %d count %u\n",
|
||||
cell->header.tag.bytes.mnemonic[0], get_tag_value( pointer ),
|
||||
pointer.page, pointer.offset, cell->header.count );
|
||||
|
||||
switch ( get_tag_value( pointer ) ) {
|
||||
case CONSTV:
|
||||
url_fwprintf( output,
|
||||
L"\t\tCons cell: car at page %d offset %d, cdr at page %d "
|
||||
L"offset %d, count %u :",
|
||||
cell->payload.cons.car.page,
|
||||
cell->payload.cons.car.offset,
|
||||
cell->payload.cons.cdr.page,
|
||||
cell->payload.cons.cdr.offset );
|
||||
print( output, pointer );
|
||||
url_fputws( L"\n", output );
|
||||
break;
|
||||
case EXCEPTIONTV:
|
||||
url_fwprintf( output, L"\t\tException cell: " );
|
||||
dump_stack_trace( output, pointer );
|
||||
break;
|
||||
case FREETV:
|
||||
url_fwprintf( output,
|
||||
L"\t\tFree cell: next at page %d offset %d\n",
|
||||
cell->payload.cons.cdr.page,
|
||||
cell->payload.cons.cdr.offset );
|
||||
break;
|
||||
case HASHTV:
|
||||
dump_map( output, pointer );
|
||||
break;
|
||||
case INTEGERTV:
|
||||
url_fwprintf( output, L"\t\tInteger cell: value %ld, count %u\n",
|
||||
cell->payload.integer.value, cell->header.count );
|
||||
break;
|
||||
case KEYTV:
|
||||
dump_string_cell( output, L"Keyword", pointer );
|
||||
break;
|
||||
case LAMBDATV:
|
||||
url_fwprintf( output, L"\t\t\u03bb cell;\n\t\t args: " );
|
||||
print( output, cell->payload.lambda.args );
|
||||
url_fwprintf( output, L";\n\t\t\tbody: " );
|
||||
print( output, cell->payload.lambda.body );
|
||||
url_fputws( L"\n", output );
|
||||
break;
|
||||
case NILTV:
|
||||
break;
|
||||
case NLAMBDATV:
|
||||
url_fwprintf( output, L"\t\tn\u03bb cell; \n\t\targs: " );
|
||||
print( output, cell->payload.lambda.args );
|
||||
url_fwprintf( output, L";\n\t\t\tbody: " );
|
||||
print( output, cell->payload.lambda.body );
|
||||
url_fputws( L"\n", output );
|
||||
break;
|
||||
case RATIOTV:
|
||||
url_fwprintf( output,
|
||||
L"\t\tRational cell: value %ld/%ld, count %u\n",
|
||||
pointer_to_object( cell->payload.ratio.
|
||||
dividend ).payload.integer.value,
|
||||
pointer_to_object( cell->payload.ratio.
|
||||
divisor ).payload.integer.value,
|
||||
cell->header.count );
|
||||
break;
|
||||
case READTV:
|
||||
url_fputws( L"\t\tInput stream; metadata: ", output );
|
||||
print( output, cell->payload.stream.meta );
|
||||
url_fputws( L"\n", output );
|
||||
break;
|
||||
case REALTV:
|
||||
url_fwprintf( output, L"\t\tReal cell: value %Lf, count %u\n",
|
||||
cell->payload.real.value, cell->header.count );
|
||||
break;
|
||||
case STACKTV:
|
||||
dump_frame( output, pointer );
|
||||
break;
|
||||
case STRINGTV:
|
||||
dump_string_cell( output, L"String", pointer );
|
||||
break;
|
||||
case SYMBOLTV:
|
||||
dump_string_cell( output, L"Symbol", pointer );
|
||||
break;
|
||||
case TRUETV:
|
||||
break;
|
||||
case WRITETV:
|
||||
url_fputws( L"\t\tOutput stream; metadata: ", output );
|
||||
print( output, cell->payload.stream.meta );
|
||||
url_fputws( L"\n", output );
|
||||
break;
|
||||
}
|
||||
}
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -17,10 +17,10 @@
|
|||
#include "memory/pso4.h"
|
||||
#include "payloads/function.h"
|
||||
|
||||
struct pso_pointer apply( struct pso_pointer frame_pointer );
|
||||
struct pso_pointer lisp_apply( struct pso_pointer frame_pointer );
|
||||
|
||||
|
||||
struct pso_pointer eval( struct pso_pointer frame_pointer );
|
||||
struct pso_pointer lisp_eval( struct pso_pointer frame_pointer );
|
||||
|
||||
|
||||
#endif
|
||||
|
|
|
|||
64
src/c/ops/inspect.c
Normal file
64
src/c/ops/inspect.c
Normal file
|
|
@ -0,0 +1,64 @@
|
|||
/**
|
||||
* inspect.c
|
||||
*
|
||||
* Post Scarcity Soctware Environment
|
||||
*
|
||||
* Display the contents of an object; later, in explorable form.
|
||||
*
|
||||
* Copyright (c): 25 Apr 2026 Simon Brooke <simon@journeyman.cc>
|
||||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
#include "debug.h"
|
||||
#include "io/fopen.h"
|
||||
#include "io/io.h"
|
||||
#include "memory/node.h"
|
||||
#include "memory/pointer.h"
|
||||
#include "memory/pso2.h"
|
||||
#include "memory/pso4.h"
|
||||
#include "memory/tags.h"
|
||||
#include "ops/stack_ops.h"
|
||||
|
||||
/**
|
||||
* Function: dump/inspect one complete lisp expression and return nil. If
|
||||
* write-stream is specified and is a write stream, then print to that stream,
|
||||
* else the stream which is the value of
|
||||
* `*out*` in the environment.
|
||||
*
|
||||
* * (inspect expr)
|
||||
* * (inspect expr write-stream)
|
||||
*
|
||||
* TODO: IT OCCURS TO ME that if `inspect` returns a Markdown formatted string
|
||||
* then it will be readable right away, but wrappable in a browser later to
|
||||
* allow interactive exploration.
|
||||
*
|
||||
* @param frame my pso4.
|
||||
* @param frame_pointer a pointer to my pso4.
|
||||
* @param env my environment (from which the stream may be extracted).
|
||||
* @return nil.
|
||||
*/
|
||||
struct pso_pointer lisp_inspect(struct pso_pointer frame_pointer) {
|
||||
debug_print( L"Entering lisp_inspect\n", DEBUG_IO, 0 );
|
||||
struct pso_pointer result = nil;
|
||||
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
|
||||
struct pso_pointer out_stream = writep( frame->payload.stack_frame.arg[1] )
|
||||
? frame->payload.stack_frame.arg[1]
|
||||
: get_default_stream( false, fetch_env( frame_pointer ) );
|
||||
URL_FILE *output;
|
||||
|
||||
if ( writep( out_stream ) ) {
|
||||
debug_print( L"lisp_inspect: setting output stream\n", DEBUG_IO, 0 );
|
||||
debug_dump_object( out_stream, DEBUG_IO );
|
||||
output = pointer_to_object( out_stream )->payload.stream.stream;
|
||||
} else {
|
||||
output = file_to_url_file( stderr );
|
||||
}
|
||||
|
||||
dump_object( output, frame->payload.stack_frame.arg[0] );
|
||||
|
||||
debug_print( L"Leaving lisp_inspect", DEBUG_IO, 0 );
|
||||
|
||||
return result;
|
||||
}
|
||||
16
src/c/ops/inspect.h
Normal file
16
src/c/ops/inspect.h
Normal file
|
|
@ -0,0 +1,16 @@
|
|||
/**
|
||||
* inspect.h
|
||||
*
|
||||
* Post Scarcity Soctware Environment
|
||||
*
|
||||
* Display the contents of an object; later, in explorable form.
|
||||
*
|
||||
* Copyright (c): 25 Apr 2026 Simon Brooke <simon@journeyman.cc>
|
||||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
#ifndef psse_ops_inspect
|
||||
#define psse_ops_inspect
|
||||
|
||||
struct pso_pointer lisp_inspect( struct pso_pointer frame_pointer );
|
||||
#endif
|
||||
49
src/c/ops/keys.c
Normal file
49
src/c/ops/keys.c
Normal file
|
|
@ -0,0 +1,49 @@
|
|||
/**
|
||||
* ops/keys.c
|
||||
*
|
||||
* Post Scarcity Software Environment: eval and apply.
|
||||
*
|
||||
* keys: return an unsorted list of the keys bound in a store.
|
||||
*
|
||||
* (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/tags.h"
|
||||
#include "ops/truth.h"
|
||||
#include "payloads/cons.h"
|
||||
|
||||
/**
|
||||
* @brief an implementation of `keys` convenient for calling from C
|
||||
*
|
||||
* @param */
|
||||
struct pso_pointer c_keys( struct pso_pointer store ) {
|
||||
struct pso_pointer result = nil;
|
||||
|
||||
if ( consp( store ) ) {
|
||||
for ( struct pso_pointer pair = c_car( store ); !c_nilp( pair );
|
||||
pair = c_car( store ) ) {
|
||||
if ( consp( pair ) ) {
|
||||
result = cons( c_car( pair ), result );
|
||||
// } else if ( hashtabp( pair ) ) {
|
||||
// result = c_append( hashmap_keys( pair ), result );
|
||||
}
|
||||
|
||||
store = c_cdr( store );
|
||||
}
|
||||
// } else if ( hashtabp( store ) ) {
|
||||
// result = hashmap_keys( store );
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
|
||||
|
||||
struct pso_pointer lisp_keys( struct pso_pointer frame_pointer) {
|
||||
return c_keys( pointer_to_pso4(frame_pointer)->payload.stack_frame.arg[0] );
|
||||
}
|
||||
|
||||
19
src/c/ops/keys.h
Normal file
19
src/c/ops/keys.h
Normal file
|
|
@ -0,0 +1,19 @@
|
|||
/**
|
||||
* ops/keys.h
|
||||
*
|
||||
* Post Scarcity Software Environment: keys.
|
||||
*
|
||||
* keys: return an unsorted list of the keys bound in a store.
|
||||
*
|
||||
* (c) 2026 Simon Brooke <simon@journeyman.cc>
|
||||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
#ifndef psse_ops_keys
|
||||
#define psse_ops_keys
|
||||
|
||||
struct pso_pointer c_keys( struct pso_pointer store );
|
||||
|
||||
struct pso_pointer lisp_keys(struct pso_pointer frame_pointer);
|
||||
|
||||
#endif
|
||||
|
|
@ -13,20 +13,24 @@
|
|||
#include "memory/pso4.h"
|
||||
|
||||
#include "ops/stack_ops.h"
|
||||
|
||||
#include "payloads/cons.h"
|
||||
#include "payloads/integer.h"
|
||||
#include "payloads/stack.h"
|
||||
|
||||
#include "ops/truth.h"
|
||||
|
||||
struct pso_pointer length( struct pso_pointer frame_pointer ) {
|
||||
struct pso_pointer count( struct pso_pointer frame_pointer ) {
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
|
||||
struct pso_pointer list = fetch_arg( frame, 0 );
|
||||
int count = 0;
|
||||
int c = 0;
|
||||
|
||||
for ( struct pso_pointer cursor = list; !c_nilp( cursor );
|
||||
cursor = cdr( make_frame( 1, frame_pointer, list ) ) ) {
|
||||
count++;
|
||||
cursor = c_cdr( cursor ) ) {
|
||||
c++;
|
||||
}
|
||||
|
||||
return make_integer( frame_pointer, count );
|
||||
return acquire_integer( frame_pointer, c );
|
||||
}
|
||||
|
||||
|
|
|
|||
62
src/c/ops/mapcar.c
Normal file
62
src/c/ops/mapcar.c
Normal file
|
|
@ -0,0 +1,62 @@
|
|||
/**
|
||||
* ops/mapcar.c
|
||||
*
|
||||
* Post Scarcity Software Environment: mapcar.
|
||||
*
|
||||
* map a function across a sequence of forms.
|
||||
*
|
||||
* (c) 2026 Simon Brooke <simon@journeyman.cc>
|
||||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
|
||||
#include "debug.h"
|
||||
#include "memory/node.h"
|
||||
#include "memory/pointer.h"
|
||||
#include "memory/pso.h"
|
||||
#include "memory/tags.h"
|
||||
#include "ops/reverse.h"
|
||||
#include "ops/truth.h"
|
||||
#include "payloads/cons.h"
|
||||
|
||||
struct pso_pointer lisp_mapcar( struct pso4 *frame,
|
||||
struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env ) {
|
||||
struct pso_pointer result = nil;
|
||||
debug_print( U"Mapcar: ", DEBUG_EVAL, 0 );
|
||||
debug_dump_object( frame_pointer, DEBUG_EVAL, 0 );
|
||||
int i = 0;
|
||||
|
||||
for ( struct pso_pointer c = frame->payload.stack_frame.arg[1]; c_truep( c );
|
||||
c = c_cdr( c ) ) {
|
||||
struct pso_pointer expr =
|
||||
cons( frame->payload.stack_frame.arg[0], cons( c_car( c ), nil ) );
|
||||
|
||||
debug_printf( DEBUG_EVAL, 0, U"Mapcar %d, evaluating ", i );
|
||||
debug_print_object( expr, DEBUG_EVAL, 0 );
|
||||
debug_println( DEBUG_EVAL, 0 );
|
||||
|
||||
struct pso_pointer r = eval_form( frame, frame_pointer, expr, env );
|
||||
|
||||
if ( exceptionp( r ) ) {
|
||||
result = r;
|
||||
inc_ref( expr ); // to protect exception from the later dec_ref
|
||||
break;
|
||||
} else {
|
||||
result = cons( r, result );
|
||||
}
|
||||
debug_printf( DEBUG_EVAL, 0, U"Mapcar %d, result is ", i++ );
|
||||
debug_print_object( result, DEBUG_EVAL, 0 );
|
||||
debug_println( DEBUG_EVAL);
|
||||
|
||||
dec_ref( expr );
|
||||
}
|
||||
|
||||
result = consp( result ) ? c_reverse( result ) : result;
|
||||
|
||||
debug_print( U"Mapcar returning: ", DEBUG_EVAL, 0 );
|
||||
debug_print_object( result, DEBUG_EVAL, 0 );
|
||||
debug_println( DEBUG_EVAL );
|
||||
|
||||
return result;
|
||||
}
|
||||
0
src/c/ops/mapcar.h
Normal file
0
src/c/ops/mapcar.h
Normal file
84
src/c/ops/progn.c
Normal file
84
src/c/ops/progn.c
Normal file
|
|
@ -0,0 +1,84 @@
|
|||
/**
|
||||
* ops/progn.c
|
||||
*
|
||||
* Post Scarcity Software Environment: progn.
|
||||
*
|
||||
* Evaluate a sequence of expressions and return the value of the last.
|
||||
*
|
||||
* (c) 2026 Simon Brooke <simon@journeyman.cc>
|
||||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
#include <stdbool.h>
|
||||
|
||||
#include "memory/node.h"
|
||||
#include "memory/pointer.h"
|
||||
#include "memory/pso4.h"
|
||||
#include "memory/tags.h"
|
||||
|
||||
#include "ops/eval_apply.h"
|
||||
#include "ops/stack_ops.h"
|
||||
|
||||
#include "payloads/cons.h"
|
||||
#include "payloads/stack.h"
|
||||
|
||||
|
||||
/**
|
||||
* Evaluate each of these expressions in this `env`ironment over this `frame`,
|
||||
* returning only the value of the last.
|
||||
*/
|
||||
struct pso_pointer
|
||||
c_progn( struct pso4 *frame, struct pso_pointer frame_pointer,
|
||||
struct pso_pointer expressions, struct pso_pointer env ) {
|
||||
struct pso_pointer result = nil;
|
||||
struct pso_pointer next_pointer =
|
||||
push_local(frame_pointer, make_frame(1, frame_pointer, nil));
|
||||
struct pso4 *next_frame = pointer_to_pso4(next_pointer);
|
||||
|
||||
while ( consp( expressions ) ) {
|
||||
next_frame->payload.stack_frame.arg[0] = c_car(expressions);
|
||||
|
||||
result = lisp_eval( next_pointer);
|
||||
|
||||
expressions = exceptionp( result ) ? nil : c_cdr( expressions );
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
|
||||
/**
|
||||
* Special form; evaluate the expressions which are listed in my arguments
|
||||
* sequentially and return the value of the last. This function is called 'do'
|
||||
* in some dialects of Lisp.
|
||||
*
|
||||
* * (progn expressions...)
|
||||
*
|
||||
* @param frame my stack frame.
|
||||
* @param frame_pointer a pointer to my pso4.
|
||||
* @param env the environment in which expressions are evaluated.
|
||||
* @return the value of the last `expression` of the sequence which is my single
|
||||
* argument.
|
||||
*/
|
||||
struct pso_pointer
|
||||
lisp_progn( struct pso_pointer frame_pointer) {
|
||||
struct pso_pointer result = nil;
|
||||
struct pso4 *frame = pointer_to_pso4(frame_pointer);
|
||||
struct pso_pointer next_pointer =
|
||||
push_local(frame_pointer, make_frame(1, frame_pointer, nil));
|
||||
struct pso4 *next_frame = pointer_to_pso4(next_pointer);
|
||||
|
||||
for (int i = 0; i < args_in_frame; i++) {
|
||||
next_frame->payload.stack_frame.arg[0] =
|
||||
frame->payload.stack_frame.arg[i];
|
||||
|
||||
result = push_local(frame_pointer, lisp_eval(next_pointer));
|
||||
}
|
||||
|
||||
if (consp(frame->payload.stack_frame.more)) {
|
||||
result =
|
||||
c_progn(frame, frame_pointer, frame->payload.stack_frame.more, env);
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
23
src/c/ops/progn.h
Normal file
23
src/c/ops/progn.h
Normal file
|
|
@ -0,0 +1,23 @@
|
|||
/**
|
||||
* ops/progn.c
|
||||
*
|
||||
* Post Scarcity Software Environment: progn.
|
||||
*
|
||||
* Evaluate a sequence of expressions and return the value of the last.
|
||||
*
|
||||
* (c) 2026 Simon Brooke <simon@journeyman.cc>
|
||||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
#ifndef __psse_ops_progn_h
|
||||
#define __psse_ops_progn_h
|
||||
|
||||
#include "memory/pointer.h"
|
||||
#include "memory/pso4.h"
|
||||
|
||||
struct pso_pointer c_progn(struct pso4 *frame, struct pso_pointer frame_pointer,
|
||||
struct pso_pointer expressions,
|
||||
struct pso_pointer env);
|
||||
|
||||
struct pso_pointer lisp_progn(struct pso_pointer frame_pointer);
|
||||
#endif
|
||||
|
|
@ -26,6 +26,7 @@
|
|||
#include "ops/truth.h"
|
||||
|
||||
#include "payloads/exception.h"
|
||||
#include "payloads/symbol.h"
|
||||
|
||||
|
||||
/**
|
||||
|
|
@ -100,45 +101,6 @@ struct pso_pointer make_string_like_thing( struct pso_pointer frame_pointer,
|
|||
return pointer;
|
||||
}
|
||||
|
||||
/**
|
||||
* Construct a string from the character `c` and this `tail`. A string is
|
||||
* implemented as a flat list of cells each of which has one character and a
|
||||
* pointer to the next; in the last cell the pointer to next is NIL.
|
||||
*
|
||||
* @param c the character to add (prepend);
|
||||
* @param tail the string which is being built.
|
||||
*/
|
||||
struct pso_pointer make_string( struct pso_pointer frame_pointer, wint_t c,
|
||||
struct pso_pointer tail ) {
|
||||
return make_string_like_thing( frame_pointer, c, tail, STRINGTAG );
|
||||
}
|
||||
|
||||
/**
|
||||
* Construct a keyword from the character `c` and this `tail`. A string is
|
||||
* implemented as a flat list of cells each of which has one character and a
|
||||
* pointer to the next; in the last cell the pointer to next is NIL.
|
||||
*
|
||||
* @param c the character to add (prepend);
|
||||
* @param tail the keyword which is being built.
|
||||
*/
|
||||
struct pso_pointer make_keyword( struct pso_pointer frame_pointer, wint_t c,
|
||||
struct pso_pointer tail ) {
|
||||
return make_string_like_thing( frame_pointer, c, tail, KEYTAG );
|
||||
}
|
||||
|
||||
/**
|
||||
* Construct a symbol from the character `c` and this `tail`. A string is
|
||||
* implemented as a flat list of cells each of which has one character and a
|
||||
* pointer to the next; in the last cell the pointer to next is NIL.
|
||||
*
|
||||
* @param c the character to add (prepend);
|
||||
* @param tail the symbol which is being built.
|
||||
*/
|
||||
struct pso_pointer make_symbol( struct pso_pointer frame_pointer, wint_t c,
|
||||
struct pso_pointer tail ) {
|
||||
return make_string_like_thing( frame_pointer, c, tail, SYMBOLTAG );
|
||||
}
|
||||
|
||||
|
||||
/**
|
||||
* Return a lisp string representation of this wide character string.
|
||||
|
|
@ -245,3 +207,15 @@ struct pso_pointer c_string_to_lisp_keyword( struct pso_pointer frame_pointer,
|
|||
|
||||
return result;
|
||||
}
|
||||
|
||||
|
||||
/**
|
||||
* @return t if `arg` represents an end of string, else false.
|
||||
* \todo candidate for moving to a memory/string.c file
|
||||
*/
|
||||
bool end_of_stringp( struct pso_pointer arg ) {
|
||||
return c_nilp( arg ) ||
|
||||
( stringp( arg ) &&
|
||||
pointer_to_object( arg )->payload.string.character ==
|
||||
( wint_t ) '\0' );
|
||||
}
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@
|
|||
|
||||
#ifndef __psse_ops_string_ops_h
|
||||
#define __psse_ops_string_ops_h
|
||||
|
||||
#include <stdbool.h>
|
||||
/*
|
||||
* wide characters
|
||||
*/
|
||||
|
|
@ -21,15 +21,6 @@ struct pso_pointer make_string_like_thing( struct pso_pointer frame_pointer,
|
|||
wint_t c, struct pso_pointer tail,
|
||||
char *tag );
|
||||
|
||||
struct pso_pointer make_string( struct pso_pointer frame_pointer, wint_t c,
|
||||
struct pso_pointer tail );
|
||||
|
||||
struct pso_pointer make_keyword( struct pso_pointer frame_pointer, wint_t c,
|
||||
struct pso_pointer tail );
|
||||
|
||||
struct pso_pointer make_symbol( struct pso_pointer frame_pointer, wint_t c,
|
||||
struct pso_pointer tail );
|
||||
|
||||
struct pso_pointer c_string_to_lisp_string( struct pso_pointer frame_pointer,
|
||||
wchar_t *string );
|
||||
char *lisp_string_to_c_string( struct pso_pointer s );
|
||||
|
|
@ -41,4 +32,6 @@ struct pso_pointer c_string_to_lisp_keyword( struct pso_pointer frame_pointer,
|
|||
struct pso_pointer c_string_to_lisp_symbol( struct pso_pointer frame_pointer,
|
||||
char32_t * symbol );
|
||||
|
||||
bool end_of_stringp(struct pso_pointer arg);
|
||||
|
||||
#endif
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue