Struggling to get Lisp tests working; total fail, but improvements.

.gitignore

@@ -16,3 +16,4 @@ pom.xml.asc
 .clj-kondo/
 .lsp/
 resources/scratch.lsp
+Sysout*.lsp

CHANGELOG.md

@@ -1,7 +1,7 @@
 # Change Log
 All notable changes to this project will be documented in this file. This change log follows the conventions of [keepachangelog.com](http://keepachangelog.com/).
 
-## [0.2.1] - 2023-03-??
+## [0.2.1] - 2023-03-30
 
 ### Changed
 - this is fundamentally a working Lisp. The reader reads S-Expressions fully and M-Expressions at least partially. It is not (yet) a feature complete Lisp 1.5.

README.md

@@ -15,8 +15,6 @@ Boots to REPL, but few functions yet available.
 
 * [Project website](https://simon-brooke.github.io/beowulf/).
 * [Source code documentation](https://simon-brooke.github.io/beowulf/docs/codox/index.html).
-* [Test Coverage Report](https://simon-brooke.github.io/beowulf/docs/cloverage/index.html)
-
 
 ### Building and Invoking
 
@@ -101,6 +99,14 @@ The following functions and symbols are implemented:
 | UNTRACE | ? | null | ? |
 | ZEROP | Lisp function | (N) | ? |
 
+Functions described as 'Lisp function' above are defined in the default 
+sysout file, `resources/lisp1.5.lsp`, which will be loaded by default unless 
+you specify another initfile on the command line.
+
+Functions described as 'Host function' are implemented in Clojure, but if you're 
+brave you can redefine them in Lisp and the Lisp definitions will take precedence
+over the Clojure implementations.
+
 ### Architectural plan
 
 Not everything documented in this section is yet built. It indicates the

src/beowulf/bootstrap.clj

@@ -360,10 +360,9 @@
    that an argument can be passed but I'm not sure of the semantics of
    this."
   []
-  (when (lax? 'OBLIST)
   (if (instance? ConsCell @oblist)
     (make-beowulf-list (map CAR @oblist))
-      NIL)))
+    NIL))
 
 (defn DEFINE
   "Bootstrap-only version of `DEFINE` which, post boostrap, can be overwritten 
@@ -396,65 +395,78 @@
     symbol val)
     NIL))
 
