Merge branch 'release/0.2.1'

.gitignore

@@ -10,3 +10,5 @@ pom.xml.asc
 /.nrepl-port
 .hgignore
 .hg/
+.idea/
+*~

README.md

@@ -1,6 +1,6 @@
 # beowulf
 
-LISP 1.5 is to all Lisp dialects as Beowulf is to Emglish literature.
+LISP 1.5 is to all Lisp dialects as Beowulf is to English literature.
 
 ## What this is
 
@@ -13,6 +13,10 @@ same bahaviour - except as documented below.
 
 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)
+
 ### Architectural plan
 
 Not everything documented in this section is yet built. It indicates the

beowulf.iml

@@ -0,0 +1,26 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<module cursive.leiningen.project.LeiningenProjectsManager.displayName="beowulf:0.2.1-SNAPSHOT" cursive.leiningen.project.LeiningenProjectsManager.isLeinModule="true" type="JAVA_MODULE" version="4">
+  <component name="NewModuleRootManager">
+    <output url="file://$MODULE_DIR$/target/default/classes" />
+    <output-test url="file://$MODULE_DIR$/target/default/classes" />
+    <exclude-output />
+    <content url="file://$MODULE_DIR$">
+      <sourceFolder url="file://$MODULE_DIR$/dev-resources" isTestSource="false" />
+      <sourceFolder url="file://$MODULE_DIR$/resources" isTestSource="false" />
+      <sourceFolder url="file://$MODULE_DIR$/src/clojure" isTestSource="false" />
+      <sourceFolder url="file://$MODULE_DIR$/src/java" isTestSource="false" />
+      <sourceFolder url="file://$MODULE_DIR$/test" isTestSource="true" />
+      <excludeFolder url="file://$MODULE_DIR$/target/default" />
+    </content>
+    <orderEntry type="inheritedJdk" />
+    <orderEntry type="sourceFolder" forTests="false" />
+    <orderEntry type="library" name="Leiningen: clojure-complete:0.2.5" level="project" />
+    <orderEntry type="library" name="Leiningen: environ:1.1.0" level="project" />
+    <orderEntry type="library" name="Leiningen: instaparse:1.4.10" level="project" />
+    <orderEntry type="library" name="Leiningen: nrepl:0.6.0" level="project" />
+    <orderEntry type="library" name="Leiningen: org.clojure/clojure:1.8.0" level="project" />
+    <orderEntry type="library" name="Leiningen: org.clojure/math.numeric-tower:0.0.4" level="project" />
+    <orderEntry type="library" name="Leiningen: org.clojure/tools.cli:0.4.2" level="project" />
+    <orderEntry type="library" name="Leiningen: org.clojure/tools.trace:0.7.10" level="project" />
+  </component>
+</module>

docs/cloverage/index.html

@@ -16,20 +16,20 @@
    </tr></thead>
 <tr>
  <td><a href="beowulf/bootstrap.clj.html">beowulf.bootstrap</a></td><td class="with-bar"><div class="covered"
-                                style="width:67.4439461883408%;
+                                style="width:60.47808764940239%;
-                                        float:left;"> 752 </div><div class="not-covered"
+                                        float:left;"> 759 </div><div class="not-covered"
-                                style="width:32.55605381165919%;
+                                style="width:39.52191235059761%;
-                                        float:left;"> 363 </div></td>
+                                        float:left;"> 496 </div></td>
-<td class="with-number">67.44 %</td>
+<td class="with-number">60.48 %</td>
 <td class="with-bar"><div class="covered"
-                                style="width:58.52272727272727%;
+                                style="width:47.92626728110599%;
-                                        float:left;"> 103 </div><div class="partial"
+                                        float:left;"> 104 </div><div class="partial"
-                                style="width:23.295454545454547%;
+                                style="width:19.35483870967742%;
-                                        float:left;"> 41 </div><div class="not-covered"
+                                        float:left;"> 42 </div><div class="not-covered"
-                                style="width:18.181818181818183%;
+                                style="width:32.71889400921659%;
-                                        float:left;"> 32 </div></td>
+                                        float:left;"> 71 </div></td>
-<td class="with-number">81.82 %</td>
+<td class="with-number">67.28 %</td>
-<td class="with-number">338</td><td class="with-number">40</td><td class="with-number">176</td>
+<td class="with-number">414</td><td class="with-number">46</td><td class="with-number">217</td>
 </tr>
 <tr>
  <td><a href="beowulf/cons_cell.clj.html">beowulf.cons-cell</a></td><td class="with-bar"><div class="covered"
