<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
<link rel="stylesheet" href="../coverage.css"/> <title> beowulf/host.clj </title>
</head>
<body>
<span class="covered" title="1 out of 1 forms covered">
001 (ns beowulf.host
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
002 "provides Lisp 1.5 functions which can't be (or can't efficiently
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
003 be) implemented in Lisp 1.5, which therefore need to be implemented in the
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
004 host language, in this case Clojure."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
005 (:require [beowulf.cons-cell :refer [F make-beowulf-list make-cons-cell
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
006 pretty-print T]] ;; note hyphen - this is Clojure...
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
007 [beowulf.gendoc :refer [open-doc]]
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
008 [beowulf.oblist :refer [*options* NIL oblist]]
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
009 [clojure.set :refer [union]]
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
010 [clojure.string :refer [upper-case]])
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
011 (:import [beowulf.cons_cell ConsCell] ;; note underscore - same namespace, but Java.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
012 ))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
013
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
014 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
015 ;;;
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
016 ;;; Copyright (C) 2022-2023 Simon Brooke
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
017 ;;;
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
018 ;;; This program is free software; you can redistribute it and/or
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
019 ;;; modify it under the terms of the GNU General Public License
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
020 ;;; as published by the Free Software Foundation; either version 2
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
021 ;;; of the License, or (at your option) any later version.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
022 ;;;
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
023 ;;; This program is distributed in the hope that it will be useful,
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
024 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
025 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
026 ;;; GNU General Public License for more details.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
027 ;;;
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
028 ;;; You should have received a copy of the GNU General Public License
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
029 ;;; along with this program; if not, write to the Free Software
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
030 ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
031 ;;;
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
032 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
033
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
034 ;; these are CANDIDATES to be host-implemented. only a subset of them MUST be.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
035 ;; those which can be implemented in Lisp should be, since that aids
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
036 ;; portability.
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
037
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
038
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
039 (defn lax?
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
040 "Are we in lax mode? If so. return true; is not, throw an exception with
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
041 this `symbol`."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
042 [symbol]
</span><br/>
<span class="covered" title="5 out of 5 forms covered">
043 (when (:strict *options*)
</span><br/>
<span class="covered" title="7 out of 7 forms covered">
044 (throw (ex-info (format "%s ne āfand innan Lisp 1.5" symbol)
</span><br/>
<span class="covered" title="6 out of 6 forms covered">
045 {:type :strict
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
046 :phase :host
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
047 :function symbol})))
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
048 true)
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
049
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
050 ;;;; Basic operations on cons cells ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
051
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
052 (defn CONS
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
053 "Construct a new instance of cons cell with this `car` and `cdr`."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
054 [car cdr]
</span><br/>
<span class="covered" title="6 out of 6 forms covered">
055 (beowulf.cons_cell.ConsCell. car cdr (gensym "c")))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
056
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
057 (defn CAR
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
058 "Return the item indicated by the first pointer of a pair. NIL is treated
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
059 specially: the CAR of NIL is NIL."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
060 [x]
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
061 (cond
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
062 (= x NIL) NIL
</span><br/>
<span class="partial" title="9 out of 10 forms covered">
063 (instance? ConsCell x) (or (.getCar x) NIL)
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
064 :else (throw (ex-info
</span><br/>
<span class="covered" title="8 out of 8 forms covered">
065 (str "Ne can tace CAR of `" x "` (" (.getName (.getClass x)) ")")
</span><br/>
<span class="covered" title="8 out of 8 forms covered">
066 {:phase :host
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
067 :function 'CAR
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
068 :args (list x)
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
069 :type :beowulf}))))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
070
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
071 (defn CDR
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
072 "Return the item indicated by the second pointer of a pair. NIL is treated
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
073 specially: the CDR of NIL is NIL."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
074 [x]
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
075 (cond
</span><br/>
<span class="partial" title="3 out of 4 forms covered">
076 (= x NIL) NIL
</span><br/>
<span class="partial" title="9 out of 10 forms covered">
077 (instance? ConsCell x) (or (.getCdr x) NIL)
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
078 :else (throw (ex-info
</span><br/>
<span class="covered" title="8 out of 8 forms covered">
079 (str "Ne can tace CDR of `" x "` (" (.getName (.getClass x)) ")")
</span><br/>
<span class="covered" title="8 out of 8 forms covered">
080 {:phase :host
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
081 :function 'CDR
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
082 :args (list x)
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
083 :type :beowulf}))))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
084
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
085
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
086 (defn uaf
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
087 "Universal access function; `l` is expected to be an arbitrary LISP list, `path`
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
088 a (clojure) list of the characters `a` and `d`. Intended to make declaring
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
089 all those fiddly `#'c[ad]+r'` functions a bit easier"
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
090 [l path]
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
091 (cond
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
092 (= l NIL) NIL
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
093 (empty? path) l
</span><br/>
<span class="covered" title="13 out of 13 forms covered">
094 (not (instance? ConsCell l)) (throw (ex-info (str "Ne liste: "
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
095 l "; " (type l))
</span><br/>
<span class="covered" title="8 out of 8 forms covered">
096 {:phase :eval
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
097 :function "universal access function"
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
098 :args [l path]
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
099 :type :beowulf}))
</span><br/>
<span class="covered" title="5 out of 5 forms covered">
100 :else (case (last path)
</span><br/>
<span class="covered" title="6 out of 6 forms covered">
101 \a (uaf (.first l) (butlast path))
</span><br/>
<span class="covered" title="6 out of 6 forms covered">
102 \d (uaf (.getCdr l) (butlast path))
</span><br/>
<span class="covered" title="6 out of 6 forms covered">
103 (throw (ex-info (str "uaf: unexpected letter in path (only `a` and `d` permitted): "
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
104 (last path))
</span><br/>
<span class="covered" title="8 out of 8 forms covered">
105 {:phase :eval
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
106 :function "universal access function"
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
107 :args [l path]
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
108 :type :beowulf})))))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
109
</span><br/>
<span class="covered" title="43 out of 43 forms covered">
110 (defmacro CAAR [x] `(uaf ~x '(\a \a)))
</span><br/>
<span class="covered" title="44 out of 44 forms covered">
111 (defmacro CADR [x] `(uaf ~x '(\a \d)))
</span><br/>
<span class="covered" title="45 out of 45 forms covered">
112 (defmacro CDDR [x] `(uaf ~x '(\d \d)))
</span><br/>
<span class="partial" title="5 out of 42 forms covered">
113 (defmacro CDAR [x] `(uaf ~x '(\d \a)))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
114
</span><br/>
<span class="partial" title="5 out of 45 forms covered">
115 (defmacro CAAAR [x] `(uaf ~x '(\a \a \a)))
</span><br/>
<span class="partial" title="5 out of 45 forms covered">
116 (defmacro CAADR [x] `(uaf ~x '(\a \a \d)))
</span><br/>
<span class="covered" title="45 out of 45 forms covered">
117 (defmacro CADAR [x] `(uaf ~x '(\a \d \a)))
</span><br/>
<span class="covered" title="45 out of 45 forms covered">
118 (defmacro CADDR [x] `(uaf ~x '(\a \d \d)))
</span><br/>
<span class="partial" title="5 out of 45 forms covered">
119 (defmacro CDDAR [x] `(uaf ~x '(\d \d \a)))
</span><br/>
<span class="partial" title="5 out of 45 forms covered">
120 (defmacro CDDDR [x] `(uaf ~x '(\d \d \d)))
</span><br/>
<span class="partial" title="5 out of 45 forms covered">
121 (defmacro CDAAR [x] `(uaf ~x '(\d \a \a)))
</span><br/>
<span class="partial" title="5 out of 45 forms covered">
122 (defmacro CDADR [x] `(uaf ~x '(\d \a \d)))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
123
</span><br/>
<span class="covered" title="48 out of 48 forms covered">
124 (defmacro CAAAAR [x] `(uaf ~x '(\a \a \a \a)))
</span><br/>
<span class="partial" title="5 out of 48 forms covered">
125 (defmacro CAADAR [x] `(uaf ~x '(\a \a \d \a)))
</span><br/>
<span class="partial" title="5 out of 48 forms covered">
126 (defmacro CADAAR [x] `(uaf ~x '(\a \d \a \a)))
</span><br/>
<span class="partial" title="5 out of 48 forms covered">
127 (defmacro CADDAR [x] `(uaf ~x '(\a \d \d \a)))
</span><br/>
<span class="partial" title="5 out of 48 forms covered">
128 (defmacro CDDAAR [x] `(uaf ~x '(\d \d \a \a)))
</span><br/>
<span class="partial" title="5 out of 48 forms covered">
129 (defmacro CDDDAR [x] `(uaf ~x '(\d \d \d \a)))
</span><br/>
<span class="partial" title="5 out of 48 forms covered">
130 (defmacro CDAAAR [x] `(uaf ~x '(\d \a \a \a)))
</span><br/>
<span class="partial" title="5 out of 48 forms covered">
131 (defmacro CDADAR [x] `(uaf ~x '(\d \a \d \a)))
</span><br/>
<span class="partial" title="5 out of 48 forms covered">
132 (defmacro CAAADR [x] `(uaf ~x '(\a \a \a \d)))
</span><br/>
<span class="partial" title="5 out of 48 forms covered">
133 (defmacro CAADDR [x] `(uaf ~x '(\a \a \d \d)))
</span><br/>
<span class="partial" title="5 out of 48 forms covered">
134 (defmacro CADADR [x] `(uaf ~x '(\a \d \a \d)))
</span><br/>
<span class="covered" title="48 out of 48 forms covered">
135 (defmacro CADDDR [x] `(uaf ~x '(\a \d \d \d)))
</span><br/>
<span class="partial" title="5 out of 48 forms covered">
136 (defmacro CDDADR [x] `(uaf ~x '(\d \d \a \d)))
</span><br/>
<span class="partial" title="5 out of 48 forms covered">
137 (defmacro CDDDDR [x] `(uaf ~x '(\d \d \d \d)))
</span><br/>
<span class="partial" title="5 out of 48 forms covered">
138 (defmacro CDAADR [x] `(uaf ~x '(\d \a \a \d)))
</span><br/>
<span class="partial" title="5 out of 48 forms covered">
139 (defmacro CDADDR [x] `(uaf ~x '(\d \a \d \d)))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
140
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
141 (defn RPLACA
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
142 "Replace the CAR pointer of this `cell` with this `value`. Dangerous, should
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
143 really not exist, but does in Lisp 1.5 (and was important for some
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
144 performance hacks in early Lisps)"
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
145 [^ConsCell cell value]
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
146 (if
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
147 (instance? ConsCell cell)
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
148 (if
</span><br/>
<span class="partial" title="11 out of 13 forms covered">
149 (or
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
150 (instance? ConsCell value)
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
151 (number? value)
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
152 (symbol? value)
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
153 (= value NIL))
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
154 (try
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
155 (.rplaca cell value)
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
156 cell
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
157 (catch Throwable any
</span><br/>
<span class="not-covered" title="0 out of 3 forms covered">
158 (throw (ex-info
</span><br/>
<span class="not-covered" title="0 out of 4 forms covered">
159 (str (.getMessage any) " in RPLACA: `")
</span><br/>
<span class="not-covered" title="0 out of 10 forms covered">
160 {:cause :upstream-error
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
161 :phase :host
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
162 :function :rplaca
</span><br/>
<span class="not-covered" title="0 out of 4 forms covered">
163 :args (list cell value)
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
164 :type :beowulf}
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
165 any))))
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
166 (throw (ex-info
</span><br/>
<span class="covered" title="9 out of 9 forms covered">
167 (str "Un-ġefōg þing in RPLACA: `" value "` (" (type value) ")")
</span><br/>
<span class="covered" title="10 out of 10 forms covered">
168 {:cause :bad-value
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
169 :phase :host
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
170 :function :rplaca
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
171 :args (list cell value)
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
172 :type :beowulf})))
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
173 (throw (ex-info
</span><br/>
<span class="covered" title="9 out of 9 forms covered">
174 (str "Uncynlic miercels in RPLACA: `" cell "` (" (type cell) ")")
</span><br/>
<span class="covered" title="10 out of 10 forms covered">
175 {:cause :bad-cell
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
176 :phase :host
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
177 :function :rplaca
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
178 :args (list cell value)
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
179 :type :beowulf}))))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
180
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
181 (defn RPLACD
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
182 "Replace the CDR pointer of this `cell` with this `value`. Dangerous, should
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
183 really not exist, but does in Lisp 1.5 (and was important for some
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
184 performance hacks in early Lisps)"
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
185 [^ConsCell cell value]
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
186 (if
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
187 (instance? ConsCell cell)
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
188 (if
</span><br/>
<span class="partial" title="12 out of 13 forms covered">
189 (or
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
190 (instance? ConsCell value)
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
191 (number? value)
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
192 (symbol? value)
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
193 (= value NIL))
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
194 (try
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
195 (.rplacd cell value)
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
196 cell
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
197 (catch Throwable any
</span><br/>
<span class="not-covered" title="0 out of 3 forms covered">
198 (throw (ex-info
</span><br/>
<span class="not-covered" title="0 out of 4 forms covered">
199 (str (.getMessage any) " in RPLACD: `")
</span><br/>
<span class="not-covered" title="0 out of 10 forms covered">
200 {:cause :upstream-error
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
201 :phase :host
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
202 :function :rplacd
</span><br/>
<span class="not-covered" title="0 out of 4 forms covered">
203 :args (list cell value)
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
204 :type :beowulf}
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
205 any))))
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
206 (throw (ex-info
</span><br/>
<span class="covered" title="9 out of 9 forms covered">
207 (str "Un-ġefōg þing in RPLACD: `" value "` (" (type value) ")")
</span><br/>
<span class="covered" title="10 out of 10 forms covered">
208 {:cause :bad-value
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
209 :phase :host
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
210 :function :rplacd
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
211 :args (list cell value)
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
212 :type :beowulf})))
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
213 (throw (ex-info
</span><br/>
<span class="covered" title="9 out of 9 forms covered">
214 (str "Uncynlic miercels in RPLACD: `" cell "` (" (type cell) ")")
</span><br/>
<span class="covered" title="10 out of 10 forms covered">
215 {:cause :bad-cell
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
216 :phase :host
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
217 :detail :rplacd
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
218 :args (list cell value)
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
219 :type :beowulf}))));; PLUS
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
220
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
221 (defn LIST
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
222 [& args]
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
223 (make-beowulf-list args))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
224
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
225 ;;;; Basic predicates ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
226
</span><br/>
<span class="covered" title="36 out of 36 forms covered">
227 (defmacro NULL
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
228 "Returns `T` if and only if the argument `x` is bound to `NIL`; else `F`."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
229 [x]
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
230 `(if (= ~x NIL) T F))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
231
</span><br/>
<span class="covered" title="36 out of 36 forms covered">
232 (defmacro NILP
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
233 "Not part of LISP 1.5: `T` if `o` is `NIL`, else `NIL`."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
234 [x]
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
235 `(if (= ~x NIL) T NIL))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
236
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
237 (defn ATOM
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
238 "Returns `T` if and only if the argument `x` is bound to an atom; else `F`.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
239 It is not clear to me from the documentation whether `(ATOM 7)` should return
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
240 `T` or `F`. I'm going to assume `T`."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
241 [x]
</span><br/>
<span class="covered" title="13 out of 13 forms covered">
242 (if (or (symbol? x) (number? x)) T F))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
243
</span><br/>
<span class="covered" title="57 out of 57 forms covered">
244 (defmacro ATOM?
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
245 "The convention of returning `F` from predicates, rather than `NIL`, is going
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
246 to tie me in knots. This is a variant of `ATOM` which returns `NIL`
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
247 on failure."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
248 [x]
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
249 `(if (or (symbol? ~x) (number? ~x)) T NIL))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
250
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
251 (defn EQ
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
252 "Returns `T` if and only if both `x` and `y` are bound to the same atom,
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
253 else `NIL`."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
254 [x y]
</span><br/>
<span class="covered" title="12 out of 12 forms covered">
255 (cond (and (instance? ConsCell x)
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
256 (.equals x y)) T
</span><br/>
<span class="covered" title="13 out of 13 forms covered">
257 (and (= (ATOM x) T) (= x y)) T
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
258 :else NIL))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
259
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
260 (defn EQUAL
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
261 "This is a predicate that is true if its two arguments are identical
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
262 S-expressions, and false if they are different. (The elementary predicate
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
263 `EQ` is defined only for atomic arguments.) The definition of `EQUAL` is
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
264 an example of a conditional expression inside a conditional expression.
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
265
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
266 NOTE: returns `F` on failure, not `NIL`"
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
267 [x y]
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
268 (cond
</span><br/>
<span class="covered" title="11 out of 11 forms covered">
269 (= (ATOM x) T) (if (= x y) T F)
</span><br/>
<span class="covered" title="18 out of 18 forms covered">
270 (= (EQUAL (CAR x) (CAR y)) T) (EQUAL (CDR x) (CDR y))
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
271 :else F))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
272
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
273 (defn AND
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
274 "`T` if and only if none of my `args` evaluate to either `F` or `NIL`,
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
275 else `F`.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
276
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
277 In `beowulf.host` principally because I don't yet feel confident to define
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
278 varargs functions in Lisp."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
279 [& args]
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
280 ;; (println "AND: " args " type: " (type args) " seq? " (seq? args))
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
281 ;; (println " filtered: " (seq (filter #{F NIL} args)))
</span><br/>
<span class="partial" title="6 out of 7 forms covered">
282 (cond (= NIL args) T
</span><br/>
<span class="covered" title="14 out of 14 forms covered">
283 (seq? args) (if (seq (filter #{F NIL} args)) F T)
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
284 :else T))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
285
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
286
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
287 (defn OR
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
288 "`T` if and only if at least one of my `args` evaluates to something other
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
289 than either `F` or `NIL`, else `F`.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
290
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
291 In `beowulf.host` principally because I don't yet feel confident to define
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
292 varargs functions in Lisp."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
293 [& args]
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
294 ;; (println "OR: " args " type: " (type args) " seq? " (seq? args))
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
295 ;; (println " filtered: " (seq (remove #{F NIL} args)))
</span><br/>
<span class="partial" title="6 out of 7 forms covered">
296 (cond (= NIL args) F
</span><br/>
<span class="covered" title="14 out of 14 forms covered">
297 (seq? args) (if (seq (remove #{F NIL} args)) T F)
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
298 :else F))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
299
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
300
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
301 ;;;; Operations on lists ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
302 ;;
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
303 ;; TODO: These are candidates for moving to Lisp urgently!
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
304
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
305 (defn ASSOC
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
306 "If a is an association list such as the one formed by PAIRLIS in the above
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
307 example, then assoc will produce the first pair whose first term is x. Thus
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
308 it is a table searching function.
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
309
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
310 All args are assumed to be `beowulf.cons-cell/ConsCell` objects.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
311 See page 12 of the Lisp 1.5 Programmers Manual.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
312
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
313 **NOTE THAT** this function is overridden by an implementation in Lisp,
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
314 but is currently still present for bootstrapping."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
315 [x a]
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
316 (cond
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
317 (= NIL a) NIL ;; this clause is not present in the original but is added for
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
318 ;; robustness.
</span><br/>
<span class="covered" title="11 out of 11 forms covered">
319 (= (EQUAL (CAAR a) x) T) (CAR a)
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
320 :else
</span><br/>
<span class="covered" title="6 out of 6 forms covered">
321 (ASSOC x (CDR a))))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
322
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
323 (defn PAIRLIS
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
324 "This function gives the list of pairs of corresponding elements of the
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
325 lists `x` and `y`, and APPENDs this to the list `a`. The resultant list
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
326 of pairs, which is like a table with two columns, is called an
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
327 association list.
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
328
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
329 Eessentially, it builds the environment on the stack, implementing shallow
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
330 binding.
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
331
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
332 All args are assumed to be `beowulf.cons-cell/ConsCell` objects.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
333 See page 12 of the Lisp 1.5 Programmers Manual.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
334
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
335 **NOTE THAT** this function is overridden by an implementation in Lisp,
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
336 but is currently still present for bootstrapping."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
337 [x y a]
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
338 (cond
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
339 ;; the original tests only x; testing y as well will be a little more
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
340 ;; robust if `x` and `y` are not the same length.
</span><br/>
<span class="covered" title="11 out of 11 forms covered">
341 (or (= NIL x) (= NIL y)) a
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
342 :else (make-cons-cell
</span><br/>
<span class="covered" title="8 out of 8 forms covered">
343 (make-cons-cell (CAR x) (CAR y))
</span><br/>
<span class="covered" title="9 out of 9 forms covered">
344 (PAIRLIS (CDR x) (CDR y) a))))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
345
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
346 ;;;; Arithmetic ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
347 ;;
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
348 ;; TODO: When in strict mode, should we limit arithmetic precision to that
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
349 ;; supported by Lisp 1.5?
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
350
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
351 (defn PLUS
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
352 [& args]
</span><br/>
<span class="covered" title="5 out of 5 forms covered">
353 (let [s (apply + args)]
</span><br/>
<span class="covered" title="7 out of 7 forms covered">
354 (if (integer? s) s (float s))))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
355
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
356 (defn TIMES
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
357 [& args]
</span><br/>
<span class="covered" title="5 out of 5 forms covered">
358 (let [p (apply * args)]
</span><br/>
<span class="covered" title="7 out of 7 forms covered">
359 (if (integer? p) p (float p))))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
360
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
361 (defn DIFFERENCE
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
362 [x y]
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
363 (let [d (- x y)]
</span><br/>
<span class="covered" title="7 out of 7 forms covered">
364 (if (integer? d) d (float d))))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
365
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
366 (defn QUOTIENT
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
367 "I'm not certain from the documentation whether Lisp 1.5 `QUOTIENT` returned
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
368 the integer part of the quotient, or a realnum representing the whole
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
369 quotient. I am for now implementing the latter."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
370 [x y]
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
371 (let [q (/ x y)]
</span><br/>
<span class="covered" title="7 out of 7 forms covered">
372 (if (integer? q) q (float q))))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
373
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
374 (defn REMAINDER
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
375 [x y]
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
376 (rem x y))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
377
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
378 (defn ADD1
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
379 [x]
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
380 (inc x))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
381
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
382 (defn SUB1
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
383 [x]
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
384 (dec x))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
385
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
386 (defn FIXP
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
387 [x]
</span><br/>
<span class="covered" title="6 out of 6 forms covered">
388 (if (integer? x) T F))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
389
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
390 (defn NUMBERP
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
391 [x]
</span><br/>
<span class="covered" title="6 out of 6 forms covered">
392 (if (number? x) T F))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
393
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
394 (defn LESSP
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
395 [x y]
</span><br/>
<span class="covered" title="6 out of 6 forms covered">
396 (if (< x y) T F))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
397
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
398 (defn GREATERP
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
399 [x y]
</span><br/>
<span class="covered" title="6 out of 6 forms covered">
400 (if (> x y) T F))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
401
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
402 ;;;; Miscellaneous ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
403
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
404 (defn GENSYM
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
405 "Generate a unique symbol."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
406 []
</span><br/>
<span class="covered" title="9 out of 9 forms covered">
407 (symbol (upper-case (str (gensym "SYM")))))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
408
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
409 (defn ERROR
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
410 "Throw an error"
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
411 [& args]
</span><br/>
<span class="covered" title="14 out of 14 forms covered">
412 (throw (ex-info "LISP STÆFLEAHTER" {:args args
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
413 :phase :eval
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
414 :function 'ERROR
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
415 :type :lisp
</span><br/>
<span class="covered" title="8 out of 8 forms covered">
416 :code (or (first args) 'A1)})))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
417
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
418 ;;;; Assignment and the object list ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
419
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
420 (defn OBLIST
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
421 "Return a list of the symbols currently bound on the object list.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
422
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
423 **NOTE THAT** in the Lisp 1.5 manual, footnote at the bottom of page 69, it implies
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
424 that an argument can be passed but I'm not sure of the semantics of
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
425 this."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
426 []
</span><br/>
<span class="not-covered" title="0 out of 7 forms covered">
427 (if (instance? ConsCell @oblist)
</span><br/>
<span class="not-covered" title="0 out of 8 forms covered">
428 (make-beowulf-list (map CAR @oblist))
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
429 NIL))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
430
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
431 (def magic-marker
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
432 "The unexplained magic number which marks the start of a property list."
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
433 (Integer/parseInt "77777" 8))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
434
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
435 (defn hit-or-miss-assoc
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
436 "Find the position of the binding of this `target` in a Lisp 1.5
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
437 property list `plist`.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
438
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
439 Lisp 1.5 property lists are not assoc lists, but lists of the form
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
440 `(name value name value name value...)`. It's therefore necessary to
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
441 recurse down the list two entries at a time to avoid confusing names
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
442 with values."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
443 [target plist]
</span><br/>
<span class="covered" title="13 out of 13 forms covered">
444 (if (and (instance? ConsCell plist) (even? (count plist)))
</span><br/>
<span class="partial" title="6 out of 7 forms covered">
445 (cond (= plist NIL) NIL
</span><br/>
<span class="covered" title="6 out of 6 forms covered">
446 (= (first plist) target) plist
</span><br/>
<span class="covered" title="6 out of 6 forms covered">
447 :else (hit-or-miss-assoc target (CDDR plist)))
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
448 NIL))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
449
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
450 (defn PUT
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
451 "Put this `value` as the value of the property indicated by this `indicator`
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
452 of this `symbol`. Return `value` on success.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
453
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
454 NOTE THAT there is no `PUT` defined in the manual, but it would have been
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
455 easy to have defined it so I don't think this fully counts as an extension."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
456 [symbol indicator value]
</span><br/>
<span class="covered" title="7 out of 7 forms covered">
457 (let [binding (ASSOC symbol @oblist)]
</span><br/>
<span class="covered" title="5 out of 5 forms covered">
458 (if (instance? ConsCell binding)
</span><br/>
<span class="covered" title="7 out of 7 forms covered">
459 (let [prop (hit-or-miss-assoc indicator (CDDR binding))]
</span><br/>
<span class="covered" title="5 out of 5 forms covered">
460 (if (instance? ConsCell prop)
</span><br/>
<span class="covered" title="6 out of 6 forms covered">
461 (RPLACA (CDR prop) value)
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
462 (RPLACD binding
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
463 (make-cons-cell
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
464 magic-marker
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
465 (make-cons-cell
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
466 indicator
</span><br/>
<span class="covered" title="6 out of 6 forms covered">
467 (make-cons-cell value (CDDR binding)))))))
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
468 (swap!
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
469 oblist
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
470 (fn [ob s p v]
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
471 (make-cons-cell
</span><br/>
<span class="covered" title="8 out of 8 forms covered">
472 (make-beowulf-list (list s magic-marker p v))
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
473 ob))
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
474 symbol indicator value)))
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
475 value)
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
476
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
477 (defn GET
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
478 "From the manual:
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
479
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
480 '`get` is somewhat like `prop`; however its value is car of the rest of
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
481 the list if the `indicator` is found, and NIL otherwise.'
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
482
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
483 It's clear that `GET` is expected to be defined in terms of `PROP`, but
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
484 we can't implement `PROP` here because we lack `EVAL`; and we can't have
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
485 `EVAL` here because both it and `APPLY` depends on `GET`.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
486
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
487 OK, It's worse than that: the statement of the definition of `GET` (and
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
488 of) `PROP` on page 59 says that the first argument to each must be a list;
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
489 But the in the definition of `ASSOC` on page 70, when `GET` is called its
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
490 first argument is always an atom. Since it's `ASSOC` and `EVAL` which I
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
491 need to make work, I'm going to assume that page 59 is wrong."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
492 [symbol indicator]
</span><br/>
<span class="covered" title="7 out of 7 forms covered">
493 (let [binding (ASSOC symbol @oblist)
</span><br/>
<span class="partial" title="2 out of 3 forms covered">
494 val (cond
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
495 (= binding NIL) NIL
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
496 (= magic-marker
</span><br/>
<span class="covered" title="5 out of 5 forms covered">
497 (CADR binding)) (loop [b binding]
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
498 ;; (println "GET loop, seeking " indicator ":")
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
499 ;; (pretty-print b)
</span><br/>
<span class="covered" title="5 out of 5 forms covered">
500 (if (instance? ConsCell b)
</span><br/>
<span class="covered" title="6 out of 6 forms covered">
501 (if (= (CAR b) indicator)
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
502 (CADR b) ;; <- this is what we should actually be returning
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
503 (recur (CDR b)))
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
504 NIL))
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
505 :else (throw
</span><br/>
<span class="not-covered" title="0 out of 3 forms covered">
506 (ex-info "Misformatted property list (missing magic marker)"
</span><br/>
<span class="not-covered" title="0 out of 8 forms covered">
507 {:phase :host
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
508 :function :get
</span><br/>
<span class="not-covered" title="0 out of 4 forms covered">
509 :args (list symbol indicator)
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
510 :type :beowulf})))]
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
511 ;; (println "<< GET returning: " val)
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
512 val))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
513
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
514 (defn DEFLIST
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
515 "For each pair in this association list `a-list`, set the property with this
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
516 `indicator` of the symbol which is the first element of the pair to the
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
517 value which is the second element of the pair. See page 58 of the manual."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
518 [a-list indicator]
</span><br/>
<span class="not-covered" title="0 out of 2 forms covered">
519 (doall
</span><br/>
<span class="not-covered" title="0 out of 3 forms covered">
520 (map
</span><br/>
<span class="not-covered" title="0 out of 14 forms covered">
521 #(when (PUT (CAR %) indicator (CDR %)) (CAR %))
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
522 a-list)))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
523
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
524 (defn DEFINE
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
525 "Bootstrap-only version of `DEFINE` which, post boostrap, can be overwritten
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
526 in LISP.
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
527
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
528 The single argument to `DEFINE` should be an association list of symbols to
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
529 lambda functions. See page 58 of the manual."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
530 [a-list]
</span><br/>
<span class="not-covered" title="0 out of 4 forms covered">
531 (DEFLIST a-list 'EXPR))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
532
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
533 (defn SET
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
534 "Implementation of SET in Clojure. Add to the `oblist` a binding of the
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
535 value of `var` to the value of `val`. NOTE WELL: this is not SETQ!"
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
536 [symbol val]
</span><br/>
<span class="not-covered" title="0 out of 5 forms covered">
537 (PUT symbol 'APVAL val))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
538
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
539 ;;;; TRACE and friends ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
540
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
541 (def traced-symbols
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
542 "Symbols currently being traced."
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
543 (atom #{}))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
544
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
545 (defn traced?
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
546 "Return `true` iff `s` is a symbol currently being traced, else `nil`."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
547 [s]
</span><br/>
<span class="partial" title="7 out of 8 forms covered">
548 (try (contains? @traced-symbols s)
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
549 (catch Throwable _ nil)))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
550
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
551 (defn TRACE
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
552 "Add this `s` to the set of symbols currently being traced. If `s`
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
553 is not a symbol or sequence of symbols, does nothing."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
554 [s]
</span><br/>
<span class="not-covered" title="0 out of 4 forms covered">
555 (swap! traced-symbols
</span><br/>
<span class="not-covered" title="0 out of 4 forms covered">
556 #(cond
</span><br/>
<span class="not-covered" title="0 out of 7 forms covered">
557 (symbol? s) (conj % s)
</span><br/>
<span class="not-covered" title="0 out of 17 forms covered">
558 (and (seq? s) (every? symbol? s)) (union % (set s))
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
559 :else %)))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
560
</span><br/>
<span class="partial" title="1 out of 3 forms covered">
561 (defn UNTRACE
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
562 "Remove this `s` from the set of symbols currently being traced. If `s`
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
563 is not a symbol or sequence of symbols, does nothing."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
564 [s]
</span><br/>
<span class="not-covered" title="0 out of 3 forms covered">
565 (cond
</span><br/>
<span class="not-covered" title="0 out of 16 forms covered">
566 (symbol? s) (swap! traced-symbols #(set (remove (fn [x] (= s x)) %)))
</span><br/>
<span class="not-covered" title="0 out of 15 forms covered">
567 (and (seq? s) (every? symbol? s)) (map UNTRACE s))
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
568 @traced-symbols)
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
569
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
570 ;;;; Extensions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
571
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
572 (defn DOC
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
573 "Open the page for this `symbol` in the Lisp 1.5 manual, if known, in the
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
574 default web browser.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
575
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
576 **NOTE THAT** this is an extension function, not available in strct mode."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
577 [symbol]
</span><br/>
<span class="not-covered" title="0 out of 5 forms covered">
578 (when (lax? 'DOC)
</span><br/>
<span class="not-covered" title="0 out of 3 forms covered">
579 (open-doc symbol)))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
580
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
581 (defn CONSP
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
582 "Return `T` if object `o` is a cons cell, else `F`.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
583
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
584 **NOTE THAT** this is an extension function, not available in strct mode.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
585 I believe that Lisp 1.5 did not have any mechanism for testing whether an
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
586 argument was, or was not, a cons cell."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
587 [o]
</span><br/>
<span class="covered" title="5 out of 5 forms covered">
588 (when (lax? 'CONSP)
</span><br/>
<span class="covered" title="7 out of 7 forms covered">
589 (if (instance? ConsCell o) 'T 'F)))
</span><br/>
</body>
</html>