Names of Clojure implementations of Lisp functions upper cased.

Makes it a damn sight easier to remember whether a function you're calling is Clojure or Lisp; avoids confusion and gets rid of those ugly 'primitive-' names.
This commit is contained in:
Simon Brooke 2019-08-17 10:55:24 +01:00
parent b92a24c089
commit dbab7651a3
4 changed files with 181 additions and 175 deletions

View file

@ -1,6 +1,6 @@
(ns beowulf.core (ns beowulf.core
(:require [beowulf.eval :refer [primitive-eval oblist]] (:require [beowulf.eval :refer [EVAL oblist]]
[beowulf.read :refer [primitive-read]]) [beowulf.read :refer [READ]])
(:gen-class)) (:gen-class))
(defn -main (defn -main
@ -10,7 +10,7 @@
(loop [] (loop []
(print ":: ") (print ":: ")
(flush) (flush)
(let [input (primitive-read)] (let [input (READ)]
(println (str "\tI read: " input)) (println (str "\tI read: " input))
(println (str "> " (primitive-eval input @oblist))) (println (str "> " (EVAL input @oblist)))
(recur)))) (recur))))

View file

@ -2,31 +2,31 @@
(:require [clojure.tools.trace :refer :all] (:require [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]]))
(declare primitive-eval) (declare EVAL)
(def oblist (def oblist
"The default environment; modified certainly be `LABEL` (which seems to "The default environment; modified certainly be `LABEL` (which seems to
be Lisp 1.5's equivalent of `SETQ`), possibly by other things." be Lisp 1.5's EQuivalent of `SETQ`), possibly by other things."
(atom NIL)) (atom NIL))
(defn null (defn NULL
[x] [x]
(if (= x NIL) 'T 'F)) (if (= x NIL) 'T 'F))
(defn primitive-atom (defn ATOM
"It is not clear to me from the documentation whether `(ATOM 7)` should return "It is not clear to me from the documentation whether `(ATOM 7)` should return
`'T` or `'F`. I'm going to assume `'T`." `'T` or `'F`. I'm going to assume `'T`."
[x] [x]
(if (or (symbol? x) (number? x)) 'T 'F)) (if (or (symbol? x) (number? x)) 'T 'F))
(defn primitive-atom? (defn ATOM?
"The convention of returning `'F` from predicates, rather than `NIL`, is going "The convention of returning `'F` from predicates, rather than `NIL`, is going
to tie me in knots. This is a variant of `primitive-atom` which returns `NIL` to tie me in knots. This is a variant of `ATOM` which returns `NIL`
on failure." on failure."
[x] [x]
(if (or (symbol? x) (number? x)) 'T NIL)) (if (or (symbol? x) (number? x)) 'T NIL))
(defn car (defn CAR
[x] [x]
(if (if
(instance? beowulf.cons_cell.ConsCell x) (instance? beowulf.cons_cell.ConsCell x)
@ -35,7 +35,7 @@
(Exception. (Exception.
(str "Cannot take CAR of `" x "` (" (.getName (.getClass x)) ")"))))) (str "Cannot take CAR of `" x "` (" (.getName (.getClass x)) ")")))))
(defn cdr (defn CDR
[x] [x]
(if (if
(instance? beowulf.cons_cell.ConsCell x) (instance? beowulf.cons_cell.ConsCell x)
@ -53,70 +53,70 @@
(= l NIL) NIL (= l NIL) NIL
(empty? path) l (empty? path) l
:else (case (last path) :else (case (last path)
\a (uaf (car l) (butlast path)) \a (uaf (CAR l) (butlast path))
\d (uaf (cdr l) (butlast path))))) \d (uaf (CDR l) (butlast path)))))
(defn caar [x] (uaf x (seq "aa"))) (defn CAAR [x] (uaf x (seq "aa")))
(defn cadr [x] (uaf x (seq "ad"))) (defn CADR [x] (uaf x (seq "ad")))
(defn cddr [x] (uaf x (seq "dd"))) (defn CDDR [x] (uaf x (seq "dd")))
(defn cdar [x] (uaf x (seq "da"))) (defn CDAR [x] (uaf x (seq "da")))
(defn caaar [x] (uaf x (seq "aaa"))) (defn CAAAR [x] (uaf x (seq "aaa")))
(defn caadr [x] (uaf x (seq "aad"))) (defn CAADR [x] (uaf x (seq "aad")))
(defn cadar [x] (uaf x (seq "ada"))) (defn CADAR [x] (uaf x (seq "ada")))
(defn caddr [x] (uaf x (seq "add"))) (defn CADDR [x] (uaf x (seq "add")))
(defn cddar [x] (uaf x (seq "dda"))) (defn CDDAR [x] (uaf x (seq "dda")))
(defn cdddr [x] (uaf x (seq "ddd"))) (defn CDDDR [x] (uaf x (seq "ddd")))
(defn cdaar [x] (uaf x (seq "daa"))) (defn CDAAR [x] (uaf x (seq "daa")))
(defn cdadr [x] (uaf x (seq "dad"))) (defn CDADR [x] (uaf x (seq "dad")))
(defn caaaar [x] (uaf x (seq "aaaa"))) (defn CAAAAR [x] (uaf x (seq "aaaa")))
(defn caadar [x] (uaf x (seq "aada"))) (defn CAADAR [x] (uaf x (seq "aada")))
(defn cadaar [x] (uaf x (seq "adaa"))) (defn CADAAR [x] (uaf x (seq "adaa")))
(defn caddar [x] (uaf x (seq "adda"))) (defn CADDAR [x] (uaf x (seq "adda")))
(defn cddaar [x] (uaf x (seq "ddaa"))) (defn CDDAAR [x] (uaf x (seq "ddaa")))
(defn cdddar [x] (uaf x (seq "ddda"))) (defn CDDDAR [x] (uaf x (seq "ddda")))
(defn cdaaar [x] (uaf x (seq "daaa"))) (defn CDAAAR [x] (uaf x (seq "daaa")))
(defn cdadar [x] (uaf x (seq "dada"))) (defn CDADAR [x] (uaf x (seq "dada")))
(defn caaadr [x] (uaf x (seq "aaad"))) (defn CAAADR [x] (uaf x (seq "aaad")))
(defn caaddr [x] (uaf x (seq "aadd"))) (defn CAADDR [x] (uaf x (seq "aadd")))
(defn cadadr [x] (uaf x (seq "adad"))) (defn CADADR [x] (uaf x (seq "adad")))
(defn cadddr [x] (uaf x (seq "addd"))) (defn CADDDR [x] (uaf x (seq "addd")))
(defn cddadr [x] (uaf x (seq "ddad"))) (defn CDDADR [x] (uaf x (seq "ddad")))
(defn cddddr [x] (uaf x (seq "dddd"))) (defn CDDDDR [x] (uaf x (seq "dddd")))
(defn cdaadr [x] (uaf x (seq "daad"))) (defn CDAADR [x] (uaf x (seq "daad")))
(defn cdaddr [x] (uaf x (seq "dadd"))) (defn CDADDR [x] (uaf x (seq "dadd")))
(defn eq (defn EQ
;; For some reason providing a doc string for this function breaks the ;; For some reason providing a doc string for this function breaks the
;; Clojure parser! ;; Clojure parser!
[x y] [x y]
(if (and (= (primitive-atom x) 'T) (= x y)) 'T 'F)) (if (and (= (ATOM x) 'T) (= x y)) 'T 'F))
(defn equal (defn EQUAL
"This is a predicate that is true if its two arguments are identical "This is a predicate that is true if its two arguments are identical
S-expressions, and false if they are different. (The elementary predicate S-expressions, and false if they are different. (The elementary predicate
`eq` is defined only for atomic arguments.) The definition of `equal` is `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" NOTE: returns F on failure, not NIL"
[x y] [x y]
(cond (cond
(= (primitive-atom x) 'T) (eq x y) (= (ATOM x) 'T) (EQ x y)
(= (equal (car x) (car y)) 'T) (equal (cdr x) (cdr y)) (= (EQUAL (CAR x) (CAR y)) 'T) (EQUAL (CDR x) (CDR y))
:else 'F)) :else 'F))
(defn subst (defn SUBST
"This function gives the result of substituting the S-expression `x` for "This function gives the result of substituting the S-expression `x` for
all occurrences of the atomic symbol `y` in the S-expression `z`." all occurrences of the atomic symbol `y` in the S-expression `z`."
[x y z] [x y z]
(cond (cond
(= (equal y z) 'T) x (= (EQUAL y z) 'T) x
(= (primitive-atom? z) 'T) z ;; NIL is a symbol (= (ATOM? z) 'T) z ;; NIL is a symbol
:else :else
(make-cons-cell (subst x y (car z)) (subst x y (cdr z))))) (make-cons-cell (SUBST x y (CAR z)) (SUBST x y (CDR z)))))
(defn append (defn APPEND
"Append the the elements of `y` to the elements of `x`. "Append the the elements of `y` to the elements of `x`.
All args are assumed to be `beowulf.cons-cell/ConsCell` objects. All args are assumed to be `beowulf.cons-cell/ConsCell` objects.
@ -125,10 +125,10 @@
(cond (cond
(= x NIL) y (= x NIL) y
:else :else
(make-cons-cell (car x) (append (cdr x) y)))) (make-cons-cell (CAR x) (APPEND (CDR x) y))))
(defn member (defn MEMBER
"This predicate is true if the S-expression `x` occurs among the elements "This predicate is true if the S-expression `x` occurs among the elements
of the list `y`. of the list `y`.
@ -137,12 +137,12 @@
[x y] [x y]
(cond (cond
(= y NIL) F ;; NOTE: returns F on falsity, not NIL (= y NIL) F ;; NOTE: returns F on falsity, not NIL
(= (equal x (car y)) 'T) 'T (= (EQUAL x (CAR y)) 'T) 'T
:else (member x (cdr y)))) :else (MEMBER x (CDR y))))
(defn pairlis (defn PAIRLIS
"This function gives the list of pairs of corresponding elements of the "This function gives the list of pairs of corresponding elements of the
lists `x` and `y`, and appends this to the list `a`. The resultant list lists `x` and `y`, and APPENDs this to the list `a`. The resultant list
of pairs, which is like a table with two columns, is called an of pairs, which is like a table with two columns, is called an
association list. association list.
@ -157,11 +157,11 @@
;; robust if `x` and `y` are not the same length. ;; robust if `x` and `y` are not the same length.
(or (= NIL x) (= NIL y)) a (or (= NIL x) (= NIL y)) a
:else (make-cons-cell :else (make-cons-cell
(make-cons-cell (car x) (car y)) (make-cons-cell (CAR x) (CAR y))
(pairlis (cdr x) (cdr y) a)))) (PAIRLIS (CDR x) (CDR y) a))))
(defn primitive-assoc (defn ASSOC
"If a is an association list such as the one formed by pairlis in the above "If a is an association list such as the one formed by PAIRLIS in the above
example, then assoc will produce the first pair whose first term is x. Thus example, then assoc will produce the first pair whose first term is x. Thus
it is a table searching function. it is a table searching function.
@ -171,25 +171,25 @@
(cond (cond
(= NIL 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. ;; robustness.
(= (equal (caar a) x) 'T) (car a) (= (EQUAL (CAAR a) x) 'T) (CAR a)
:else :else
(primitive-assoc x (cdr a)))) (ASSOC x (CDR a))))
(defn- sub2 (defn- SUB2
"Internal to `sublis`, q.v., which substitutes into a list from a store. "Internal to `SUBLIS`, q.v., which SUBSTitutes into a list from a store.
? I think this is doing variable binding in the stack frame?" ? I think this is doing variable binding in the stack frame?"
[a z] [a z]
(cond (cond
(= NIL a) z (= NIL a) z
(= (caar a) z) (cdar a) ;; TODO: this looks definitely wrong (= (CAAR a) z) (CDAR a) ;; TODO: this looks definitely wrong
:else :else
(sub2 (cdr a) z))) (SUB2 (CDR a) z)))
(defn sublis (defn SUBLIS
"Here `a` is assumed to be an association list of the form "Here `a` is assumed to be an association list of the form
`((ul . vl)...(un . vn))`, where the `u`s are atomic, and `y` is any `((ul . vl)...(un . vn))`, where the `u`s are atomic, and `y` is any
S-expression. What `sublis` does, is to treat the `u`s as variables when S-expression. What `SUBLIS` does, is to treat the `u`s as variables when
they occur in `y`, and to substitute the corresponding `v`s from the pair they occur in `y`, and to SUBSTitute the corresponding `v`s from the pair
list. list.
My interpretation is that this is variable binding in the stack frame. My interpretation is that this is variable binding in the stack frame.
@ -198,78 +198,84 @@
See page 12 of the Lisp 1.5 Programmers Manual." See page 12 of the Lisp 1.5 Programmers Manual."
[a y] [a y]
(cond (cond
(= (primitive-atom? y) 'T) (sub2 a y) (= (ATOM? y) 'T) (SUB2 a y)
:else :else
(make-cons-cell (sublis a (car y)) (sublis a (cdr y))))) (make-cons-cell (SUBLIS a (CAR y)) (SUBLIS a (CDR y)))))
(deftrace primitive-apply (deftrace APPLY
"For bootstrapping, at least, a version of APPLY written in Clojure. "For bootstrapping, at least, a version of APPLY written in Clojure.
All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects. All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects.
See page 13 of the Lisp 1.5 Programmers Manual." See page 13 of the Lisp 1.5 Programmers Manual."
[function args environment] [function args environment]
(cond (cond
(primitive-atom? function)(cond (=
(= function 'CAR) (caar args) (ATOM? function)
(= function 'CDR) (cdar args) 'T)(cond
(= function 'CONS) (make-cons-cell (car args) (cadr args)) (= function 'CAR) (CAAR args)
(= function 'ATOM) (if (primitive-atom? (car args)) T NIL) (= function 'CDR) (CDAR args)
(= function 'EQ) (if (= (car args) (cadr args)) T NIL) (= function 'CONS) (make-cons-cell (CAR args) (CADR args))
(= function 'ATOM) (if (ATOM? (CAR args)) T NIL)
(= function 'EQ) (if (= (CAR args) (CADR args)) T NIL)
:else :else
(primitive-apply (APPLY
(primitive-eval function environment) (EVAL function environment)
args args
environment)) environment))
(= (first function) 'LAMBDA) (primitive-eval (= (first function) 'LAMBDA) (EVAL
(caddr function) (CADDR function)
(pairlis (cadr function) args environment)) (PAIRLIS (CADR function) args environment))
(= (first function) 'LABEL) (primitive-apply (= (first function) 'LABEL) (APPLY
(caddr function) (CADDR function)
args args
(make-cons-cell (make-cons-cell
(make-cons-cell (make-cons-cell
(cadr function) (CADR function)
(caddr function)) (CADDR function))
environment)))) environment))))
(defn- evcon (defn- EVCON
"Inner guts of primitive COND. All args are assumed to be "Inner guts of primitive COND. All args are assumed to be
`beowulf.cons-cell/ConsCell` objects. `beowulf.cons-cell/ConsCell` objects.
See page 13 of the Lisp 1.5 Programmers Manual." See page 13 of the Lisp 1.5 Programmers Manual."
[clauses env] [clauses env]
(if (if
(not= (primitive-eval (caar clauses) env) NIL) (not= (EVAL (CAAR clauses) env) NIL)
(primitive-eval (cadar clauses) env) (EVAL (CADAR clauses) env)
(evcon (cdr clauses) env))) (EVCON (CDR clauses) env)))
(defn- evlis (defn- EVLIS
"Map `primitive-eval` across this list of `args` in the context of this "Map `EVAL` across this list of `args` in the context of this
`env`ironment.All args are assumed to be `beowulf.cons-cell/ConsCell` objects. `env`ironment.All args are assumed to be `beowulf.cons-cell/ConsCell` objects.
See page 13 of the Lisp 1.5 Programmers Manual." See page 13 of the Lisp 1.5 Programmers Manual."
[args env] [args env]
(cond (cond
(null args) NIL (= NIL args) NIL
:else :else
(make-cons-cell (make-cons-cell
(primitive-eval (car args) env) (EVAL (CAR args) env)
(evlis (cdr args) env)))) (EVLIS (CDR args) env))))
(deftrace primitive-eval (deftrace EVAL
"For bootstrapping, at least, a version of EVAL written in Clojure. "For bootstrapping, at least, a version of EVAL written in Clojure.
All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects. All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects.
See page 13 of the Lisp 1.5 Programmers Manual." See page 13 of the Lisp 1.5 Programmers Manual."
[expr env] [expr env]
(cond (cond
(primitive-atom? expr) (cdr (primitive-assoc expr env)) (=
(primitive-atom? (car expr))(cond (ATOM? expr) 'T)
(eq (car expr) 'QUOTE) (cadr expr) (CDR (ASSOC expr env))
(eq (car expr) 'COND) (evcon (cdr expr) env) (=
:else (primitive-apply (ATOM? (CAR expr))
(car expr) 'T)(cond
(evlis (cdr expr) env) (= (CAR expr) 'QUOTE) (CADR expr)
(= (CAR expr) 'COND) (EVCON (CDR expr) env)
:else (APPLY
(CAR expr)
(EVLIS (CDR expr) env)
env)) env))
:else (primitive-apply :else (APPLY
(car expr) (CAR expr)
(evlis (cdr expr) env) (EVLIS (CDR expr) env)
env))) env)))

View file

@ -266,13 +266,13 @@
(throw (Exception. (str "Cannot yet generate " (first p))))) (throw (Exception. (str "Cannot yet generate " (first p)))))
p)) p))
(defn primitive-read
[]
(generate (simplify (parse (read-line)))))
(defmacro gsp (defmacro gsp
"Shortcut macro - the internals of read; or, if you like, read-string. "Shortcut macro - the internals of read; or, if you like, read-string.
Argument `s` should be a string representation of a valid Lisp Argument `s` should be a string representation of a valid Lisp
expression." expression."
[s] [s]
`(generate (simplify (parse ~s)))) `(generate (simplify (parse ~s))))
(defn READ
[]
(gsp (read-line)))

View file

@ -14,136 +14,136 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(deftest atom-tests (deftest atom-tests
(testing "primitive-atom" (testing "ATOM"
(let [expected T (let [expected T
actual (primitive-atom T)] actual (ATOM T)]
(is (= actual expected) "T is an atom (symbol)")) (is (= actual expected) "T is an atom (symbol)"))
(let [expected T (let [expected T
actual (primitive-atom (gsp "HELLO"))] actual (ATOM (gsp "HELLO"))]
(is (= actual expected) "HELLO is an atom (symbol)")) (is (= actual expected) "HELLO is an atom (symbol)"))
(let [expected T (let [expected T
actual (primitive-atom 7)] actual (ATOM 7)]
(is (= actual expected) (is (= actual expected)
"I'm not actually certain whether a number should be treated as an "I'm not actually certain whether a number should be treated as an
atom, but I'm guessing so")) atom, but I'm guessing so"))
(let [expected F (let [expected F
actual (primitive-atom (make-cons-cell 'A 'B))] actual (ATOM (make-cons-cell 'A 'B))]
(is (= actual expected) "A dotted pair is explicitly not an atom.")) (is (= actual expected) "A dotted pair is explicitly not an atom."))
(let [expected F (let [expected F
actual (primitive-atom (gsp "(A B C D)"))] actual (ATOM (gsp "(A B C D)"))]
(is (= actual expected) "A list is explicitly not an atom"))) (is (= actual expected) "A list is explicitly not an atom")))
(testing "primitive-atom?" (testing "ATOM?"
(let [expected T (let [expected T
actual (primitive-atom? T)] actual (ATOM? T)]
(is (= actual expected) "T is an atom (symbol)")) (is (= actual expected) "T is an atom (symbol)"))
(let [expected T (let [expected T
actual (primitive-atom? (gsp "HELLO"))] actual (ATOM? (gsp "HELLO"))]
(is (= actual expected) "HELLO is an atom (symbol)")) (is (= actual expected) "HELLO is an atom (symbol)"))
(let [expected T (let [expected T
actual (primitive-atom? 7)] actual (ATOM? 7)]
(is (= actual expected) (is (= actual expected)
"I'm not actually certain whether a number should be treated as an "I'm not actually certain whether a number should be treated as an
atom, but I'm guessing so")) atom, but I'm guessing so"))
(let [expected NIL (let [expected NIL
actual (primitive-atom? (make-cons-cell 'A 'B))] actual (ATOM? (make-cons-cell 'A 'B))]
(is (= actual expected) "A dotted pair is explicitly not an atom.")) (is (= actual expected) "A dotted pair is explicitly not an atom."))
(let [expected NIL (let [expected NIL
actual (primitive-atom? (gsp "(A B C D)"))] actual (ATOM? (gsp "(A B C D)"))]
(is (= actual expected) "A list is explicitly not an atom")))) (is (= actual expected) "A list is explicitly not an atom"))))
(deftest access-function-tests (deftest access-function-tests
(testing "car" (testing "CAR"
(let [expected 'A (let [expected 'A
actual (car (make-cons-cell 'A 'B))] actual (CAR (make-cons-cell 'A 'B))]
(is (= actual expected) "A is car of (A . B)")) (is (= actual expected) "A is CAR of (A . B)"))
(let [expected 'A (let [expected 'A
actual (car (gsp "(A B C D)"))] actual (CAR (gsp "(A B C D)"))]
(is (= actual expected) "A is car of (A B C D)")) (is (= actual expected) "A is CAR of (A B C D)"))
(is (thrown-with-msg? (is (thrown-with-msg?
Exception Exception
#"Cannot take CAR of `.*" #"Cannot take CAR of `.*"
(car 'T)) (CAR 'T))
"Can't take the car of an atom") "Can't take the CAR of an atom")
(is (thrown-with-msg? (is (thrown-with-msg?
Exception Exception
#"Cannot take CAR of `.*" #"Cannot take CAR of `.*"
(car 7)) (CAR 7))
"Can't take the car of a number")) "Can't take the CAR of a number"))
(testing "cdr" (testing "CDR"
(let [expected 'B (let [expected 'B
actual (cdr (make-cons-cell 'A 'B))] actual (CDR (make-cons-cell 'A 'B))]
(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.cons_cell.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?
Exception Exception
#"Cannot take CDR of `.*" #"Cannot take CDR of `.*"
(cdr 'T)) (CDR 'T))
"Can't take the cdr of an atom") "Can't take the CDR of an atom")
(is (thrown-with-msg? (is (thrown-with-msg?
Exception Exception
#"Cannot take CDR of `.*" #"Cannot take CDR of `.*"
(cdr 7)) (CDR 7))
"Can't take the cdr of a number")) "Can't take the CDR of a number"))
(let [s (gsp "((((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 ;; structure for testing access functions
(testing "cadr" (testing "cadr"
(let [expected 'B (let [expected 'B
actual (cadr (gsp "(A B C D)"))] actual (CADR (gsp "(A B C D)"))]
(is (= actual expected)))) (is (= actual expected))))
(testing "caddr" (testing "caddr"
(let [expected 'C (let [expected 'C
actual (caddr (gsp "(A B C D)"))] actual (CADDR (gsp "(A B C D)"))]
(is (= actual expected))) (is (= actual expected)))
(let [expected 14 (let [expected 14
actual (caddr s)] actual (CADDR s)]
(is (= actual expected))) (is (= actual expected)))
) )
(testing "cadddr" (testing "cadddr"
(let [expected 'D (let [expected 'D
actual (cadddr (gsp "(A B C D)"))] actual (CADDDR (gsp "(A B C D)"))]
(is (= actual expected)))) (is (= actual expected))))
(testing "caaaar" (testing "caaaar"
(let [expected "1" (let [expected "1"
actual (print-str (caaaar s))] actual (print-str (CAAAAR s))]
(is (= actual expected)))))) (is (= actual expected))))))
(deftest equality-tests (deftest equality-tests
(testing "eq" (testing "eq"
(let [expected 'T (let [expected 'T
actual (eq 'FRED 'FRED)] actual (EQ 'FRED 'FRED)]
(is (= actual expected) "identical symbols")) (is (= actual expected) "identical symbols"))
(let [expected 'F (let [expected 'F
actual (eq 'FRED 'ELFREDA)] actual (EQ 'FRED 'ELFREDA)]
(is (= actual expected) "different symbols")) (is (= actual expected) "different symbols"))
(let [expected 'F (let [expected 'F
l (gsp "(NOT AN ATOM)") l (gsp "(NOT AN ATOM)")
actual (eq l l)] actual (EQ l l)]
(is (= actual expected) "identical lists (eq is not defined for lists)"))) (is (= actual expected) "identical lists (EQ is not defined for lists)")))
(testing "equal" (testing "equal"
(let [expected 'T (let [expected 'T
actual (equal 'FRED 'FRED)] actual (EQUAL 'FRED 'FRED)]
(is (= actual expected) "identical symbols")) (is (= actual expected) "identical symbols"))
(let [expected 'F (let [expected 'F
actual (equal 'FRED 'ELFREDA)] actual (EQUAL 'FRED 'ELFREDA)]
(is (= actual expected) "different symbols")) (is (= actual expected) "different symbols"))
(let [expected 'T (let [expected 'T
l (gsp "(NOT AN ATOM)") l (gsp "(NOT AN ATOM)")
actual (equal l l)] actual (EQUAL l l)]
(is (= actual expected) "same list, same content")) (is (= actual expected) "same list, same content"))
(let [expected 'T (let [expected 'T
l (gsp "(NOT AN ATOM)") l (gsp "(NOT AN ATOM)")
m (gsp "(NOT AN ATOM)") m (gsp "(NOT AN ATOM)")
actual (equal l m)] actual (EQUAL l m)]
(is (= actual expected) "different lists, same content")) (is (= actual expected) "different lists, same content"))
(let [expected 'F (let [expected 'F
l (gsp "(NOT AN ATOM)") l (gsp "(NOT AN ATOM)")
m (gsp "(NOT REALLY AN ATOM)") m (gsp "(NOT REALLY AN ATOM)")
actual (equal l m)] actual (EQUAL l m)]
(is (= actual expected) "different lists, different content")))) (is (= actual expected) "different lists, different content"))))
(deftest substitution-tests (deftest substitution-tests
@ -152,7 +152,7 @@
;; differs from example in book only because of how the function ;; differs from example in book only because of how the function
;; `beowulf.cons-cell/to-string` formats lists. ;; `beowulf.cons-cell/to-string` formats lists.
actual (print-str actual (print-str
(subst (SUBST
(gsp "(X . A)") (gsp "(X . A)")
(gsp "B") (gsp "B")
(gsp "((A . B) . C)")))] (gsp "((A . B) . C)")))]
@ -162,13 +162,13 @@
(testing "append" (testing "append"
(let [expected "(A B C . D)" (let [expected "(A B C . D)"
actual (print-str actual (print-str
(append (APPEND
(gsp "(A B)") (gsp "(A B)")
(gsp "(C . D)")))] (gsp "(C . D)")))]
(is (= actual expected))) (is (= actual expected)))
(let [expected "(A B C D E)" (let [expected "(A B C D E)"
actual (print-str actual (print-str
(append (APPEND
(gsp "(A B)") (gsp "(A B)")
(gsp "(C D E)")))] (gsp "(C D E)")))]
(is (= actual expected))))) (is (= actual expected)))))
@ -176,23 +176,23 @@
(deftest member-tests (deftest member-tests
(testing "member" (testing "member"
(let [expected 'T (let [expected 'T
actual (member (gsp "ALBERT") (gsp "(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED)"))] actual (MEMBER (gsp "ALBERT") (gsp "(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED)"))]
(= actual expected)) (= actual expected))
(let [expected 'T (let [expected 'T
actual (member (gsp "BELINDA") (gsp "(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED)"))] actual (MEMBER (gsp "BELINDA") (gsp "(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED)"))]
(= actual expected)) (= actual expected))
(let [expected 'T (let [expected 'T
actual (member (gsp "ELFREDA") (gsp "(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED)"))] actual (MEMBER (gsp "ELFREDA") (gsp "(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED)"))]
(= actual expected)) (= actual expected))
(let [expected 'F (let [expected 'F
actual (member (gsp "BERTRAM") (gsp "(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED)"))] actual (MEMBER (gsp "BERTRAM") (gsp "(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED)"))]
(= actual expected)))) (= actual expected))))
(deftest pairlis-tests (deftest pairlis-tests
(testing "pairlis" (testing "pairlis"
(let [expected "((A . U) (B . V) (C . W) (D . X) (E . Y))" (let [expected "((A . U) (B . V) (C . W) (D . X) (E . Y))"
actual (print-str actual (print-str
(pairlis (PAIRLIS
(gsp "(A B C)") (gsp "(A B C)")
(gsp "(U V W)") (gsp "(U V W)")
(gsp "((D . X)(E . Y))")))] (gsp "((D . X)(E . Y))")))]
@ -202,19 +202,19 @@
(testing "assoc" (testing "assoc"
(let [expected "(B CAR X)" (let [expected "(B CAR X)"
actual (print-str actual (print-str
(primitive-assoc (ASSOC
'B 'B
(gsp "((A . (M N)) (B . (CAR X)) (C . (QUOTE M)) (C . (CDR X)))")))] (gsp "((A . (M N)) (B . (CAR X)) (C . (QUOTE M)) (C . (CDR X)))")))]
(is (= actual expected))) (is (= actual expected)))
(let [expected "(C QUOTE M)" (let [expected "(C QUOTE M)"
actual (print-str actual (print-str
(primitive-assoc (ASSOC
'C 'C
(gsp "((A . (M N)) (B . (CAR X)) (C . (QUOTE M)) (C . (CDR X)))")))] (gsp "((A . (M N)) (B . (CAR X)) (C . (QUOTE M)) (C . (CDR X)))")))]
(is (= actual expected))) (is (= actual expected)))
(let [expected "NIL" (let [expected "NIL"
actual (print-str actual (print-str
(primitive-assoc (ASSOC
'D 'D
(gsp "((A . (M N)) (B . (CAR X)) (C . (QUOTE M)) (C . (CDR X)))")))] (gsp "((A . (M N)) (B . (CAR X)) (C . (QUOTE M)) (C . (CDR X)))")))]
(is (= actual expected))))) (is (= actual expected)))))
@ -223,7 +223,7 @@
(testing "sublis" (testing "sublis"
(let [expected "(SHAKESPEARE WROTE (THE TEMPEST))" (let [expected "(SHAKESPEARE WROTE (THE TEMPEST))"
actual (print-str actual (print-str
(sublis (SUBLIS
(gsp "((X . SHAKESPEARE) (Y . (THE TEMPEST)))") (gsp "((X . SHAKESPEARE) (Y . (THE TEMPEST)))")
(gsp "(X WROTE Y)")))] (gsp "(X WROTE Y)")))]
(is (= actual expected))))) (is (= actual expected)))))