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

Investigating why symbols created by read are not equal to those created in C.

Browse source
This commit is contained in:
Simon Brooke 2026-05-06 09:16:46 +01:00
parent 1cfd333e26
commit cf655e8020
6 changed files with 67 additions and 123 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -42,9 +42,16 @@ struct pso_pointer search( struct pso_pointer key,
bool found = false;
#ifdef DEBUG
debug_print( L"In search; key is: ", DEBUG_BIND, 0 );
debug_print( L"In search; key is: `", DEBUG_BIND, 0 );
debug_print_object( key, DEBUG_BIND, 0 );
debug_println( DEBUG_BIND );
debug_print( L"`\n", DEBUG_BIND, 0 );
debug_print(L"", DEBUG_BIND, 2);
if (symbolp(key)) {
for ( struct pso_pointer cursor = key; !c_nilp(cursor); cursor = c_cdr(cursor)) {
wint_t c = pointer_to_object(cursor)->payload.string.character;
debug_printf( DEBUG_BIND, 0, L"[Character %lc (%d)]", c, c);
}
}
#endif
if ( consp( store ) ) {
@ -53,7 +60,17 @@ struct pso_pointer search( struct pso_pointer key,
struct pso_pointer pair = c_car( cursor );
#ifdef DEBUG
debug_print( L"Checking ", DEBUG_BIND, 2 );
debug_print_object( pair, DEBUG_BIND, 0 );
debug_print_object( c_car( pair), DEBUG_BIND, 0 );
debug_println( DEBUG_BIND);
debug_print(L"", DEBUG_BIND, 4);
if (symbolp(c_car( pair))) {
for ( struct pso_pointer cursor = c_car(pair); !c_nilp(cursor); cursor = c_cdr(cursor)) {
wint_t c = pointer_to_object(cursor)->payload.string.character;
debug_printf( DEBUG_BIND, 0, L"[Character %lc (%d)]", c, c);
}
}
debug_println(DEBUG_BIND);
#endif
if ( consp( pair ) && c_equal( c_car( pair ), key ) ) {

112
src/c/ops/eval_apply.c
View file

@ -45,112 +45,6 @@
#include "payloads/stack.h"
#include "payloads/symbol.h"
///**
// * @brief Apply a function to arguments in an environment.
// *
// * * (apply fn args)
// */
//struct pso_pointer apply( struct pso_pointer frame_pointer ) {
//
//// TODO.
//
//}
//
///**
// * @brief Evaluate a form, in an environment
// *
// * * (eval form)
// */
//struct pso_pointer eval( struct pso_pointer frame_pointer ) {
// struct pso4 *frame = pointer_to_pso4( frame_pointer );
//
// struct pso_pointer arg = fetch_arg( frame, 0 );
// struct pso_pointer result = nil;
//
// if ( !c_c_nilp( arg ) ) {
// switch ( get_tag_value( arg ) ) {
// // case CONSTV:
// // result = eval_cons( frame, frame_pointer, env);
// // break;
// case INTEGERTV:
// case KEYTV:
// case NILTV:
// case STRINGTV:
// // self evaluating
// result = nil;
// break;
// case SYMBOLTV:
// result = c_assoc( arg, fetch_env( frame_pointer ) );
// break;
// // case LAMBDATV:
// // result = eval_lambda( frame, frame_pointer, env);
// // break;
// // case NLAMBDATV:
// // result = eval_nlambda( frame, frame_pointer, env);
// // break;
// // case SPECIALTV:
// // result = eval_special( frame, frame_pointer, env);
// // break;
// default:
//#ifdef DEBUG
// struct pso2 *object = pointer_to_object( arg );
// debug_printf( DEBUG_EVAL, 0,
// L"Can't yet evaluate objects of type %3.3s\n",
// object->header.tag.bytes.mnemonic[0] );
// debug_print_object( arg, DEBUG_EVAL, 2 );
// debug_println( DEBUG_EVAL, 0 );
//#endif
// result = make_exception( make_frame( 1, frame_pointer,
// make_cons( frame_pointer,
// c_string_to_lisp_string
// ( frame_pointer,
// L"Can't yet evaluate things of this type: " ),
// arg ),
// make_cons( frame_pointer,
// make_cons
// ( frame_pointer,
// c_string_to_lisp_keyword
// ( frame_pointer,
// L"tag" ),
// get_tag_string
// ( frame_pointer,
// arg ) ),
// nil ), nil ) );
// }
// }
//
// if ( exceptionp( result ) ) {
// struct pso3 *x =
// ( struct pso3 * ) pointer_to_object_with_tag_value( result,
// EXCEPTIONTV );
//
// if ( c_c_nilp( x->payload.exception.stack ) ) {
// x->payload.exception.stack = frame_pointer;
// }
// }
//
// return result;
//}
/*
* lispops.c
*
* List processing operations.
*
* The general idea here is that a list processing operation is a
* function which takes two arguments, both pso_pointers:
*
* 1. args, the argument list to this function;
* 2. env, the environment in which this function should be evaluated;
*
* and returns a pso_pointer, the result.
*
* They must all have the same signature so that I can call them as
* function pointers.
*
* (c) 2017 Simon Brooke <simon@journeyman.cc>
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
/**
* Useful building block; evaluate this single form in the context of this
* parent stack frame and this environment.
@ -779,6 +673,12 @@ lisp_eval( struct pso_pointer frame_pointer ) {
case SYMBOLTV:
{
#ifdef DEBUG
debug_print( L"\nEvaluating symbol `", DEBUG_EVAL, 0);
debug_print_object( fetch_arg( frame, 0), DEBUG_EVAL, 0);
debug_print( L"`\n\tEnvironment is: ", DEBUG_EVAL, 0);
debug_dump_object( fetch_env(frame_pointer), DEBUG_EVAL, 0);
#endif
struct pso_pointer canonical =
c_interned( frame->payload.stack_frame.arg[0], fetch_env(frame_pointer) );
if ( c_nilp( canonical ) ) {

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

@ -172,7 +172,6 @@ char *lisp_string_to_c_string( struct pso_pointer s ) {
return result;
}
/**
* Return a lisp symbol representation of this wide character string. In
* symbols, I am accepting only lower case characters and certain punctuation.
@ -182,9 +181,9 @@ struct pso_pointer c_string_to_lisp_symbol( struct pso_pointer frame_pointer,
struct pso_pointer result = nil;
for ( int i = wcslen( symbol ) - 1; i >= 0; i-- ) {
char32_t c = towlower( symbol[i] );
char32_t c = symbol[i];
if ( iswalpha( c ) || wcschr(L"-*|!?", c)) {
if ( symbol_char_p(c)) {
result = make_symbol( frame_pointer, c, result );
}
}