837 lines
60 KiB
HTML
837 lines
60 KiB
HTML
<html>
|
||
<head>
|
||
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
|
||
<link rel="stylesheet" href="../../coverage.css"/> <title> beowulf/reader/generate.clj </title>
|
||
</head>
|
||
<body>
|
||
<span class="covered" title="1 out of 1 forms covered">
|
||
001 (ns beowulf.reader.generate
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
002 "Generating S-Expressions from parse trees.
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
003
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
004 ## From Lisp 1.5 Programmers Manual, page 10
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
005 *Note that I've retyped much of this, since copy/pasting out of PDF is less
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
006 than reliable. Any typos are mine.*
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
007
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
008 *Quote starts:*
|
||
</span><br/>
|
||
<span class="blank" title="0 out of 0 forms covered">
|
||
009
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
010 We are now in a position to define the universal LISP function
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
011 `evalquote[fn;args]`, When evalquote is given a function and a list of arguments
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
012 for that function, it computes the value of the function applied to the arguments.
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
013 LISP functions have S-expressions as arguments. In particular, the argument `fn`
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
014 of the function evalquote must be an S-expression. Since we have been
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
015 writing functions as M-expressions, it is necessary to translate them into
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
016 S-expressions.
|
||
</span><br/>
|
||
<span class="blank" title="0 out of 0 forms covered">
|
||
017
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
018 The following rules define a method of translating functions written in the
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
019 meta-language into S-expressions.
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
020 1. If the function is represented by its name, it is translated by changing
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
021 all of the letters to upper case, making it an atomic symbol. Thus `car` is
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
022 translated to `CAR`.
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
023 2. If the function uses the lambda notation, then the expression
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
024 `λ[[x ..;xn]; ε]` is translated into `(LAMBDA (X1 ...XN) ε*)`, where ε* is the translation
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
025 of ε.
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
026 3. If the function begins with label, then the translation of
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
027 `label[α;ε]` is `(LABEL α* ε*)`.
|
||
</span><br/>
|
||
<span class="blank" title="0 out of 0 forms covered">
|
||
028
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
029 Forms are translated as follows:
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
030 1. A variable, like a function name, is translated by using uppercase letters.
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
031 Thus the translation of `var1` is `VAR1`.
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
032 2. The obvious translation of letting a constant translate into itself will not
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
033 work. Since the translation of `x` is `X`, the translation of `X` must be something
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
034 else to avoid ambiguity. The solution is to quote it. Thus `X` is translated
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
035 into `(QUOTE X)`.
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
036 3. The form `fn[argl;. ..;argn]` is translated into `(fn* argl* ...argn*)`
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
037 4. The conditional expression `[pl-el;...;pn-en]` is translated into
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
038 `(COND (p1* e1*)...(pn* en*))`
|
||
</span><br/>
|
||
<span class="blank" title="0 out of 0 forms covered">
|
||
039
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
040 ## Examples
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
041 ```
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
042 M-expressions S-expressions
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
043
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
044 x X
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
045 car CAR
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
046 car[x] (CAR X)
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
047 T (QUOTE T)
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
048 ff[car [x]] (FF (CAR X))
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
049 [atom[x]->x; T->ff[car[x]]] (COND ((ATOM X) X)
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
050 ((QUOTE T)(FF (CAR X))))
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
051 label[ff;λ[[x];[atom[x]->x; (LABEL FF (LAMBDA (X)
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
052 T->ff[car[x]]]]] (COND ((ATOM X) X)
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
053 ((QUOTE T)(FF (CAR X))))))
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
054 ```
|
||
</span><br/>
|
||
<span class="blank" title="0 out of 0 forms covered">
|
||
055
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
056 *quote ends*
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
057 "
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
058 (:require [beowulf.cons-cell :refer [make-beowulf-list make-cons-cell]]
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
059 [beowulf.reader.macros :refer [expand-macros]]
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
060 [beowulf.oblist :refer [NIL]]
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
061 [clojure.math.numeric-tower :refer [expt]]
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
062 [clojure.string :refer [upper-case]]
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
063 [clojure.tools.trace :refer [deftrace]]))
|
||
</span><br/>
|
||
<span class="blank" title="0 out of 0 forms covered">
|
||
064
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
065 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
066 ;;;
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
067 ;;; Copyright (C) 2022-2023 Simon Brooke
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
068 ;;;
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
069 ;;; This program is free software; you can redistribute it and/or
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
070 ;;; modify it under the terms of the GNU General Public License
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
071 ;;; as published by the Free Software Foundation; either version 2
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
072 ;;; of the License, or (at your option) any later version.
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
073 ;;;
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
074 ;;; 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">
|
||
075 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
076 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
077 ;;; GNU General Public License for more details.
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
078 ;;;
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
079 ;;; 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">
|
||
080 ;;; along with this program; if not, write to the Free Software
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
081 ;;; 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">
|
||
082 ;;;
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
083 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
</span><br/>
|
||
<span class="blank" title="0 out of 0 forms covered">
|
||
084
|
||
</span><br/>
|
||
<span class="covered" title="2 out of 2 forms covered">
|
||
085 (declare generate)
|
||
</span><br/>
|
||
<span class="blank" title="0 out of 0 forms covered">
|
||
086
|
||
</span><br/>
|
||
<span class="covered" title="1 out of 1 forms covered">
|
||
087 (defn gen-cond-clause
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
088 "Generate a cond clause from this simplified parse tree fragment `p`;
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
089 returns `nil` if `p` does not represent a cond clause."
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
090 [p context]
|
||
</span><br/>
|
||
<span class="covered" title="2 out of 2 forms covered">
|
||
091 (when
|
||
</span><br/>
|
||
<span class="partial" title="11 out of 12 forms covered">
|
||
092 (and (coll? p) (= :cond-clause (first p)))
|
||
</span><br/>
|
||
<span class="covered" title="2 out of 2 forms covered">
|
||
093 (make-beowulf-list
|
||
</span><br/>
|
||
<span class="partial" title="12 out of 13 forms covered">
|
||
094 (list (if (= (nth p 1) [:quoted-expr [:atom "T"]])
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
095 'T
|
||
</span><br/>
|
||
<span class="covered" title="6 out of 6 forms covered">
|
||
096 (generate (nth p 1) context))
|
||
</span><br/>
|
||
<span class="covered" title="6 out of 6 forms covered">
|
||
097 (generate (nth p 2) context)))))
|
||
</span><br/>
|
||
<span class="blank" title="0 out of 0 forms covered">
|
||
098
|
||
</span><br/>
|
||
<span class="covered" title="1 out of 1 forms covered">
|
||
099 (defn gen-cond
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
100 "Generate a cond statement from this simplified parse tree fragment `p`;
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
101 returns `nil` if `p` does not represent a (MEXPR) cond statement."
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
102 [p context]
|
||
</span><br/>
|
||
<span class="covered" title="2 out of 2 forms covered">
|
||
103 (when
|
||
</span><br/>
|
||
<span class="partial" title="11 out of 12 forms covered">
|
||
104 (and (coll? p) (= :cond (first p)))
|
||
</span><br/>
|
||
<span class="covered" title="2 out of 2 forms covered">
|
||
105 (make-beowulf-list
|
||
</span><br/>
|
||
<span class="covered" title="3 out of 3 forms covered">
|
||
106 (cons
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
107 'COND
|
||
</span><br/>
|
||
<span class="covered" title="3 out of 3 forms covered">
|
||
108 (map
|
||
</span><br/>
|
||
<span class="partial" title="8 out of 9 forms covered">
|
||
109 #(generate % (if (= context :mexpr) :cond-mexpr context))
|
||
</span><br/>
|
||
<span class="covered" title="3 out of 3 forms covered">
|
||
110 (rest p))))))
|
||
</span><br/>
|
||
<span class="blank" title="0 out of 0 forms covered">
|
||
111
|
||
</span><br/>
|
||
<span class="covered" title="1 out of 1 forms covered">
|
||
112 (defn gen-fn-call
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
113 "Generate a function call from this simplified parse tree fragment `p`;
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
114 returns `nil` if `p` does not represent a (MEXPR) function call."
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
115 [p context]
|
||
</span><br/>
|
||
<span class="covered" title="2 out of 2 forms covered">
|
||
116 (when
|
||
</span><br/>
|
||
<span class="partial" title="21 out of 23 forms covered">
|
||
117 (and (coll? p) (= :fncall (first p)) (= :mvar (first (second p))))
|
||
</span><br/>
|
||
<span class="covered" title="2 out of 2 forms covered">
|
||
118 (make-cons-cell
|
||
</span><br/>
|
||
<span class="covered" title="6 out of 6 forms covered">
|
||
119 (generate (second p) context)
|
||
</span><br/>
|
||
<span class="covered" title="6 out of 6 forms covered">
|
||
120 (generate (nth p 2) context))))
|
||
</span><br/>
|
||
<span class="blank" title="0 out of 0 forms covered">
|
||
121
|
||
</span><br/>
|
||
<span class="blank" title="0 out of 0 forms covered">
|
||
122
|
||
</span><br/>
|
||
<span class="covered" title="1 out of 1 forms covered">
|
||
123 (defn gen-dot-terminated-list
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
124 "Generate a list, which may be dot-terminated, from this partial parse tree
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
125 'p'. Note that the function acts recursively and progressively decapitates
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
126 its argument, so that the argument will not always be a valid parse tree."
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
127 [p]
|
||
</span><br/>
|
||
<span class="covered" title="3 out of 3 forms covered">
|
||
128 (cond
|
||
</span><br/>
|
||
<span class="covered" title="3 out of 3 forms covered">
|
||
129 (empty? p)
|
||
</span><br/>
|
||
<span class="covered" title="1 out of 1 forms covered">
|
||
130 NIL
|
||
</span><br/>
|
||
<span class="partial" title="15 out of 16 forms covered">
|
||
131 (and (coll? (first p)) (= :dot-terminal (first (first p))))
|
||
</span><br/>
|
||
<span class="covered" title="4 out of 4 forms covered">
|
||
132 (let [dt (first p)]
|
||
</span><br/>
|
||
<span class="covered" title="2 out of 2 forms covered">
|
||
133 (make-cons-cell
|
||
</span><br/>
|
||
<span class="covered" title="5 out of 5 forms covered">
|
||
134 (generate (nth dt 1))
|
||
</span><br/>
|
||
<span class="covered" title="5 out of 5 forms covered">
|
||
135 (generate (nth dt 2))))
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
136 :else
|
||
</span><br/>
|
||
<span class="covered" title="2 out of 2 forms covered">
|
||
137 (make-cons-cell
|
||
</span><br/>
|
||
<span class="covered" title="5 out of 5 forms covered">
|
||
138 (generate (first p))
|
||
</span><br/>
|
||
<span class="covered" title="5 out of 5 forms covered">
|
||
139 (gen-dot-terminated-list (rest p)))))
|
||
</span><br/>
|
||
<span class="blank" title="0 out of 0 forms covered">
|
||
140
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
141 ;; null[x] = [x = NIL -> T; T -> F]
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
142 ;; [:defn
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
143 ;; [:mexpr [:fncall [:mvar "null"] [:bindings [:args [:mexpr [:mvar "x"]]]]]]
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
144 ;; "="
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
145 ;; [:mexpr [:cond
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
146 ;; [:cond-clause [:mexpr [:iexpr [:lhs [:mexpr [:mvar "x"]]] [:iop "="] [:rhs [:mexpr [:mconst "NIL"]]]]] [:mexpr [:mconst "T"]]]
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
147 ;; [:cond-clause [:mexpr [:mconst "T"]] [:mexpr [:mconst "F"]]]]]]
|
||
</span><br/>
|
||
<span class="blank" title="0 out of 0 forms covered">
|
||
148
|
||
</span><br/>
|
||
<span class="covered" title="1 out of 1 forms covered">
|
||
149 (defn generate-defn
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
150 [tree context]
|
||
</span><br/>
|
||
<span class="covered" title="6 out of 6 forms covered">
|
||
151 (if (= :mexpr (first tree))
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 6 forms covered">
|
||
152 (generate-defn (second tree) context)
|
||
</span><br/>
|
||
<span class="covered" title="2 out of 2 forms covered">
|
||
153 (make-beowulf-list
|
||
</span><br/>
|
||
<span class="covered" title="3 out of 3 forms covered">
|
||
154 (list 'PUT
|
||
</span><br/>
|
||
<span class="covered" title="13 out of 13 forms covered">
|
||
155 (list 'QUOTE (generate (-> tree second second second) context))
|
||
</span><br/>
|
||
<span class="covered" title="4 out of 4 forms covered">
|
||
156 (list 'QUOTE 'EXPR)
|
||
</span><br/>
|
||
<span class="covered" title="3 out of 3 forms covered">
|
||
157 (list 'QUOTE
|
||
</span><br/>
|
||
<span class="covered" title="3 out of 3 forms covered">
|
||
158 (cons 'LAMBDA
|
||
</span><br/>
|
||
<span class="covered" title="12 out of 12 forms covered">
|
||
159 (list (generate (nth (-> tree second second) 2) context)
|
||
</span><br/>
|
||
<span class="covered" title="6 out of 6 forms covered">
|
||
160 (generate (nth tree 3) context))))))))
|
||
</span><br/>
|
||
<span class="blank" title="0 out of 0 forms covered">
|
||
161
|
||
</span><br/>
|
||
<span class="covered" title="1 out of 1 forms covered">
|
||
162 (defn gen-iexpr
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
163 [tree context]
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 11 forms covered">
|
||
164 (let [bundle (reduce #(assoc %1 (first %2) %2)
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 1 forms covered">
|
||
165 {}
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 3 forms covered">
|
||
166 (rest tree))]
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 8 forms covered">
|
||
167 (list (generate (:iop bundle) context)
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 6 forms covered">
|
||
168 (generate (:lhs bundle) context)
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 6 forms covered">
|
||
169 (generate (:rhs bundle) context))))
|
||
</span><br/>
|
||
<span class="blank" title="0 out of 0 forms covered">
|
||
170
|
||
</span><br/>
|
||
<span class="covered" title="1 out of 1 forms covered">
|
||
171 (defn generate-set
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
172 "Actually not sure what the mexpr representation of set looks like"
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
173 [tree context]
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 7 forms covered">
|
||
174 (throw (ex-info "Not Yet Implemented" {:feature "generate-set"})))
|
||
</span><br/>
|
||
<span class="blank" title="0 out of 0 forms covered">
|
||
175
|
||
</span><br/>
|
||
<span class="covered" title="1 out of 1 forms covered">
|
||
176 (defn generate-assign
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
177 "Generate an assignment statement based on this `tree`. If the thing
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
178 being assigned to is a function signature, then we have to do something
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
179 different to if it's an atom."
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
180 [tree context]
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 13 forms covered">
|
||
181 (case (first (second tree))
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 4 forms covered">
|
||
182 :fncall (generate-defn tree context)
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 12 forms covered">
|
||
183 :mexpr (map #(generate % context) (rest (second tree)))
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 8 forms covered">
|
||
184 (:mvar :atom) (generate-set tree context)))
|
||
</span><br/>
|
||
<span class="blank" title="0 out of 0 forms covered">
|
||
185
|
||
</span><br/>
|
||
<span class="covered" title="1 out of 1 forms covered">
|
||
186 (defn strip-leading-zeros
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
187 "`read-string` interprets strings with leading zeros as octal; strip
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
188 any from this string `s`. If what's left is empty (i.e. there were
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
189 only zeros, return `\"0\"`."
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
190 ([s]
|
||
</span><br/>
|
||
<span class="covered" title="4 out of 4 forms covered">
|
||
191 (strip-leading-zeros s ""))
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
192 ([s prefix]
|
||
</span><br/>
|
||
<span class="partial" title="1 out of 2 forms covered">
|
||
193 (if
|
||
</span><br/>
|
||
<span class="covered" title="3 out of 3 forms covered">
|
||
194 (empty? s) "0"
|
||
</span><br/>
|
||
<span class="covered" title="5 out of 5 forms covered">
|
||
195 (case (first s)
|
||
</span><br/>
|
||
<span class="partial" title="12 out of 24 forms covered">
|
||
196 (\+ \-) (strip-leading-zeros (subs s 1) (str (first s) prefix))
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 7 forms covered">
|
||
197 "0" (strip-leading-zeros (subs s 1) prefix)
|
||
</span><br/>
|
||
<span class="covered" title="4 out of 4 forms covered">
|
||
198 (str prefix s)))))
|
||
</span><br/>
|
||
<span class="blank" title="0 out of 0 forms covered">
|
||
199
|
||
</span><br/>
|
||
<span class="covered" title="1 out of 1 forms covered">
|
||
200 (defn generate
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
201 "Generate lisp structure from this parse tree `p`. It is assumed that
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
202 `p` has been simplified."
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
203 ([p]
|
||
</span><br/>
|
||
<span class="covered" title="4 out of 4 forms covered">
|
||
204 (generate p :expr))
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
205 ([p context]
|
||
</span><br/>
|
||
<span class="covered" title="1 out of 1 forms covered">
|
||
206 (try
|
||
</span><br/>
|
||
<span class="covered" title="2 out of 2 forms covered">
|
||
207 (expand-macros
|
||
</span><br/>
|
||
<span class="covered" title="1 out of 1 forms covered">
|
||
208 (if
|
||
</span><br/>
|
||
<span class="covered" title="3 out of 3 forms covered">
|
||
209 (coll? p)
|
||
</span><br/>
|
||
<span class="covered" title="6 out of 6 forms covered">
|
||
210 (case (first p)
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
211 :λ "LAMBDA"
|
||
</span><br/>
|
||
<span class="covered" title="2 out of 2 forms covered">
|
||
212 :λexpr (make-cons-cell
|
||
</span><br/>
|
||
<span class="covered" title="6 out of 6 forms covered">
|
||
213 (generate (nth p 1) context)
|
||
</span><br/>
|
||
<span class="covered" title="8 out of 8 forms covered">
|
||
214 (make-cons-cell (generate (nth p 2) context)
|
||
</span><br/>
|
||
<span class="covered" title="6 out of 6 forms covered">
|
||
215 (generate (nth p 3) context)))
|
||
</span><br/>
|
||
<span class="covered" title="12 out of 12 forms covered">
|
||
216 :args (make-beowulf-list (map #(generate % context) (rest p)))
|
||
</span><br/>
|
||
<span class="covered" title="5 out of 5 forms covered">
|
||
217 :atom (symbol (second p))
|
||
</span><br/>
|
||
<span class="covered" title="6 out of 6 forms covered">
|
||
218 :bindings (generate (second p) context)
|
||
</span><br/>
|
||
<span class="covered" title="12 out of 12 forms covered">
|
||
219 :body (make-beowulf-list (map #(generate % context) (rest p)))
|
||
</span><br/>
|
||
<span class="covered" title="12 out of 12 forms covered">
|
||
220 (:coefficient :exponent) (generate (second p) context)
|
||
</span><br/>
|
||
<span class="partial" title="8 out of 9 forms covered">
|
||
221 :cond (gen-cond p (if (= context :mexpr) :cond-mexpr context))
|
||
</span><br/>
|
||
<span class="covered" title="4 out of 4 forms covered">
|
||
222 :cond-clause (gen-cond-clause p context)
|
||
</span><br/>
|
||
<span class="covered" title="11 out of 11 forms covered">
|
||
223 :decimal (read-string (apply str (map second (rest p))))
|
||
</span><br/>
|
||
<span class="covered" title="4 out of 4 forms covered">
|
||
224 :defn (generate-defn p context)
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 2 forms covered">
|
||
225 :dotted-pair (make-cons-cell
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 6 forms covered">
|
||
226 (generate (nth p 1) context)
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 6 forms covered">
|
||
227 (generate (nth p 2) context))
|
||
</span><br/>
|
||
<span class="covered" title="4 out of 4 forms covered">
|
||
228 :fncall (gen-fn-call p context)
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 4 forms covered">
|
||
229 :iexpr (gen-iexpr p context)
|
||
</span><br/>
|
||
<span class="covered" title="7 out of 7 forms covered">
|
||
230 :integer (read-string (strip-leading-zeros (second p)))
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 11 forms covered">
|
||
231 :iop (case (second p)
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
232 "/" 'DIFFERENCE
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
233 "=" 'EQUAL
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
234 ">" 'GREATERP
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
235 "<" 'LESSP
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
236 "+" 'PLUS
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
237 "*" 'TIMES
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
238 ;; else
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 4 forms covered">
|
||
239 (throw (ex-info "Unrecognised infix operator symbol"
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 4 forms covered">
|
||
240 {:phase :generate
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 1 forms covered">
|
||
241 :fragment p})))
|
||
</span><br/>
|
||
<span class="covered" title="5 out of 5 forms covered">
|
||
242 :list (gen-dot-terminated-list (rest p))
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 12 forms covered">
|
||
243 (:lhs :rhs) (generate (second p) context)
|
||
</span><br/>
|
||
<span class="covered" title="11 out of 11 forms covered">
|
||
244 :mexpr (generate (second p) (if (= context :cond-mexpr) context :mexpr))
|
||
</span><br/>
|
||
<span class="covered" title="4 out of 4 forms covered">
|
||
245 :mconst (if (= context :cond-mexpr)
|
||
</span><br/>
|
||
<span class="covered" title="5 out of 5 forms covered">
|
||
246 (case (second p)
|
||
</span><br/>
|
||
<span class="partial" title="5 out of 15 forms covered">
|
||
247 ("T" "F" "NIL") (symbol (second p))
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
248 ;; else
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 8 forms covered">
|
||
249 (list 'QUOTE (symbol (second p))))
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
250 ;; else
|
||
</span><br/>
|
||
<span class="covered" title="8 out of 8 forms covered">
|
||
251 (list 'QUOTE (symbol (second p))))
|
||
</span><br/>
|
||
<span class="covered" title="7 out of 7 forms covered">
|
||
252 :mvar (symbol (upper-case (second p)))
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 6 forms covered">
|
||
253 :number (generate (second p) context)
|
||
</span><br/>
|
||
<span class="covered" title="9 out of 9 forms covered">
|
||
254 :octal (let [n (read-string (strip-leading-zeros (second p) "0"))
|
||
</span><br/>
|
||
<span class="covered" title="6 out of 6 forms covered">
|
||
255 scale (generate (nth p 3) context)]
|
||
</span><br/>
|
||
<span class="covered" title="6 out of 6 forms covered">
|
||
256 (* n (expt 8 scale)))
|
||
</span><br/>
|
||
<span class="blank" title="0 out of 0 forms covered">
|
||
257
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
258 ;; the quote read macro (which probably didn't exist in Lisp 1.5, but...)
|
||
</span><br/>
|
||
<span class="covered" title="11 out of 11 forms covered">
|
||
259 :quoted-expr (make-beowulf-list (list 'QUOTE (generate (second p) context)))
|
||
</span><br/>
|
||
<span class="covered" title="2 out of 2 forms covered">
|
||
260 :scale-factor (if
|
||
</span><br/>
|
||
<span class="covered" title="5 out of 5 forms covered">
|
||
261 (empty? (second p)) 0
|
||
</span><br/>
|
||
<span class="covered" title="7 out of 7 forms covered">
|
||
262 (read-string (strip-leading-zeros (second p))))
|
||
</span><br/>
|
||
<span class="covered" title="7 out of 7 forms covered">
|
||
263 :scientific (let [n (generate (second p) context)
|
||
</span><br/>
|
||
<span class="covered" title="6 out of 6 forms covered">
|
||
264 exponent (generate (nth p 3) context)]
|
||
</span><br/>
|
||
<span class="covered" title="6 out of 6 forms covered">
|
||
265 (* n (expt 10 exponent)))
|
||
</span><br/>
|
||
<span class="covered" title="6 out of 6 forms covered">
|
||
266 :sexpr (generate (second p) :sexpr)
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 5 forms covered">
|
||
267 :subr (symbol (second p))
|
||
</span><br/>
|
||
<span class="blank" title="0 out of 0 forms covered">
|
||
268
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
269 ;; default
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 9 forms covered">
|
||
270 (throw (ex-info (str "Unrecognised head: " (first p))
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 3 forms covered">
|
||
271 {:generating p})))
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 1 forms covered">
|
||
272 p))
|
||
</span><br/>
|
||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||
273 (catch Throwable any
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 4 forms covered">
|
||
274 (throw (ex-info "Could not generate"
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 3 forms covered">
|
||
275 {:generating p}
|
||
</span><br/>
|
||
<span class="not-covered" title="0 out of 1 forms covered">
|
||
276 any))))))
|
||
</span><br/>
|
||
</body>
|
||
</html>
|