Not really making progress.

lisp/not-working-yet.lisp

@@ -0,0 +1,6 @@
+(set! or (lambda values
+                 "True if any of `values` are non-nil."
+                 (cond
+                   ((nil? values) nil)
+                   ((car values) t)
+                   (t (eval (cons 'or (cdr values)))))))

lisp/types.lisp

@@ -15,10 +15,3 @@
 (set! true? (lambda (o) "True if o is the canonical true value." (= (type o) "TRUE") ) )
 (set! write? (lambda (o) "True if o is a write stream." (= (type o) "WRIT") ) )
 
-(set! or (lambda values
-                 "True if any of `values` are non-nil."
-                 (cond ((car values) t) (t (apply 'or (cdr values))))))
-
-(set! number?
-      (lambda (o)
-              "I don't yet have an `or` operator

src/init.c

@@ -146,6 +146,7 @@ int main( int argc, char *argv[] ) {
     bind_function( L"progn", &lisp_progn );
     bind_function( L"reverse", &lisp_reverse );
     bind_function( L"set", &lisp_set );
+    bind_function( L"source", &lisp_source );
     bind_function( L"subtract", &lisp_subtract );
     bind_function( L"throw", &lisp_exception );
     bind_function( L"type", &lisp_type );

src/ops/lispops.c

@@ -1035,18 +1035,21 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
          * are not visible. So copy changes made in the oblist into the enviroment.
          * TODO: the whole process of resolving symbol values needs to be revisited
          * when we get onto namespaces. */
-        struct cons_pointer cursor = oblist;
-        while ( !nilp( cursor ) && !eq( cursor, old_oblist ) ) {
-            debug_print
-                ( L"lisp_repl: copying new oblist binding into REPL environment:\n",
-                  DEBUG_REPL );
-            debug_print_object( c_car( cursor ), DEBUG_REPL );
-            debug_println( DEBUG_REPL );
+        if ( !eq( oblist, old_oblist ) ) {
+            struct cons_pointer cursor = oblist;
 
-            new_env = make_cons( c_car( cursor ), new_env );
-            cursor = c_cdr( cursor );
+            while ( !nilp( cursor ) && !eq( cursor, old_oblist ) ) {
+                debug_print
+                    ( L"lisp_repl: copying new oblist binding into REPL environment:\n",
+                      DEBUG_REPL );
+                debug_print_object( c_car( cursor ), DEBUG_REPL );
+                debug_println( DEBUG_REPL );
+
+                new_env = make_cons( c_car( cursor ), new_env );
+                cursor = c_cdr( cursor );
+            }
+            old_oblist = oblist;
         }
-        old_oblist = oblist;
 
         println( os );
 
@@ -1079,3 +1082,40 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
 
     return expr;
 }
+
+/**
+ * (source object)
+ *
+ * Function.
+ * Return the source code of the object, if it is an executable
+ * and has source code.
+ */
+struct cons_pointer lisp_source( struct stack_frame *frame,
+                                 struct cons_pointer frame_pointer,
+                                 struct cons_pointer env ) {
+    struct cons_pointer result = NIL;
+    struct cons_space_object cell = pointer2cell( frame->arg[0] );
+
+    switch ( cell.tag.value ) {
+        case FUNCTIONTV:
+            result = cell.payload.function.source;
+            break;
+        case SPECIALTV:
+            result = cell.payload.special.source;
+            break;
+        case LAMBDATV:
+            result = make_cons( c_string_to_lisp_symbol( L"lambda" ),
+                                make_cons( cell.payload.lambda.args,
+                                           cell.payload.lambda.body ) );
+            break;
+        case NLAMBDATV:
+            result = make_cons( c_string_to_lisp_symbol( L"nlambda" ),
+                                make_cons( cell.payload.lambda.args,
+                                           cell.payload.lambda.body ) );
+            break;
+    }
+    // TODO: suffers from premature GC, and I can't see why!
+    inc_ref( result );
+
+    return result;
+}

src/ops/lispops.h

@@ -197,3 +197,7 @@ struct cons_pointer throw_exception( struct cons_pointer message,
 struct cons_pointer
 lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 struct cons_pointer env );
+
+struct cons_pointer lisp_source( struct stack_frame *frame,
+                                 struct cons_pointer frame_pointer,
+                                 struct cons_pointer env );

src/ops/read.c

@@ -275,6 +275,9 @@ struct cons_pointer read_string( FILE * input, wint_t initial ) {
             result = make_string( initial, 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:
@@ -302,9 +305,9 @@ struct cons_pointer read_symbol( FILE * input, wint_t initial ) {
             break;
         case ')':
             /*
-             * unquoted strings may not include right-parenthesis
+             * symbols may not include right-parenthesis
              */
-            result = make_symbol( '\0', NIL );
+            result = NIL;
             /*
              * push back the character read
              */