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:
parent
b92a24c089
commit
dbab7651a3
|
|
@ -1,6 +1,6 @@
|
|||
(ns beowulf.core
|
||||
(:require [beowulf.eval :refer [primitive-eval oblist]]
|
||||
[beowulf.read :refer [primitive-read]])
|
||||
(:require [beowulf.eval :refer [EVAL oblist]]
|
||||
[beowulf.read :refer [READ]])
|
||||
(:gen-class))
|
||||
|
||||
(defn -main
|
||||
|
|
@ -10,7 +10,7 @@
|
|||
(loop []
|
||||
(print ":: ")
|
||||
(flush)
|
||||
(let [input (primitive-read)]
|
||||
(let [input (READ)]
|
||||
(println (str "\tI read: " input))
|
||||
(println (str "> " (primitive-eval input @oblist)))
|
||||
(println (str "> " (EVAL input @oblist)))
|
||||
(recur))))
|
||||
|
|
|
|||
|
|
@ -2,31 +2,31 @@
|
|||
(:require [clojure.tools.trace :refer :all]
|
||||
[beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL T F]]))
|
||||
|
||||
(declare primitive-eval)
|
||||
(declare EVAL)
|
||||
|
||||
(def oblist
|
||||
"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))
|
||||
|
||||
(defn null
|
||||
(defn NULL
|
||||
[x]
|
||||
(if (= x NIL) 'T 'F))
|
||||
|
||||
(defn primitive-atom
|
||||
(defn ATOM
|
||||
"It is not clear to me from the documentation whether `(ATOM 7)` should return
|
||||
`'T` or `'F`. I'm going to assume `'T`."
|
||||
[x]
|
||||
(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
|
||||
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."
|
||||
[x]
|
||||
(if (or (symbol? x) (number? x)) 'T NIL))
|
||||
|
||||
(defn car
|
||||
(defn CAR
|
||||
[x]
|
||||
(if
|
||||
(instance? beowulf.cons_cell.ConsCell x)
|
||||
|
|
@ -35,7 +35,7 @@
|
|||
(Exception.
|
||||
(str "Cannot take CAR of `" x "` (" (.getName (.getClass x)) ")")))))
|
||||
|
||||
(defn cdr
|
||||
(defn CDR
|
||||
[x]
|
||||
(if
|
||||
(instance? beowulf.cons_cell.ConsCell x)
|
||||
|
|
@ -53,70 +53,70 @@
|
|||
(= l NIL) NIL
|
||||
(empty? path) l
|
||||
:else (case (last path)
|
||||
\a (uaf (car l) (butlast path))
|
||||
\d (uaf (cdr l) (butlast path)))))
|
||||
\a (uaf (CAR l) (butlast path))
|
||||
\d (uaf (CDR l) (butlast path)))))
|
||||
|
||||
(defn caar [x] (uaf x (seq "aa")))
|
||||
(defn cadr [x] (uaf x (seq "ad")))
|
||||
(defn cddr [x] (uaf x (seq "dd")))
|
||||
(defn cdar [x] (uaf x (seq "da")))
|
||||
(defn CAAR [x] (uaf x (seq "aa")))
|
||||
(defn CADR [x] (uaf x (seq "ad")))
|
||||
(defn CDDR [x] (uaf x (seq "dd")))
|
||||
(defn CDAR [x] (uaf x (seq "da")))
|
||||
|
||||
(defn caaar [x] (uaf x (seq "aaa")))
|
||||
(defn caadr [x] (uaf x (seq "aad")))
|
||||
(defn cadar [x] (uaf x (seq "ada")))
|
||||
(defn caddr [x] (uaf x (seq "add")))
|
||||
(defn cddar [x] (uaf x (seq "dda")))
|
||||
(defn cdddr [x] (uaf x (seq "ddd")))
|
||||
(defn cdaar [x] (uaf x (seq "daa")))
|
||||
(defn cdadr [x] (uaf x (seq "dad")))
|
||||
(defn CAAAR [x] (uaf x (seq "aaa")))
|
||||
(defn CAADR [x] (uaf x (seq "aad")))
|
||||
(defn CADAR [x] (uaf x (seq "ada")))
|
||||
(defn CADDR [x] (uaf x (seq "add")))
|
||||
(defn CDDAR [x] (uaf x (seq "dda")))
|
||||
(defn CDDDR [x] (uaf x (seq "ddd")))
|
||||
(defn CDAAR [x] (uaf x (seq "daa")))
|
||||
(defn CDADR [x] (uaf x (seq "dad")))
|
||||
|
||||
(defn caaaar [x] (uaf x (seq "aaaa")))
|
||||
(defn caadar [x] (uaf x (seq "aada")))
|
||||
(defn cadaar [x] (uaf x (seq "adaa")))
|
||||
(defn caddar [x] (uaf x (seq "adda")))
|
||||
(defn cddaar [x] (uaf x (seq "ddaa")))
|
||||
(defn cdddar [x] (uaf x (seq "ddda")))
|
||||
(defn cdaaar [x] (uaf x (seq "daaa")))
|
||||
(defn cdadar [x] (uaf x (seq "dada")))
|
||||
(defn caaadr [x] (uaf x (seq "aaad")))
|
||||
(defn caaddr [x] (uaf x (seq "aadd")))
|
||||
(defn cadadr [x] (uaf x (seq "adad")))
|
||||
(defn cadddr [x] (uaf x (seq "addd")))
|
||||
(defn cddadr [x] (uaf x (seq "ddad")))
|
||||
(defn cddddr [x] (uaf x (seq "dddd")))
|
||||
(defn cdaadr [x] (uaf x (seq "daad")))
|
||||
(defn cdaddr [x] (uaf x (seq "dadd")))
|
||||
(defn CAAAAR [x] (uaf x (seq "aaaa")))
|
||||
(defn CAADAR [x] (uaf x (seq "aada")))
|
||||
(defn CADAAR [x] (uaf x (seq "adaa")))
|
||||
(defn CADDAR [x] (uaf x (seq "adda")))
|
||||
(defn CDDAAR [x] (uaf x (seq "ddaa")))
|
||||
(defn CDDDAR [x] (uaf x (seq "ddda")))
|
||||
(defn CDAAAR [x] (uaf x (seq "daaa")))
|
||||
(defn CDADAR [x] (uaf x (seq "dada")))
|
||||
(defn CAAADR [x] (uaf x (seq "aaad")))
|
||||
(defn CAADDR [x] (uaf x (seq "aadd")))
|
||||
(defn CADADR [x] (uaf x (seq "adad")))
|
||||
(defn CADDDR [x] (uaf x (seq "addd")))
|
||||
(defn CDDADR [x] (uaf x (seq "ddad")))
|
||||
(defn CDDDDR [x] (uaf x (seq "dddd")))
|
||||
(defn CDAADR [x] (uaf x (seq "daad")))
|
||||
(defn CDADDR [x] (uaf x (seq "dadd")))
|
||||
|
||||
(defn eq
|
||||
(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))
|
||||
(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
|
||||
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.
|
||||
|
||||
NOTE: returns F on failure, not NIL"
|
||||
[x y]
|
||||
(cond
|
||||
(= (primitive-atom x) 'T) (eq x y)
|
||||
(= (equal (car x) (car y)) 'T) (equal (cdr x) (cdr y))
|
||||
(= (ATOM x) 'T) (EQ x y)
|
||||
(= (EQUAL (CAR x) (CAR y)) 'T) (EQUAL (CDR x) (CDR y))
|
||||
:else 'F))
|
||||
|
||||
(defn subst
|
||||
(defn SUBST
|
||||
"This function gives the result of substituting the S-expression `x` for
|
||||
all occurrences of the atomic symbol `y` in the S-expression `z`."
|
||||
[x y z]
|
||||
(cond
|
||||
(= (equal y z) 'T) x
|
||||
(= (primitive-atom? z) 'T) z ;; NIL is a symbol
|
||||
(= (EQUAL y z) 'T) x
|
||||
(= (ATOM? z) 'T) z ;; NIL is a symbol
|
||||
: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`.
|
||||
|
||||
All args are assumed to be `beowulf.cons-cell/ConsCell` objects.
|
||||
|
|
@ -125,10 +125,10 @@
|
|||
(cond
|
||||
(= x NIL) y
|
||||
: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
|
||||
of the list `y`.
|
||||
|
||||
|
|
@ -137,12 +137,12 @@
|
|||
[x y]
|
||||
(cond
|
||||
(= y NIL) F ;; NOTE: returns F on falsity, not NIL
|
||||
(= (equal x (car y)) 'T) 'T
|
||||
:else (member x (cdr y))))
|
||||
(= (EQUAL x (CAR y)) 'T) 'T
|
||||
:else (MEMBER x (CDR y))))
|
||||
|
||||
(defn pairlis
|
||||
(defn PAIRLIS
|
||||
"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
|
||||
association list.
|
||||
|
||||
|
|
@ -157,11 +157,11 @@
|
|||
;; robust if `x` and `y` are not the same length.
|
||||
(or (= NIL x) (= NIL y)) a
|
||||
:else (make-cons-cell
|
||||
(make-cons-cell (car x) (car y))
|
||||
(pairlis (cdr x) (cdr y) a))))
|
||||
(make-cons-cell (CAR x) (CAR y))
|
||||
(PAIRLIS (CDR x) (CDR y) a))))
|
||||
|
||||
(defn primitive-assoc
|
||||
"If a is an association list such as the one formed by pairlis in the above
|
||||
(defn ASSOC
|
||||
"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
|
||||
it is a table searching function.
|
||||
|
||||
|
|
@ -171,25 +171,25 @@
|
|||
(cond
|
||||
(= NIL a) NIL ;; this clause is not present in the original but is added for
|
||||
;; robustness.
|
||||
(= (equal (caar a) x) 'T) (car a)
|
||||
(= (EQUAL (CAAR a) x) 'T) (CAR a)
|
||||
:else
|
||||
(primitive-assoc x (cdr a))))
|
||||
(ASSOC x (CDR a))))
|
||||
|
||||
(defn- sub2
|
||||
"Internal to `sublis`, q.v., which substitutes into a list from a store.
|
||||
(defn- SUB2
|
||||
"Internal to `SUBLIS`, q.v., which SUBSTitutes into a list from a store.
|
||||
? I think this is doing variable binding in the stack frame?"
|
||||
[a z]
|
||||
(cond
|
||||
(= NIL a) z
|
||||
(= (caar a) z) (cdar a) ;; TODO: this looks definitely wrong
|
||||
(= (CAAR a) z) (CDAR a) ;; TODO: this looks definitely wrong
|
||||
: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
|
||||
`((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
|
||||
they occur in `y`, and to substitute the corresponding `v`s from the pair
|
||||
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
|
||||
list.
|
||||
|
||||
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."
|
||||
[a y]
|
||||
(cond
|
||||
(= (primitive-atom? y) 'T) (sub2 a y)
|
||||
(= (ATOM? y) 'T) (SUB2 a y)
|
||||
: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.
|
||||
All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects.
|
||||
See page 13 of the Lisp 1.5 Programmers Manual."
|
||||
[function args environment]
|
||||
(cond
|
||||
(primitive-atom? function)(cond
|
||||
(= function 'CAR) (caar args)
|
||||
(= function 'CDR) (cdar args)
|
||||
(= function 'CONS) (make-cons-cell (car args) (cadr args))
|
||||
(= function 'ATOM) (if (primitive-atom? (car args)) T NIL)
|
||||
(= function 'EQ) (if (= (car args) (cadr args)) T NIL)
|
||||
(=
|
||||
(ATOM? function)
|
||||
'T)(cond
|
||||
(= function 'CAR) (CAAR args)
|
||||
(= function 'CDR) (CDAR args)
|
||||
(= 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
|
||||
(primitive-apply
|
||||
(primitive-eval function environment)
|
||||
(APPLY
|
||||
(EVAL function environment)
|
||||
args
|
||||
environment))
|
||||
(= (first function) 'LAMBDA) (primitive-eval
|
||||
(caddr function)
|
||||
(pairlis (cadr function) args environment))
|
||||
(= (first function) 'LABEL) (primitive-apply
|
||||
(caddr function)
|
||||
(= (first function) 'LAMBDA) (EVAL
|
||||
(CADDR function)
|
||||
(PAIRLIS (CADR function) args environment))
|
||||
(= (first function) 'LABEL) (APPLY
|
||||
(CADDR function)
|
||||
args
|
||||
(make-cons-cell
|
||||
(make-cons-cell
|
||||
(cadr function)
|
||||
(caddr function))
|
||||
(CADR function)
|
||||
(CADDR function))
|
||||
environment))))
|
||||
|
||||
(defn- evcon
|
||||
(defn- EVCON
|
||||
"Inner guts of primitive COND. All args are assumed to be
|
||||
`beowulf.cons-cell/ConsCell` objects.
|
||||
See page 13 of the Lisp 1.5 Programmers Manual."
|
||||
[clauses env]
|
||||
(if
|
||||
(not= (primitive-eval (caar clauses) env) NIL)
|
||||
(primitive-eval (cadar clauses) env)
|
||||
(evcon (cdr clauses) env)))
|
||||
(not= (EVAL (CAAR clauses) env) NIL)
|
||||
(EVAL (CADAR clauses) env)
|
||||
(EVCON (CDR clauses) env)))
|
||||
|
||||
(defn- evlis
|
||||
"Map `primitive-eval` across this list of `args` in the context of this
|
||||
(defn- EVLIS
|
||||
"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.
|
||||
See page 13 of the Lisp 1.5 Programmers Manual."
|
||||
[args env]
|
||||
(cond
|
||||
(null args) NIL
|
||||
(= NIL args) NIL
|
||||
:else
|
||||
(make-cons-cell
|
||||
(primitive-eval (car args) env)
|
||||
(evlis (cdr args) env))))
|
||||
(EVAL (CAR args) env)
|
||||
(EVLIS (CDR args) env))))
|
||||
|
||||
|
||||
(deftrace primitive-eval
|
||||
(deftrace EVAL
|
||||
"For bootstrapping, at least, a version of EVAL written in Clojure.
|
||||
All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects.
|
||||
See page 13 of the Lisp 1.5 Programmers Manual."
|
||||
[expr env]
|
||||
(cond
|
||||
(primitive-atom? expr) (cdr (primitive-assoc expr env))
|
||||
(primitive-atom? (car expr))(cond
|
||||
(eq (car expr) 'QUOTE) (cadr expr)
|
||||
(eq (car expr) 'COND) (evcon (cdr expr) env)
|
||||
:else (primitive-apply
|
||||
(car expr)
|
||||
(evlis (cdr expr) env)
|
||||
(=
|
||||
(ATOM? expr) 'T)
|
||||
(CDR (ASSOC expr env))
|
||||
(=
|
||||
(ATOM? (CAR expr))
|
||||
'T)(cond
|
||||
(= (CAR expr) 'QUOTE) (CADR expr)
|
||||
(= (CAR expr) 'COND) (EVCON (CDR expr) env)
|
||||
:else (APPLY
|
||||
(CAR expr)
|
||||
(EVLIS (CDR expr) env)
|
||||
env))
|
||||
:else (primitive-apply
|
||||
(car expr)
|
||||
(evlis (cdr expr) env)
|
||||
:else (APPLY
|
||||
(CAR expr)
|
||||
(EVLIS (CDR expr) env)
|
||||
env)))
|
||||
|
||||
|
|
|
|||
|
|
@ -266,13 +266,13 @@
|
|||
(throw (Exception. (str "Cannot yet generate " (first p)))))
|
||||
p))
|
||||
|
||||
(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))))
|
||||
|
||||
(defn READ
|
||||
[]
|
||||
(gsp (read-line)))
|
||||
|
|
|
|||
|
|
@ -14,136 +14,136 @@
|
|||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(deftest atom-tests
|
||||
(testing "primitive-atom"
|
||||
(testing "ATOM"
|
||||
(let [expected T
|
||||
actual (primitive-atom T)]
|
||||
actual (ATOM T)]
|
||||
(is (= actual expected) "T is an atom (symbol)"))
|
||||
(let [expected T
|
||||
actual (primitive-atom (gsp "HELLO"))]
|
||||
actual (ATOM (gsp "HELLO"))]
|
||||
(is (= actual expected) "HELLO is an atom (symbol)"))
|
||||
(let [expected T
|
||||
actual (primitive-atom 7)]
|
||||
actual (ATOM 7)]
|
||||
(is (= actual expected)
|
||||
"I'm not actually certain whether a number should be treated as an
|
||||
atom, but I'm guessing so"))
|
||||
(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."))
|
||||
(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")))
|
||||
(testing "primitive-atom?"
|
||||
(testing "ATOM?"
|
||||
(let [expected T
|
||||
actual (primitive-atom? T)]
|
||||
actual (ATOM? T)]
|
||||
(is (= actual expected) "T is an atom (symbol)"))
|
||||
(let [expected T
|
||||
actual (primitive-atom? (gsp "HELLO"))]
|
||||
actual (ATOM? (gsp "HELLO"))]
|
||||
(is (= actual expected) "HELLO is an atom (symbol)"))
|
||||
(let [expected T
|
||||
actual (primitive-atom? 7)]
|
||||
actual (ATOM? 7)]
|
||||
(is (= actual expected)
|
||||
"I'm not actually certain whether a number should be treated as an
|
||||
atom, but I'm guessing so"))
|
||||
(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."))
|
||||
(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"))))
|
||||
|
||||
(deftest access-function-tests
|
||||
(testing "car"
|
||||
(testing "CAR"
|
||||
(let [expected 'A
|
||||
actual (car (make-cons-cell 'A 'B))]
|
||||
(is (= actual expected) "A is car of (A . B)"))
|
||||
actual (CAR (make-cons-cell 'A 'B))]
|
||||
(is (= actual expected) "A is CAR of (A . B)"))
|
||||
(let [expected 'A
|
||||
actual (car (gsp "(A B C D)"))]
|
||||
(is (= actual expected) "A is car of (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
|
||||
#"Cannot take CAR of `.*"
|
||||
(car 'T))
|
||||
"Can't take the car of an atom")
|
||||
(CAR 'T))
|
||||
"Can't take the CAR of an atom")
|
||||
(is (thrown-with-msg?
|
||||
Exception
|
||||
#"Cannot take CAR of `.*"
|
||||
(car 7))
|
||||
"Can't take the car of a number"))
|
||||
(testing "cdr"
|
||||
(CAR 7))
|
||||
"Can't take the CAR of a number"))
|
||||
(testing "CDR"
|
||||
(let [expected 'B
|
||||
actual (cdr (make-cons-cell 'A 'B))]
|
||||
(is (= actual expected) "B is cdr of (A . B)"))
|
||||
actual (CDR (make-cons-cell 'A 'B))]
|
||||
(is (= actual expected) "B is CDR of (A . 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)
|
||||
"cdr of (A B C D) is a cons cell")
|
||||
(is (= (car actual) expected) "the car of that cons-cell is B"))
|
||||
"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?
|
||||
Exception
|
||||
#"Cannot take CDR of `.*"
|
||||
(cdr 'T))
|
||||
"Can't take the cdr of an atom")
|
||||
(CDR 'T))
|
||||
"Can't take the CDR of an atom")
|
||||
(is (thrown-with-msg?
|
||||
Exception
|
||||
#"Cannot take CDR of `.*"
|
||||
(cdr 7))
|
||||
"Can't take the cdr of a number"))
|
||||
(CDR 7))
|
||||
"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)")]
|
||||
;; structure for testing access functions
|
||||
(testing "cadr"
|
||||
(let [expected 'B
|
||||
actual (cadr (gsp "(A B C D)"))]
|
||||
actual (CADR (gsp "(A B C D)"))]
|
||||
(is (= actual expected))))
|
||||
(testing "caddr"
|
||||
(let [expected 'C
|
||||
actual (caddr (gsp "(A B C D)"))]
|
||||
actual (CADDR (gsp "(A B C D)"))]
|
||||
(is (= actual expected)))
|
||||
(let [expected 14
|
||||
actual (caddr s)]
|
||||
actual (CADDR s)]
|
||||
(is (= actual expected)))
|
||||
)
|
||||
(testing "cadddr"
|
||||
(let [expected 'D
|
||||
actual (cadddr (gsp "(A B C D)"))]
|
||||
actual (CADDDR (gsp "(A B C D)"))]
|
||||
(is (= actual expected))))
|
||||
(testing "caaaar"
|
||||
(let [expected "1"
|
||||
actual (print-str (caaaar s))]
|
||||
actual (print-str (CAAAAR s))]
|
||||
(is (= actual expected))))))
|
||||
|
||||
|
||||
(deftest equality-tests
|
||||
(testing "eq"
|
||||
(let [expected 'T
|
||||
actual (eq 'FRED 'FRED)]
|
||||
actual (EQ 'FRED 'FRED)]
|
||||
(is (= actual expected) "identical symbols"))
|
||||
(let [expected 'F
|
||||
actual (eq 'FRED 'ELFREDA)]
|
||||
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)")))
|
||||
actual (EQ l l)]
|
||||
(is (= actual expected) "identical lists (EQ is not defined for lists)")))
|
||||
(testing "equal"
|
||||
(let [expected 'T
|
||||
actual (equal 'FRED 'FRED)]
|
||||
actual (EQUAL 'FRED 'FRED)]
|
||||
(is (= actual expected) "identical symbols"))
|
||||
(let [expected 'F
|
||||
actual (equal 'FRED 'ELFREDA)]
|
||||
actual (EQUAL 'FRED 'ELFREDA)]
|
||||
(is (= actual expected) "different symbols"))
|
||||
(let [expected 'T
|
||||
l (gsp "(NOT AN ATOM)")
|
||||
actual (equal l l)]
|
||||
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)]
|
||||
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)]
|
||||
actual (EQUAL l m)]
|
||||
(is (= actual expected) "different lists, different content"))))
|
||||
|
||||
(deftest substitution-tests
|
||||
|
|
@ -152,7 +152,7 @@
|
|||
;; differs from example in book only because of how the function
|
||||
;; `beowulf.cons-cell/to-string` formats lists.
|
||||
actual (print-str
|
||||
(subst
|
||||
(SUBST
|
||||
(gsp "(X . A)")
|
||||
(gsp "B")
|
||||
(gsp "((A . B) . C)")))]
|
||||
|
|
@ -162,13 +162,13 @@
|
|||
(testing "append"
|
||||
(let [expected "(A B C . D)"
|
||||
actual (print-str
|
||||
(append
|
||||
(APPEND
|
||||
(gsp "(A B)")
|
||||
(gsp "(C . D)")))]
|
||||
(is (= actual expected)))
|
||||
(let [expected "(A B C D E)"
|
||||
actual (print-str
|
||||
(append
|
||||
(APPEND
|
||||
(gsp "(A B)")
|
||||
(gsp "(C D E)")))]
|
||||
(is (= actual expected)))))
|
||||
|
|
@ -176,23 +176,23 @@
|
|||
(deftest member-tests
|
||||
(testing "member"
|
||||
(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))
|
||||
(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))
|
||||
(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))
|
||||
(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))))
|
||||
|
||||
(deftest pairlis-tests
|
||||
(testing "pairlis"
|
||||
(let [expected "((A . U) (B . V) (C . W) (D . X) (E . Y))"
|
||||
actual (print-str
|
||||
(pairlis
|
||||
(PAIRLIS
|
||||
(gsp "(A B C)")
|
||||
(gsp "(U V W)")
|
||||
(gsp "((D . X)(E . Y))")))]
|
||||
|
|
@ -202,19 +202,19 @@
|
|||
(testing "assoc"
|
||||
(let [expected "(B CAR X)"
|
||||
actual (print-str
|
||||
(primitive-assoc
|
||||
(ASSOC
|
||||
'B
|
||||
(gsp "((A . (M N)) (B . (CAR X)) (C . (QUOTE M)) (C . (CDR X)))")))]
|
||||
(is (= actual expected)))
|
||||
(let [expected "(C QUOTE M)"
|
||||
actual (print-str
|
||||
(primitive-assoc
|
||||
(ASSOC
|
||||
'C
|
||||
(gsp "((A . (M N)) (B . (CAR X)) (C . (QUOTE M)) (C . (CDR X)))")))]
|
||||
(is (= actual expected)))
|
||||
(let [expected "NIL"
|
||||
actual (print-str
|
||||
(primitive-assoc
|
||||
(ASSOC
|
||||
'D
|
||||
(gsp "((A . (M N)) (B . (CAR X)) (C . (QUOTE M)) (C . (CDR X)))")))]
|
||||
(is (= actual expected)))))
|
||||
|
|
@ -223,7 +223,7 @@
|
|||
(testing "sublis"
|
||||
(let [expected "(SHAKESPEARE WROTE (THE TEMPEST))"
|
||||
actual (print-str
|
||||
(sublis
|
||||
(SUBLIS
|
||||
(gsp "((X . SHAKESPEARE) (Y . (THE TEMPEST)))")
|
||||
(gsp "(X WROTE Y)")))]
|
||||
(is (= actual expected)))))
|
||||
|
|
|
|||
Loading…
Reference in a new issue