String-like-things are being created and printed correctly; bind is broken.

src/c/environment/environment.c

@@ -36,7 +36,7 @@ bool environment_initialised = false;
  * @brief Initialise a minimal environment, so that Lisp can be bootstrapped.
  * 
  * @param node the index of the node we are initialising.
- * @return struct pso_pointer t on success, else an exception.
+ * @return a proto-environment on success, else an exception.
  */
 
 struct pso_pointer initialise_environment( uint32_t node ) {
@@ -85,9 +85,14 @@ struct pso_pointer initialise_environment( uint32_t node ) {
     }
     if ( !exceptionp( result ) ) {
         result = c_bind( c_string_to_lisp_symbol( L"nil" ), nil, nil );
+		debug_print(L"Environment after binding `nil`: ", DEBUG_BOOTSTRAP, 0);
+		debug_print_object( result, DEBUG_BOOTSTRAP, 0);
         result = c_bind( c_string_to_lisp_symbol( L"t" ), t, result );
 
         environment_initialised = true;
+		debug_print(L"Environment after binding `t`: ", DEBUG_BOOTSTRAP, 0);
+		debug_print_object( result, DEBUG_BOOTSTRAP, 0);
+
         debug_print( L"\nEnvironment initialised successfully.\n",
                      DEBUG_BOOTSTRAP, 0 );
     }

src/c/environment/environment.h

@@ -10,6 +10,7 @@
 #ifndef __psse_environment_environment_h
 #define __psse_environment_environment_h
 
+#include <stdint.h>
 struct pso_pointer initialise_environment( uint32_t node );
 
 #endif

src/c/io/io.c

@@ -35,6 +35,7 @@
 
 #include "memory/node.h"
 #include "memory/pointer.h"
+#include "memory/pso.h"
 #include "memory/pso2.h"
 #include "memory/pso4.h"
 #include "memory/tags.h"
@@ -122,25 +123,32 @@ 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);
 	
-    env = c_bind( lisp_io_in,
+	debug_print( L"In initialise_default_streams; environment is: ", DEBUG_IO, 0);
-                  make_read_stream( file_to_url_file( stdin ),
+	debug_print_object(env, DEBUG_IO, 0);
-                                    c_cons( c_cons
+
-                                            ( c_string_to_lisp_keyword
+	env = c_bind(
-                                              ( L"url" ),
+		lisp_io_in,
-                                              c_string_to_lisp_string
+		lock_object(make_read_stream(
-                                              ( L"system:standard input" ) ),
+			file_to_url_file(stdin),
-                                            nil ) ), env );
+			c_cons(c_cons(c_string_to_lisp_keyword(L"url"),
+						  c_string_to_lisp_string(L"::system:standard-input")),
+				   nil))),
+		env);
+	debug_print_object(env, DEBUG_IO, 0);
 	if (!nilp(env) && !exceptionp(env)) {
 		env = c_bind(lisp_io_out,
-                      make_write_stream( file_to_url_file( stdout ),
+					 lock_object(make_write_stream(
-                                         c_cons( c_cons
+						 file_to_url_file(stdout),
-                                                 ( c_string_to_lisp_keyword
+						 c_cons(c_cons(c_string_to_lisp_keyword(L"url"),
-                                                   ( L"url" ),
+									   c_string_to_lisp_string(
-                                                   c_string_to_lisp_string
+										   L"::system:standard-output")),
-                                                   ( L"system:standard input" ) ),
+								nil))),
-                                                 nil ) ), env );
+					 env);
 	}
 
+	debug_print( L"Leaving initialise_default_streams; environment is: ", DEBUG_IO, 0);
+	debug_print_object(env, DEBUG_IO, 0);
+
 	return env;
 }
 
