Much improvement; printing works, and bootstrap tests started

There's probably redundant code in this, but I want to commit here just in case what I think is redundant isn't!

src/beowulf/cons_cell.clj

@@ -14,13 +14,19 @@
   ;; next and more must return ISeq:
   ;; https://github.com/clojure/clojure/blob/master/src/jvm/clojure/lang/ISeq.java
   (more [this] (if
-                 (= (.CDR this) NIL)
+                 (seq? this)
-                 clojure.lang.PersistentList/EMPTY
+                 (if
-                 (.CDR this)))
+                   (= (.CDR this) NIL)
+                   clojure.lang.PersistentList/EMPTY
+                   (.CDR this))
+                 NIL))
   (next [this] (if
-                 (= (.CDR this) NIL)
+                 (seq? this)
-                 nil ;; next returns nil when empty
+                 (if
-                 (.CDR this)))
+                   (= (.CDR this) NIL)
+                   nil ;; next returns nil when empty
+                   (.CDR this))
+                 NIL))
 
   clojure.lang.Seqable
   (seq [this] this)
@@ -31,12 +37,50 @@
 
   clojure.lang.IPersistentCollection
   (count [this] (if
-                 (= (.CDR this) NIL)
+                  (seq? this)
-                  0
+                  (if
-                  (inc (count (.CDR this)))))
+                    (= (.CDR this) NIL)
+                    0
+                    (inc (count (.CDR this))))
+                  0))
   (empty [this] false)
   (equiv [this other] false))
 
+(defn- to-string
+  "Printing ConsCells gave me a *lot* of trouble. This is an internal function
+  used by the print-method override (below) in order that the standard Clojure
+  `print` and `str` functions will print ConsCells correctly. The argument
+  `cell` must, obviously, be an instance of `ConsCell`."
+  [cell]
+  (loop [c cell
+         n 0
+         s "("]
+    (if
+      (instance? beowulf.cons_cell.ConsCell c)
+      (let [car (.CAR c)
+            cdr (.CDR c)
+            cons? (instance? beowulf.cons_cell.ConsCell cdr)
+            ss (str
+                 s
+                 (to-string car)
+                 (cond
+                   cons?
+                   " "
+                   (or (nil? cdr) (= cdr 'NIL))
+                   ")"
+                   :else
+                   (str " . " (to-string cdr) ")")))]
+        (if
+          cons?
+          (recur cdr (inc n) ss)
+          ss))
+      (str c))))
+
+(defmethod clojure.core/print-method beowulf.cons_cell.ConsCell
+  [this writer]
+  (.write writer (to-string this)))
+
+
 (defn make-cons-cell
   [a d]
   (ConsCell. a d))

src/beowulf/core.clj

@@ -1,7 +1,6 @@
 (ns beowulf.core
   (:require [beowulf.eval :refer [primitive-eval oblist]]
-            [beowulf.read :refer [primitive-read]]
+            [beowulf.read :refer [primitive-read]])
-            [beowulf.print :refer [primitive-print prin]])
   (:gen-class))
 
 (defn -main
@@ -12,6 +11,6 @@
     (print ":: ")
     (flush)
     (let [input (primitive-read)]
-      (println (str "\tI read: " (prin input)))
+      (println (str "\tI read: " input))
-      (println (str ">  "(prin (primitive-eval input @oblist))))
+      (println (str ">  " (primitive-eval input @oblist)))
       (recur))))

src/beowulf/eval.clj

