<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
<link rel="stylesheet" href="../coverage.css"/> <title> beowulf/bootstrap.clj </title>
</head>
<body>
<span class="covered" title="1 out of 1 forms covered">
001 (ns beowulf.bootstrap
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
002 "Lisp as defined in Chapter 1 (pages 1-14) of the
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
003 `Lisp 1.5 Programmer's Manual`; that is to say, a very simple Lisp language,
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
004 which should, I believe, be sufficient in conjunction with the functions
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
005 provided by `beowulf.host`, be sufficient to bootstrap the full Lisp 1.5
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
006 interpreter..
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
007
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
008 The convention is adopted that functions in this file with names in
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
009 ALLUPPERCASE are Lisp 1.5 functions (although written in Clojure) and that
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
010 therefore all arguments must be numbers, symbols or `beowulf.cons_cell.ConsCell`
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
011 objects."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
012 (: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">
013 pretty-print T]]
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
014 [beowulf.host :refer [ASSOC ATOM CAAR CADAR CADDR CADR CAR CDR GET
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
015 LIST NUMBERP PAIRLIS traced?]]
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
016 [beowulf.oblist :refer [*options* NIL oblist]])
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
017 (:import [beowulf.cons_cell ConsCell]
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
018 [clojure.lang Symbol]))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
019
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
020 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
021 ;;;
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
022 ;;; Copyright (C) 2022-2023 Simon Brooke
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
023 ;;;
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
024 ;;; This program is free software; you can redistribute it and/or
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
025 ;;; modify it under the terms of the GNU General Public License
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
026 ;;; as published by the Free Software Foundation; either version 2
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
027 ;;; of the License, or (at your option) any later version.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
028 ;;;
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
029 ;;; 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">
030 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
031 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
032 ;;; GNU General Public License for more details.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
033 ;;;
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
034 ;;; 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">
035 ;;; along with this program; if not, write to the Free Software
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
036 ;;; 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">
037 ;;;
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
038 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
039
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
040 (declare APPLY EVAL prog-eval)
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
041
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
042 ;;;; The PROGram feature ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
043
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
044 (def find-target
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
045 (memoize
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
046 (fn [target body]
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
047 (loop [body' body]
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
048 (cond
</span><br/>
<span class="partial" title="3 out of 11 forms covered">
049 (= body' NIL) (throw (ex-info (str "Mislar GO miercels: `" target "`")
</span><br/>
<span class="not-covered" title="0 out of 10 forms covered">
050 {:phase :lisp
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
051 :function 'PROG
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
052 :type :lisp
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
053 :code :A6
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
054 :target target}))
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
055 (= (.getCar body') target) body'
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
056 :else (recur (.getCdr body')))))))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
057
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
058 (defn- prog-cond
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
059 "Like `EVCON`, q.v. except using `prog-eval` instead of `EVAL` and not
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
060 throwing an error if no clause matches."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
061 [clauses vars env depth]
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
062 (loop [clauses' clauses]
</span><br/>
<span class="covered" title="6 out of 6 forms covered">
063 (if-not (= clauses' NIL)
</span><br/>
<span class="covered" title="9 out of 9 forms covered">
064 (let [test (prog-eval (CAAR clauses') vars env depth)]
</span><br/>
<span class="covered" title="8 out of 8 forms covered">
065 (if (not (#{NIL F} test))
</span><br/>
<span class="covered" title="8 out of 8 forms covered">
066 (prog-eval (CADAR clauses') vars env depth)
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
067 (recur (.getCdr clauses'))))
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
068 NIL)))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
069
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
070 (defn- merge-vars [vars env]
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
071 (reduce
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
072 #(make-cons-cell
</span><br/>
<span class="covered" title="8 out of 8 forms covered">
073 (make-cons-cell %2 (@vars %2))
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
074 env)
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
075 env
</span><br/>
<span class="covered" title="5 out of 5 forms covered">
076 (keys @vars)))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
077
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
078 (defn prog-eval
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
079 "Like `EVAL`, q.v., except handling symbols, and expressions starting
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
080 `GO`, `RETURN`, `SET` and `SETQ` specially."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
081 [expr vars env depth]
</span><br/>
<span class="partial" title="3 out of 4 forms covered">
082 (cond
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
083 (number? expr) expr
</span><br/>
<span class="covered" title="8 out of 8 forms covered">
084 (symbol? expr) (@vars expr)
</span><br/>
<span class="covered" title="7 out of 7 forms covered">
085 (instance? ConsCell expr) (case (.getCar expr)
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
086 COND (prog-cond (.getCdr expr)
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
087 vars env depth)
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
088 GO (make-cons-cell
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
089 '*PROGGO* (.getCar (.getCdr expr)))
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
090 RETURN (make-cons-cell
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
091 '*PROGRETURN*
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
092 (prog-eval (.getCar (.getCdr expr))
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
093 vars env depth))
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
094 SET (let [v (CADDR expr)]
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
095 (swap! vars
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
096 assoc
</span><br/>
<span class="covered" title="5 out of 5 forms covered">
097 (prog-eval (CADR expr)
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
098 vars env depth)
</span><br/>
<span class="covered" title="5 out of 5 forms covered">
099 (prog-eval (CADDR expr)
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
100 vars env depth))
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
101 v)
</span><br/>
<span class="not-covered" title="0 out of 4 forms covered">
102 SETQ (let [v (CADDR expr)]
</span><br/>
<span class="not-covered" title="0 out of 3 forms covered">
103 (swap! vars
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
104 assoc
</span><br/>
<span class="not-covered" title="0 out of 3 forms covered">
105 (CADR expr)
</span><br/>
<span class="not-covered" title="0 out of 3 forms covered">
106 (prog-eval v
</span><br/>
<span class="not-covered" title="0 out of 3 forms covered">
107 vars env depth))
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
108 v)
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
109 ;; else
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
110 (beowulf.bootstrap/EVAL expr
</span><br/>
<span class="covered" title="6 out of 6 forms covered">
111 (merge-vars vars env)
</span><br/>
<span class="partial" title="4 out of 8 forms covered">
112 depth))))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
113
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
114 (defn PROG
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
115 "The accursed `PROG` feature. See page 71 of the manual.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
116
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
117 Lisp 1.5 introduced `PROG`, and most Lisps have been stuck with it ever
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
118 since. It introduces imperative programming into what should be a pure
</span><br/>
<span class="partial" title="3 out of 7 forms covered">
119 functional language, and consequently it's going to be a pig to implement.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
120
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
121 Broadly, `PROG` is a variadic pseudo function called as a `FEXPR` (or
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
122 possibly an `FSUBR`, although I'm not presently sure that would even work.)
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
123
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
124 The arguments, which are unevaluated, are a list of forms, the first of
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
125 which is expected to be a list of symbols which will be treated as names
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
126 of variables within the program, and the rest of which (the 'program body')
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
127 are either lists or symbols. Lists are treated as Lisp expressions which
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
128 may be evaulated in turn. Symbols are treated as targets for the `GO`
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
129 statement.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
130
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
131 **GO:**
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
132 A `GO` statement takes the form of `(GO target)`, where
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
133 `target` should be one of the symbols which occur at top level among that
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
134 particular invocation of `PROG`s arguments. A `GO` statement may occur at
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
135 top level in a PROG, or in a clause of a `COND` statement in a `PROG`, but
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
136 not in a function called from the `PROG` statement. When a `GO` statement
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
137 is evaluated, execution should transfer immediately to the expression which
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
138 is the argument list immediately following the symbol which is its target.
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
139
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
140 If the target is not found, an error with the code `A6` should be thrown.
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
141
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
142 **RETURN:**
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
143 A `RETURN` statement takes the form `(RETURN value)`, where
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
144 `value` is any value. Following the evaluation of a `RETURN` statement,
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
145 the `PROG` should immediately exit without executing any further
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
146 expressions, returning the value.
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
147
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
148 **SET and SETQ:**
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
149 In addition to the above, if a `SET` or `SETQ` expression is encountered
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
150 in any expression within the `PROG` body, it should affect not the global
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
151 object list but instead only the local variables of the program.
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
152
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
153 **COND:**
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
154 In **strict** mode, when in normal execution, a `COND` statement none of
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
155 whose clauses match should not return `NIL` but should throw an error with
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
156 the code `A3`... *except* that inside a `PROG` body, it should not do so.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
157 *sigh*.
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
158
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
159 **Flow of control:**
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
160 Apart from the exceptions specified above, expressions in the program body
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
161 are evaluated sequentially. If execution reaches the end of the program
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
162 body, `NIL` is returned.
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
163
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
164 Got all that?
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
165
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
166 Good."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
167 [program env depth]
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
168 (let [trace (traced? 'PROG)
</span><br/>
<span class="covered" title="14 out of 14 forms covered">
169 vars (atom (reduce merge (map #(assoc {} % NIL) (.getCar program))))
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
170 body (.getCdr program)
</span><br/>
<span class="covered" title="6 out of 6 forms covered">
171 targets (set (filter symbol? body))]
</span><br/>
<span class="partial" title="2 out of 4 forms covered">
172 (when trace (do
</span><br/>
<span class="not-covered" title="0 out of 3 forms covered">
173 (println "Program:")
</span><br/>
<span class="not-covered" title="0 out of 3 forms covered">
174 (pretty-print program))) ;; for debugging
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
175 (loop [cursor body]
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
176 (let [step (.getCar cursor)]
</span><br/>
<span class="partial" title="2 out of 8 forms covered">
177 (when trace (do (println "Executing step: " step)
</span><br/>
<span class="not-covered" title="0 out of 6 forms covered">
178 (println " with vars: " @vars)))
</span><br/>
<span class="partial" title="6 out of 7 forms covered">
179 (cond (= cursor NIL) NIL
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
180 (symbol? step) (recur (.getCdr cursor))
</span><br/>
<span class="covered" title="7 out of 7 forms covered">
181 :else (let [v (prog-eval (.getCar cursor) vars env depth)]
</span><br/>
<span class="partial" title="2 out of 7 forms covered">
182 (when trace (println " --> " v))
</span><br/>
<span class="covered" title="5 out of 5 forms covered">
183 (if (instance? ConsCell v)
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
184 (case (.getCar v)
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
185 *PROGGO* (let [target (.getCdr v)]
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
186 (if (targets target)
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
187 (recur (find-target target body))
</span><br/>
<span class="not-covered" title="0 out of 7 forms covered">
188 (throw (ex-info (str "Uncynlic GO miercels `"
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
189 target "`")
</span><br/>
<span class="not-covered" title="0 out of 12 forms covered">
190 {:phase :lisp
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
191 :function 'PROG
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
192 :args program
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
193 :type :lisp
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
194 :code :A6
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
195 :target target
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
196 :targets targets}))))
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
197 *PROGRETURN* (.getCdr v)
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
198 ;; else
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
199 (recur (.getCdr cursor)))
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
200 (recur (.getCdr cursor)))))))))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
201
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
202 ;;;; Tracing execution ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
203
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
204 (defn- trace-call
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
205 "Show a trace of a call to the function named by this `function-symbol`
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
206 with these `args` at this depth."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
207 [function-symbol args depth]
</span><br/>
<span class="partial" title="4 out of 5 forms covered">
208 (when (traced? function-symbol)
</span><br/>
<span class="not-covered" title="0 out of 8 forms covered">
209 (let [indent (apply str (repeat depth "-"))]
</span><br/>
<span class="not-covered" title="0 out of 9 forms covered">
210 (println (str indent "> " function-symbol " " args)))))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
211
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
212 (defn- trace-response
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
213 "Show a trace of this `response` from the function named by this
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
214 `function-symbol` at this depth."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
215 [function-symbol response depth]
</span><br/>
<span class="partial" title="4 out of 5 forms covered">
216 (when (traced? function-symbol)
</span><br/>
<span class="not-covered" title="0 out of 8 forms covered">
217 (let [indent (apply str (repeat depth "-"))]
</span><br/>
<span class="not-covered" title="0 out of 10 forms covered">
218 (println (str "<" indent " " function-symbol " " response))))
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
219 response)
</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- value
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
222 "Seek a value for this symbol `s` by checking each of these indicators in
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
223 turn."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
224 ([s]
</span><br/>
<span class="not-covered" title="0 out of 10 forms covered">
225 (value s (list 'APVAL 'EXPR 'FEXPR 'SUBR 'FSUBR)))
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
226 ([s indicators]
</span><br/>
<span class="covered" title="5 out of 5 forms covered">
227 (when (symbol? s)
</span><br/>
<span class="covered" title="15 out of 15 forms covered">
228 (first (remove #(= % NIL) (map #(GET s %)
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
229 indicators))))))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
230
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
231 ;;;; APPLY ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
232
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
233 (defn try-resolve-subroutine
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
234 "Attempt to resolve this `subr` with these `args`."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
235 [subr args]
</span><br/>
<span class="covered" title="11 out of 11 forms covered">
236 (when (and subr (not= subr NIL))
</span><br/>
<span class="covered" title="6 out of 6 forms covered">
237 (try @(resolve subr)
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
238 (catch Throwable any
</span><br/>
<span class="not-covered" title="0 out of 4 forms covered">
239 (throw (ex-info "þegnung (SUBR) ne āfand"
</span><br/>
<span class="not-covered" title="0 out of 7 forms covered">
240 {:phase :apply
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
241 :function subr
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
242 :args args
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
243 :type :beowulf}
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
244 any))))))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
245
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
246 (defn- apply-symbolic
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
247 "Apply this `funtion-symbol` to these `args` in this `environment` and
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
248 return the result."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
249 [^Symbol function-symbol args ^ConsCell environment depth]
</span><br/>
<span class="covered" title="5 out of 5 forms covered">
250 (trace-call function-symbol args depth)
</span><br/>
<span class="covered" title="5 out of 5 forms covered">
251 (let [lisp-fn (value function-symbol '(EXPR FEXPR))
</span><br/>
<span class="partial" title="6 out of 8 forms covered">
252 args' (cond (= NIL args) args
</span><br/>
<span class="partial" title="3 out of 4 forms covered">
253 (empty? args) NIL
</span><br/>
<span class="covered" title="5 out of 5 forms covered">
254 (instance? ConsCell args) args
</span><br/>
<span class="not-covered" title="0 out of 3 forms covered">
255 :else (make-beowulf-list args))
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
256 subr (value function-symbol '(SUBR FSUBR))
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
257 host-fn (try-resolve-subroutine subr args')
</span><br/>
<span class="partial" title="8 out of 9 forms covered">
258 result (cond (and lisp-fn
</span><br/>
<span class="covered" title="9 out of 9 forms covered">
259 (not= lisp-fn NIL)) (APPLY lisp-fn args' environment depth)
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
260 host-fn (try
</span><br/>
<span class="covered" title="10 out of 10 forms covered">
261 (apply host-fn (when (instance? ConsCell args') args'))
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
262 (catch Exception any
</span><br/>
<span class="covered" title="6 out of 6 forms covered">
263 (throw (ex-info (str "Uncynlic þegnung: "
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
264 (.getMessage any))
</span><br/>
<span class="covered" title="7 out of 7 forms covered">
265 {:phase :apply
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
266 :function function-symbol
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
267 :args args
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
268 :type :beowulf}
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
269 any))))
</span><br/>
<span class="not-covered" title="0 out of 3 forms covered">
270 :else (ex-info "þegnung ne āfand"
</span><br/>
<span class="not-covered" title="0 out of 7 forms covered">
271 {:phase :apply
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
272 :function function-symbol
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
273 :args args
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
274 :type :beowulf}))]
</span><br/>
<span class="covered" title="5 out of 5 forms covered">
275 (trace-response function-symbol result depth)
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
276 result))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
277
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
278 (defn APPLY
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
279 "Apply this `function` to these `arguments` in this `environment` and return
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
280 the result.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
281
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
282 For bootstrapping, at least, a version of APPLY written in Clojure.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
283 All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
284 See page 13 of the Lisp 1.5 Programmers Manual."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
285 [function args environment depth]
</span><br/>
<span class="covered" title="9 out of 9 forms covered">
286 (trace-call 'APPLY (list function args environment) depth)
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
287 (let [result (cond
</span><br/>
<span class="partial" title="3 out of 7 forms covered">
288 (= NIL function) (if (:strict *options*)
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
289 NIL
</span><br/>
<span class="not-covered" title="0 out of 4 forms covered">
290 (throw (ex-info "NIL sí ne þegnung"
</span><br/>
<span class="not-covered" title="0 out of 8 forms covered">
291 {:phase :apply
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
292 :function "NIL"
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
293 :args args
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
294 :type :beowulf})))
</span><br/>
<span class="covered" title="12 out of 12 forms covered">
295 (= (ATOM function) T) (apply-symbolic function args environment (inc depth))
</span><br/>
<span class="covered" title="5 out of 5 forms covered">
296 :else (case (first function)
</span><br/>
<span class="not-covered" title="0 out of 2 forms covered">
297 LABEL (APPLY
</span><br/>
<span class="not-covered" title="0 out of 3 forms covered">
298 (CADDR function)
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
299 args
</span><br/>
<span class="not-covered" title="0 out of 2 forms covered">
300 (make-cons-cell
</span><br/>
<span class="not-covered" title="0 out of 2 forms covered">
301 (make-cons-cell
</span><br/>
<span class="not-covered" title="0 out of 3 forms covered">
302 (CADR function)
</span><br/>
<span class="not-covered" title="0 out of 3 forms covered">
303 (CADDR function))
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
304 environment)
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
305 depth)
</span><br/>
<span class="not-covered" title="0 out of 10 forms covered">
306 FUNARG (APPLY (CADR function) args (CADDR function) depth)
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
307 LAMBDA (EVAL
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
308 (CADDR function)
</span><br/>
<span class="covered" title="8 out of 8 forms covered">
309 (PAIRLIS (CADR function) args environment) depth)
</span><br/>
<span class="not-covered" title="0 out of 4 forms covered">
310 (throw (ex-info "Ungecnáwen wyrþan sí þegnung-weard"
</span><br/>
<span class="not-covered" title="0 out of 7 forms covered">
311 {:phase :apply
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
312 :function function
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
313 :args args
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
314 :type :beowulf}))))]
</span><br/>
<span class="covered" title="5 out of 5 forms covered">
315 (trace-response 'APPLY result depth)
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
316 result))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
317
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
318 ;;;; EVAL ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
319
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
320 (defn- EVCON
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
321 "Inner guts of primitive COND. All `clauses` are assumed to be
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
322 `beowulf.cons-cell/ConsCell` objects. Note that tests in Lisp 1.5
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
323 often return `F`, not `NIL`, on failure. If no clause matches,
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
324 then, strictly, we throw an error with code `:A3`.
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
325
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
326 See pages 13 and 71 of the Lisp 1.5 Programmers Manual."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
327 [clauses env depth]
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
328 (loop [clauses' clauses]
</span><br/>
<span class="covered" title="6 out of 6 forms covered">
329 (if-not (= clauses' NIL)
</span><br/>
<span class="covered" title="8 out of 8 forms covered">
330 (let [test (EVAL (CAAR clauses') env depth)]
</span><br/>
<span class="covered" title="8 out of 8 forms covered">
331 (if (not (#{NIL F} test))
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
332 ;; (and (not= test NIL) (not= test F))
</span><br/>
<span class="covered" title="7 out of 7 forms covered">
333 (EVAL (CADAR clauses') env depth)
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
334 (recur (.getCdr clauses'))))
</span><br/>
<span class="not-covered" title="0 out of 4 forms covered">
335 (if (:strict *options*)
</span><br/>
<span class="not-covered" title="0 out of 4 forms covered">
336 (throw (ex-info "Ne ġefōg dǣl in COND"
</span><br/>
<span class="not-covered" title="0 out of 10 forms covered">
337 {:phase :eval
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
338 :function 'COND
</span><br/>
<span class="not-covered" title="0 out of 3 forms covered">
339 :args (list clauses)
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
340 :type :lisp
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
341 :code :A3}))
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
342 NIL))))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
343
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
344 (defn- EVLIS
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
345 "Map `EVAL` across this list of `args` in the context of this
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
346 `env`ironment.All args are assumed to be `beowulf.cons-cell/ConsCell` objects.
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
347 See page 13 of the Lisp 1.5 Programmers Manual."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
348 [args env depth]
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
349 (cond
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
350 (= NIL args) NIL
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
351 :else
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
352 (make-cons-cell
</span><br/>
<span class="covered" title="7 out of 7 forms covered">
353 (EVAL (CAR args) env depth)
</span><br/>
<span class="covered" title="7 out of 7 forms covered">
354 (EVLIS (CDR args) env depth))))
</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- eval-symbolic
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
357 [expr env depth]
</span><br/>
<span class="covered" title="5 out of 5 forms covered">
358 (let [v (ASSOC expr env)
</span><br/>
<span class="covered" title="7 out of 7 forms covered">
359 indent (apply str (repeat depth "-"))]
</span><br/>
<span class="partial" title="4 out of 5 forms covered">
360 (when (traced? 'EVAL)
</span><br/>
<span class="not-covered" title="0 out of 12 forms covered">
361 (println (str indent ": EVAL: sceald bindele: " (or v "nil"))))
</span><br/>
<span class="covered" title="5 out of 5 forms covered">
362 (if (instance? ConsCell v)
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
363 (.getCdr v)
</span><br/>
<span class="covered" title="7 out of 7 forms covered">
364 (let [v' (value expr (list 'APVAL))]
</span><br/>
<span class="partial" title="4 out of 5 forms covered">
365 (when (traced? 'EVAL)
</span><br/>
<span class="not-covered" title="0 out of 15 forms covered">
366 (println (str indent ": EVAL: deóp bindele: (" expr " . " (or v' "nil") ")")))
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
367 (if v'
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
368 v'
</span><br/>
<span class="not-covered" title="0 out of 4 forms covered">
369 (throw (ex-info "Ne tácen-bindele āfand"
</span><br/>
<span class="not-covered" title="0 out of 10 forms covered">
370 {:phase :eval
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
371 :function 'EVAL
</span><br/>
<span class="not-covered" title="0 out of 5 forms covered">
372 :args (list expr env depth)
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
373 :type :lisp
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
374 :code :A8})))))))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
375
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
376 (defn EVAL
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
377 "Evaluate this `expr` and return the result. If `environment` is not passed,
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
378 it defaults to the current value of the global object list. The `depth`
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
379 argument is part of the tracing system and should not be set by user code.
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
380
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
381 All args are assumed to be numbers, symbols or `beowulf.cons-cell/ConsCell`
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
382 objects. However, if called with just a single arg, `expr`, I'll assume it's
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
383 being called from the Clojure REPL and will coerce the `expr` to `ConsCell`."
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
384 ([expr]
</span><br/>
<span class="partial" title="14 out of 15 forms covered">
385 (let [expr' (if (and (coll? expr) (not (instance? ConsCell expr)))
</span><br/>
<span class="not-covered" title="0 out of 3 forms covered">
386 (make-beowulf-list expr)
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
387 expr)]
</span><br/>
<span class="covered" title="5 out of 5 forms covered">
388 (EVAL expr' NIL 0)))
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
389 ([expr env depth]
</span><br/>
<span class="covered" title="9 out of 9 forms covered">
390 (trace-call 'EVAL (list expr env depth) depth)
</span><br/>
<span class="partial" title="6 out of 7 forms covered">
391 (let [result (cond
</span><br/>
<span class="covered" title="4 out of 4 forms covered">
392 (= NIL expr) NIL ;; it was probably a mistake to make Lisp
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
393 ;; NIL distinct from Clojure nil
</span><br/>
<span class="covered" title="6 out of 6 forms covered">
394 (= (NUMBERP expr) T) expr
</span><br/>
<span class="covered" title="8 out of 8 forms covered">
395 (symbol? expr) (eval-symbolic expr env depth)
</span><br/>
<span class="partial" title="3 out of 7 forms covered">
396 (string? expr) (if (:strict *options*)
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
397 (throw
</span><br/>
<span class="not-covered" title="0 out of 2 forms covered">
398 (ex-info
</span><br/>
<span class="not-covered" title="0 out of 5 forms covered">
399 (str "EVAL: strings not allowed in strict mode: \"" expr "\"")
</span><br/>
<span class="not-covered" title="0 out of 6 forms covered">
400 {:phase :eval
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
401 :detail :strict
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
402 :expr expr}))
</span><br/>
<span class="not-covered" title="0 out of 3 forms covered">
403 (symbol expr))
</span><br/>
<span class="covered" title="12 out of 12 forms covered">
404 (= (ATOM (CAR expr)) T) (case (CAR expr)
</span><br/>
<span class="covered" title="7 out of 7 forms covered">
405 COND (EVCON (CDR expr) env depth)
</span><br/>
<span class="not-covered" title="0 out of 6 forms covered">
406 FUNCTION (LIST 'FUNARG (CADR expr))
</span><br/>
<span class="covered" title="7 out of 7 forms covered">
407 PROG (PROG (CDR expr) env depth)
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
408 QUOTE (CADR expr)
</span><br/>
<span class="not-tracked" title="0 out of 0 forms covered">
409 ;; else
</span><br/>
<span class="covered" title="2 out of 2 forms covered">
410 (APPLY
</span><br/>
<span class="covered" title="3 out of 3 forms covered">
411 (CAR expr)
</span><br/>
<span class="covered" title="7 out of 7 forms covered">
412 (EVLIS (CDR expr) env depth)
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
413 env
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
414 depth))
</span><br/>
<span class="not-covered" title="0 out of 2 forms covered">
415 :else (APPLY
</span><br/>
<span class="not-covered" title="0 out of 3 forms covered">
416 (CAR expr)
</span><br/>
<span class="not-covered" title="0 out of 7 forms covered">
417 (EVLIS (CDR expr) env depth)
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
418 env
</span><br/>
<span class="not-covered" title="0 out of 1 forms covered">
419 depth))]
</span><br/>
<span class="covered" title="5 out of 5 forms covered">
420 (trace-response 'EVAL result depth)
</span><br/>
<span class="covered" title="1 out of 1 forms covered">
421 result)))
</span><br/>
<span class="blank" title="0 out of 0 forms covered">
422
</span><br/>
</body>
</html>