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

Added unit tests for about half the bootstrap functions

Browse source
This commit is contained in:
Simon Brooke 2019-08-16 19:16:44 +01:00
parent 3f4e873e74
commit 10b2ad5322
4 changed files with 153 additions and 46 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

36
src/beowulf/cons_cell.clj
View file

@ -67,6 +67,42 @@
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 beowulf.cons_cell.ConsCell
[this writer]
(.write writer (to-string this)))

54
src/beowulf/eval.clj
View file

@ -11,7 +11,7 @@
(defn null
[x]
(= x NIL))
(if (= x NIL) 'T 'F))
(defn primitive-atom
"It is not clear to me from the documentation whether `(ATOM 7)` should return
@ -50,7 +50,7 @@
all those fiddly `#'c[ad]+r'` functions a bit easier"
[l path]
(cond
(null l) NIL
(= l NIL) NIL
(empty? path) l
:else (case (last path)
\a (uaf (car l) (butlast path))
@ -87,30 +87,23 @@
(defn cdaadr [x] (uaf x (seq "daad")))
(defn cdaddr [x] (uaf x (seq "dadd")))
;; (defn eq
;; "`eq` is only defined for atoms (symbols); it is NOT pointer identity, as
;; it is in later Lisps. Returns `'T` on success (identical atoms), `'F`
;; (NOT `NIL`) on failure. The behaviour if either argument is not an atom is
;; stated to be 'undefined', but I shall return `'F` for consistency."I
;; [x y]
;; (cond
;; (and (primitive-atom? x) (= x y)) 'T
;; :else
;; 'F))
(defn eq [x y] (if (and (primitive-atom? x) (= x y)) T F))
(defn eq
;; For some reason providing a doc string for this function breaks the
;; Clojure parser!
[x y]
(if (and (= (primitive-atom x) 'T) (= x y)) 'T 'F))
(defn equal
"This is a predicate that is true if its two arguments are identical
S-expressions, and false if they are different. (The elementary predicate
`eq` is defined only for atomic arguments.) The definition of `equal` is
an example of a conditional expression inside a conditional expression."
an example of a conditional expression inside a conditional expression.
NOTE: returns F on failure, not NIL"
[x y]
(cond
(primitive-atom? x) (cond
(primitive-atom? y) (eq x y)
:else 'F) ;; NOTE: returns F on failure, not NIL
(equal (car x) (car y)) (equal (cdr x) (cdr y))
(= (primitive-atom x) 'T) (eq x y)
(= (equal (car x) (car y)) 'T) (equal (cdr x) (cdr y))
:else 'F))
(defn subst
@ -118,8 +111,8 @@
all occurrences of the atomic symbol `y` in the S-expression `z`."
[x y z]
(cond
(equal y z) x
(primitive-atom? z) z ;; NIL is a symbol
(= (equal y z) 'T) x
(= (primitive-atom? z) 'T) z ;; NIL is a symbol
:else
(make-cons-cell (subst x y (car z)) (subst x y (cdr z)))))
@ -130,9 +123,9 @@
See page 11 of the Lisp 1.5 Programmers Manual."
[x y]
(cond
(null x) y
(= x NIL) y
:else
(cons (car x) (append (cdr x) y))))
(make-cons-cell (car x) (append (cdr x) y))))
(defn member
@ -144,7 +137,7 @@
[x y]
(cond
(= y NIL) F ;; NOTE: returns F on falsity, not NIL
(equal x (car y)) T
(= (equal x (car y)) 'T) 'T
:else (member x (cdr y))))
(defn pairlis
@ -162,7 +155,7 @@
(cond
;; the original tests only x; testing y as well will be a little more
;; robust if `x` and `y` are not the same length.
(or (null x) (null y)) a
(or (= NIL x) (= NIL y)) a
:else (make-cons-cell
(make-cons-cell (car x) (car y))
(pairlis (cdr x) (cdr y) a))))
@ -176,9 +169,9 @@
See page 12 of the Lisp 1.5 Programmers Manual."
[x a]
(cond
(null a) NIL ;; this clause is not present in the original but is added for
(= NIL a) NIL ;; this clause is not present in the original but is added for
;; robustness.
(equal (caar a) x) (car a)
(= (equal (caar a) x) 'T) (car a)
:else
(primitive-assoc x (cdr a))))
@ -187,8 +180,8 @@
? I think this is doing variable binding in the stack frame?"
[a z]
(cond
(null a) z
(= (caar a) z) (cdar a)
(= NIL a) z
(= (caar a) z) (cdar a) ;; TODO: this looks definitely wrong
:else
(sub2 (cdr a) z)))
@ -243,10 +236,9 @@
`beowulf.cons-cell/ConsCell` objects.
See page 13 of the Lisp 1.5 Programmers Manual."
[clauses env]
(cond
(if
(not= (primitive-eval (caar clauses) env) NIL)
(primitive-eval (cadar clauses) env)
:else
(evcon (cdr clauses) env)))
(defn- evlis

7
src/beowulf/read.clj
View file

@ -269,3 +269,10 @@
(defn primitive-read
[]
(generate (simplify (parse (read-line)))))
(defmacro gsp
"Shortcut macro - the internals of read; or, if you like, read-string.
Argument `s` should be a string representation of a valid Lisp
expression."
[s]
`(generate (simplify (parse ~s))))

102
test/beowulf/bootstrap_test.clj
View file

@ -3,7 +3,7 @@
[clojure.test :refer :all]
[beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL T F]]
[beowulf.eval :refer :all]
[beowulf.read :refer [parse simplify generate]]))
[beowulf.read :refer [gsp]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@ -19,7 +19,7 @@
actual (primitive-atom T)]
(is (= actual expected) "T is an atom (symbol)"))
(let [expected T
actual (primitive-atom (generate (simplify (parse "HELLO"))))]
actual (primitive-atom (gsp "HELLO"))]
(is (= actual expected) "HELLO is an atom (symbol)"))
(let [expected T
actual (primitive-atom 7)]
@ -30,14 +30,14 @@
actual (primitive-atom (make-cons-cell 'A 'B))]
(is (= actual expected) "A dotted pair is explicitly not an atom."))
(let [expected F
actual (primitive-atom (generate (simplify (parse "(A B C D)"))))]
actual (primitive-atom (gsp "(A B C D)"))]
(is (= actual expected) "A list is explicitly not an atom")))
(testing "primitive-atom?"
(let [expected T
actual (primitive-atom? T)]
(is (= actual expected) "T is an atom (symbol)"))
(let [expected T
actual (primitive-atom? (generate (simplify (parse "HELLO"))))]
actual (primitive-atom? (gsp "HELLO"))]
(is (= actual expected) "HELLO is an atom (symbol)"))
(let [expected T
actual (primitive-atom? 7)]
@ -48,7 +48,7 @@
actual (primitive-atom? (make-cons-cell 'A 'B))]
(is (= actual expected) "A dotted pair is explicitly not an atom."))
(let [expected NIL
actual (primitive-atom? (generate (simplify (parse "(A B C D)"))))]
actual (primitive-atom? (gsp "(A B C D)"))]
(is (= actual expected) "A list is explicitly not an atom"))
))
@ -59,7 +59,7 @@
actual (car (make-cons-cell 'A 'B))]
(is (= actual expected) "A is car of (A . B)"))
(let [expected 'A
actual (car (generate (simplify (parse "(A B C D)"))))]
actual (car (gsp "(A B C D)"))]
(is (= actual expected) "A is car of (A B C D)"))
(is (thrown-with-msg?
Exception
@ -76,7 +76,7 @@
actual (cdr (make-cons-cell 'A 'B))]
(is (= actual expected) "B is cdr of (A . B)"))
(let [expected 'B
actual (cdr (generate (simplify (parse "(A B C D)"))))]
actual (cdr (gsp "(A B C D)"))]
(is (instance? beowulf.cons_cell.ConsCell actual)
"cdr of (A B C D) is a cons cell")
(is (= (car actual) expected) "the car of that cons-cell is B"))
@ -90,22 +90,23 @@
#"Cannot take CDR of `.*"
(cdr 7))
"Can't take the cdr of a number"))
(let [s (generate
(simplify
(parse
"((((1 . 2) 3)(4 5) 6)(7 (8 9) (10 11 12) 13) 14 (15 16) 17)")))]
(let [s (gsp "((((1 . 2) 3)(4 5) 6)(7 (8 9) (10 11 12) 13) 14 (15 16) 17)")]
;; structure for testing access functions
(testing "cadr"
(let [expected 'B
actual (cadr (generate (simplify (parse "(A B C D)"))))]
actual (cadr (gsp "(A B C D)"))]
(is (= actual expected))))
(testing "caddr"
(let [expected 'C
actual (caddr (generate (simplify (parse "(A B C D)"))))]
(is (= actual expected))))
actual (caddr (gsp "(A B C D)"))]
(is (= actual expected)))
(let [expected 14
actual (caddr s)]
(is (= actual expected)))
)
(testing "cadddr"
(let [expected 'D
actual (cadddr (generate (simplify (parse "(A B C D)"))))]
actual (cadddr (gsp "(A B C D)"))]
(is (= actual expected))))
(testing "caaaar"
(let [expected "1"
@ -114,3 +115,74 @@
))
(deftest equality-tests
(testing "eq"
(let [expected 'T
actual (eq 'FRED 'FRED)]
(is (= actual expected) "identical symbols"))
(let [expected 'F
actual (eq 'FRED 'ELFREDA)]
(is (= actual expected) "different symbols"))
(let [expected 'F
l (gsp "(NOT AN ATOM)")
actual (eq l l)]
(is (= actual expected) "identical lists (eq is not defined for lists)")))
(testing "equal"
(let [expected 'T
actual (equal 'FRED 'FRED)]
(is (= actual expected) "identical symbols"))
(let [expected 'F
actual (equal 'FRED 'ELFREDA)]
(is (= actual expected) "different symbols"))
(let [expected 'T
l (gsp "(NOT AN ATOM)")
actual (equal l l)]
(is (= actual expected) "same list, same content"))
(let [expected 'T
l (gsp "(NOT AN ATOM)")
m (gsp "(NOT AN ATOM)")
actual (equal l m)]
(is (= actual expected) "different lists, same content"))
(let [expected 'F
l (gsp "(NOT AN ATOM)")
m (gsp "(NOT REALLY AN ATOM)")
actual (equal l m)]
(is (= actual expected) "different lists, different content"))))
(deftest substitution-tests
(testing "subst"
(let [expected "((A X . A) . C)"
;; differs from example in book only because of how the function
;; `beowulf.cons-cell/to-string` formats lists.
actual (print-str
(subst
(gsp "(X . A)")
(gsp "B")
(gsp "((A . B) . C)")))]
(is (= actual expected)))))
(deftest append-tests
(testing "append"
(let [expected "(A B C D E)"
actual (print-str
(append
(gsp "(A B)")
(gsp "(C D E)")))]
(is (= actual expected)))))
(deftest member-tests
(testing "member"
(let [expected 'T
actual (member (gsp "ALBERT") (gsp "(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED)"))]
(= actual expected))
(let [expected 'T
actual (member (gsp "BELINDA") (gsp "(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED)"))]
(= actual expected))
(let [expected 'T
actual (member (gsp "ELFREDA") (gsp "(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED)"))]
(= actual expected))
(let [expected 'F
actual (member (gsp "BERTRAM") (gsp "(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED)"))]
(= actual expected))))