@@ -31,14 +31,18 @@
   (if
     (instance? beowulf.cons_cell.ConsCell x)
     (.CAR x)
-    NIL))
+    (throw
+      (Exception.
+        (str "Cannot take CAR of `" x "` (" (.getName (.getClass x)) ")")))))
 
 (defn cdr
   [x]
   (if
     (instance? beowulf.cons_cell.ConsCell x)
     (.CDR x)
-    NIL))
+    (throw
+      (Exception.
+        (str "Cannot take CDR of `" x "` (" (.getName (.getClass x)) ")")))))
 
 (defn uaf
   "Universal access function; `l` is expected to be an arbitrary list, `path`
@@ -47,14 +51,10 @@
   [l path]
   (cond
     (null l) NIL
-    (not (instance? beowulf.cons_cell.ConsCell l))
+    (empty? path) l
-    (throw (Exception. (str "Unexpected list argument to uaf: `" l "`")))
+    :else (case (last path)
-    (empty? (rest path))(case (first path)
+            \a (uaf (car l) (butlast path))
-                          \a (car l)
+            \d (uaf (cdr l) (butlast path)))))
-                          \d (cdr l))
-    :else (case (first path)
-            \a (uaf (car l) (rest path))
-            \d (uaf (cdr l) (rest path)))))
 
 (defn caar [x] (uaf x (seq "aa")))
 (defn cadr [x] (uaf x (seq "ad")))

src/beowulf/print.clj

