Made the string returned by c_type null-character terminated. Fixes #6.

This is probably the wrong fix; probably I should have fixed read_string
so that it did not create null-character terminated strings, but it will
do for now. Probably will revisit.

docs/Home.md

@@ -115,7 +115,7 @@ The following functions are provided as of release 0.0.6:
 | not | FUNC | `(not arg)`: Return`t` only if `arg` is `nil`, else `nil`. |
 | nλ | SPFM | `(nlamda arg-list forms...)`: Construct an interpretable special form. When the form is interpreted, arguments specified in the `arg-list` will not be evaluated. |
 | oblist | FUNC | `(oblist)`: Return the current top-level symbol bindings, as a map. |
-| open | FUNC | `(open url read?)`: Open a stream to this `url`. If `read` is present and is non-nil, open it for reading, else writing. |
+| open | FUNC | `(open url write?)`: Open a stream to this `url`. If `write?` is present and is non-nil, open it for writing, else reading. |
 | or | FUNC | `(or args...)`: Return a logical `or` of all the arguments and return `t` if any is truthy, else `nil`. |
 | print | FUNC | `(print object stream)`: Print `object` to `stream`, if specified, else to `*out*`. |
 | progn | SPFM | `(progn forms...)`: Evaluate these `forms` sequentially, and return the value of the last. |
@@ -129,7 +129,7 @@ The following functions are provided as of release 0.0.6:
 | reverse | FUNC | `(reverse sequence)` Returns a sequence of the top level elements of this `sequence`, which may be a list or a string, in the reverse order. |
 | set | FUNC | null |
 | set! | SPFM | null |
-| slurp | FUNC | null |
+| slurp | FUNC | `(slurp read-stream)` Read all the characters from `read-stream` to the end of stream, and return them as a string. |
 | source | FUNC | `(source  object)`: If `object` is an interpreted function or interpreted special form, returns the source code; else nil. Once we get a compiler working, will also return the source code of compiled functions and special forms. |
 | subtract | FUNC | `(- a b)`: Subtracts `b` from `a` and returns the result. Expects both arguments to be numbers. |
 | throw | FUNC | null |

lisp/scratchpad.lisp

@@ -46,3 +46,7 @@
 
 "This blows up: 10^37, which is a three cell bignum."
 (inspect (set! final (+ z z z z z z z z z z)))
+
+(mapcar (lambda (n) (list (:name (meta n)) (:documentation (meta n)))) (keys (oblist)))
+
+((keys "`(keys store)`: Return a list of all keys in this `store`.") (set nil) (let nil) (quote nil) (nil nil) (read nil) (nil nil) (nil nil) (oblist "`(oblist)`: Return the current symbol bindings, as a map.") (cons "`(cons a b)`: Return a cons cell whose `car` is `a` and whose `cdr` is `b`.") (source nil) (cond nil) (nil nil) (eq? "`(eq? args...)`: Return `t` if all args are the exact same object, else `nil`.") (close "`(close stream)`: If `stream` is a stream, close that stream.") (meta "`(meta symbol)`: If the binding of `symbol` has metadata, return that metadata, else `nil`.") (nil nil) (not "`(not arg)`: Return`t` only if `arg` is `nil`, else `nil`.") (mapcar "`(mapcar function sequence)`: Apply `function` to each element of `sequence` in turn, and return a sequence of the results.") (negative? "`(negative? n)`: Return `t` if `n` is a negative number, else `nil`.") (open "`(open url read?)`: Open a stream to this `url`. If `read` is present and is non-nil, open it for reading, else writing.") (subtract nil) (nil nil) (nil nil) (nil nil) (or "`(or args...)`: Return a logical `or` of all the arguments and return `t` if any is truthy, else `nil`.") (nil nil) (and "`(and args...)`: Return a logical `and` of all the arguments and return `t` only if all are truthy, else `nil`.") (count "`(count s)`: Return the number of items in the sequence `s`.") (eval nil) (nλ nil) (nil nil) (nil nil) (nil nil) (nil nil) (cdr "`(cdr arg)`: If `arg` is a sequence, return the remainder of that sequence with the first item removed.") (equal? "`(equal? args...)`: Return `t` if all args have logically equivalent value, else `nil`.") (set! nil) (nil nil) (nil nil) (reverse nil) (slurp nil) (try nil) (assoc "`(assoc key store)`: Return the value associated with this `key` in this `store`.") (nil nil) (add "`(+ args...)`: If `args` are all numbers, return the sum of those numbers.") (list "`(list args...): Return a list of these `args`.") (time nil) (car "`(car arg)`: If `arg` is a sequence, return the item which is the head of that sequence.") (nil nil) (nil nil) (nil nil) (absolute "`(absolute arg)`: If `arg` is a number, return the absolute value of that number, else `nil`.") (append "`(append args...)`: If args are all collections, return the concatenation of those collections.") (apply "`(apply f args)`: If `f` is usable as a function, and `args` is a collection, apply `f` to `args` and return the value.") (divide "`(/ a b)`: If `a` and `b` are both numbers, return the numeric result of dividing `a` by `b`.") (exception "`(exception message)`: Return (throw) an exception with this `message`.") (get-hash "`(get-hash arg)`: returns the natural number hash value of `arg`.") (hashmap "`(hashmap n-buckets hashfn store acl)`: Return a new hashmap, with `n-buckets` buckets and this `hashfn`, containing the content of this `store`.") (inspect "`(inspect object ouput-stream)`: Print details of this `object` to this `output-stream` or `*out*`.") (metadata "`(metadata symbol)`: If the binding of `symbol` has metadata, return that metadata, else `nil`.") (multiply "`(* args...)` Multiply these `args`, all of which should be numbers.") (print "`(print object stream)`: Print `object` to `stream`, if specified, else to `*out*`.") (put! nil) (put-all! nil) (ratio->real "`(ratio->real r)`: If `r` is a rational number, return the real number equivalent.") (read-char nil) (repl nil) (throw nil) (type nil) (+ "`(+ args...)`: If `args` are all numbers, return the sum of those numbers.") (* nil) (- nil) (/ nil) (= "`(equal? args...)`: Return `t` if all args have logically equivalent value, else `nil`.") (lambda nil) (λ nil) (nlambda nil) (progn nil) (nil nil) (nil nil) (nil nil) (nil nil) (nil nil) (nil nil) (nil nil) (nil nil) (nil nil) (nil nil))