+(defn- traced-apply
+  "Like `APPLY`, but with trace output to console."
+  [function-symbol args lisp-fn environment depth]
+  (let [indent (apply str (repeat depth "-"))]
+    (println (str indent "> " function-symbol " " args))
+    (let [r (APPLY lisp-fn args environment depth)]
+      (println (str "<" indent " " r))
+      r)))
+
+(defn- safe-apply 
+  "We've a real problem with varargs functions when `args` is `NIL`, because
+   Clojure does not see `NIL` as an empty sequence."
+  [clj-fn args]
+  (let [args' (when (instance? ConsCell args) args)]
+    (apply clj-fn args')))
+
 (defn- apply-symbolic
   "Apply this `funtion-symbol` to these `args` in this `environment` and 
    return the result."
-  [^Symbol function-symbol ^ConsCell args ^ConsCell environment depth]
+  [^Symbol function-symbol args ^ConsCell environment depth]
-  (let [fn (try (EVAL function-symbol environment depth)
+  (let [lisp-fn (try (EVAL function-symbol environment depth)
                      (catch Throwable any (when (:trace *options*)
-                                       (println any))))
+                                            (println any))))]
-        indent (apply str (repeat depth "-"))]
+    (if (and lisp-fn
-    (if (and fn (not= fn NIL))
+             (not= lisp-fn NIL)) (if (traced? function-symbol)
-      (if (traced? function-symbol)
+                                   (traced-apply function-symbol
-        (do
+                                                 args
-         (println (str indent "> " function-symbol " " args))
+                                                 lisp-fn
-         (let [r (APPLY fn args environment depth)]
+                                                 environment
-           (println (str "<" indent " " r))
+                                                 depth)
-           r))
+                                   (APPLY lisp-fn args environment depth))
-        (APPLY fn args environment depth))
         (case function-symbol ;; there must be a better way of doing this!
-        ADD1 (apply ADD1 args)
+          ADD1 (safe-apply ADD1 args)
-        AND (apply AND args)
+          AND (safe-apply AND args)
-        APPEND (apply APPEND args)
+          APPEND (safe-apply APPEND args)
-        APPLY (apply APPLY args)
+          APPLY (safe-apply APPLY args) ;; TODO: need to pass the environment and depth
           ATOM (ATOM? (CAR args))
           CAR (CAAR args)
           CDR (CDAR args)
           CONS (make-cons-cell (CAR args) (CADR args))
           DEFINE (DEFINE (CAR args))
           DIFFERENCE (DIFFERENCE (CAR args) (CADR args))
-        EQ (apply EQ args)
+          EQ (safe-apply EQ args)
-        EQUAL (apply EQUAL args)
+          EQUAL (safe-apply EQUAL args)
-        ERROR (apply ERROR args)
+          ERROR (safe-apply ERROR args)
         ;; think about EVAL. Getting the environment right is subtle
-        FIXP (apply FIXP args)
+          FIXP (safe-apply FIXP args)
           GENSYM (GENSYM)
-        GREATERP (apply GREATERP args)
+          GREATERP (safe-apply GREATERP args)
-        INTEROP (when (lax? INTEROP) (apply INTEROP args))
+          INTEROP (when (lax? INTEROP) (safe-apply INTEROP args))
-        LESSP (apply LESSP args)
+          LESSP (safe-apply LESSP args)
-        LIST (apply LIST args)
+          LIST (safe-apply LIST args)
-        NUMBERP (apply NUMBERP args)
+          NUMBERP (safe-apply NUMBERP args)
           OBLIST (OBLIST)
-        PLUS (apply PLUS args)
+          PLUS (safe-apply PLUS args)
           PRETTY (when (lax? 'PRETTY)
-                 (apply pretty-print args))
+                   (safe-apply pretty-print args))
-        PRINT (apply print args)
+          PRINT (safe-apply print args)
-        QUOTIENT (apply QUOTIENT args)
+          QUOTIENT (safe-apply QUOTIENT args)
           READ (READ)
-        REMAINDER (apply REMAINDER args)
+          REMAINDER (safe-apply REMAINDER args)
-        RPLACA (apply RPLACA args)
+          RPLACA (safe-apply RPLACA args)
-        RPLACD (apply RPLACD args)
+          RPLACD (safe-apply RPLACD args)
-        SET (apply SET args)
+          SET (safe-apply SET args)
           SYSIN (when (lax? 'SYSIN)
-                (apply SYSIN args))
+                  (safe-apply SYSIN args))
           SYSOUT (when (lax? 'SYSOUT)
-                 (if (empty? args)
+                   (safe-apply SYSOUT args))
-                   (SYSOUT)
-                   (apply SYSOUT args)))
           TERPRI (println)
-        TIMES (apply TIMES args)
+          TIMES (safe-apply TIMES args)
-        TRACE (apply TRACE args)
+          TRACE (safe-apply TRACE args)
-        UNTRACE (apply UNTRACE args)
+          UNTRACE (safe-apply UNTRACE args)
         ;; else
           (ex-info "No function found"
                    {:context "APPLY"

src/beowulf/cons_cell.clj

@@ -138,7 +138,7 @@
          (cond
            (instance? ConsCell (. this CDR)) (str " " (subs (.toString (. this CDR)) 1))
            (= NIL (. this CDR)) ")"
-           :else (str " . " (. this CDR))))))
+           :else (str " . " (. this CDR) ")")))))
 
 (defn- to-string
   "Printing ConsCells gave me a *lot* of trouble. This is an internal function
@@ -161,12 +161,9 @@
                 s
                 (to-string car)
                 (cond
-                  (or (nil? cdr) (= cdr NIL))
+                  (or (nil? cdr) (= cdr NIL)) ")"
-                  ")"
+                  cons?  " "
-                  cons?
+                  :else (str " . " (to-string cdr) ")")))]
-                  " "
-                  :else
-                  (str " . " (to-string cdr) ")")))]
         (if
          cons?
           (recur cdr (inc n) ss)

src/beowulf/io.clj

@@ -71,7 +71,9 @@
    **NOTE THAT** if the provided `filename` does not end with `.lsp` (which,
    if you're writing it from the Lisp REPL, it won't), the extension `.lsp`
    will be appended."
-  [filename]
+  ([]
+   (SYSIN (or (:read *options*) "resources/lisp1.5.lsp")))
+  ([filename]
   (let [fp (file (full-path (str filename)))
         file (when (and (.exists fp) (.canRead fp)) fp)
         res (try (resource filename)
@@ -82,4 +84,4 @@
                                        {:context "SYSIN"
                                         :filepath fp}
                                        any))))]
