simon/beowulf
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

RPLACA and RPLACD now working

Browse source 
Regressions on `pretty-print` and `count`, but I'll accept that for now.

I'm not happy with rewriting ConsCell in Java, but I could not get mutable-unsynchronized to work.
This commit is contained in:
Simon Brooke 2019-08-22 16:03:38 +01:00
parent 34096ecae5
commit 6e5fcbed77
8 changed files with 260 additions and 224 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
src/clojure/beowulf/bootstrap.clj
View file

@ -7,11 +7,12 @@
The convention is adopted that functions in this file with names in The convention is adopted that functions in this file with names in
ALLUPPERCASE are Lisp 1.5 functions (although written in Clojure) and that 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." objects."
(:require [clojure.string :as s] (:require [clojure.string :as s]
[clojure.tools.trace :refer :all] [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] [x]
(cond (cond
(= x NIL) NIL (= x NIL) NIL
(instance? beowulf.cons_cell.ConsCell x) (.CAR x) (instance? ConsCell x) (.getCar x)
:else :else
(throw (throw
(Exception. (Exception.
@ -70,7 +71,7 @@
[x] [x]
(cond (cond
(= x NIL) NIL (= x NIL) NIL
(instance? beowulf.cons_cell.ConsCell x) (.CDR x) (instance? ConsCell x) (.getCdr x)
:else :else
(throw (throw
(Exception. (Exception.
@ -297,7 +298,7 @@
:also-tried l-name}))) :also-tried l-name})))
result (eval (cons f args))] result (eval (cons f args))]
(cond (cond
(instance? beowulf.cons_cell.ConsCell result) result (instance? ConsCell result) result
(seq? result) (make-beowulf-list result) (seq? result) (make-beowulf-list result)
(symbol? result) result (symbol? result) result
(string? result) (symbol result) (string? result) (symbol result)

228
src/clojure/beowulf/cons_cell.clj
View file

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

40
src/clojure/beowulf/host.clj
View file

@ -2,7 +2,8 @@
"provides Lisp 1.5 functions which can't be (or can't efficiently "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 be) implemented in Lisp 1.5, which therefore need to be implemented in the
host language, in this case Clojure." host language, in this case Clojure."
(:require [beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL T F]])) (: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. ;; 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 ;; those which can be implemented in Lisp should be, since that aids
@ -11,17 +12,20 @@
;; RPLACA ;; RPLACA
(defn RPLACA (defn RPLACA
[^beowulf.cons_cell.ConsCell cell value] "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 (if
(instance? beowulf.cons_cell.ConsCell cell) (instance? ConsCell cell)
(if (if
(or (or
(instance? beowulf.cons_cell.ConsCell value) (instance? ConsCell value)
(number? value) (number? value)
(symbol? value) (symbol? value)
(= value NIL)) (= value NIL))
(do (do
(set! (. cell CAR) value) (.setCar cell value)
cell) cell)
(throw (ex-info (throw (ex-info
(str "Invalid value in RPLACA: `" value "` (" (type value) ")") (str "Invalid value in RPLACA: `" value "` (" (type value) ")")
@ -34,8 +38,34 @@
;; RPLACD ;; 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 ;; PLUS
;; MINUS ;; MINUS
;; DIFFERENCE ;; DIFFERENCE

2
src/clojure/beowulf/read.clj
View file

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

143
src/java/beowulf/substrate/ConsCell.java
View file

@ -3,7 +3,7 @@ package beowulf.substrate;
import clojure.lang.*; import clojure.lang.*;
import java.lang.Number; import java.lang.Number;
import beowulf.cons_cell.NIL; //import beowulf.cons_cell.NIL;
/** /**
* <p> * <p>
@ -12,7 +12,9 @@ import beowulf.cons_cell.NIL;
* <p> * <p>
* Implementing mutable data in Clojure if <em>hard</em> - deliberately so. * 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 * But Lisp 1.5 cons cells need to be mutable. This class is part of thrashing
* around trying to find a solution. * 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> * </p>
*/ */
public class ConsCell public class ConsCell
@ -39,49 +41,31 @@ public class ConsCell
*/ */
private Object cdr; private Object cdr;
public ConsCell(ConsCell car, ConsCell cdr) { /**
this.car = car; * Construct a new ConsCell object with this `car` and this `cdr`.
this.cdr = cdr; *
} * @param car
* @param cdr
public ConsCell(ConsCell car, Symbol cdr) { * @throws IllegalArgumentException if either `car` or `cdr` is not one
this.car = car; * of ConsCell, Symbol, Number
this.cdr = cdr; */
} public ConsCell(Object car, Object cdr) {
if (car instanceof ConsCell || car instanceof Number || car instanceof Symbol) {
public ConsCell(ConsCell car, Number cdr) { this.car = car;
this.car = car; } else {
this.cdr = cdr; StringBuilder bob = new StringBuilder("Invalid CAR value (`")
} .append(car.toString()).append("`; ")
.append(car.getClass().getName()).append(") passed to CONS");
public ConsCell(Symbol car, ConsCell cdr) { throw new IllegalArgumentException(bob.toString());
this.car = car; }
this.cdr = cdr; if (cdr instanceof ConsCell || cdr instanceof Number || cdr instanceof Symbol) {
} this.cdr = cdr;
} else {
public ConsCell(Symbol car, Symbol cdr) { StringBuilder bob = new StringBuilder("Invalid CDR value (`")
this.car = car; .append(cdr.toString()).append("`; ")
this.cdr = cdr; .append(cdr.getClass().getName()).append(") passed to CONS");
} throw new IllegalArgumentException(bob.toString());
}
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() { public Object getCar() {
@ -122,7 +106,7 @@ public class ConsCell
return this; return this;
} }
@Override @Override
public boolean equals(Object other) { public boolean equals(Object other) {
boolean result; boolean result;
@ -139,37 +123,45 @@ public class ConsCell
return result; return result;
} }
@Override @Override
public String toString() { public String toString() {
StringBuilder bob = new StringBuilder("("); StringBuilder bob = new StringBuilder("(");
for (Object d = this; d instanceof ConsCell; d = ((ConsCell)d).cdr) { for (Object d = this; d instanceof ConsCell; d = ((ConsCell) d).cdr) {
ConsCell cell = (ConsCell)d; ConsCell cell = (ConsCell) d;
bob.append(cell.car.toString()) bob.append(cell.car.toString());
if ( cell.cdr instanceof ConsCell) { if (cell.cdr instanceof ConsCell) {
bob.append(" "); bob.append(" ");
} else if ( cell.cdr.toString().equals("NIL")) { } else if (cell.cdr.toString().equals("NIL")) {
/* That's an ugly hack to work around the fact I can't currently /* 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 * get a handle on the NIL symbol itself. In theory, nothing else
* in Lisp 1.5 should have the print-name `NIL`.*/ * in Lisp 1.5 should have the print-name `NIL`.*/
bob.append(")"); bob.append(")");
} else { } else {
bob.append(" . ").append(cell.cdr.toString()).append(")"); bob.append(" . ").append(cell.cdr.toString()).append(")");
} }
} }
return bob.toString(); return bob.toString();
}
/* IPersistentCollection interface implementation */
public int count() {
return this.cdr instanceof ConsCell ?
1 + ((ConsCell) this.cdr).count() :
1;
} }
/* 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. * `empty` is completely undocumented, I'll return `null` until something breaks.
*/ */
@ -182,16 +174,18 @@ public class ConsCell
* undocumented. But in PersistentList it's simply a synonym for 'equals', * undocumented. But in PersistentList it's simply a synonym for 'equals',
* and that's what I'll implement. * and that's what I'll implement.
*/ */
@Override
public boolean equiv(Object o) { public boolean equiv(Object o) {
return this.equals(o); return this.equals(o);
} }
/* ISeq interface implementation */ /* ISeq interface implementation */
@Override
public Object first() { public Object first() {
return this.car; return this.car;
} }
@Override
public ISeq next() { public ISeq next() {
ISeq result; ISeq result;
@ -204,6 +198,7 @@ public class ConsCell
return result; return result;
} }
@Override
public ISeq more() { public ISeq more() {
ISeq result; ISeq result;
@ -222,6 +217,7 @@ public class ConsCell
* `ConsCell` I'll satisfy both the IPersistentCollection and the * `ConsCell` I'll satisfy both the IPersistentCollection and the
* ISeq interfaces. * ISeq interfaces.
*/ */
@Override
public ConsCell cons(Object o) { public ConsCell cons(Object o) {
if (o instanceof ConsCell) { if (o instanceof ConsCell) {
return new ConsCell((ConsCell) o, this); return new ConsCell((ConsCell) o, this);
@ -235,6 +231,7 @@ public class ConsCell
} }
/* Seqable interface */ /* Seqable interface */
@Override
public ISeq seq() { public ISeq seq() {
return this; return this;
} }

2
test/beowulf/bootstrap_test.clj
View file

@ -75,7 +75,7 @@
(is (= actual expected) "B is CDR of (A . B)")) (is (= actual expected) "B is CDR of (A . B)"))
(let [expected 'B (let [expected 'B
actual (CDR (gsp "(A B C D)"))] 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") "CDR of (A B C D) is a cons cell")
(is (= (CAR actual) expected) "the CAR of that cons-cell is B")) (is (= (CAR actual) expected) "the CAR of that cons-cell is B"))
(is (thrown-with-msg? (is (thrown-with-msg?

41
test/beowulf/cons_cell_test.clj
View file

@ -1,16 +1,16 @@
(ns beowulf.core-test (ns beowulf.cons-cell-test
(:require [clojure.test :refer :all] (:require [clojure.test :refer :all]
[beowulf.cons-cell :refer :all])) [beowulf.cons-cell :refer :all]))
(deftest cons-cell-tests (deftest cons-cell-tests
(testing "make-cons-cell" (testing "make-cons-cell"
(let [expected "(A . B)" (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.")) (is (= actual expected) "Cons cells should print as cons cells, natch."))
(let [expected "(A . B)" (let [expected "(A . B)"
actual (print-str (make-cons-cell 'A 'B))] actual (print-str (make-cons-cell 'A 'B))]
(is (= actual expected) "Even if build with the macro.")) (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))] actual (print-str (make-cons-cell 'A 'B))]
(is (= actual expected) "And they should be cons cells.")) (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)))] actual (print-str (make-beowulf-list '(A (B C) (D E (F) G) H)))]
(is (= actual expected) "Should work for clojure lists, recursively.")) (is (= actual expected) "Should work for clojure lists, recursively."))
(let [expected "(A (B C) (D E (F) G) H)" (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.")) (is (= actual expected) "Should work for vectors, too."))
(let [expected "NIL" (let [expected "NIL"
actual (print-str (make-beowulf-list []))] 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" (testing "pretty-print"
(let [expected "(A\n (B C)\n (D E (F) G) H)" (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))) (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)))) (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" (testing "sequence functions"
(let [expected "A" (let [expected "A"
actual (print-str (first (make-beowulf-list '(A (B C) (D E (F) G) H))))] actual (print-str (first (make-beowulf-list '(A (B C) (D E (F) G) H))))]
(is (= actual expected))) (is (= actual expected)))
(let [expected "((B C) (D E (F) G) H)" (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))) (is (= actual expected)))
(let [expected "((B C) (D E (F) G) H)" (let [expected "((B C) (D E (F) G) H)"
actual (print-str (next (make-beowulf-list '(A (B C) (D E (F) G) H))))] actual (print-str (next (make-beowulf-list '(A (B C) (D E (F) G) H))))]

17
test/beowulf/host_test.clj
View file

@ -2,6 +2,7 @@
(:require [clojure.math.numeric-tower :refer [abs]] (:require [clojure.math.numeric-tower :refer [abs]]
[clojure.test :refer :all] [clojure.test :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]]
[beowulf.bootstrap :refer [CDR]]
[beowulf.host :refer :all] [beowulf.host :refer :all]
[beowulf.read :refer [gsp]])) [beowulf.read :refer [gsp]]))
@ -9,10 +10,18 @@
(testing "RPLACA" (testing "RPLACA"
(let (let
[l (make-beowulf-list '(A B C D E)) [l (make-beowulf-list '(A B C D E))
target (.CDR l) target (CDR l)
expected "(A F C D E)" expected "(A F C D E)"
actual (print-str (RPLACA target 'F))] actual (do (RPLACA target 'F) (print-str l))]
(is (= actual expected))) (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)))
)
)