From 10b2ad53221fcc4162ba91f8b21d64fba6eaaa6a Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Fri, 16 Aug 2019 19:16:44 +0100 Subject: [PATCH] Added unit tests for about half the bootstrap functions --- src/beowulf/cons_cell.clj | 36 +++++++++++ src/beowulf/eval.clj | 54 +++++++---------- src/beowulf/read.clj | 7 +++ test/beowulf/bootstrap_test.clj | 102 +++++++++++++++++++++++++++----- 4 files changed, 153 insertions(+), 46 deletions(-) diff --git a/src/beowulf/cons_cell.clj b/src/beowulf/cons_cell.clj index a83830b..86d6fce 100644 --- a/src/beowulf/cons_cell.clj +++ b/src/beowulf/cons_cell.clj @@ -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))) diff --git a/src/beowulf/eval.clj b/src/beowulf/eval.clj index 394e4ff..ab1be39 100644 --- a/src/beowulf/eval.clj +++ b/src/beowulf/eval.clj @@ -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 diff --git a/src/beowulf/read.clj b/src/beowulf/read.clj index 6b83b84..897b265 100644 --- a/src/beowulf/read.clj +++ b/src/beowulf/read.clj @@ -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)))) diff --git a/test/beowulf/bootstrap_test.clj b/test/beowulf/bootstrap_test.clj index 7f5e1c4..785324b 100644 --- a/test/beowulf/bootstrap_test.clj +++ b/test/beowulf/bootstrap_test.clj @@ -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)))) + +