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

src/c/environment/function_bindings.c

@@ -177,13 +177,13 @@ struct function_data function_initialisers[] = {
 	 U"return that expression unevaluated.",
 	 &read},
 	{U"read-character",
-	 U"(read_character stream): read a single character from `stream` and "
+	 U"(read-character stream): read a single character from `stream` and "
 	 U"return it.",
 	 &read_character},
-	{U"read_number",
+	{U"read-number",
 	 U"(read-number stream): read a number from `stream` and return it.",
 	 &read_number},
-	{U"read_symbol",
+	{U"read-symbol",
 	 U"(read-symbol stream): read a symbol from `stream` and return it.",
 	 &read_symbol},
 #endif
@@ -318,16 +318,18 @@ initialise_function_bindings(struct pso_pointer frame_pointer) {
 	struct pso_pointer result = fetch_env(frame_pointer);
 
 	for (int i = 0; function_initialisers[i].executable != NULL; i++) {
-		result = bind_function(push_local(frame_pointer, make_frame_with_env(0, frame_pointer, result)),
+		struct pso_pointer b = c_car( bind_function( frame_pointer,
 							   function_initialisers[i].name,
 							   function_initialisers[i].documentation,
-							   function_initialisers[i].executable);
+							   function_initialisers[i].executable));
+		result = make_cons( frame_pointer, b, result);
 	}
 	for (int i = 0; special_initialisers[i].executable != NULL; i++) {
-		result = bind_function(push_local( frame_pointer, make_frame_with_env(0, frame_pointer, result)),
+		struct pso_pointer b = c_car( bind_special( frame_pointer,
 							   special_initialisers[i].name,
 							   special_initialisers[i].documentation,
-							   special_initialisers[i].executable);
+							   special_initialisers[i].executable));
+		result = make_cons( frame_pointer, b, result);
 	}
 
 	return result;

src/c/io/read.c

@@ -33,10 +33,12 @@
 #include "memory/tags.h"
 
 #include "payloads/character.h"
+#include "payloads/cons.h"
 #include "payloads/exception.h"
 #include "payloads/function.h"
 #include "payloads/integer.h"
 #include "payloads/read_stream.h"
+#include "payloads/symbol.h"
 
 #include "ops/assoc.h"
 #include "ops/reverse.h"
@@ -150,6 +152,9 @@ struct pso_pointer read_number( struct pso_pointer frame_pointer ) {
         url_ungetwc( c, input );
         result = make_integer( frame_pointer, value );
     }                           // else exception?
+#ifdef DEBUG
+        debug_printf( DEBUG_IO, 0, L"\nRead number %ld\n", value );
+#endif
 
     return result;
 }
@@ -171,7 +176,7 @@ struct pso_pointer read_symbol( struct pso_pointer frame_pointer ) {
             ? 0 : 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 ( ; symbol_char_p( c ); c = url_fgetwc( input ) ) {
             result =
                 make_string_like_thing( frame_pointer, c, result, SYMBOLTAG );
         }
@@ -180,6 +185,17 @@ struct pso_pointer read_symbol( struct pso_pointer frame_pointer ) {
         result = c_reverse( frame_pointer, result );
     }
 
+#ifdef DEBUG
+        debug_print( L"\nRead symbol `", DEBUG_IO, 0 );
+        debug_print_object( result, DEBUG_IO, 0);
+        debug_print( L"`\n\t", DEBUG_IO, 0);
+        for ( struct pso_pointer cursor = result; !c_nilp(cursor); cursor = c_cdr(cursor)) {
+            wint_t c = pointer_to_object(cursor)->payload.string.character;
+            debug_printf( DEBUG_IO, 0, L"[Character %lc (%d)]", c, c);
+        }
+        debug_println(DEBUG_IO);
+#endif
+
     return result;
 }
 
@@ -244,7 +260,7 @@ struct pso_pointer read( struct pso_pointer frame_pointer ) {
                 inc_ref( next );
                 if ( iswdigit( c ) ) {
                     result = push_local( frame_pointer, read_number( next ) );
-                } else if ( iswalpha( c ) ) {
+                } else if ( symbol_char_p( c ) ) {
                     result = push_local( frame_pointer, read_symbol( next ) );
                 } else {
                     //                    result =
@@ -268,9 +284,9 @@ struct pso_pointer read( struct pso_pointer frame_pointer ) {
         }
     }
 #ifdef DEBUG
-    debug_print( L"Read object: ", DEBUG_IO, 0 );
+    debug_print( L"Read expression: `", DEBUG_IO, 0 );
     debug_print_object( result, DEBUG_IO, 0 );
-    debug_println( DEBUG_IO );
+    debug_print( L"`\n", DEBUG_IO, 0 );
 #endif
 
     return result;

src/c/ops/assoc.c

@@ -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 ) ) {

src/c/ops/eval_apply.c

@@ -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 ) ) {

src/c/ops/string_ops.c

@@ -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 );
         }
     }

src/c/payloads/symbol.h

@@ -14,6 +14,16 @@
 
 #include "memory/pointer.h"
 
+/**
+ * @brief true if the argument `wc`, a wide character, is suitable for 
+ * inclusion in a symbol. 
+ *
+ * Note that Common Lisp is *much* less restrictive
+ * than this currently is, so rethinking may be necessary. 
+ */
+#define symbol_char_p(wc)(iswalpha( wc ) || wcschr(L"-*|!?", wc))
+
+
 /* TODO: for now, Symbol shares a payload with String, but this may change.
  * Strings are of indefinite length, but symbols are really not, and might
  * fit into any size class. */