diff --git a/docs/cloverage/beowulf/bootstrap.clj.html b/docs/cloverage/beowulf/bootstrap.clj.html
index b8944e7..20afabb 100644
--- a/docs/cloverage/beowulf/bootstrap.clj.html
+++ b/docs/cloverage/beowulf/bootstrap.clj.html
@@ -38,910 +38,910 @@
011 objects."
- 012 (:require [clojure.tools.trace :refer :all]
+ 012 (:require [clojure.string :as s]
- 013 [beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL T F]]))
+ 013 [clojure.tools.trace :refer :all]
+
+
+ 014 [beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL T F]]))
- 014
+ 015
- 015 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ 016 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- 016 ;;;
+ 017 ;;;
- 017 ;;; This file is essentially Lisp as defined in Chapter 1 (pages 1-14) of the
+ 018 ;;; This file is essentially Lisp as defined in Chapter 1 (pages 1-14) of the
- 018 ;;; Lisp 1.5 Programmer's Manual; that is to say, a very simple Lisp language,
+ 019 ;;; Lisp 1.5 Programmer's Manual; that is to say, a very simple Lisp language,
- 019 ;;; which should, I believe, be sufficient in conjunction with the functions
+ 020 ;;; which should, I believe, be sufficient in conjunction with the functions
- 020 ;;; provided by `beowulf.host`, be sufficient to bootstrap the full Lisp 1.5
+ 021 ;;; provided by `beowulf.host`, be sufficient to bootstrap the full Lisp 1.5
- 021 ;;; interpreter.
+ 022 ;;; interpreter.
- 022 ;;;
+ 023 ;;;
- 023 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ 024 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- 024
+ 025
- 025 (declare EVAL)
+ 026 (declare EVAL)
- 026
+ 027
- 027 (def oblist
+ 028 (def oblist
- 028 "The default environment."
+ 029 "The default environment."
- 029 (atom NIL))
+ 030 (atom NIL))
- 030
+ 031
- 031 (def ^:dynamic *options*
+ 032 (def ^:dynamic *options*
- 032 "Command line options from invocation."
+ 033 "Command line options from invocation."
- 033 {})
+ 034 {})
- 034
+ 035
- 035 (defmacro NULL
+ 036 (defmacro NULL
- 036 "Returns `T` if and only if the argument `x` is bound to `NIL`; else `F`."
+ 037 "Returns `T` if and only if the argument `x` is bound to `NIL`; else `F`."
- 037 [x]
+ 038 [x]
- 038 `(if (= ~x NIL) T F))
+ 039 `(if (= ~x NIL) T F))
- 039
+ 040
- 040 (defmacro ATOM
+ 041 (defmacro ATOM
- 041 "Returns `T` if and only is the argument `x` is bound to and atom; else `F`.
+ 042 "Returns `T` if and only is the argument `x` is bound to and atom; else `F`.
- 042 It is not clear to me from the documentation whether `(ATOM 7)` should return
+ 043 It is not clear to me from the documentation whether `(ATOM 7)` should return
- 043 `T` or `F`. I'm going to assume `T`."
+ 044 `T` or `F`. I'm going to assume `T`."
- 044 [x]
+ 045 [x]
- 045 `(if (or (symbol? ~x) (number? ~x)) T F))
+ 046 `(if (or (symbol? ~x) (number? ~x)) T F))
- 046
+ 047
- 047 (defmacro ATOM?
+ 048 (defmacro ATOM?
- 048 "The convention of returning `F` from predicates, rather than `NIL`, is going
+ 049 "The convention of returning `F` from predicates, rather than `NIL`, is going
- 049 to tie me in knots. This is a variant of `ATOM` which returns `NIL`
+ 050 to tie me in knots. This is a variant of `ATOM` which returns `NIL`
- 050 on failure."
+ 051 on failure."
- 051 [x]
+ 052 [x]
- 052 `(if (or (symbol? ~x) (number? ~x)) T NIL))
+ 053 `(if (or (symbol? ~x) (number? ~x)) T NIL))
- 053
+ 054
- 054 (defn CAR
+ 055 (defn CAR
- 055 "Return the item indicated by the first pointer of a pair. NIL is treated
+ 056 "Return the item indicated by the first pointer of a pair. NIL is treated
- 056 specially: the CAR of NIL is NIL."
+ 057 specially: the CAR of NIL is NIL."
- 057 [x]
+ 058 [x]
- 058 (cond
+ 059 (cond
- 059 (= x NIL) NIL
+ 060 (= x NIL) NIL
- 060 (instance? beowulf.cons_cell.ConsCell x) (.CAR x)
+ 061 (instance? beowulf.cons_cell.ConsCell x) (.CAR x)
- 061 :else
+ 062 :else
- 062 (throw
+ 063 (throw
- 063 (Exception.
+ 064 (Exception.
- 064 (str "Cannot take CAR of `" x "` (" (.getName (.getClass x)) ")")))))
+ 065 (str "Cannot take CAR of `" x "` (" (.getName (.getClass x)) ")")))))
- 065
+ 066
- 066 (defn CDR
+ 067 (defn CDR
- 067 "Return the item indicated by the second pointer of a pair. NIL is treated
+ 068 "Return the item indicated by the second pointer of a pair. NIL is treated
- 068 specially: the CDR of NIL is NIL."
+ 069 specially: the CDR of NIL is NIL."
- 069 [x]
+ 070 [x]
- 070 (cond
+ 071 (cond
- 071 (= x NIL) NIL
+ 072 (= x NIL) NIL
- 072 (instance? beowulf.cons_cell.ConsCell x) (.CDR x)
+ 073 (instance? beowulf.cons_cell.ConsCell x) (.CDR x)
- 073 :else
+ 074 :else
- 074 (throw
+ 075 (throw
- 075 (Exception.
+ 076 (Exception.
- 076 (str "Cannot take CDR of `" x "` (" (.getName (.getClass x)) ")")))))
+ 077 (str "Cannot take CDR of `" x "` (" (.getName (.getClass x)) ")")))))
- 077
+ 078
- 078 (defn uaf
+ 079 (defn uaf
- 079 "Universal access function; `l` is expected to be an arbitrary list, `path`
+ 080 "Universal access function; `l` is expected to be an arbitrary list, `path`
- 080 a (clojure) list of the characters `a` and `d`. Intended to make declaring
+ 081 a (clojure) list of the characters `a` and `d`. Intended to make declaring
- 081 all those fiddly `#'c[ad]+r'` functions a bit easier"
+ 082 all those fiddly `#'c[ad]+r'` functions a bit easier"
- 082 [l path]
+ 083 [l path]
- 083 (cond
+ 084 (cond
- 084 (= l NIL) NIL
+ 085 (= l NIL) NIL
- 085 (empty? path) l
+ 086 (empty? path) l
- 086 :else (case (last path)
+ 087 :else (case (last path)
- 087 \a (uaf (CAR l) (butlast path))
+ 088 \a (uaf (CAR l) (butlast path))
- 088 \d (uaf (CDR l) (butlast path)))))
+ 089 \d (uaf (CDR l) (butlast path)))))
- 089
+ 090
- 090 (defn CAAR [x] (uaf x (seq "aa")))
+ 091 (defn CAAR [x] (uaf x (seq "aa")))
- 091 (defn CADR [x] (uaf x (seq "ad")))
+ 092 (defn CADR [x] (uaf x (seq "ad")))
- 092 (defn CDDR [x] (uaf x (seq "dd")))
+ 093 (defn CDDR [x] (uaf x (seq "dd")))
- 093 (defn CDAR [x] (uaf x (seq "da")))
+ 094 (defn CDAR [x] (uaf x (seq "da")))
- 094
+ 095
- 095 (defn CAAAR [x] (uaf x (seq "aaa")))
+ 096 (defn CAAAR [x] (uaf x (seq "aaa")))
- 096 (defn CAADR [x] (uaf x (seq "aad")))
+ 097 (defn CAADR [x] (uaf x (seq "aad")))
- 097 (defn CADAR [x] (uaf x (seq "ada")))
+ 098 (defn CADAR [x] (uaf x (seq "ada")))
- 098 (defn CADDR [x] (uaf x (seq "add")))
+ 099 (defn CADDR [x] (uaf x (seq "add")))
- 099 (defn CDDAR [x] (uaf x (seq "dda")))
+ 100 (defn CDDAR [x] (uaf x (seq "dda")))
- 100 (defn CDDDR [x] (uaf x (seq "ddd")))
+ 101 (defn CDDDR [x] (uaf x (seq "ddd")))
- 101 (defn CDAAR [x] (uaf x (seq "daa")))
+ 102 (defn CDAAR [x] (uaf x (seq "daa")))
- 102 (defn CDADR [x] (uaf x (seq "dad")))
+ 103 (defn CDADR [x] (uaf x (seq "dad")))
- 103
+ 104
- 104 (defn CAAAAR [x] (uaf x (seq "aaaa")))
+ 105 (defn CAAAAR [x] (uaf x (seq "aaaa")))
- 105 (defn CAADAR [x] (uaf x (seq "aada")))
+ 106 (defn CAADAR [x] (uaf x (seq "aada")))
- 106 (defn CADAAR [x] (uaf x (seq "adaa")))
+ 107 (defn CADAAR [x] (uaf x (seq "adaa")))
- 107 (defn CADDAR [x] (uaf x (seq "adda")))
+ 108 (defn CADDAR [x] (uaf x (seq "adda")))
- 108 (defn CDDAAR [x] (uaf x (seq "ddaa")))
+ 109 (defn CDDAAR [x] (uaf x (seq "ddaa")))
- 109 (defn CDDDAR [x] (uaf x (seq "ddda")))
+ 110 (defn CDDDAR [x] (uaf x (seq "ddda")))
- 110 (defn CDAAAR [x] (uaf x (seq "daaa")))
+ 111 (defn CDAAAR [x] (uaf x (seq "daaa")))
- 111 (defn CDADAR [x] (uaf x (seq "dada")))
+ 112 (defn CDADAR [x] (uaf x (seq "dada")))
- 112 (defn CAAADR [x] (uaf x (seq "aaad")))
+ 113 (defn CAAADR [x] (uaf x (seq "aaad")))
- 113 (defn CAADDR [x] (uaf x (seq "aadd")))
+ 114 (defn CAADDR [x] (uaf x (seq "aadd")))
- 114 (defn CADADR [x] (uaf x (seq "adad")))
+ 115 (defn CADADR [x] (uaf x (seq "adad")))
- 115 (defn CADDDR [x] (uaf x (seq "addd")))
+ 116 (defn CADDDR [x] (uaf x (seq "addd")))
- 116 (defn CDDADR [x] (uaf x (seq "ddad")))
+ 117 (defn CDDADR [x] (uaf x (seq "ddad")))
- 117 (defn CDDDDR [x] (uaf x (seq "dddd")))
+ 118 (defn CDDDDR [x] (uaf x (seq "dddd")))
- 118 (defn CDAADR [x] (uaf x (seq "daad")))
+ 119 (defn CDAADR [x] (uaf x (seq "daad")))
- 119 (defn CDADDR [x] (uaf x (seq "dadd")))
+ 120 (defn CDADDR [x] (uaf x (seq "dadd")))
- 120
+ 121
- 121 (defn EQ
+ 122 (defn EQ
- 122 "Returns `T` if and only if both `x` and `y` are bound to the same atom,
+ 123 "Returns `T` if and only if both `x` and `y` are bound to the same atom,
- 123 else `F`."
+ 124 else `F`."
- 124 [x y]
+ 125 [x y]
- 125 (if (and (= (ATOM x) T) (= x y)) T F))
+ 126 (if (and (= (ATOM x) T) (= x y)) T F))
- 126
+ 127
- 127 (defn EQUAL
+ 128 (defn EQUAL
- 128 "This is a predicate that is true if its two arguments are identical
+ 129 "This is a predicate that is true if its two arguments are identical
- 129 S-expressions, and false if they are different. (The elementary predicate
+ 130 S-expressions, and false if they are different. (The elementary predicate
- 130 `EQ` is defined only for atomic arguments.) The definition of `EQUAL` is
+ 131 `EQ` is defined only for atomic arguments.) The definition of `EQUAL` is
- 131 an example of a conditional expression inside a conditional expression.
+ 132 an example of a conditional expression inside a conditional expression.
- 132
+ 133
- 133 NOTE: returns `F` on failure, not `NIL`"
+ 134 NOTE: returns `F` on failure, not `NIL`"
- 134 [x y]
+ 135 [x y]
- 135 (cond
+ 136 (cond
- 136 (= (ATOM x) T) (EQ x y)
+ 137 (= (ATOM x) T) (EQ x y)
- 137 (= (EQUAL (CAR x) (CAR y)) T) (EQUAL (CDR x) (CDR y))
+ 138 (= (EQUAL (CAR x) (CAR y)) T) (EQUAL (CDR x) (CDR y))
- 138 :else F))
+ 139 :else F))
- 139
+ 140
- 140 (defn SUBST
+ 141 (defn SUBST
- 141 "This function gives the result of substituting the S-expression `x` for
+ 142 "This function gives the result of substituting the S-expression `x` for
- 142 all occurrences of the atomic symbol `y` in the S-expression `z`."
+ 143 all occurrences of the atomic symbol `y` in the S-expression `z`."
- 143 [x y z]
+ 144 [x y z]
- 144 (cond
+ 145 (cond
- 145 (= (EQUAL y z) T) x
+ 146 (= (EQUAL y z) T) x
- 146 (= (ATOM? z) T) z ;; NIL is a symbol
+ 147 (= (ATOM? z) T) z ;; NIL is a symbol
- 147 :else
+ 148 :else
- 148 (make-cons-cell (SUBST x y (CAR z)) (SUBST x y (CDR z)))))
+ 149 (make-cons-cell (SUBST x y (CAR z)) (SUBST x y (CDR z)))))
- 149
+ 150
- 150 (defn APPEND
+ 151 (defn APPEND
- 151 "Append the the elements of `y` to the elements of `x`.
+ 152 "Append the the elements of `y` to the elements of `x`.
- 152
+ 153
- 153 All args are assumed to be `beowulf.cons-cell/ConsCell` objects.
+ 154 All args are assumed to be `beowulf.cons-cell/ConsCell` objects.
- 154 See page 11 of the Lisp 1.5 Programmers Manual."
+ 155 See page 11 of the Lisp 1.5 Programmers Manual."
- 155 [x y]
+ 156 [x y]
- 156 (cond
+ 157 (cond
- 157 (= x NIL) y
+ 158 (= x NIL) y
- 158 :else
+ 159 :else
- 159 (make-cons-cell (CAR x) (APPEND (CDR x) y))))
-
-
- 160
+ 160 (make-cons-cell (CAR x) (APPEND (CDR x) y))))
161
+
+ 162
+
- 162 (defn MEMBER
+ 163 (defn MEMBER
- 163 "This predicate is true if the S-expression `x` occurs among the elements
+ 164 "This predicate is true if the S-expression `x` occurs among the elements
- 164 of the list `y`.
+ 165 of the list `y`.
- 165
+ 166
- 166 All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects.
+ 167 All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects.
- 167 See page 11 of the Lisp 1.5 Programmers Manual."
+ 168 See page 11 of the Lisp 1.5 Programmers Manual."
- 168 [x y]
+ 169 [x y]
- 169 (cond
+ 170 (cond
- 170 (= y NIL) F ;; NOTE: returns F on falsity, not NIL
+ 171 (= y NIL) F ;; NOTE: returns F on falsity, not NIL
- 171 (= (EQUAL x (CAR y)) T) T
+ 172 (= (EQUAL x (CAR y)) T) T
- 172 :else (MEMBER x (CDR y))))
+ 173 :else (MEMBER x (CDR y))))
- 173
+ 174
- 174 (defn PAIRLIS
+ 175 (defn PAIRLIS
- 175 "This function gives the list of pairs of corresponding elements of the
+ 176 "This function gives the list of pairs of corresponding elements of the
- 176 lists `x` and `y`, and APPENDs this to the list `a`. The resultant list
+ 177 lists `x` and `y`, and APPENDs this to the list `a`. The resultant list
- 177 of pairs, which is like a table with two columns, is called an
+ 178 of pairs, which is like a table with two columns, is called an
- 178 association list.
+ 179 association list.
- 179
+ 180
- 180 Eessentially, it builds the environment on the stack, implementing shallow
+ 181 Eessentially, it builds the environment on the stack, implementing shallow
- 181 binding.
+ 182 binding.
- 182
+ 183
- 183 All args are assumed to be `beowulf.cons-cell/ConsCell` objects.
+ 184 All args are assumed to be `beowulf.cons-cell/ConsCell` objects.
- 184 See page 12 of the Lisp 1.5 Programmers Manual."
+ 185 See page 12 of the Lisp 1.5 Programmers Manual."
- 185 [x y a]
+ 186 [x y a]
- 186 (cond
+ 187 (cond
- 187 ;; the original tests only x; testing y as well will be a little more
+ 188 ;; the original tests only x; testing y as well will be a little more
- 188 ;; robust if `x` and `y` are not the same length.
+ 189 ;; robust if `x` and `y` are not the same length.
- 189 (or (= NIL x) (= NIL y)) a
+ 190 (or (= NIL x) (= NIL y)) a
- 190 :else (make-cons-cell
+ 191 :else (make-cons-cell
- 191 (make-cons-cell (CAR x) (CAR y))
+ 192 (make-cons-cell (CAR x) (CAR y))
- 192 (PAIRLIS (CDR x) (CDR y) a))))
+ 193 (PAIRLIS (CDR x) (CDR y) a))))
- 193
+ 194
- 194 (defn ASSOC
+ 195 (defn ASSOC
- 195 "If a is an association list such as the one formed by PAIRLIS in the above
+ 196 "If a is an association list such as the one formed by PAIRLIS in the above
- 196 example, then assoc will produce the first pair whose first term is x. Thus
+ 197 example, then assoc will produce the first pair whose first term is x. Thus
- 197 it is a table searching function.
+ 198 it is a table searching function.
- 198
+ 199
- 199 All args are assumed to be `beowulf.cons-cell/ConsCell` objects.
+ 200 All args are assumed to be `beowulf.cons-cell/ConsCell` objects.
- 200 See page 12 of the Lisp 1.5 Programmers Manual."
+ 201 See page 12 of the Lisp 1.5 Programmers Manual."
- 201 [x a]
+ 202 [x a]
- 202 (cond
+ 203 (cond
- 203 (= NIL a) NIL ;; this clause is not present in the original but is added for
+ 204 (= NIL a) NIL ;; this clause is not present in the original but is added for
- 204 ;; robustness.
+ 205 ;; robustness.
- 205 (= (EQUAL (CAAR a) x) T) (CAR a)
+ 206 (= (EQUAL (CAAR a) x) T) (CAR a)
- 206 :else
+ 207 :else
- 207 (ASSOC x (CDR a))))
+ 208 (ASSOC x (CDR a))))
- 208
+ 209
- 209 (defn- SUB2
+ 210 (defn- SUB2
- 210 "Internal to `SUBLIS`, q.v., which SUBSTitutes into a list from a store.
+ 211 "Internal to `SUBLIS`, q.v., which SUBSTitutes into a list from a store.
- 211 ? I think this is doing variable binding in the stack frame?"
+ 212 ? I think this is doing variable binding in the stack frame?"
- 212 [a z]
+ 213 [a z]
- 213 (cond
+ 214 (cond
- 214 (= NIL a) z
+ 215 (= NIL a) z
- 215 (= (CAAR a) z) (CDAR a) ;; TODO: this looks definitely wrong
+ 216 (= (CAAR a) z) (CDAR a) ;; TODO: this looks definitely wrong
- 216 :else
+ 217 :else
- 217 (SUB2 (CDR a) z)))
+ 218 (SUB2 (CDR a) z)))
- 218
+ 219
- 219 (defn SUBLIS
+ 220 (defn SUBLIS
- 220 "Here `a` is assumed to be an association list of the form
+ 221 "Here `a` is assumed to be an association list of the form
- 221 `((ul . vl)...(un . vn))`, where the `u`s are atomic, and `y` is any
+ 222 `((ul . vl)...(un . vn))`, where the `u`s are atomic, and `y` is any
- 222 S-expression. What `SUBLIS` does, is to treat the `u`s as variables when
+ 223 S-expression. What `SUBLIS` does, is to treat the `u`s as variables when
- 223 they occur in `y`, and to SUBSTitute the corresponding `v`s from the pair
+ 224 they occur in `y`, and to SUBSTitute the corresponding `v`s from the pair
- 224 list.
+ 225 list.
- 225
+ 226
- 226 My interpretation is that this is variable binding in the stack frame.
+ 227 My interpretation is that this is variable binding in the stack frame.
- 227
+ 228
- 228 All args are assumed to be `beowulf.cons-cell/ConsCell` objects.
+ 229 All args are assumed to be `beowulf.cons-cell/ConsCell` objects.
- 229 See page 12 of the Lisp 1.5 Programmers Manual."
+ 230 See page 12 of the Lisp 1.5 Programmers Manual."
- 230 [a y]
+ 231 [a y]
- 231 (cond
+ 232 (cond
- 232 (= (ATOM? y) T) (SUB2 a y)
+ 233 (= (ATOM? y) T) (SUB2 a y)
- 233 :else
+ 234 :else
- 234 (make-cons-cell (SUBLIS a (CAR y)) (SUBLIS a (CDR y)))))
+ 235 (make-cons-cell (SUBLIS a (CAR y)) (SUBLIS a (CDR y)))))
- 235
+ 236
- 236 (defn APPLY
+ 237 (defn interop-interpret-q-name
- 237 "For bootstrapping, at least, a version of APPLY written in Clojure.
+ 238 "For interoperation with Clojure, it will often be necessary to pass
- 238 All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects.
+ 239 qualified names that are not representable in Lisp 1.5. This function
- 239 See page 13 of the Lisp 1.5 Programmers Manual."
+ 240 takes a sequence in the form `(PART PART PART... NAME)` and returns
- 240 [function args environment]
-
-
- 241 (cond
-
-
- 242 (=
-
-
- 243 (ATOM? function)
-
-
- 244 T)(cond
+ 241 a symbol in the form `PART.PART.PART/NAME`. This symbol will then be
- 245 ;; TODO: doesn't check whether `function` is bound in the environment;
+ 242 tried in both that form and lower-cased. Names with hyphens or
- 246 ;; we'll need that before we can bootstrap.
-
-
- 247 (= function 'CAR) (CAAR args)
-
-
- 248 (= function 'CDR) (CDAR args)
-
-
- 249 (= function 'CONS) (make-cons-cell (CAR args) (CADR args))
-
-
- 250 (= function 'ATOM) (if (ATOM? (CAR args)) T NIL)
-
-
- 251 (= function 'EQ) (if (= (CAR args) (CADR args)) T NIL)
+ 243 underscores cannot be represented with this scheme."
- 252 :else
+ 244 [l]
+
+
+ 245 (if
+
+
+ 246 (seq? l)
- 253 (APPLY
+ 247 (symbol
+
+
+ 248 (s/reverse
- 254 (EVAL function environment)
+ 249 (s/replace-first
-
- 255 args
-
-
- 256 environment))
-
-
- 257 (= (first function) 'LAMBDA) (EVAL
-
-
- 258 (CADDR function)
+
+ 250 (s/reverse
- 259 (PAIRLIS (CADR function) args environment))
+ 251 (s/join "." (map str l)))
-
- 260 (= (first function) 'LABEL) (APPLY
+
+ 252 "."
-
- 261 (CADDR function)
+
+ 253 "/")))
- 262 args
+ 254 l))
-
- 263 (make-cons-cell
+
+ 255
-
- 264 (make-cons-cell
+
+ 256 (deftrace INTEROP
-
- 265 (CADR function)
+
+ 257 "Clojure (or other host environment) interoperation API. `fn-symbol` is expected
-
- 266 (CADDR function))
+
+ 258 to be either
-
- 267 environment))))
+
+ 259
+
+
+ 260 1. a symbol bound in the host environment to a function; or
+
+
+ 261 2. a sequence (list) of symbols forming a qualified path name bound to a
+
+
+ 262 function.
+
+
+ 263
+
+
+ 264 Lower case characters cannot normally be represented in Lisp 1.5, so both the
+
+
+ 265 upper case and lower case variants of `fn-symbol` will be tried. If the
+
+
+ 266 function you're looking for has a mixed case name, that is not currently
+
+
+ 267 accessible.
268
-
- 269 (defn- EVCON
+
+ 269 `args` is expected to be a Lisp 1.5 list of arguments to be passed to that
- 270 "Inner guts of primitive COND. All args are assumed to be
+ 270 function. Return value must be something acceptable to Lisp 1.5, so either
- 271 `beowulf.cons-cell/ConsCell` objects.
+ 271 a symbol, a number, or a Lisp 1.5 list.
+
+
+ 272
- 272 See page 13 of the Lisp 1.5 Programmers Manual."
+ 273 If `fn-symbol` is not found (even when cast to lower case), or is not a function,
- 273 [clauses env]
+ 274 or the value returned cannot be represented in Lisp 1.5, an exception is thrown
+
+
+ 275 with `:cause` bound to `:interop` and `:detail` set to a value representing the
+
+
+ 276 actual problem."
+
+
+ 277 [fn-symbol args]
- 274 (if
+ 278 (let
-
- 275 (not= (EVAL (CAAR clauses) env) NIL)
-
-
- 276 (EVAL (CADAR clauses) env)
-
-
- 277 (EVCON (CDR clauses) env)))
-
-
- 278
-
-
- 279 (defn- EVLIS
-
-
- 280 "Map `EVAL` across this list of `args` in the context of this
-
-
- 281 `env`ironment.All args are assumed to be `beowulf.cons-cell/ConsCell` objects.
-
-
- 282 See page 13 of the Lisp 1.5 Programmers Manual."
-
-
- 283 [args env]
-
-
- 284 (cond
-
-
- 285 (= NIL args) NIL
-
-
- 286 :else
-
-
- 287 (make-cons-cell
-
-
- 288 (EVAL (CAR args) env)
-
-
- 289 (EVLIS (CDR args) env))))
-
-
- 290
-
-
- 291 (deftrace traced-eval
-
-
- 292 "Essentially, identical to EVAL except traced."
-
-
- 293 [expr env]
-
-
- 294 (cond
-
-
- 295 (=
-
-
- 296 (ATOM? expr) T)
-
-
- 297 (CDR (ASSOC expr env))
-
-
- 298 (=
-
-
- 299 (ATOM? (CAR expr))
-
-
- 300 T)(cond
-
-
- 301 (= (CAR expr) 'QUOTE) (CADR expr)
-
-
- 302 (= (CAR expr) 'COND) (EVCON (CDR expr) env)
-
-
- 303 :else (APPLY
-
-
- 304 (CAR expr)
-
-
- 305 (EVLIS (CDR expr) env)
-
-
- 306 env))
-
-
- 307 :else (APPLY
+
+ 279 [q-name (if
- 308 (CAR expr)
+ 280 (seq? fn-symbol)
-
- 309 (EVLIS (CDR expr) env)
+
+ 281 (interop-interpret-q-name fn-symbol)
- 310 env)))
+ 282 fn-symbol)
+
+
+ 283 l-name (symbol (s/lower-case q-name))
+
+
+ 284 f (cond
+
+
+ 285 (try
+
+
+ 286 (fn? (eval l-name))
+
+
+ 287 (catch java.lang.ClassNotFoundException e nil)) (eval l-name)
+
+
+ 288 (try
+
+
+ 289 (fn? (eval q-name))
+
+
+ 290 (catch java.lang.ClassNotFoundException e nil)) (eval q-name)
+
+
+ 291 :else (throw
+
+
+ 292 (ex-info
+
+
+ 293 (str "INTEROP: unknown function `" fn-symbol "`")
+
+
+ 294 {:cause :interop
+
+
+ 295 :detail :not-found
+
+
+ 296 :name fn-symbol
+
+
+ 297 :also-tried l-name})))
+
+
+ 298 result (eval (cons f args))]
+
+
+ 299 (cond
+
+
+ 300 (instance? beowulf.cons_cell.ConsCell result) result
+
+
+ 301 (seq? result) (make-beowulf-list result)
+
+
+ 302 (symbol? result) result
+
+
+ 303 (string? result) (symbol result)
+
+
+ 304 (number? result) result
+
+
+ 305 :else (throw
+
+
+ 306 (ex-info
+
+
+ 307 (str "INTEROP: Cannot return `" result "` to Lisp 1.5.")
+
+
+ 308 {:cause :interop
+
+
+ 309 :detail :not-representable
+
+
+ 310 :result result})))))
311
- 312 (defn EVAL
+ 312 (defn APPLY
- 313 "For bootstrapping, at least, a version of EVAL written in Clojure.
+ 313 "For bootstrapping, at least, a version of APPLY written in Clojure.
314 All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects.
@@ -950,73 +950,301 @@
315 See page 13 of the Lisp 1.5 Programmers Manual."
- 316 [expr env]
+ 316 [function args environment]
-
+
317 (cond
-
- 318 (true? (:trace *options*))
-
-
- 319 (traced-eval expr env)
-
- 320 (=
+ 318 (=
-
- 321 (ATOM? expr) T)
+
+ 319 (ATOM? function)
-
- 322 (CDR (ASSOC expr env))
+
+ 320 T)(cond
-
- 323 (=
+
+ 321 ;; TODO: doesn't check whether `function` is bound in the environment;
-
- 324 (ATOM? (CAR expr))
+
+ 322 ;; we'll need that before we can bootstrap.
-
- 325 T)(cond
+
+ 323 (= function 'CAR) (CAAR args)
-
- 326 (= (CAR expr) 'QUOTE) (CADR expr)
+
+ 324 (= function 'CDR) (CDAR args)
-
- 327 (= (CAR expr) 'COND) (EVCON (CDR expr) env)
+
+ 325 (= function 'CONS) (make-cons-cell (CAR args) (CADR args))
-
- 328 :else (APPLY
+
+ 326 (= function 'ATOM) (if (ATOM? (CAR args)) T NIL)
-
- 329 (CAR expr)
+
+ 327 (= function 'EQ) (if (= (CAR args) (CADR args)) T NIL)
-
- 330 (EVLIS (CDR expr) env)
-
-
- 331 env))
+
+ 328 :else
- 332 :else (APPLY
+ 329 (APPLY
-
- 333 (CAR expr)
-
-
- 334 (EVLIS (CDR expr) env)
+
+ 330 (EVAL function environment)
- 335 env)))
+ 331 args
+
+
+ 332 environment))
+
+
+ 333 (= (first function) 'LAMBDA) (EVAL
+
+
+ 334 (CADDR function)
+
+
+ 335 (PAIRLIS (CADR function) args environment))
+
+
+ 336 (= (first function) 'LABEL) (APPLY
+
+
+ 337 (CADDR function)
+
+
+ 338 args
+
+
+ 339 (make-cons-cell
+
+
+ 340 (make-cons-cell
+
+
+ 341 (CADR function)
+
+
+ 342 (CADDR function))
+
+
+ 343 environment))))
- 336
+ 344
+
+
+ 345 (defn- EVCON
+
+
+ 346 "Inner guts of primitive COND. All args are assumed to be
+
+
+ 347 `beowulf.cons-cell/ConsCell` objects.
+
+
+ 348 See page 13 of the Lisp 1.5 Programmers Manual."
+
+
+ 349 [clauses env]
+
+
+ 350 (if
+
+
+ 351 (not= (EVAL (CAAR clauses) env) NIL)
+
+
+ 352 (EVAL (CADAR clauses) env)
+
+
+ 353 (EVCON (CDR clauses) env)))
- 337
+ 354
+
+
+ 355 (defn- EVLIS
+
+
+ 356 "Map `EVAL` across this list of `args` in the context of this
+
+
+ 357 `env`ironment.All args are assumed to be `beowulf.cons-cell/ConsCell` objects.
+
+
+ 358 See page 13 of the Lisp 1.5 Programmers Manual."
+
+
+ 359 [args env]
+
+
+ 360 (cond
+
+
+ 361 (= NIL args) NIL
+
+
+ 362 :else
+
+
+ 363 (make-cons-cell
+
+
+ 364 (EVAL (CAR args) env)
+
+
+ 365 (EVLIS (CDR args) env))))
- 338
+ 366
+
+
+ 367 (deftrace traced-eval
+
+
+ 368 "Essentially, identical to EVAL except traced."
+
+
+ 369 [expr env]
+
+
+ 370 (cond
+
+
+ 371 (=
+
+
+ 372 (ATOM? expr) T)
+
+
+ 373 (CDR (ASSOC expr env))
+
+
+ 374 (=
+
+
+ 375 (ATOM? (CAR expr))
+
+
+ 376 T)(cond
+
+
+ 377 (= (CAR expr) 'QUOTE) (CADR expr)
+
+
+ 378 (= (CAR expr) 'COND) (EVCON (CDR expr) env)
+
+
+ 379 :else (APPLY
+
+
+ 380 (CAR expr)
+
+
+ 381 (EVLIS (CDR expr) env)
+
+
+ 382 env))
+
+
+ 383 :else (APPLY
+
+
+ 384 (CAR expr)
+
+
+ 385 (EVLIS (CDR expr) env)
+
+
+ 386 env)))
+
+
+ 387
+
+
+ 388 (defn EVAL
+
+
+ 389 "For bootstrapping, at least, a version of EVAL written in Clojure.
+
+
+ 390 All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects.
+
+
+ 391 See page 13 of the Lisp 1.5 Programmers Manual."
+
+
+ 392 [expr env]
+
+
+ 393 (cond
+
+
+ 394 (true? (:trace *options*))
+
+
+ 395 (traced-eval expr env)
+
+
+ 396 (=
+
+
+ 397 (ATOM? expr) T)
+
+
+ 398 (CDR (ASSOC expr env))
+
+
+ 399 (=
+
+
+ 400 (ATOM? (CAR expr))
+
+
+ 401 T)(cond
+
+
+ 402 (= (CAR expr) 'QUOTE) (CADR expr)
+
+
+ 403 (= (CAR expr) 'COND) (EVCON (CDR expr) env)
+
+
+ 404 :else (APPLY
+
+
+ 405 (CAR expr)
+
+
+ 406 (EVLIS (CDR expr) env)
+
+
+ 407 env))
+
+
+ 408 :else (APPLY
+
+
+ 409 (CAR expr)
+
+
+ 410 (EVLIS (CDR expr) env)
+
+
+ 411 env)))
+
+
+ 412
+
+
+ 413
+
+
+ 414