Fixed, working.

src/io/fopen.c

@@ -223,7 +223,7 @@ URL_FILE *url_fopen( const char *url, const char *operation ) {
         curl_easy_setopt( file->handle.curl, CURLOPT_WRITEFUNCTION,
                           write_callback );
         /* use the share object */
-        curl_easy_setopt(file->handle.curl, CURLOPT_SHARE, io_share);
+        curl_easy_setopt( file->handle.curl, CURLOPT_SHARE, io_share );
 
 
         if ( !multi_handle )

src/io/io.c

@@ -44,22 +44,23 @@ wint_t ungotten = 0;
  *
  * @return 0 on success; any other value means failure.
  */
-int io_init() {
-  CURL *curl;
-  CURLcode res;
-  int result = curl_global_init( CURL_GLOBAL_SSL );
+int io_init(  ) {
+    CURL *curl;
+    CURLcode res;
+    int result = curl_global_init( CURL_GLOBAL_SSL );
 
-  io_share = curl_share_init();
+    io_share = curl_share_init(  );
 
-  if (result == 0) {
-      curl_share_setopt(io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_CONNECT);
-      curl_share_setopt(io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_COOKIE );
-      curl_share_setopt(io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_DNS );
-      curl_share_setopt(io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_SSL_SESSION );
-      curl_share_setopt(io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_PSL );
-  }
+    if ( result == 0 ) {
+        curl_share_setopt( io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_CONNECT );
+        curl_share_setopt( io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_COOKIE );
+        curl_share_setopt( io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_DNS );
+        curl_share_setopt( io_share, CURLSHOPT_SHARE,
+                           CURL_LOCK_DATA_SSL_SESSION );
+        curl_share_setopt( io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_PSL );
+    }
 
-  return result;
+    return result;
 }
 
 /**
@@ -243,67 +244,72 @@ lisp_close( struct stack_frame *frame, struct cons_pointer frame_pointer,
     return result;
 }
 
-int index_of( char c, char * s) {
-  int i;
+int index_of( char c, char *s ) {
+    int i;
 
-  for (i = 0; s[i] != c && s[i] != 0; i++);
+    for ( i = 0; s[i] != c && s[i] != 0; i++ );
 
-  return s[i] == c ? i : -1;
+    return s[i] == c ? i : -1;
 }
 
-char * trim(char *s) {
-  int i;
+char *trim( char *s ) {
+    int i;
 
-  for (i = strlen(s); (isblank(s[i]) || iscntrl(s[i])) && i > -1; i--) {
-    s[i] = (char) 0;
-  }
-  for (i = 0; isblank(s[i]) && s[i] != 0; i++);
+    for ( i = strlen( s ); ( isblank( s[i] ) || iscntrl( s[i] ) ) && i > -1;
+          i-- ) {
+        s[i] = ( char ) 0;
+    }
+    for ( i = 0; isblank( s[i] ) && s[i] != 0; i++ );
 
-  return (char *)&s[i];
+    return ( char * ) &s[i];
 }
 
 /**
  * Callback to assemble metadata for a URL stream. This is naughty because
  * it modifies data, but it's really the only way to create metadata.
  */
-static size_t write_meta_callback(void *ptr, size_t size, size_t nmemb, struct cons_pointer stream)
-{
-  struct cons_space_object * cell = &pointer2cell(stream);
+static size_t write_meta_callback( void *ptr, size_t size, size_t nmemb,
+                                   struct cons_pointer stream ) {
+    struct cons_space_object *cell = &pointer2cell( stream );
 
-  if (strncmp(&cell->tag.bytes[0], READTAG, 4) ||
-      strncmp(&cell->tag.bytes[0], WRITETAG, 4)) {
-    char * s = (char *)ptr;
-    int offset = index_of (':', ptr);
+    if ( strncmp( &cell->tag.bytes[0], READTAG, 4 ) ||
+         strncmp( &cell->tag.bytes[0], WRITETAG, 4 ) ) {
+        char *s = ( char * ) ptr;
+        int offset = index_of( ':', ptr );
 
-    if (offset != -1) {
-      s[offset] = (char)0;
-      char * name = s;
-      char * value = trim( &s[++offset]);
-      wchar_t * wname = calloc(strlen(name), sizeof(wchar_t));
-      wchar_t * wvalue = calloc(strlen(value), sizeof(wchar_t));
+        if ( offset != -1 ) {
+            s[offset] = ( char ) 0;
+            char *name = s;
+            char *value = trim( &s[++offset] );
+            wchar_t *wname = calloc( strlen( name ), sizeof( wchar_t ) );
+            wchar_t *wvalue = calloc( strlen( value ), sizeof( wchar_t ) );
 
-      mbstowcs(wname, name, strlen(name));
-      mbstowcs(wvalue, value, strlen(value));
+            mbstowcs( wname, name, strlen( name ) );
+            mbstowcs( wvalue, value, strlen( value ) );
 
-      cell->payload.stream.meta = make_cons(
-        make_cons(
-          c_string_to_lisp_keyword( wname),
-          c_string_to_lisp_string(wvalue)),
-        cell->payload.stream.meta);
+            cell->payload.stream.meta =
+                make_cons( make_cons
+                           ( c_string_to_lisp_keyword( wname ),
+                             c_string_to_lisp_string( wvalue ) ),
+                           cell->payload.stream.meta );
 
-      debug_printf( DEBUG_IO, L"write_meta_callback: added header '%s': value '%s'\n", name, value);
+            debug_printf( DEBUG_IO,
+                          L"write_meta_callback: added header '%s': value '%s'\n",
+                          name, value );
+        }
+    } else {
+        debug_print
+            ( L"Pointer passed to write_meta_callback did not point to a stream: ",
+              DEBUG_IO );
+        debug_dump_object( stream, DEBUG_IO );
     }
-  } else {
-    debug_print( L"Pointer passed to write_meta_callback did not point to a stream: ", DEBUG_IO);
-    debug_dump_object(stream, DEBUG_IO);
-  }
 
-  return nmemb;
+    return nmemb;
 }
 
 
 void collect_meta( struct cons_pointer stream, struct cons_pointer url ) {
-    URL_FILE * s = pointer2cell(stream).payload.stream.stream;
+    URL_FILE *s = pointer2cell( stream ).payload.stream.stream;
 
     switch ( s->type ) {
         case CFTYPE_NONE:
@@ -315,8 +321,9 @@ void collect_meta( struct cons_pointer stream, struct cons_pointer url ) {
         case CFTYPE_CURL:
             curl_easy_setopt( s->handle.curl, CURLOPT_VERBOSE, 1L );
             curl_easy_setopt( s->handle.curl, CURLOPT_HEADER, 1L );
-            curl_easy_setopt( s->handle.curl, CURLOPT_HEADERFUNCTION, write_meta_callback);
-            curl_easy_setopt( s->handle.curl, CURLOPT_HEADERDATA, stream);
+            curl_easy_setopt( s->handle.curl, CURLOPT_HEADERFUNCTION,
+                              write_meta_callback );
+            curl_easy_setopt( s->handle.curl, CURLOPT_HEADERDATA, stream );
             break;
     }
 }
@@ -338,38 +345,37 @@ void collect_meta( struct cons_pointer stream, struct cons_pointer url ) {
  * on my stream, if any, else NIL.
  */
 struct cons_pointer
-  lisp_open( struct stack_frame *frame, struct cons_pointer frame_pointer,
-            struct cons_pointer env ) {
-  struct cons_pointer result = NIL;
+lisp_open( struct stack_frame *frame, struct cons_pointer frame_pointer,
+           struct cons_pointer env ) {
+    struct cons_pointer result = NIL;
 
-  if ( stringp( frame->arg[0] ) ) {
-    struct cons_pointer meta =
-      make_cons( make_cons(
-        c_string_to_lisp_keyword( L"url" ),
-        frame->arg[0] ),
-                NIL );
+    if ( stringp( frame->arg[0] ) ) {
+        struct cons_pointer meta =
+            make_cons( make_cons( c_string_to_lisp_keyword( L"url" ),
+                                  frame->arg[0] ),
+                       NIL );
 
-    char *url = lisp_string_to_c_string( frame->arg[0] );
+        char *url = lisp_string_to_c_string( frame->arg[0] );
 
-    if ( nilp( frame->arg[1] ) ) {
-      URL_FILE *stream = url_fopen( url, "r" );
-      result = make_read_stream( stream, meta );
-    } else {
-      // TODO: anything more complex is a problem for another day.
-      URL_FILE *stream = url_fopen( url, "w" );
-      result = make_write_stream( stream, meta);
+        if ( nilp( frame->arg[1] ) ) {
+            URL_FILE *stream = url_fopen( url, "r" );
+            result = make_read_stream( stream, meta );
+        } else {
+            // TODO: anything more complex is a problem for another day.
+            URL_FILE *stream = url_fopen( url, "w" );
+            result = make_write_stream( stream, meta );
+        }
+
+        free( url );
+
+        if ( pointer2cell( result ).payload.stream.stream == NULL ) {
+            result = NIL;
+        } else {
+            collect_meta( result, frame->arg[0] );
+        }
     }
 
-    free( url );
-
-    if ( pointer2cell( result ).payload.stream.stream == NULL ) {
-      result = NIL;
-    } else {
-      collect_meta( result, frame->arg[0]);
-    }
-  }
-
-  return result;
+    return result;
 }
 
 /**
@@ -392,8 +398,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
     if ( readp( frame->arg[0] ) ) {
         result =
             make_string( url_fgetwc
-                         ( pointer2cell( frame->arg[0] ).payload.
-                           stream.stream ), NIL );
+                         ( pointer2cell( frame->arg[0] ).payload.stream.
+                           stream ), NIL );
     }
 
     return result;

src/io/io.h

@@ -15,7 +15,7 @@
 
 extern CURLSH *io_share;
 
-int io_init();
+int io_init(  );
 
 URL_FILE *file_to_url_file( FILE * f );
 wint_t url_fgetwc( URL_FILE * input );

src/io/print.c

@@ -0,0 +1,237 @@
+/*
+ * print.c
+ *
+ * First pass at a printer, for bootstrapping.
+ *
+ * (c) 2017 Simon Brooke <simon@journeyman.cc>
+ * Licensed under GPL version 2.0, or, at your option, any later version.
+ */
+
+#include <ctype.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+/*
+ * wide characters
+ */
+#include <wchar.h>
+#include <wctype.h>
+
+#include "conspage.h"
+#include "consspaceobject.h"
+#include "integer.h"
+#include "stack.h"
+#include "print.h"
+
+/**
+ * Whether or not we colorise output.
+ * \todo this should be a Lisp symbol binding, not a C variable.
+ */
+int print_use_colours = 0;
+
+/**
+ * print all the characters in the symbol or string indicated by `pointer`
+ * onto this `output`; if `pointer` does not indicate a string or symbol,
+ * don't print anything but just return.
+ */
+void print_string_contents( URL_FILE * output, struct cons_pointer pointer ) {
+    while ( stringp( pointer ) || symbolp( pointer ) || keywordp( pointer ) ) {
+        struct cons_space_object *cell = &pointer2cell( pointer );
+        wchar_t c = cell->payload.string.character;
+
+        if ( c != '\0' ) {
+            url_fputwc( c, output );
+        }
+        pointer = cell->payload.string.cdr;
+    }
+}
+
+/**
+ * print all the characters in the string indicated by `pointer` onto
+ * the stream at this `output`, prepending and appending double quote
+ * characters.
+ */
+void print_string( URL_FILE * output, struct cons_pointer pointer ) {
+    url_fputwc( btowc( '"' ), output );
+    print_string_contents( output, pointer );
+    url_fputwc( btowc( '"' ), output );
+}
+
+/**
+ * Print a single list cell (cons cell) indicated by `pointer` to the
+ * stream indicated by `output`. if `initial_space` is `true`, prepend
+ * a space character.
+ */
+void
+print_list_contents( URL_FILE * output, struct cons_pointer pointer,
+                     bool initial_space ) {
+    struct cons_space_object *cell = &pointer2cell( pointer );
+
+    switch ( cell->tag.value ) {
+        case CONSTV:
+            if ( initial_space ) {
+                url_fputwc( btowc( ' ' ), output );
+            }
+            print( output, cell->payload.cons.car );
+
+            print_list_contents( output, cell->payload.cons.cdr, true );
+            break;
+        case NILTV:
+            break;
+        default:
+            url_fwprintf( output, L" . " );
+            print( output, pointer );
+    }
+}
+
+void print_list( URL_FILE * output, struct cons_pointer pointer ) {
+    if ( print_use_colours ) {
+        url_fwprintf( output, L"%s(%s", "\x1B[31m", "\x1B[39m" );
+    } else {
+        url_fputws( L"(", output );
+    };
+
+    print_list_contents( output, pointer, false );
+    if ( print_use_colours ) {
+        url_fwprintf( output, L"%s)%s", "\x1B[31m", "\x1B[39m" );
+    } else {
+        url_fputws( L")", output );
+    }
+
+}
+
+/**
+ * Print the cons-space object indicated by `pointer` to the stream indicated
+ * by `output`.
+ */
+struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) {
+    struct cons_space_object cell = pointer2cell( pointer );
+    char *buffer;
+
+    /*
+     * Because tags have values as well as bytes, this if ... else if
+     * statement can ultimately be replaced by a switch, which will be neater.
+     */
+    switch ( cell.tag.value ) {
+        case CONSTV:
+            print_list( output, pointer );
+            break;
+        case EXCEPTIONTV:
+            url_fwprintf( output, L"\n%sException: ",
+                          print_use_colours ? "\x1B[31m" : "" );
+            dump_stack_trace( output, pointer );
+            break;
+        case FUNCTIONTV:
+            url_fwprintf( output, L"<Function>" );
+            break;
+        case INTEGERTV:{
+                struct cons_pointer s = integer_to_string( pointer, 10 );
+                inc_ref( s );
+                if ( print_use_colours ) {
+                    url_fputws( L"\x1B[34m", output );
+                }
+                print_string_contents( output, s );
+                dec_ref( s );
+            }
+            break;
+        case KEYTV:
+            if ( print_use_colours ) {
+                url_fputws( L"\x1B[1;33m", output );
+            }
+            url_fputws( L":", output );
+            print_string_contents( output, pointer );
+            break;
+        case LAMBDATV:{
+                struct cons_pointer to_print =
+                    make_cons( c_string_to_lisp_symbol( L"lambda" ),
+                               make_cons( cell.payload.lambda.args,
+                                          cell.payload.lambda.body ) );
+                inc_ref( to_print );
+
+                print( output, to_print );
+
+                dec_ref( to_print );
+            }
+            break;
+        case NILTV:
+            url_fwprintf( output, L"nil" );
+            break;
+        case NLAMBDATV:{
+                struct cons_pointer to_print =
+                    make_cons( c_string_to_lisp_symbol( L"nlambda" ),
+                               make_cons( cell.payload.lambda.args,
+                                          cell.payload.lambda.body ) );
+                inc_ref( to_print );
+
+                print( output, to_print );
+
+                dec_ref( to_print );
+            }
+            break;
+        case RATIOTV:
+            print( output, cell.payload.ratio.dividend );
+            url_fputws( L"/", output );
+            print( output, cell.payload.ratio.divisor );
+            break;
+        case READTV:
+            url_fwprintf( output, L"<Input stream>" );
+            break;
+        case REALTV:
+            /* \todo using the C heap is a bad plan because it will fragment.
+             * As soon as I have working vector space I'll use a special purpose
+             * vector space object */
+            buffer = ( char * ) malloc( 24 );
+            memset( buffer, 0, 24 );
+            /* format it really long, then clear the trailing zeros */
+            sprintf( buffer, "%-.23Lg", cell.payload.real.value );
+            if ( strchr( buffer, '.' ) != NULL ) {
+                for ( int i = strlen( buffer ) - 1; buffer[i] == '0'; i-- ) {
+                    buffer[i] = '\0';
+                }
+            }
+            if ( print_use_colours ) {
+                url_fputws( L"\x1B[34m", output );
+            }
+            url_fwprintf( output, L"%s", buffer );
+            free( buffer );
+            break;
+        case STRINGTV:
+            if ( print_use_colours ) {
+                url_fputws( L"\x1B[36m", output );
+            }
+            print_string( output, pointer );
+            break;
+        case SYMBOLTV:
+            if ( print_use_colours ) {
+                url_fputws( L"\x1B[1;33m", output );
+            }
+            print_string_contents( output, pointer );
+            break;
+        case SPECIALTV:
+            url_fwprintf( output, L"<Special form>" );
+            break;
+        case TRUETV:
+            url_fwprintf( output, L"t" );
+            break;
+        case WRITETV:
+            url_fwprintf( output, L"<Output stream>" );
+            break;
+        default:
+            fwprintf( stderr,
+                      L"%sError: Unrecognised tag value %d (%c%c%c%c)\n",
+                      print_use_colours ? "\x1B[31m" : "",
+                      cell.tag.value, cell.tag.bytes[0], cell.tag.bytes[1],
+                      cell.tag.bytes[2], cell.tag.bytes[3] );
+            break;
+    }
+
+    if ( print_use_colours ) {
+        url_fputws( L"\x1B[39m", output );
+    }
+
+    return pointer;
+}
+
+void println( URL_FILE * output ) {
+    url_fputws( L"\n", output );
+}

src/io/print.h

@@ -0,0 +1,21 @@
+/**
+ * print.h
+ *
+ * First pass at a printer, for bootstrapping.
+ *
+ *
+ * (c) 2017 Simon Brooke <simon@journeyman.cc>
+ * Licensed under GPL version 2.0, or, at your option, any later version.
+ */
+
+#include <ctype.h>
+#include <stdio.h>
+
+#ifndef __print_h
+#define __print_h
+
+struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer );
+void println( URL_FILE * output );
+extern int print_use_colours;
+
+#endif

src/io/read.c

@@ -0,0 +1,385 @@
+/*
+ * read.c
+ *
+ * First pass at a reader, for bootstrapping.
+ *
+ *
+ * (c) 2017 Simon Brooke <simon@journeyman.cc>
+ * Licensed under GPL version 2.0, or, at your option, any later version.
+ */
+
+#include <math.h>
+#include <stdbool.h>
+#include <stdio.h>
+/*
+ * wide characters
+ */
+#include <wchar.h>
+#include <wctype.h>
+
+#include "consspaceobject.h"
+#include "debug.h"
+#include "dump.h"
+#include "integer.h"
+#include "intern.h"
+#include "io.h"
+#include "lispops.h"
+#include "peano.h"
+#include "print.h"
+#include "ratio.h"
+#include "read.h"
+#include "real.h"
+#include "vectorspace.h"
+
+/*
+ * for the time being things which may be read are: strings numbers - either
+ * integer or real, but not yet including ratios or bignums lists Can't read
+ * atoms because I don't yet know what an atom is or how it's stored.
+ */
+
+struct cons_pointer read_number( struct stack_frame *frame,
+                                 struct cons_pointer frame_pointer,
+                                 URL_FILE * input, wint_t initial,
+                                 bool seen_period );
+struct cons_pointer read_list( struct stack_frame *frame,
+                               struct cons_pointer frame_pointer,
+                               URL_FILE * input, wint_t initial );
+struct cons_pointer read_string( URL_FILE * input, wint_t initial );
+struct cons_pointer read_symbol_or_key( URL_FILE * input, char *tag,
+                                        wint_t initial );
+
+/**
+ * quote reader macro in C (!)
+ */
+struct cons_pointer c_quote( struct cons_pointer arg ) {
+    return make_cons( c_string_to_lisp_symbol( L"quote" ),
+                      make_cons( arg, NIL ) );
+}
+
+/**
+ * Read the next object on this input stream and return a cons_pointer to it,
+ * treating this initial character as the first character of the object
+ * representation.
+ */
+struct cons_pointer read_continuation( struct stack_frame *frame,
+                                       struct cons_pointer frame_pointer,
+                                       URL_FILE * input, wint_t initial ) {
+    debug_print( L"entering read_continuation\n", DEBUG_IO );
+    struct cons_pointer result = NIL;
+
+    wint_t c;
+
+    for ( c = initial;
+          c == '\0' || iswblank( c ) || iswcntrl( c );
+          c = url_fgetwc( input ) );
+
+    if ( url_feof( input ) ) {
+        result =
+            throw_exception( c_string_to_lisp_string
+                             ( L"End of file while reading" ), frame_pointer );
+    } else {
+        switch ( c ) {
+            case ';':
+                for ( c = url_fgetwc( input ); c != '\n';
+                      c = url_fgetwc( input ) );
+                /* skip all characters from semi-colon to the end of the line */
+                break;
+            case EOF:
+                result = throw_exception( c_string_to_lisp_string
+                                          ( L"End of input while reading" ),
+                                          frame_pointer );
+                break;
+            case '\'':
+                result =
+                    c_quote( read_continuation
+                             ( frame, frame_pointer, input,
+                               url_fgetwc( input ) ) );
+                break;
+            case '(':
+                result =
+                    read_list( frame, frame_pointer, input,
+                               url_fgetwc( input ) );
+                break;
+            case '"':
+                result = read_string( input, url_fgetwc( input ) );
+                break;
+            case '-':{
+                    wint_t next = url_fgetwc( input );
+                    url_ungetwc( next, input );
+                    if ( iswdigit( next ) ) {
+                        result =
+                            read_number( frame, frame_pointer, input, c,
+                                         false );
+                    } else {
+                        result = read_symbol_or_key( input, SYMBOLTAG, c );
+                    }
+                }
+                break;
+            case '.':
+                {
+                    wint_t next = url_fgetwc( input );
+                    if ( iswdigit( next ) ) {
+                        url_ungetwc( next, input );
+                        result =
+                            read_number( frame, frame_pointer, input, c,
+                                         true );
+                    } else if ( iswblank( next ) ) {
+                        /* dotted pair. \todo this isn't right, we
+                         * really need to backtrack up a level. */
+                        result =
+                            read_continuation( frame, frame_pointer, input,
+                                               url_fgetwc( input ) );
+                    } else {
+                        read_symbol_or_key( input, SYMBOLTAG, c );
+                    }
+                }
+                break;
+            case ':':
+                result =
+                    read_symbol_or_key( input, KEYTAG, url_fgetwc( input ) );
+                break;
+            default:
+                if ( iswdigit( c ) ) {
+                    result =
+                        read_number( frame, frame_pointer, input, c, false );
+                } else if ( iswprint( c ) ) {
+                    result = read_symbol_or_key( input, SYMBOLTAG, c );
+                } else {
+                    result =
+                        throw_exception( make_cons( c_string_to_lisp_string
+                                                    ( L"Unrecognised start of input character" ),
+                                                    make_string( c, NIL ) ),
+                                         frame_pointer );
+                }
+                break;
+        }
+    }
+    debug_print( L"read_continuation returning\n", DEBUG_IO );
+    debug_dump_object( result, DEBUG_IO );
+
+    return result;
+}
+
+/**
+ * read a number from this input stream, given this initial character.
+ * \todo Need to do a lot of inc_ref and dec_ref, to make sure the
+ * garbage is collected.
+ */
+struct cons_pointer read_number( struct stack_frame *frame,
+                                 struct cons_pointer frame_pointer,
+                                 URL_FILE * input,
+                                 wint_t initial, bool seen_period ) {
+    debug_print( L"entering read_number\n", DEBUG_IO );
+
+    struct cons_pointer result = make_integer( 0, NIL );
+    /* \todo we really need to be getting `base` from a privileged Lisp name -
+     * and it should be the same privileged name we use when writing numbers */
+    struct cons_pointer base = make_integer( 10, NIL );
+    struct cons_pointer dividend = NIL;
+    int places_of_decimals = 0;
+    wint_t c;
+    bool neg = initial == btowc( '-' );
+
+    if ( neg ) {
+        initial = url_fgetwc( input );
+    }
+
+    debug_printf( DEBUG_IO, L"read_number starting '%c' (%d)\n", initial,
+                  initial );
+
+    for ( c = initial; iswdigit( c )
+          || c == L'.' || c == L'/' || c == L','; c = url_fgetwc( input ) ) {
+        switch ( c ) {
+            case L'.':
+                if ( seen_period || !nilp( dividend ) ) {
+                    return throw_exception( c_string_to_lisp_string
+                                            ( L"Malformed number: too many periods" ),
+                                            frame_pointer );
+                } else {
+                    debug_print( L"read_number: decimal point seen\n",
+                                 DEBUG_IO );
+                    seen_period = true;
+                }
+                break;
+            case L'/':
+                if ( seen_period || !nilp( dividend ) ) {
+                    return throw_exception( c_string_to_lisp_string
+                                            ( L"Malformed number: dividend of rational must be integer" ),
+                                            frame_pointer );
+                } else {
+                    debug_print( L"read_number: ratio slash seen\n",
+                                 DEBUG_IO );
+                    dividend = result;
+
+                    result = make_integer( 0, NIL );
+                }
+                break;
+            case L',':
+                // silently ignore it.
+                break;
+            default:
+                result = add_integers( multiply_integers( result, base ),
+                                       make_integer( ( int ) c - ( int ) '0',
+                                                     NIL ) );
+
+                debug_printf( DEBUG_IO,
+                              L"read_number: added character %c, result now ",
+                              c );
+                debug_print_object( result, DEBUG_IO );
+                debug_print( L"\n", DEBUG_IO );
+
+                if ( seen_period ) {
+                    places_of_decimals++;
+                }
+        }
+    }
+
+    /*
+     * push back the character read which was not a digit
+     */
+    url_ungetwc( c, input );
+
+    if ( seen_period ) {
+        debug_print( L"read_number: converting result to real\n", DEBUG_IO );
+        struct cons_pointer div = make_ratio( frame_pointer, result,
+                                              make_integer( powl
+                                                            ( to_long_double
+                                                              ( base ),
+                                                              places_of_decimals ),
+                                                            NIL ) );
+        inc_ref( div );
+
+        result = make_real( to_long_double( div ) );
+
+        dec_ref( div );
+    } else if ( integerp( dividend ) ) {
+        debug_print( L"read_number: converting result to ratio\n", DEBUG_IO );
+        result = make_ratio( frame_pointer, dividend, result );
+    }
+
+    if ( neg ) {
+        debug_print( L"read_number: converting result to negative\n",
+                     DEBUG_IO );
+
+        result = negative( frame_pointer, result );
+    }
+
+    debug_print( L"read_number returning\n", DEBUG_IO );
+    debug_dump_object( result, DEBUG_IO );
+
+    return result;
+}
+
+/**
+ * Read a list from this input stream, which no longer contains the opening
+ * left parenthesis.
+ */
+struct cons_pointer read_list( struct stack_frame *frame,
+                               struct cons_pointer frame_pointer,
+                               URL_FILE * input, wint_t initial ) {
+    struct cons_pointer result = NIL;
+    if ( initial != ')' ) {
+        debug_printf( DEBUG_IO,
+                      L"read_list starting '%C' (%d)\n", initial, initial );
+        struct cons_pointer car =
+            read_continuation( frame, frame_pointer, input,
+                               initial );
+        result =
+            make_cons( car,
+                       read_list( frame, frame_pointer, input,
+                                  url_fgetwc( input ) ) );
+    } else {
+        debug_print( L"End of list detected\n", DEBUG_IO );
+    }
+
+    return result;
+}
+
+/**
+ * Read a string. This means either a string delimited by double quotes
+ * (is_quoted == true), in which case it may contain whitespace but may
+ * not contain a double quote character (unless escaped), or one not
+ * so delimited in which case it may not contain whitespace (unless escaped)
+ * but may contain a double quote character (probably not a good idea!)
+ */
+struct cons_pointer read_string( URL_FILE * input, wint_t initial ) {
+    struct cons_pointer cdr = NIL;
+    struct cons_pointer result;
+    switch ( initial ) {
+        case '\0':
+            result = NIL;
+            break;
+        case '"':
+            /* making a string of the null character means we can have an empty
+             * string. Just returning NIL here would make an empty string
+             * impossible. */
+            result = make_string( '\0', NIL );
+            break;
+        default:
+            result =
+                make_string( initial,
+                             read_string( input, url_fgetwc( input ) ) );
+            break;
+    }
+
+    return result;
+}
+
+struct cons_pointer read_symbol_or_key( URL_FILE * input, char *tag,
+                                        wint_t initial ) {
+    struct cons_pointer cdr = NIL;
+    struct cons_pointer result;
+    switch ( initial ) {
+        case '\0':
+            result = make_symbol_or_key( initial, NIL, tag );
+            break;
+        case '"':
+        case '\'':
+            /* unwise to allow embedded quotation marks in symbols */
+        case ')':
+        case ':':
+            /*
+             * symbols and keywords may not include right-parenthesis
+             * or colons.
+             */
+            result = NIL;
+            /*
+             * push back the character read
+             */
+            url_ungetwc( initial, input );
+            break;
+        default:
+            if ( iswprint( initial )
+                 && !iswblank( initial ) ) {
+                result =
+                    make_symbol_or_key( initial,
+                                        read_symbol_or_key( input,
+                                                            tag,
+                                                            url_fgetwc
+                                                            ( input ) ), tag );
+            } else {
+                result = NIL;
+                /*
+                 * push back the character read
+                 */
+                url_ungetwc( initial, input );
+            }
+            break;
+    }
+
+    debug_print( L"read_symbol_or_key returning\n", DEBUG_IO );
+    debug_dump_object( result, DEBUG_IO );
+
+    return result;
+}
+
+/**
+ * Read the next object on this input stream and return a cons_pointer to it.
+ */
+struct cons_pointer read( struct
+                          stack_frame
+                          *frame, struct cons_pointer frame_pointer,
+                          URL_FILE * input ) {
+    return read_continuation( frame, frame_pointer, input,
+                              url_fgetwc( input ) );
+}

src/io/read.h

@@ -0,0 +1,21 @@
+/**
+ * read.c
+ *
+ * First pass at a reader, for bootstrapping.
+ *
+ *
+ * (c) 2017 Simon Brooke <simon@journeyman.cc>
+ * Licensed under GPL version 2.0, or, at your option, any later version.
+ */
+
+#ifndef __read_h
+#define __read_h
+
+/**
+ * read the next object on this input stream and return a cons_pointer to it.
+ */
+struct cons_pointer read( struct stack_frame *frame,
+                          struct cons_pointer frame_pointer,
+                          URL_FILE * input );
+
+#endif