@@ -95,9 +95,9 @@
 </tr>
 <tr><td>Totals:</td>
 <td class="with-bar"></td>
-<td class="with-number">72.95 %</td>
+<td class="with-number">68.97 %</td>
 <td class="with-bar"></td>
-<td class="with-number">79.52 %</td>
+<td class="with-number">72.89 %</td>
    </tr>
   </table>
  </body>

project.clj

@@ -1,4 +1,4 @@
-(defproject beowulf "0.2.1-SNAPSHOT"
+(defproject beowulf "0.2.1"
   :cloverage {:output "docs/cloverage"}
   :codox {:metadata {:doc "**TODO**: write docs"
                      :doc/format :markdown}
@@ -13,7 +13,9 @@
                  [org.clojure/tools.trace "0.7.10"]
                  [environ "1.1.0"]
                  [instaparse "1.4.10"]]
+  :java-source-paths ["src/java"]
   :main ^:skip-aot beowulf.core
+  :min-lein-version  "2.0.0"
   :plugins [[lein-cloverage "1.1.1"]
             [lein-codox "0.10.7"]
             [lein-environ "1.1.0"]]
@@ -28,7 +30,7 @@
                   ["uberjar"]
                   ["change" "version" "leiningen.release/bump-version"]
                   ["vcs" "commit"]]
-
+  :source-paths ["src/clojure"]
   :target-path "target/%s"
-  :url "https://github.com/simon-brooke/the-great-game"
+  :url "https://github.com/simon-brooke/beowulf"
   )

src/beowulf/cons_cell.clj

