Safety commit before major change - this does not work.

.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
 

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>

project.clj

@@ -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/host.clj

@@ -1,38 +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.")
-
-;; 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
-
-;; RPLACD
-
-;; PLUS
-
-;; MINUS
-
-;; DIFFERENCE
-
-;; QUOTIENT
-
-;; REMAINDER
-
-;; ADD1
-
-;; SUB1
-
-;; MAX
-
-;; MIN
-
-;; RECIP
-
-;; FIXP
-
-;; NUMBERP
-
-;;

src/clojure/beowulf/cons_cell.clj

@@ -3,20 +3,43 @@
   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 NIL
+;;   "The canonical empty list symbol."
+;;   'NIL)
 
-(def T
-  "The canonical true value."
-  (symbol "T")) ;; true.
+;; (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."
-  (symbol "F")) ;; false as distinct from nil
+;; (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.cons_cell.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}))))
 
-(deftype ConsCell [CAR CDR]
   clojure.lang.ISeq
   (cons [this x] (ConsCell. x this))
   (first [this] (.CAR this))

src/clojure/beowulf/host.clj

@@ -0,0 +1,61 @@
+(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]]))
+
+;; 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
+  [^beowulf.cons_cell.ConsCell cell value]
+  (if
+    (instance? beowulf.cons_cell.ConsCell cell)
+    (if
+      (or
+        (instance? beowulf.cons_cell.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})))
+    (throw (ex-info
+             (str "Invalid cell in RPLACA: `" cell "` (" (type cell) ")")
+             {:cause :bad-value
+              :detail :rplaca}))))
+
+;; RPLACD
+
+;; PLUS
+
+;; MINUS
+
+;; DIFFERENCE
+
+;; QUOTIENT
+
+;; REMAINDER
+
+;; ADD1
+
+;; SUB1
+
+;; MAX
+
+;; MIN
+
+;; RECIP
+
+;; FIXP
+
+;; NUMBERP
+
+;;

src/java/beowulf/substrate/ConsCell.java

@@ -0,0 +1,246 @@
+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.
+ * </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;
+
+    public ConsCell(ConsCell car, ConsCell cdr) {
+        this.car = car;
+        this.cdr = cdr;
+    }
+
+    public ConsCell(ConsCell car, Symbol cdr) {
+        this.car = car;
+        this.cdr = cdr;
+    }
+
+    public ConsCell(ConsCell car, Number cdr) {
+        this.car = car;
+        this.cdr = cdr;
+    }
+
+    public ConsCell(Symbol car, ConsCell cdr) {
+        this.car = car;
+        this.cdr = cdr;
+    }
+
+    public ConsCell(Symbol car, Symbol cdr) {
+        this.car = car;
+        this.cdr = cdr;
+    }
+
+    public ConsCell(Symbol car, Number cdr) {
+        this.car = car;
+        this.cdr = cdr;
+    }
+
+    public ConsCell(Number car, ConsCell cdr) {
+        this.car = car;
+        this.cdr = cdr;
+    }
+
+    public ConsCell(Number car, Symbol cdr) {
+        this.car = car;
+        this.cdr = cdr;
+    }
+
+    public ConsCell(Number car, Number cdr) {
+        this.car = car;
+        this.cdr = cdr;
+    }
+
+    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 */
+
+    public int count() {
+        return this.cdr instanceof ConsCell ?
+                1 + ((ConsCell) this.cdr).count() :
+                1;
+    }
+
+    /**
+     * `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.
+     */
+    public boolean equiv(Object o) {
+        return this.equals(o);
+    }
+
+    /* ISeq interface implementation */
+
+    public Object first() {
+        return this.car;
+    }
+
+    public ISeq next() {
+        ISeq result;
+
+        if (this.cdr instanceof ConsCell) {
+            result = (ISeq) this.cdr;
+        } else {
+            result = null;
+        }
+
+        return result;
+    }
+
+    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.
+     */
+    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 */
+    public ISeq seq() {
+        return this;
+    }
+
+    /* Sequential interface is just a marker and does not require us to
+     * implement anything */
+
+
+}

test/beowulf/host_test.clj

@@ -0,0 +1,18 @@
+(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.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 (print-str (RPLACA target 'F))]
+      (is (= actual expected)))
+
+    ))
+