-    (swap! oblist #(when (or % (seq content)) content))))
+    (swap! oblist #(when (or % (seq content)) content)))))

src/beowulf/oblist.clj

@@ -6,7 +6,12 @@
   )
 
 (def NIL
-  "The canonical empty list symbol."
+  "The canonical empty list symbol.
+   
+   TODO: this doesn't really work, because (from Clojure) `(empty? NIL)` throws
+   an exception. It might be better to subclass beowulf.cons_cell.ConsCell to create
+   a new singleton class Nil which overrides the `empty` method of 
+   IPersistentCollection?"
   'NIL)
 
 (def oblist

test/beowulf/lisp_test.clj

@@ -0,0 +1,32 @@
+(ns beowulf.lisp-test
+  "The idea here is to test actual Lisp functions"
+  (:require [clojure.test :refer [deftest testing is use-fixtures]]
+            [beowulf.bootstrap :refer [EVAL]]
+            [beowulf.cons-cell :refer [make-beowulf-list]]
+            [beowulf.io :refer [SYSIN]]
+            [beowulf.read :refer [READ]]))
+
+;; (use-fixtures :once (fn [f]
+;;                        (try (SYSIN "resources/lisp1.5.lsp")
+;;                        (f)
+;;                             (catch Throwable any
+;;                               (throw (ex-info "Failed to load Lisp sysout"
+;;                                               {:phase test
+;;                                                :function 'SYSIN
+;;                                                :file "resources/lisp1.5.lsp"}))))))
+
+;; (deftest "COPY test"
+;;   ;; (testing "copy NIL"
+;;   ;;   (println "in-test: " (SYSIN "resources/lisp1.5.lsp"))
+;;   ;;   (let [expected "NIL"
+;;   ;;         actual (with-out-str (println (EVAL (READ "(COPY NIL)"))))]
+;;   ;;     (is (= actual expected))))
+;;   (testing "copy straight list"
+;;     (println "in-test: " (SYSIN "resources/lisp1.5.lsp"))
+;;     (let [expected (make-beowulf-list '(A B C))
+;;           actual (with-out-str (print (EVAL (READ "(COPY '(A B C))"))))]
+;;       (is (= actual expected))))
+;;   (testing "copy assoc list"
+;;     (let [expected "((A . 1) (B . 2) (C . 3))"
+;;           actual (with-out-str (println (EVAL (READ "(COPY '((A . 1) (B . 2) (C . 3)))"))))]
+;;       (is (= actual expected)))))

test/beowulf/mexpr_test.clj

@@ -53,7 +53,7 @@
     ;; I suspect as (CAR (LIST A B C)).
 
     (let [expected "(CAR (LIST A B C))"
-          actual (print-str (gsp "car[(A B C)]"))]
+          actual (print-str (gsp "car[ list[a; b; c]]"))]
       (is (= actual expected)))
     ))