src/init.c

@@ -387,7 +387,7 @@ int main( int argc, char *argv[] ) {
         L"`(not arg)`: Return`t` only if `arg` is `nil`, else `nil`.",
         &lisp_not);
     bind_function( L"oblist", L"`(oblist)`: Return the current symbol bindings, as a map.", &lisp_oblist );
-    bind_function( L"open", L"`(open url read?)`: Open a stream to this `url`. If `read` is present and is non-nil, open it for reading, else writing.", &lisp_open );
+    bind_function( L"open", L"`(open url write?)`: Open a stream to this `url`. If `write?` is present and is non-nil, open it for writing, else reading.", &lisp_open );
     bind_function( L"or", 
         L"`(or args...)`: Return a logical `or` of all the arguments and return `t` if any is truthy, else `nil`.",
         &lisp_or);

src/io/io.c

@@ -420,7 +420,7 @@ struct cons_pointer get_default_stream( bool inputp, struct cons_pointer env ) {
 
 /**
  * Function: return a stream open on the URL indicated by the first argument;
- * if a second argument is present and is non-nil, open it for reading. At
+ * if a second argument is present and is non-nil, open it for writing. At
  * present, further arguments are ignored and there is no mechanism to open
  * to append, or error if the URL is faulty or indicates an unavailable
  * resource.

src/memory/consspaceobject.c

@@ -114,11 +114,15 @@ struct cons_pointer dec_ref( struct cons_pointer pointer ) {
  * @return As a Lisp string, the tag of the object which is at that pointer.
  */
 struct cons_pointer c_type( struct cons_pointer pointer ) {
-    struct cons_pointer result = NIL;
-    struct cons_space_object cell = pointer2cell( pointer );
+    /* Strings read by `read` have the null character termination. This means 
+     * that for the same printable string, the hashcode is different from 
+     * strings made with NIL termination. The question is which should be 
+     * fixed, and actually that's probably strings read by `read`. However,
+     * for now, it was easier to add a null character here. */
+    struct cons_pointer result = make_string( (wchar_t) 0, NIL);
+    struct cons_space_object * cell = &pointer2cell( pointer );
 
-    if ( strncmp( ( char * ) &cell.tag.bytes, VECTORPOINTTAG, TAGLENGTH ) ==
-         0 ) {
+    if ( cell->tag.value == VECTORPOINTTV ) {
         struct vector_space_object *vec = pointer_to_vso( pointer );
 
         for ( int i = TAGLENGTH - 1; i >= 0; i-- ) {
@@ -127,7 +131,7 @@ struct cons_pointer c_type( struct cons_pointer pointer ) {
         }
     } else {
         for ( int i = TAGLENGTH - 1; i >= 0; i-- ) {
-            result = make_string( ( wchar_t ) cell.tag.bytes[i], result );
+            result = make_string( ( wchar_t ) cell->tag.bytes[i], result );
         }
     }
 
@@ -333,6 +337,8 @@ struct cons_pointer make_string_like_thing( wint_t c, struct cons_pointer tail,
         cell->payload.string.cdr = tail;
 
         cell->payload.string.hash = calculate_hash( c, tail );
+        debug_dump_object( pointer, DEBUG_ALLOC);
+        debug_println( DEBUG_ALLOC);
     } else {
         // \todo should throw an exception!
         debug_printf( DEBUG_ALLOC,

unit-tests/equal.sh

@@ -0,0 +1,206 @@
+#!/bin/bash
+
+# Tests for equality.
+
+result=0
+
+echo -n "$0: integers... "
+
+expected="t"
+actual=`echo "(= 5 5)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: different integers... "
+
+expected="nil"
+actual=`echo "(= 4 5)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+
+echo -n "$0: reals... "
+
+expected="t"
+actual=`echo "(= 5.001 5.001)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+
+echo -n "$0: different reals... "
+
+expected="nil"
+actual=`echo "(= 5.001 5.002)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: ratios... "
+
+expected="t"
+actual=`echo "(= 4/5 4/5)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+
+echo -n "$0: equivalent ratios... "
+
+expected="t"
+actual=`echo "(= 4/5 12/15)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+
+echo -n "$0: different ratios... "
+
+expected="nil"
+actual=`echo "(= 4/5 5/5)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: atoms... "
+
+expected="t"
+actual=`echo "(= 'foo 'foo)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: different atoms... "
+
+expected="nil"
+actual=`echo "(= 'foo 'bar)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: keywords... "
+
+expected="t"
+actual=`echo "(= :foo :foo)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: different keywords... "
+
+expected="nil"
+actual=`echo "(= :foo :bar)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: strings... "
+
+expected="t"
+actual=`echo '(= "foo" "foo")' | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: different strings... "
+
+expected="nil"
+actual=`echo '(= "foo" "bar")' | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: maps... "
+
+expected="t"
+actual=`echo '(= {:foo 1 :bar 2} {:bar 2 :foo 1})' | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: different maps... "
+
+expected="nil"
+actual=`echo '(= {:foo 1 :bar 2} {:bar 1 :foo 2})' | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+exit ${result}