diff --git a/.gitignore b/.gitignore
index d18f225..5903fe9 100644
--- a/.gitignore
+++ b/.gitignore
@@ -10,3 +10,5 @@ pom.xml.asc
/.nrepl-port
.hgignore
.hg/
+.idea/
+*~
diff --git a/README.md b/README.md
index e95c3a4..56ed168 100644
--- a/README.md
+++ b/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
diff --git a/_config.yml b/_config.yml
new file mode 100644
index 0000000..c741881
--- /dev/null
+++ b/_config.yml
@@ -0,0 +1 @@
+theme: jekyll-theme-slate
\ No newline at end of file
diff --git a/beowulf.iml b/beowulf.iml
new file mode 100644
index 0000000..62bb49e
--- /dev/null
+++ b/beowulf.iml
@@ -0,0 +1,26 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
\ No newline at end of file
diff --git a/project.clj b/project.clj
index 1e3cecb..c2bd739 100644
--- a/project.clj
+++ b/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"
)
diff --git a/src/beowulf/cons_cell.clj b/src/beowulf/cons_cell.clj
deleted file mode 100644
index 3fd104b..0000000
--- a/src/beowulf/cons_cell.clj
+++ /dev/null
@@ -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))
diff --git a/src/beowulf/host.clj b/src/beowulf/host.clj
deleted file mode 100644
index 042dc8f..0000000
--- a/src/beowulf/host.clj
+++ /dev/null
@@ -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
-
-;;
diff --git a/src/beowulf/bootstrap.clj b/src/clojure/beowulf/bootstrap.clj
similarity index 98%
rename from src/beowulf/bootstrap.clj
rename to src/clojure/beowulf/bootstrap.clj
index e082cc1..8ca3d3a 100644
--- a/src/beowulf/bootstrap.clj
+++ b/src/clojure/beowulf/bootstrap.clj
@@ -7,11 +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.string :as s]
[clojure.tools.trace :refer :all]
- [beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL T F]]))
+ [beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL T F]])
+ (:import (beowulf.substrate ConsCell)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -58,7 +59,7 @@
[x]
(cond
(= x NIL) NIL
- (instance? beowulf.cons_cell.ConsCell x) (.CAR x)
+ (instance? ConsCell x) (.getCar x)
:else
(throw
(Exception.
@@ -70,7 +71,7 @@
[x]
(cond
(= x NIL) NIL
- (instance? beowulf.cons_cell.ConsCell x) (.CDR x)
+ (instance? ConsCell x) (.getCdr x)
:else
(throw
(Exception.
@@ -297,7 +298,7 @@
:also-tried l-name})))
result (eval (cons f args))]
(cond
- (instance? beowulf.cons_cell.ConsCell result) result
+ (instance? ConsCell result) result
(seq? result) (make-beowulf-list result)
(symbol? result) result
(string? result) (symbol result)
diff --git a/src/clojure/beowulf/cons_cell.clj b/src/clojure/beowulf/cons_cell.clj
new file mode 100644
index 0000000..5c04188
--- /dev/null
+++ b/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))
diff --git a/src/beowulf/core.clj b/src/clojure/beowulf/core.clj
similarity index 100%
rename from src/beowulf/core.clj
rename to src/clojure/beowulf/core.clj
diff --git a/src/clojure/beowulf/host.clj b/src/clojure/beowulf/host.clj
new file mode 100644
index 0000000..b716ec6
--- /dev/null
+++ b/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
+
+;;
diff --git a/src/beowulf/read.clj b/src/clojure/beowulf/read.clj
similarity index 96%
rename from src/beowulf/read.clj
rename to src/clojure/beowulf/read.clj
index 6ede7e8..6e66fef 100644
--- a/src/beowulf/read.clj
+++ b/src/clojure/beowulf/read.clj
@@ -47,7 +47,7 @@
fncall := fn-name lsqb args rsqb;
lsqb := '[';
rsqb := ']';
- defn := mexpr opt-space '=' opt-space mexpr;
+ defn := mexpr opt-space <'='> opt-space mexpr;
cond := lsqb (cond-clause semi-colon opt-space)* cond-clause rsqb;
cond-clause := expr opt-space arrow opt-space expr;
arrow := '->';
@@ -105,7 +105,7 @@
(case (first p)
(:arg :expr :coefficient :fn-name :number :sexpr) (simplify (second p) context)
(:λexpr
- :args :bindings :body :cond :cond-clause :dot-terminal
+ :args :bindings :body :cond :cond-clause :defn :dot-terminal
:fncall :octal :quoted-expr :scientific) (map #(simplify % context) p)
(:arrow :dot :e :lpar :lsqb :opt-space :q :quote :rpar :rsqb
:semi-colon :sep :space) nil
@@ -226,6 +226,17 @@
(generate (second p))
(generate (nth p 2)))))
+(defn gen-defn
+ [p]
+ (make-beowulf-list
+ (list
+ 'LABEL
+ (generate (second (second p)))
+ (make-beowulf-list
+ (list
+ 'LAMBDA
+ (generate (nth (second p) 2))
+ (doall (map generate (rest (rest p)))))))))
(defn gen-dot-terminated-list
"Generate a list, which may be dot-terminated, from this partial parse tree
@@ -267,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))
@@ -278,6 +289,7 @@
:body (make-beowulf-list (map generate (rest p)))
:cond (gen-cond p)
(:decimal :integer) (read-string (strip-leading-zeros (second p)))
+ :defn (gen-defn p)
:dotted-pair (make-cons-cell
(generate (nth p 1))
(generate (nth p 2)))
diff --git a/src/java/beowulf/substrate/ConsCell.java b/src/java/beowulf/substrate/ConsCell.java
new file mode 100644
index 0000000..63a12e5
--- /dev/null
+++ b/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;
+
+/**
+ *
+ * A cons cell - a tuple of two pointers - is the fundamental unit of Lisp store.
+ *
+ *
+ * Implementing mutable data in Clojure if hard - 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.
+ *
+ */
+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 */
+
+
+}
diff --git a/test/beowulf/bootstrap_test.clj b/test/beowulf/bootstrap_test.clj
index 25ac23d..0a2d732 100644
--- a/test/beowulf/bootstrap_test.clj
+++ b/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?
diff --git a/test/beowulf/cons_cell_test.clj b/test/beowulf/cons_cell_test.clj
index 7476db9..3a026a9 100644
--- a/test/beowulf/cons_cell_test.clj
+++ b/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."))
- (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.")))
+ (is (= actual expected) "An empty sequence is NIL.")))
(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)"
- actual (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))]
+ (let [expected "(A (B C) (D E (F) G) H)\n"
+ 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 "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))))]
diff --git a/test/beowulf/host_test.clj b/test/beowulf/host_test.clj
new file mode 100644
index 0000000..777bd36
--- /dev/null
+++ b/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)))
+ )
+ )
+