@@ -204,20 +212,18 @@ wint_t url_fgetwc( URL_FILE *input ) {
 			break;
 
 		case CFTYPE_CURL: {
-                    char *cbuff =
+			char *cbuff = calloc(sizeof(wchar_t) + 2, sizeof(char));
-                        calloc( sizeof( wchar_t ) + 2, sizeof( char ) );
 			wchar_t *wbuff = calloc(2, sizeof(wchar_t));
 
 			size_t count = 0;
 
-                    debug_print( L"url_fgetwc: about to call url_fgets\n",
+			debug_print(L"url_fgetwc: about to call url_fgets\n", DEBUG_IO, 0);
-                                 DEBUG_IO, 0 );
 			url_fgets(cbuff, 2, input);
-                    debug_print( L"url_fgetwc: back from url_fgets\n",
+			debug_print(L"url_fgetwc: back from url_fgets\n", DEBUG_IO, 0);
-                                 DEBUG_IO, 0 );
 			int c = (int)cbuff[0];
 			// TODO: risk of reading off cbuff?
-                    debug_printf( DEBUG_IO, 0,
+			debug_printf(
+				DEBUG_IO, 0,
 				L"url_fgetwc: cbuff is '%s'; (first) character = %d (%c)\n",
 				cbuff, c, c & 0xf7);
 			/* The value of each individual byte indicates its UTF-8 function,
@@ -243,7 +249,8 @@ wint_t url_fgetwc( URL_FILE *input ) {
 			if (count > 1) {
 				url_fgets((char *)&cbuff[1], count, input);
 			}
-                    mbstowcs( wbuff, cbuff, 2 );  //(char *)(&input->buffer[input->buffer_pos]), 1 );
+			mbstowcs(wbuff, cbuff,
+					 2); //(char *)(&input->buffer[input->buffer_pos]), 1 );
 			result = wbuff[0];
 
 			free(wbuff);
@@ -291,9 +298,8 @@ struct pso_pointer get_character( struct pso_pointer read_stream ) {
 	struct pso_pointer result = nil;
 
 	if (readp(read_stream)) {
-        result =
+		result = make_character(
-            make_character( url_fgetwc
+			url_fgetwc(pointer_to_object_of_size_class(read_stream, 2)
-                            ( pointer_to_object_of_size_class( read_stream, 2 )
 						   ->payload.stream.stream));
 	}
 
@@ -313,11 +319,9 @@ struct pso_pointer push_back_character( struct pso_pointer c,
 	struct pso_pointer result = nil;
 
 	if (characterp(c) && readp(r)) {
-        if ( url_ungetwc( ( wint_t )
+		if (url_ungetwc(
-                          ( pointer_to_object( c )->payload.character.
+				(wint_t)(pointer_to_object(c)->payload.character.character),
-                            character ),
+				pointer_to_object(r)->payload.stream.stream) >= 0) {
-                          pointer_to_object( r )->payload.stream.stream ) >=
-             0 ) {
 			result = t;
 		}
 	}
@@ -353,9 +357,7 @@ struct pso_pointer lisp_close( struct pso_pointer frame_pointer,
 
 struct pso_pointer add_meta_integer(struct pso_pointer meta, wchar_t *key,
 									long int value) {
-    return
+	return c_cons(c_cons(c_string_to_lisp_keyword(key), make_integer(value)),
-        c_cons( c_cons
-                ( c_string_to_lisp_keyword( key ), make_integer( value ) ),
 				  meta);
 }
 
@@ -365,10 +367,9 @@ struct pso_pointer add_meta_string( struct pso_pointer meta, wchar_t *key,
 	wchar_t buffer[strlen(value) + 1];
 	mbstowcs(buffer, value, strlen(value) + 1);
 
-    return
+	return c_cons(
-        c_cons( c_cons
+		c_cons(c_string_to_lisp_keyword(key), c_string_to_lisp_string(buffer)),
-                ( c_string_to_lisp_keyword( key ),
+		meta);
-                  c_string_to_lisp_string( buffer ) ), meta );
 }
 
 struct pso_pointer add_meta_time(struct pso_pointer meta, wchar_t *key,
@@ -474,9 +475,7 @@ void collect_meta( struct pso_pointer stream, char *url ) {
 				meta = add_meta_integer(meta, L"group", statbuf.st_gid);
 			}
 
-                meta =
+			meta = add_meta_integer(meta, L"size", (intmax_t)statbuf.st_size);
-                    add_meta_integer( meta, L"size",
-                                      ( intmax_t ) statbuf.st_size );
 
 			meta = add_meta_time(meta, L"modified", &statbuf.st_mtime);
 		}
@@ -613,8 +612,7 @@ struct pso_pointer lisp_read_char( struct pso_pointer frame_pointer,
 	struct pso_pointer stream_pointer = fetch_arg(frame, 0);
 	if (readp(stream_pointer)) {
 		result =
-            make_string( url_fgetwc( stream_get_url_file( stream_pointer ) ),
+			make_string(url_fgetwc(stream_get_url_file(stream_pointer)), nil);
-                         nil );
 	}
 
 	return result;

src/c/io/print.c

@@ -12,6 +12,7 @@
  */
 
 #include <ctype.h>
+#include <stdint.h>
 #include <stdio.h>
 #include <stdlib.h>
 #include <string.h>
@@ -36,8 +37,34 @@
 #include "payloads/cons.h"
 #include "payloads/integer.h"
 
+#include "ops/truth.h"
+
 struct pso_pointer in_print(struct pso_pointer p, URL_FILE *output);
 
+struct pso_pointer print_string_like_thing(struct pso_pointer p,
+										   URL_FILE *output) {
+	switch (get_tag_value(p)) {
+	case KEYTV:
+		url_fputwc(L':', output);
+		break;
+	case STRINGTV:
+		url_fputwc(L'"', output);
+		break;
+	}
+
+	if (keywordp(p) || stringp(p) || symbolp(p)) {
+		for (struct pso_pointer cursor = p; !nilp(cursor);
+			 cursor = pointer_to_object(cursor)->payload.string.cdr) {
+			url_fputwc(pointer_to_object(cursor)->payload.character.character,
+					   output);
+		}
+	}
+
+	if (stringp(p)) {
+		url_fputwc(L'"', output);
+	}
+}
+
 struct pso_pointer print_list_content(struct pso_pointer p, URL_FILE *output) {
 	struct pso_pointer result = nil;
 
@@ -60,7 +87,6 @@ struct pso_pointer print_list_content( struct pso_pointer p, URL_FILE *output )
 				url_fputws(L" . ", output);
 				result = in_print(object->payload.cons.cdr, output);
 			}
-
 		}
 	} else {
 		// TODO: return exception
@@ -74,7 +100,8 @@ struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) {
 	struct pso_pointer result = nil;
 
 	if (object != NULL) {
-        switch ( get_tag_value( p ) ) {
+		uint32_t v = get_tag_value(p);
+		switch (v) {
 		case CHARACTERTV:
 			url_fputwc(object->payload.character.character, output);
 			break;
@@ -87,11 +114,23 @@ struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) {
 			url_fwprintf(output, L"%d",
 						 (int64_t)(object->payload.integer.value));
 			break;
-            case TRUETV:
+		case KEYTV:
-                url_fputwc( L't', output );
+		case STRINGTV:
+		case SYMBOLTV:
+			print_string_like_thing(p, output);
 			break;
 		case NILTV:
 			url_fputws(L"nil", output);
+			break;
+		case READTV:
+		case WRITETV:
+			url_fwprintf(output, L"<%s stream: ", v == READTV ? "read" : "write");
+			in_print(object->payload.stream.meta, output);
+			url_fputwc(L'>', output);
+			break;
+		case TRUETV:
+			url_fputwc(L't', output);
+			break;
 		default:
 			// TODO: return exception
 		}
@@ -110,17 +149,16 @@ struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) {
  * @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) {
-    URL_FILE *output = writep( stream ) ?
+	struct pso_pointer result = p;
-        pointer_to_object( stream )->payload.stream.stream :
+	URL_FILE *output = writep(stream)
-        file_to_url_file( stdout );
+						   ? pointer_to_object(stream)->payload.stream.stream
+						   : file_to_url_file(stdout);
 
 	if (writep(stream)) {
 		inc_ref(stream);
-    }
 
-    struct pso_pointer result = in_print( p, output );
+		result = in_print(p, output);
 
-    if ( writep( stream ) ) {
 		dec_ref(stream);
 	}
 

src/c/memory/tags.h

@@ -13,6 +13,7 @@
 #define __psse_memory_tags_h
 
 #include <stdbool.h>
+#include <stdint.h>
 
 #define TAGLENGTH 3
 
@@ -71,8 +72,8 @@
 #define TRUETV      5591636
 #define VECTORTV    4408662
 #define VECTORPOINTTV 5264214
-#define WRITETV     5264214
+#define WRITETV     5526103
-
+// 5526103
 /**
  * @brief return the numerical value of the tag of the object indicated by
  * pointer `p`.

src/c/ops/assoc.c

@@ -41,7 +41,7 @@ struct pso_pointer search( struct pso_pointer key,
 
     if ( consp( store ) ) {
         for ( struct pso_pointer cursor = store;
-              consp( store ) && found == false; cursor = c_cdr( cursor ) ) {
+              consp( cursor ) && found == false; cursor = c_cdr( cursor ) ) {
             struct pso_pointer pair = c_car( cursor );
 
             if ( consp( pair ) && c_equal( c_car( pair ), key ) ) {

src/c/ops/repl.c

@@ -58,6 +58,15 @@ void c_repl(  ) {
     struct pso_pointer input_stream = c_assoc( lisp_io_in, env );
     struct pso_pointer output_stream = c_assoc( lisp_io_out, env );
 	
+	if (!readp(input_stream)) {
+		debug_print(L"Invalid read stream: ", DEBUG_IO, 0);
+		debug_print_object(input_stream, DEBUG_IO, 0);
+	}
+	if (!writep(output_stream)) {
+		debug_print(L"Invalid write stream: ", DEBUG_IO, 0);
+		debug_print_object(output_stream, DEBUG_IO, 0);
+	}
+
     while ( readp( input_stream )
             && !url_feof( stream_get_url_file( input_stream ) ) ) {
         /* bottom of stack */

src/c/ops/string_ops.c

@@ -71,7 +71,7 @@ uint32_t calculate_hash( wint_t c, struct pso_pointer ptr ) {
  */
 struct pso_pointer make_string_like_thing( wint_t c, struct pso_pointer tail,
                                            char *tag ) {
-    struct pso_pointer pointer = nil;
+    struct pso_pointer pointer = tail;
 
     if ( check_type( tail, tag ) || nilp( tail ) ) {
         pointer = allocate( tag, CONS_SIZE_CLASS );
@@ -81,7 +81,10 @@ struct pso_pointer make_string_like_thing( wint_t c, struct pso_pointer tail,
         cell->payload.string.cdr = tail;
 
         cell->payload.string.hash = calculate_hash( c, tail );
-        debug_dump_object( pointer, DEBUG_ALLOC, 0 );
+		debug_printf( DEBUG_ALLOC, 0,
+			 L"Building string-like-thing of type %3.3s: ", 
+			 cell->header.tag.bytes.mnemonic);
+		debug_print_object(pointer, DEBUG_ALLOC, 0);
 		debug_println(DEBUG_ALLOC);
     } else {
         // \todo should throw an exception!
@@ -91,6 +94,7 @@ struct pso_pointer make_string_like_thing( wint_t c, struct pso_pointer tail,
                       tag, tobj->header.tag.bytes.mnemonic );
     }
 
+	
     return pointer;
 }
 
@@ -138,8 +142,10 @@ struct pso_pointer c_string_to_lisp_string( wchar_t *string ) {
     struct pso_pointer result = nil;
 
     for ( int i = wcslen( string ) - 1; i >= 0; i-- ) {
-        if ( iswprint( string[i] ) && string[i] != '"' ) {
+        if ( string[i] != '"' ) {
             result = make_string( string[i], result );
+        } else {
+			result = make_string( L'\\', make_string( string[i], result));
 		}
     }
 
@@ -157,7 +163,7 @@ struct pso_pointer c_string_to_lisp_symbol( wchar_t *symbol ) {
     for ( int i = wcslen( symbol ) - 1; i >= 0; i-- ) {
         wchar_t c = towlower( symbol[i] );
 
-        if ( iswalpha( c ) || c == L'-' ) {
+        if ( iswalpha( c ) || c == L'-' || c == L'*') {
             result = make_symbol( c, result );
         }
     }