@@ -1,59 +0,0 @@
-(ns beowulf.print
-  )
-
-(defprotocol Printable
-  (prin [x]))
-
-(extend-type
-  clojure.lang.Symbol
-  Printable
-  (prin [x] (str x)))
-
-(extend-protocol
-  Printable
-  nil
-  (prin [x] "NIL"))
-
-(extend-protocol
-  Printable
-
-  clojure.lang.Symbol
-  (prin [x] (str x))
-
-  java.lang.Number
-  (prin [x] (str x))
-
-  beowulf.cons_cell.ConsCell
-  (prin [x]
-        (loop [c x
-               n 0
-               s "("]
-          (let [car (.CAR c)
-                cdr (.CDR c)
-                cons? (instance? beowulf.cons_cell.ConsCell cdr)
-                ss (str
-                     s
-                     (prin car)
-                     (cond
-                       cons?
-                       " "
-                       (or (nil? cdr) (= cdr 'NIL))
-                       ")"
-                       :else
-                       (str " . " (prin cdr) ")")))]
-            (if
-              cons?
-              (recur cdr (inc n) ss)
-              ss))))
-
-  java.lang.Object
-  (prin
-    [x]
-    (str x)))
-
-(defn primitive-print
-  [x]
-  (if
-    (satisfies? beowulf.print.Printable x) (prin x)
-    (str x)))
-

test/beowulf/bootstrap_test.clj

@@ -0,0 +1,116 @@
+(ns beowulf.bootstrap-test
+  (:require [clojure.math.numeric-tower :refer [abs]]
+            [clojure.test :refer :all]
+            [beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL T F]]
+            [beowulf.eval :refer :all]
+            [beowulf.read :refer [parse simplify generate]]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; This file is primarily tests of the functions in `beowulf.eval` - which
+;;; are Clojure functions, but aim to provide sufficient functionality that
+;;; Beowulf can get up to the level of running its own code.
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(deftest atom-tests
+  (testing "primitive-atom"
+    (let [expected T
+          actual (primitive-atom T)]
+      (is (= actual expected) "T is an atom (symbol)"))
+    (let [expected T
+          actual (primitive-atom (generate (simplify (parse "HELLO"))))]
+      (is (= actual expected) "HELLO is an atom (symbol)"))
+    (let [expected T
+          actual (primitive-atom 7)]
+      (is (= actual expected)
+          "I'm not actually certain whether a number should be treated as an
+          atom, but I'm guessing so"))
+    (let [expected F
+          actual (primitive-atom (make-cons-cell 'A 'B))]
+      (is (= actual expected) "A dotted pair is explicitly not an atom."))
+    (let [expected F
+          actual (primitive-atom (generate (simplify (parse "(A B C D)"))))]
+      (is (= actual expected) "A list is explicitly not an atom")))
+  (testing "primitive-atom?"
+    (let [expected T
+          actual (primitive-atom? T)]
+      (is (= actual expected) "T is an atom (symbol)"))
+    (let [expected T
+          actual (primitive-atom? (generate (simplify (parse "HELLO"))))]
+      (is (= actual expected) "HELLO is an atom (symbol)"))
+    (let [expected T
+          actual (primitive-atom? 7)]
+      (is (= actual expected)
+          "I'm not actually certain whether a number should be treated as an
+          atom, but I'm guessing so"))
+    (let [expected NIL
+          actual (primitive-atom? (make-cons-cell 'A 'B))]
+      (is (= actual expected) "A dotted pair is explicitly not an atom."))
+    (let [expected NIL
+          actual (primitive-atom? (generate (simplify (parse "(A B C D)"))))]
+      (is (= actual expected) "A list is explicitly not an atom"))
+
+    ))
+
+(deftest access-function-tests
+  (testing "car"
+    (let [expected 'A
+          actual (car (make-cons-cell 'A 'B))]
+      (is (= actual expected) "A is car of (A . B)"))
+    (let [expected 'A
+          actual (car (generate (simplify (parse "(A B C D)"))))]
+      (is (= actual expected) "A is car of (A B C D)"))
+    (is (thrown-with-msg?
+          Exception
+          #"Cannot take CAR of `.*"
+          (car 'T))
+        "Can't take the car of an atom")
+    (is (thrown-with-msg?
+          Exception
+          #"Cannot take CAR of `.*"
+          (car 7))
+        "Can't take the car of a number"))
+  (testing "cdr"
+    (let [expected 'B
+          actual (cdr (make-cons-cell 'A 'B))]
+      (is (= actual expected) "B is cdr of (A . B)"))
+    (let [expected 'B
+          actual (cdr (generate (simplify (parse "(A B C D)"))))]
+      (is (instance? beowulf.cons_cell.ConsCell actual)
+          "cdr of (A B C D) is a cons cell")
+      (is (= (car actual) expected) "the car of that cons-cell is B"))
+    (is (thrown-with-msg?
+          Exception
+          #"Cannot take CDR of `.*"
+          (cdr 'T))
+        "Can't take the cdr of an atom")
+    (is (thrown-with-msg?
+          Exception
+          #"Cannot take CDR of `.*"
+          (cdr 7))
+        "Can't take the cdr of a number"))
+  (let [s (generate
+            (simplify
+              (parse
+                "((((1 . 2) 3)(4 5) 6)(7 (8 9) (10 11 12) 13) 14 (15 16) 17)")))]
+    ;; structure for testing access functions
+    (testing "cadr"
+      (let [expected 'B
+            actual (cadr (generate (simplify (parse "(A B C D)"))))]
+        (is (= actual expected))))
+    (testing "caddr"
+      (let [expected 'C
+            actual (caddr (generate (simplify (parse "(A B C D)"))))]
+        (is (= actual expected))))
+    (testing "cadddr"
+      (let [expected 'D
+            actual (cadddr (generate (simplify (parse "(A B C D)"))))]
+        (is (= actual expected))))
+    (testing "caaaar"
+      (let [expected "1"
+            actual (print-str (caaaar s))]
+        (is (= actual expected))))
+    ))
+
+

test/beowulf/mexpr_test.clj

@@ -1,7 +1,6 @@
 (ns beowulf.mexpr-test
   (:require [clojure.test :refer :all]
-            [beowulf.read :refer [parse simplify generate]]
+            [beowulf.read :refer [parse simplify generate]]))
-            [beowulf.print :refer :all]))
 
 ;; These tests are taken generally from the examples on page 10 of
 ;; Lisp 1.5 Programmers Manual:
@@ -23,10 +22,10 @@
 (deftest variable-tests
   (testing "Variable translation"
     (let [expected "X"
-          actual (prin (generate (simplify (parse "x"))))]
+          actual (print-str (generate (simplify (parse "x"))))]
       (is (= actual expected)))
     (let [expected "CAR"
-          actual (prin (generate (simplify (parse "car"))))]
+          actual (print-str (generate (simplify (parse "car"))))]
       (is (= actual expected)))
     ))
 
@@ -38,7 +37,7 @@
     ;; "T" would be interpreted as a sexpr, which would not be
     ;; quoted.
     (let [expected "(ATOM (QUOTE T))"
-          actual (prin (generate (simplify (parse "atom[T]"))))]
+          actual (print-str (generate (simplify (parse "atom[T]"))))]
       (is (= actual expected)))
     ;; I'm not clear how `car[(A B C)]` should be translated, but
     ;; I suspect as (CAR (LIST 'A 'B 'C)).
@@ -47,19 +46,19 @@
 (deftest fncall-tests
   (testing "Function calls"
     (let [expected "(CAR X)"
-          actual (prin (generate (simplify (parse "car[x]"))))]
+          actual (print-str (generate (simplify (parse "car[x]"))))]
       (is (= actual expected)))
     (let [expected "(FF (CAR X))"
-          actual (prin (generate (simplify (parse "ff[car[x]]"))))]
+          actual (print-str (generate (simplify (parse "ff[car[x]]"))))]
       (is (= actual expected)))))
 
 (deftest conditional-tests
   (testing "Conditional expressions"
     (let [expected "(COND ((ATOM X) X) ((QUOTE T) (FF (CAR X))))"
-          actual (prin (generate (simplify (parse "[atom[x]->x; T->ff[car[x]]]"))))]
+          actual (print-str (generate (simplify (parse "[atom[x]->x; T->ff[car[x]]]"))))]
       (is (= actual expected)))
     (let [expected "(LABEL FF (LAMBDA (X) (COND ((ATOM X) X) ((QUOTE T) (FF (CAR X))))))"
-          actual (prin
+          actual (print-str
                    (generate
                      (simplify
                        (parse "label[ff;λ[[x];[atom[x]->x; T->ff[car[x]]]]]"))))]

test/beowulf/read_test.clj

@@ -1,8 +0,0 @@
-(ns beowulf.read-test
-  (:require [clojure.test :refer :all]
-            [beowulf.core :refer :all]))
-
-;; (deftest a-test
-;;   (testing "FIXME, I fail."
-;;     (is (= 0 1))))
-

test/beowulf/sexpr_test.clj

@@ -2,8 +2,7 @@
   (:require [clojure.math.numeric-tower :refer [abs]]
             [clojure.test :refer :all]
             [beowulf.cons-cell :refer :all]
-            [beowulf.read :refer [parse simplify generate]]
+            [beowulf.read :refer [parse simplify generate]]))
-            [beowulf.print :refer :all]))
 
 ;; broadly, sexprs should be homoiconic
 
@@ -78,17 +77,17 @@
 (deftest dotted-pair-tests
   (testing "Reading dotted pairs"
     (let [expected "(A . B)"
-          actual (prin (generate (simplify (parse expected))))]
+          actual (print-str (generate (simplify (parse expected))))]
       (is (= actual expected)))
     (let [expected "(A B C . D)"
-          actual (prin (generate (simplify (parse expected))))]
+          actual (print-str (generate (simplify (parse expected))))]
       (is (= actual expected)))
     (let [expected "(A B (C . D) E)"
-          actual (prin (generate (simplify (parse expected))))]
+          actual (print-str (generate (simplify (parse expected))))]
       (is (= actual expected)))))
 
 (deftest list-tests
   (testing "Reading arbitrarily structured lists"
     (let [expected "(DEFUN FACT (X) (COND ((ZEROP X) 1) (T (TIMES X (FACT (SUB1 X))))))"
-          actual (prin (generate (simplify (parse expected))))]
+          actual (print-str (generate (simplify (parse expected))))]
       (is (= actual expected)))))