@@ -1,156 +0,0 @@
-(ns beowulf.cons-cell
-  "The fundamental cons cell on which all Lisp structures are built.
-  Lisp 1.5 lists do not necessarily have a sequence as their CDR, so
-  cannot be implemented on top of Clojure lists.")
-
-(def NIL
-  "The canonical empty list symbol."
-  (symbol "NIL"))
-
-(def T
-  "The canonical true value."
-  (symbol "T")) ;; true.
-
-(def F
-  "The canonical false value - different from `NIL`, which is not canonically
-  false in Lisp 1.5."
-  (symbol "F")) ;; false as distinct from nil
-
-(deftype ConsCell [CAR CDR]
-  clojure.lang.ISeq
-  (cons [this x] (ConsCell. x this))
-  (first [this] (.CAR this))
-  ;; next and more must return ISeq:
-  ;; https://github.com/clojure/clojure/blob/master/src/jvm/clojure/lang/ISeq.java
-  (more [this] (if
-                 (seq? (.CDR this))
-                 (.CDR this)
-                 clojure.lang.PersistentList/EMPTY))
-  (next [this] (if
-                 (seq? (.CDR this))
-                 (.CDR this)
-                 nil ;; next returns nil when empty
-                 ))
-
-  clojure.lang.Seqable
-  (seq [this] this)
-
-  ;; for some reason this marker protocol is needed otherwise compiler complains
-  ;; that `nth not supported on ConsCell`
-  clojure.lang.Sequential
-
-  clojure.lang.IPersistentCollection
-  (count [this] (if
-                  (coll? (.CDR this))
-                  (inc (.count (.CDR this)))
-                  1))
-  (empty [this] false) ;; a cons cell is by definition not empty.
-  (equiv [this other] (if
-                        (seq? other)
-                        (and
-                          (if
-                            (and
-                              (seq? (first this))
-                              (seq? (first other)))
-                            (.equiv (first this) (first other))
-                            (= (first this) (first other)))
-                          (if
-                            (and
-                              (seq? (rest this))
-                              (seq? (rest other)))
-                            (.equiv (rest this) (rest other))
-                            (= (rest this) (rest 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))))
-
-(defn pretty-print
-  "This isn't the world's best pretty printer but it sort of works."
-  ([^beowulf.cons_cell.ConsCell cell]
-   (println (pretty-print cell 80 0)))
-  ([^beowulf.cons_cell.ConsCell cell width level]
-   (loop [c cell
-          n (inc level)
-          s "("]
-     (if
-       (instance? beowulf.cons_cell.ConsCell c)
-       (let [car (.CAR c)
-             cdr (.CDR c)
-             cons? (instance? beowulf.cons_cell.ConsCell cdr)
-             print-width (count (print-str c))
-             indent (apply str (repeat n "  "))
-             ss (str
-                  s
-                  (pretty-print car width n)
-                  (cond
-                    cons?
-                    (if
-                      (< (+ (count indent) print-width) width)
-                      " "
-                      (str "\n" indent))
-                    (or (nil? cdr) (= cdr 'NIL))
-                    ")"
-                    :else
-                    (str " . " (pretty-print cdr width n) ")")))]
-         (if
-           cons?
-           (recur cdr n ss)
-           ss))
-       (str c)))))
-
-
-
-(defmethod clojure.core/print-method
-  ;;; I have not worked out how to document defmethod without blowing up the world.
-  beowulf.cons_cell.ConsCell
-  [this writer]
-  (.write writer (to-string this)))
-
-
-(defmacro make-cons-cell
-  "Construct a new instance of cons cell with this `car` and `cdr`."
-  [car cdr]
-  `(ConsCell. ~car ~cdr))
-
-(defn make-beowulf-list
-  "Construct a linked list of cons cells with the same content as the
-  sequence `x`."
-  [x]
-  (cond
-    (empty? x) NIL
-    (coll? x) (ConsCell.
-                (if
-                  (seq? (first x))
-                  (make-beowulf-list (first x))
-                  (first x))
-                (make-beowulf-list (rest x)))
-    :else
-    NIL))

src/beowulf/host.clj

@@ -1,5 +0,0 @@
-(ns beowulf.host
-  "provides Lisp 1.5 functions which can't be (or can't efficiently
-   be) implemented in Lisp 1.5, which therefore need to be implemented in the
-   host language, in this case Clojure.")
-

src/clojure/beowulf/bootstrap.clj

@@ -7,10 +7,12 @@
 
   The convention is adopted that functions in this file with names in
   ALLUPPERCASE are Lisp 1.5 functions (although written in Clojure) and that
-  therefore all arguments must be numbers, symbols or `beowulf.cons_cell.ConsCell`
+  therefore all arguments must be numbers, symbols or `beowulf.substrate.ConsCell`
   objects."
-  (:require [clojure.tools.trace :refer :all]
+  (:require [clojure.string :as s]
-            [beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL T F]]))
+            [clojure.tools.trace :refer :all]
+            [beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL T F]])
+  (:import (beowulf.substrate ConsCell)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
@@ -57,7 +59,7 @@
   [x]
   (cond
     (= x NIL) NIL
-    (instance? beowulf.cons_cell.ConsCell x) (.CAR x)
+    (instance? ConsCell x) (.getCar x)
     :else
     (throw
       (Exception.
@@ -69,7 +71,7 @@
   [x]
   (cond
     (= x NIL) NIL
-    (instance? beowulf.cons_cell.ConsCell x) (.CDR x)
+    (instance? ConsCell x) (.getCdr x)
     :else
     (throw
       (Exception.
@@ -233,6 +235,81 @@
     :else
     (make-cons-cell (SUBLIS a (CAR y)) (SUBLIS a (CDR y)))))
 
+(defn interop-interpret-q-name
+  "For interoperation with Clojure, it will often be necessary to pass
+  qualified names that are not representable in Lisp 1.5. This function
+  takes a sequence in the form `(PART PART PART... NAME)` and returns
+  a symbol in the form `PART.PART.PART/NAME`. This symbol will then be
+  tried in both that form and lower-cased. Names with hyphens or
+  underscores cannot be represented with this scheme."
+  [l]
+  (if
+    (seq? l)
+    (symbol
+      (s/reverse
+        (s/replace-first
+          (s/reverse
+            (s/join "." (map str l)))
+          "."
+          "/")))
+    l))
+
+(deftrace INTEROP
+  "Clojure (or other host environment) interoperation API. `fn-symbol` is expected
+  to be either
+
+  1. a symbol bound in the host environment to a function; or
+  2. a sequence (list) of symbols forming a qualified path name bound to a
+     function.
+
+  Lower case characters cannot normally be represented in Lisp 1.5, so both the
+  upper case and lower case variants of `fn-symbol` will be tried. If the
+  function you're looking for has a mixed case name, that is not currently
+  accessible.
+
+  `args` is expected to be a Lisp 1.5 list of arguments to be passed to that
+  function. Return value must be something acceptable to Lisp 1.5, so either
+  a symbol, a number, or a Lisp 1.5 list.
+
+  If `fn-symbol` is not found (even when cast to lower case), or is not a function,
+  or the value returned cannot be represented in Lisp 1.5, an exception is thrown
+  with `:cause` bound to `:interop` and `:detail` set to a value representing the
+  actual problem."
+  [fn-symbol args]
+  (let
+    [q-name (if
+              (seq? fn-symbol)
+              (interop-interpret-q-name fn-symbol)
+              fn-symbol)
+     l-name (symbol (s/lower-case q-name))
+     f (cond
+            (try
+              (fn? (eval l-name))
+              (catch java.lang.ClassNotFoundException e nil)) (eval l-name)
+            (try
+              (fn? (eval q-name))
+              (catch java.lang.ClassNotFoundException e nil)) (eval q-name)
+             :else (throw
+                     (ex-info
+                       (str "INTEROP: unknown function `" fn-symbol "`")
+                       {:cause :interop
+                        :detail :not-found
+                         :name fn-symbol
+                         :also-tried l-name})))
+      result (eval (cons f args))]
+    (cond
+      (instance? ConsCell result) result
+      (seq? result) (make-beowulf-list result)
+      (symbol? result) result
+      (string? result) (symbol result)
+      (number? result) result
+      :else (throw
+              (ex-info
+                (str "INTEROP: Cannot return `" result "` to Lisp 1.5.")
+                {:cause :interop
+                 :detail :not-representable
+                 :result result})))))
+
 (defn APPLY
   "For bootstrapping, at least, a version of APPLY written in Clojure.
   All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects.

src/clojure/beowulf/cons_cell.clj

@@ -0,0 +1,181 @@
+(ns beowulf.cons-cell
+  "The fundamental cons cell on which all Lisp structures are built.
+  Lisp 1.5 lists do not necessarily have a sequence as their CDR, so
+  cannot be implemented on top of Clojure lists."
+  (:import (beowulf.substrate ConsCell)
+           (java.io Writer)))
+
+(def NIL
+  "The canonical empty list symbol."
+  'NIL)
+
+(def T
+  "The canonical true value."
+  'T) ;; true.
+
+(def F
+  "The canonical false value - different from `NIL`, which is not canonically
+  false in Lisp 1.5."
+  'F) ;; false as distinct from nil
+
+;; (deftype ConsCell [^:unsynchronized-mutable car ^:unsynchronized-mutable cdr]
+;;   ;; Note that, because the CAR and CDR fields are unsynchronised mutable - i.e.
+;;   ;; plain old Java instance variables which can be written as well as read -
+;;   ;; ConsCells are NOT thread safe. This does not matter, since Lisp 1.5 is
+;;   ;; single threaded.
+
+;;   (CAR [this] (.car this))
+;;   (CDR [this] (.cdr this))
+;;   (RPLACA
+;;     [this value]
+;;     (if
+;;       (or
+;;         (instance? beowulf.substrate.ConsCell value)
+;;         (number? value)
+;;         (symbol? value)
+;;         (= value NIL))
+;;     (do
+;;       (set! (. cell CAR) value)
+;;       cell)
+;;     (throw (ex-info
+;;              (str "Invalid value in RPLACA: `" value "` (" (type value) ")")
+;;              {:cause :bad-value
+;;               :detail :rplaca}))))
+
+;;   clojure.lang.ISeq
+;;   (cons [this x] (ConsCell. x this))
+;;   (first [this] (.CAR this))
+;;   ;; next and more must return ISeq:
+;;   ;; https://github.com/clojure/clojure/blob/master/src/jvm/clojure/lang/ISeq.java
+;;   (more [this] (if
+;;                  (seq? (.CDR this))
+;;                  (.CDR this)
+;;                  clojure.lang.PersistentList/EMPTY))
+;;   (next [this] (if
+;;                  (seq? (.CDR this))
+;;                  (.CDR this)
+;;                  nil ;; next returns nil when empty
+;;                  ))
+
+;;   clojure.lang.Seqable
+;;   (seq [this] this)
+
+;;   ;; for some reason this marker protocol is needed otherwise compiler complains
+;;   ;; that `nth not supported on ConsCell`
+;;   clojure.lang.Sequential
+
+;;   clojure.lang.IPersistentCollection
+;;   (count [this] (if
+;;                   (coll? (.CDR this))
+;;                   (inc (.count (.CDR this)))
+;;                   1))
+;;   (empty [this] false) ;; a cons cell is by definition not empty.
+;;   (equiv [this other] (if
+;;                         (seq? other)
+;;                         (and
+;;                           (if
+;;                             (and
+;;                               (seq? (first this))
+;;                               (seq? (first other)))
+;;                             (.equiv (first this) (first other))
+;;                             (= (first this) (first other)))
+;;                           (if
+;;                             (and
+;;                               (seq? (rest this))
+;;                               (seq? (rest other)))
+;;                             (.equiv (rest this) (rest other))
+;;                             (= (rest this) (rest 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? ConsCell c)
+;      (let [car (.getCar c)
+;            cdr (.getCdr c)
+;            cons? (instance? 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))))
+
+(defn pretty-print
+  "This isn't the world's best pretty printer but it sort of works."
+  ([^ConsCell cell]
+   (println (pretty-print cell 80 0)))
+  ([^ConsCell cell width level]
+   (loop [c cell
+          n (inc level)
+          s "("]
+     (if
+       (instance? ConsCell c)
+       (let [car (.getCar c)
+             cdr (.getCdr c)
+             cons? (instance? ConsCell cdr)
+             print-width (count (print-str c))
+             indent (apply str (repeat n "  "))
+             ss (str
+                  s
+                  (pretty-print car width n)
+                  (cond
+                    cons?
+                    (if
+                      (< (+ (count indent) print-width) width)
+                      " "
+                      (str "\n" indent))
+                    (or (nil? cdr) (= cdr 'NIL))
+                    ")"
+                    :else
+                    (str " . " (pretty-print cdr width n) ")")))]
+         (if
+           cons?
+           (recur cdr n ss)
+           ss))
+       (str c)))))
+
+
+
+(defmethod clojure.core/print-method
+  ;;; I have not worked out how to document defmethod without blowing up the world.
+  ConsCell
+  [this ^Writer writer]
+  (.write writer (.toString this)))
+
+
+(defmacro make-cons-cell
+  "Construct a new instance of cons cell with this `car` and `cdr`."
+  [car cdr]
+  `(ConsCell. ~car ~cdr))
+
+(defn make-beowulf-list
+  "Construct a linked list of cons cells with the same content as the
+  sequence `x`."
+  [x]
+  (cond
+    (empty? x) NIL
+    (coll? x) (ConsCell.
+                (if
+                  (coll? (first x))
+                  (make-beowulf-list (first x))
+                  (first x))
+                (make-beowulf-list (rest x)))
+    :else
+    NIL))

src/clojure/beowulf/host.clj

@@ -0,0 +1,91 @@
+(ns beowulf.host
+  "provides Lisp 1.5 functions which can't be (or can't efficiently
+   be) implemented in Lisp 1.5, which therefore need to be implemented in the
+   host language, in this case Clojure."
+  (:require [beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL T F]])
+  (:import (beowulf.substrate ConsCell)))
+
+;; these are CANDIDATES to be host-implemented. only a subset of them MUST be.
+;; those which can be implemented in Lisp should be, since that aids
+;; portability.
+
+;; RPLACA
+
+(defn RPLACA
+  "Replace the CAR pointer of this `cell` with this `value`. Dangerous, should
+  really not exist, but does in Lisp 1.5 (and was important for some
+  performance hacks in early Lisps)"
+  [^ConsCell cell value]
+  (if
+    (instance? ConsCell cell)
+    (if
+      (or
+        (instance? ConsCell value)
+        (number? value)
+        (symbol? value)
+        (= value NIL))
+    (do
+      (.setCar cell value)
+      cell)
+    (throw (ex-info
+             (str "Invalid value in RPLACA: `" value "` (" (type value) ")")
+             {:cause :bad-value
+              :detail :rplaca})))
+    (throw (ex-info
+             (str "Invalid cell in RPLACA: `" cell "` (" (type cell) ")")
+             {:cause :bad-value
+              :detail :rplaca}))))
+
+;; RPLACD
+
+(defn RPLACD
+  "Replace the CDR pointer of this `cell` with this `value`. Dangerous, should
+  really not exist, but does in Lisp 1.5 (and was important for some
+  performance hacks in early Lisps)"
+  [^ConsCell cell value]
+  (if
+    (instance? ConsCell cell)
+    (if
+      (or
+        (instance? ConsCell value)
+        (number? value)
+        (symbol? value)
+        (= value NIL))
+    (do
+      (.setCdr cell value)
+      cell)
+    (throw (ex-info
+             (str "Invalid value in RPLACD: `" value "` (" (type value) ")")
+             {:cause :bad-value
+              :detail :rplaca})))
+    (throw (ex-info
+             (str "Invalid cell in RPLACD: `" cell "` (" (type cell) ")")
+             {:cause :bad-value
+              :detail :rplaca}))))
+
+;; PLUS
+
+
+;; MINUS
+
+;; DIFFERENCE
+
+;; QUOTIENT
+
+;; REMAINDER
+
+;; ADD1
+
+;; SUB1
+
+;; MAX
+
+;; MIN
+
+;; RECIP
+
+;; FIXP
+
+;; NUMBERP
+
+;;

src/clojure/beowulf/read.clj

@@ -278,7 +278,7 @@
   (if
     (coll? p)
     (case (first p)
-      :λ "LAMBDA"
+      :λ 'LAMBDA
       :λexpr (make-cons-cell
                (generate (nth p 1))
                (make-cons-cell (generate (nth p 2))

src/java/beowulf/substrate/ConsCell.java

@@ -0,0 +1,243 @@
+package beowulf.substrate;
+
+import clojure.lang.*;
+
+import java.lang.Number;
+//import beowulf.cons_cell.NIL;
+
+/**
+ * <p>
+ * A cons cell - a tuple of two pointers - is the fundamental unit of Lisp store.
+ * </p>
+ * <p>
+ * Implementing mutable data in Clojure if <em>hard</em> - deliberately so.
+ * But Lisp 1.5 cons cells need to be mutable. This class is part of thrashing
+ * around trying to find a solution. In theory it should be possible to make
+ * instance variables of a `deftype` mutable by supplying the meta-data tag
+ * :unsynchronized-mutable, but I failed to make that work.
+ * </p>
+ */
+public class ConsCell
+        implements clojure.lang.IPersistentCollection,
+        clojure.lang.ISeq,
+        clojure.lang.Seqable,
+        clojure.lang.Sequential {
+
+    /**
+     * The car of a cons cell can't be just any object; it needs to be
+     * a number, a symbol or a cons cell. But as there is no common superclass
+     * or interface for those things, we use Object here and specify the
+     * types of objects which can be stored in the constructors and setter
+     * methods.
+     */
+    private Object car;
+
+    /**
+     * The car of a cons cell can't be just any object; it needs to be
+     * a number, a symbol or a cons cell. But as there is no common superclass
+     * or interface for those things, we use Object here and specify the
+     * types of objects which can be stored in the constructors and setter
+     * methods.
+     */
+    private Object cdr;
+
+    /**
+     * Construct a new ConsCell object with this `car` and this `cdr`.
+     *
+     * @param car
+     * @param cdr
+     * @throws IllegalArgumentException if either `car` or `cdr` is not one
+     *                                  of ConsCell, Symbol, Number
+     */
+    public ConsCell(Object car, Object cdr) {
+        if (car instanceof ConsCell || car instanceof Number || car instanceof Symbol) {
+            this.car = car;
+        } else {
+            StringBuilder bob = new StringBuilder("Invalid CAR value (`")
+                    .append(car.toString()).append("`; ")
+                    .append(car.getClass().getName()).append(") passed to CONS");
+            throw new IllegalArgumentException(bob.toString());
+        }
+        if (cdr instanceof ConsCell || cdr instanceof Number || cdr instanceof Symbol) {
+            this.cdr = cdr;
+        } else {
+            StringBuilder bob = new StringBuilder("Invalid CDR value (`")
+                    .append(cdr.toString()).append("`; ")
+                    .append(cdr.getClass().getName()).append(") passed to CONS");
+            throw new IllegalArgumentException(bob.toString());
+        }
+    }
+
+    public Object getCar() {
+        return this.car;
+    }
+
+    public Object getCdr() {
+        return this.cdr;
+    }
+
+    public ConsCell setCar(ConsCell c) {
+        this.car = c;
+        return this;
+    }
+
+    public ConsCell setCdr(ConsCell c) {
+        this.cdr = c;
+        return this;
+    }
+
+    public ConsCell setCar(java.lang.Number n) {
+        this.car = n;
+        return this;
+    }
+
+    public ConsCell setCdr(java.lang.Number n) {
+        this.cdr = n;
+        return this;
+    }
+
+    public ConsCell setCar(clojure.lang.Symbol s) {
+        this.car = s;
+        return this;
+    }
+
+    public ConsCell setCdr(clojure.lang.Symbol s) {
+        this.cdr = s;
+        return this;
+    }
+
+    @Override
+    public boolean equals(Object other) {
+        boolean result;
+
+        if (other instanceof IPersistentCollection) {
+            ISeq s = ((IPersistentCollection) other).seq();
+
+            result = this.car.equals(s.first()) &&
+                    this.cdr instanceof ConsCell &&
+                    ((ISeq) this.cdr).equiv(s.more());
+        } else {
+            result = false;
+        }
+
+        return result;
+    }
+
+    @Override
+    public String toString() {
+        StringBuilder bob = new StringBuilder("(");
+
+        for (Object d = this; d instanceof ConsCell; d = ((ConsCell) d).cdr) {
+            ConsCell cell = (ConsCell) d;
+            bob.append(cell.car.toString());
+
+            if (cell.cdr instanceof ConsCell) {
+                bob.append(" ");
+            } else if (cell.cdr.toString().equals("NIL")) {
+                /* That's an ugly hack to work around the fact I can't currently
+                 * get a handle on the NIL symbol itself. In theory, nothing else
+                 * in Lisp 1.5 should have the print-name `NIL`.*/
+                bob.append(")");
+            } else {
+                bob.append(" . ").append(cell.cdr.toString()).append(")");
+            }
+        }
+
+        return bob.toString();
+    }
+
+    /* IPersistentCollection interface implementation */
+
+    @Override
+    public int count() {
+      int result = 1;
+      ConsCell cell = this;
+
+      while (cell.cdr instanceof ConsCell) {
+        result ++;
+        cell = (ConsCell)cell.cdr;
+      }
+
+      return result;
+    }
+
+    @Override
+    /**
+     * `empty` is completely undocumented, I'll return `null` until something breaks.
+     */
+    public IPersistentCollection empty() {
+        return null;
+    }
+
+    /**
+     * God alone knows what `equiv` is intended to do; it's completely
+     * undocumented. But in PersistentList it's simply a synonym for 'equals',
+     * and that's what I'll implement.
+     */
+    @Override
+    public boolean equiv(Object o) {
+        return this.equals(o);
+    }
+
+    /* ISeq interface implementation */
+    @Override
+    public Object first() {
+        return this.car;
+    }
+
+    @Override
+    public ISeq next() {
+        ISeq result;
+
+        if (this.cdr instanceof ConsCell) {
+            result = (ISeq) this.cdr;
+        } else {
+            result = null;
+        }
+
+        return result;
+    }
+
+    @Override
+    public ISeq more() {
+        ISeq result;
+
+        if (this.cdr instanceof ConsCell) {
+            result = (ISeq) this.cdr;
+        } else {
+            result = null;
+        }
+
+        return result;
+    }
+
+    /**
+     * Return a new cons cell comprising the object `o` as car,
+     * and myself as cdr. Hopefully by declaring the return value
+     * `ConsCell` I'll satisfy both the IPersistentCollection and the
+     * ISeq interfaces.
+     */
+    @Override
+    public ConsCell cons(Object o) {
+        if (o instanceof ConsCell) {
+            return new ConsCell((ConsCell) o, this);
+        } else if (o instanceof Number) {
+            return new ConsCell((Number) o, this);
+        } else if (o instanceof Symbol) {
+            return new ConsCell((Symbol) o, this);
+        } else {
+            throw new IllegalArgumentException("Unrepresentable argument passed to CONS");
+        }
+    }
+
+    /* Seqable interface */
+    @Override
+    public ISeq seq() {
+        return this;
+    }
+
+    /* Sequential interface is just a marker and does not require us to
+     * implement anything */
+
+
+}

test/beowulf/bootstrap_test.clj

@@ -75,7 +75,7 @@
       (is (= actual expected) "B is CDR of (A . B)"))
     (let [expected 'B
           actual (CDR (gsp "(A B C D)"))]
-      (is (instance? beowulf.cons_cell.ConsCell actual)
+      (is (instance? beowulf.substrate.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?

test/beowulf/cons_cell_test.clj

@@ -1,16 +1,16 @@
-(ns beowulf.core-test
+(ns beowulf.cons-cell-test
   (:require [clojure.test :refer :all]
             [beowulf.cons-cell :refer :all]))
 
 (deftest cons-cell-tests
   (testing "make-cons-cell"
     (let [expected "(A . B)"
-          actual (print-str (beowulf.cons_cell.ConsCell. 'A 'B))]
+          actual (print-str (beowulf.substrate.ConsCell. 'A 'B))]
       (is (= actual expected) "Cons cells should print as cons cells, natch."))
     (let [expected "(A . B)"
           actual (print-str (make-cons-cell 'A 'B))]
       (is (= actual expected) "Even if build with the macro."))
-    (let [expected beowulf.cons_cell.ConsCell
+    (let [expected beowulf.substrate.ConsCell
           actual (print-str (make-cons-cell 'A 'B))]
       (is (= actual expected) "And they should be cons cells."))
     )
@@ -19,37 +19,34 @@
           actual (print-str (make-beowulf-list '(A (B C) (D E (F) G) H)))]
       (is (= actual expected) "Should work for clojure lists, recursively."))
     (let [expected "(A (B C) (D E (F) G) H)"
-          actual (print-str (make-beowulf-list [A [B C] [D E [F] G] H]))]
+          actual (print-str (make-beowulf-list ['A ['B 'C] ['D 'E ['F] 'G] 'H]))]
       (is (= actual expected) "Should work for vectors, too."))
     (let [expected "NIL"
           actual (print-str (make-beowulf-list []))]
-      (is (= actual expected) "An empty sequence is NIL."))
+      (is (= actual expected) "An empty sequence is NIL.")))
-    (let [expected beowulf.cons_cell.ConsCell
-          actual (make-beowulf-list '(A (B C) (D E (F) G) H))]
-      (is (= actual expected) "A beowulf list is made of cons cells.")))
   (testing "pretty-print"
     (let [expected "(A\n  (B C)\n  (D E (F) G) H)"
-          actual (pretty-print (make-beowulf-list '(A (B C) (D E (F) G) H)) 20 0)]
+          actual (with-out-str (pretty-print (make-beowulf-list '(A (B C) (D E (F) G) H)) 20 0))]
       (is (= actual expected)))
-    (let [expected "(A (B C) (D E (F) G) H)"
+    (let [expected "(A (B C) (D E (F) G) H)\n"
-          actual (pretty-print (make-beowulf-list '(A (B C) (D E (F) G) H)))]
+          actual (with-out-str (pretty-print (make-beowulf-list '(A (B C) (D E (F) G) H))))]
-      (is (= actual expected))))
-  (testing "count"
-    (let [expected 4
-          actual (count (make-beowulf-list '(A (B C) (D E (F) G) H)) 20 0)]
-      (is (= actual expected)))
-    (let [expected 1
-          actual (count (make-beowulf-list '(A)))]
-      (is (= actual expected)))
-    (let [expected 1
-          actual (count (make-cons-cell 'A 'B))]
       (is (= actual expected))))
+;;   (testing "count"
+;;     (let [expected 4
+;;           actual (.count (make-beowulf-list '(A (B C) (D E (F) G) H)) 20 0)]
+;;       (is (= actual expected)))
+;;     (let [expected 1
+;;           actual (.count (make-beowulf-list '(A)))]
+;;       (is (= actual expected)))
+;;     (let [expected 1
+;;           actual (.count (make-cons-cell 'A 'B))]
+;;       (is (= actual expected))))
   (testing "sequence functions"
     (let [expected "A"
           actual (print-str (first (make-beowulf-list '(A (B C) (D E (F) G) H))))]
       (is (= actual expected)))
     (let [expected "((B C) (D E (F) G) H)"
-          actual (print-str (more (make-beowulf-list '(A (B C) (D E (F) G) H))))]
+          actual (print-str (.more (make-beowulf-list '(A (B C) (D E (F) G) H))))]
       (is (= actual expected)))
     (let [expected "((B C) (D E (F) G) H)"
           actual (print-str (next (make-beowulf-list '(A (B C) (D E (F) G) H))))]

test/beowulf/host_test.clj

@@ -0,0 +1,27 @@
+(ns beowulf.host-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.bootstrap :refer [CDR]]
+            [beowulf.host :refer :all]
+            [beowulf.read :refer [gsp]]))
+
+(deftest destructive-change-test
+  (testing "RPLACA"
+    (let
+      [l (make-beowulf-list '(A B C D E))
+       target (CDR l)
+       expected "(A F C D E)"
+       actual (do (RPLACA target 'F) (print-str l))]
+      (is (= actual expected)))
+    )
+  (testing "RPLACA"
+    (let
+      [l (make-beowulf-list '(A B C D E))
+       target (CDR l)
+       expected "(A B . F)"
+       actual (do (RPLACD target 'F) (print-str l))]
+      (is (= actual expected)))
+    )
+  )
+