001 (ns ^{:doc "Generate Clojure source from simplified parse trees."
002 :author "Simon Brooke"}
003 mw-parser.generate
004 (:require [clojure.pprint :refer [pprint]]
005 [clojure.tools.trace :refer [deftrace]]
006 [mw-parser.utils :refer [assert-type TODO]]
007 [mw-parser.errors :as pe]))
008
009 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
010 ;;
011 ;; This program is free software; you can redistribute it and/or
012 ;; modify it under the terms of the GNU General Public License
013 ;; as published by the Free Software Foundation; either version 2
014 ;; of the License, or (at your option) any later version.
015 ;;
016 ;; This program is distributed in the hope that it will be useful,
017 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
018 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
019 ;; GNU General Public License for more details.
020 ;;
021 ;; You should have received a copy of the GNU General Public License
022 ;; along with this program; if not, write to the Free Software
023 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
024 ;; USA.
025 ;;
026 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
027
028 (declare generate generate-action)
029
030 (defn generate-rule
031 "From this `tree`, assumed to be a syntactically correct rule specification,
032 generate and return the appropriate rule as a function of two arguments."
033 [tree]
034 (assert-type tree :RULE)
035 (vary-meta
036 (list 'fn ['cell 'world] (list 'when (generate (nth tree 2)) (generate (nth tree 3))))
037 merge
038 {:rule-type
039 :production}))
040
041 (defn generate-conditions
042 "From this `tree`, assumed to be a syntactically correct conditions clause,
043 generate and return the appropriate clojure fragment."
044 [tree]
045 (assert-type tree :CONDITIONS)
046 (generate (second tree)))
047
048 (defn generate-condition
049 "From this `tree`, assumed to be a syntactically correct condition clause,
050 generate and return the appropriate clojure fragment."
051 [tree]
052 (assert-type tree :CONDITION)
053 (generate (second tree)))
054
055 (defn generate-conjunct-condition
056 "From this `tree`, assumed to be a syntactically conjunct correct condition clause,
057 generate and return the appropriate clojure fragment."
058 [tree]
059 (assert-type tree :CONJUNCT-CONDITION)
060 (cons 'and (map generate (rest tree))))
061
062 (defn generate-disjunct-condition
063 "From this `tree`, assumed to be a syntactically correct disjunct condition clause,
064 generate and return the appropriate clojure fragment."
065 [tree]
066 (assert-type tree :DISJUNCT-CONDITION)
067 (cons 'or (map generate (rest tree))))
068
069 (defn generate-ranged-property-condition
070 "From this `tree`, assumed to be a syntactically property condition clause for
071 this `property` where the `expression` is a numeric range, generate and return
072 the appropriate clojure fragment."
073 [tree property expression]
074 (assert-type tree :PROPERTY-CONDITION)
075 (assert-type (nth tree 3) :RANGE-EXPRESSION)
076 (let [l1 (generate (nth expression 2))
077 l2 (generate (nth expression 4))
078 pv (list property 'cell)]
079 (list 'let ['lower (list 'min l1 l2)
080 'upper (list 'max l1 l2)]
081 (list 'and (list '>= pv 'lower) (list '<= pv 'upper)))))
082
083 (defn generate-disjunct-property-condition
084 "From this `tree`, assumed to be a syntactically property condition clause
085 where the expression is a a disjunction, generate and return
086 the appropriate clojure fragment.
087 TODO: this is definitely still wrong!"
088 ([tree]
089 (let [property (generate (second tree))
090 qualifier (generate (nth tree 2))
091 expression (generate (nth tree 3))]
092 (generate-disjunct-property-condition tree property qualifier expression)))
093 ([_tree property qualifier expression]
094 (let [e (list expression (list property 'cell))]
095 (if (= qualifier '=) e
096 (list 'not e)))))
097
098 (defn generate-property-condition
099 "From this `tree`, assumed to be a syntactically property condition clause,
100 generate and return the appropriate clojure fragment."
101 ([tree]
102 (assert-type tree :PROPERTY-CONDITION)
103 (if
104 (and (= (count tree) 2) (= (first (second tree)) :SYMBOL))
105 ;; it's a shorthand for 'state equal to symbol'. This should probably have
106 ;; been handled in simplify...
107 (generate-property-condition
108 (list
109 :PROPERTY-CONDITION
110 '(:SYMBOL "state")
111 '(:QUALIFIER (:EQUIVALENCE (:EQUAL "equal to")))
112 (second tree)))
113 ;; otherwise...
114 (generate-property-condition tree (first (nth tree 3)))))
115 ([tree expression-type]
116 (assert-type tree :PROPERTY-CONDITION)
117 (let [property (generate (second tree))
118 qualifier (generate (nth tree 2))
119 e (generate (nth tree 3))
120 expression (cond
121 (and (not (= qualifier '=)) (keyword? e)) (list 'or (list e 'cell) e)
122 (and (not (= qualifier 'not=)) (keyword? e)) (list 'or (list e 'cell) e)
123 :else e)]
124 (case expression-type
125 :DISJUNCT-EXPRESSION (generate-disjunct-property-condition tree property qualifier expression)
126 :RANGE-EXPRESSION (generate-ranged-property-condition tree property expression)
127 (list qualifier (list property 'cell) expression)))))
128
129 (defn generate-qualifier
130 "From this `tree`, assumed to be a syntactically correct qualifier,
131 generate and return the appropriate clojure fragment."
132 [tree]
133 (if
134 (= (count tree) 2)
135 (generate (second tree))
136 ;; else
137 (generate (nth tree 2))))
138
139 (defn generate-simple-action
140 "From this `tree`, assumed to be a syntactically correct simple action,
141 generate and return the appropriate clojure fragment."
142 ([tree]
143 (assert-type tree :SIMPLE-ACTION)
144 (generate-simple-action tree []))
145 ([tree others]
146 (assert-type tree :SIMPLE-ACTION)
147 (let [property (generate (second tree))
148 expression (generate (nth tree 3))]
149 (if (or (= property :x) (= property :y))
150 (throw (Exception. pe/reserved-properties-error))
151 (list 'merge
152 (if (empty? others) 'cell
153 ;; else
154 (generate others))
155 {property expression})))))
156
157 (defn generate-probable-action
158 "From this `tree`, assumed to be a syntactically correct probable action,
159 generate and return the appropriate clojure fragment."
160 ([tree]
161 (assert-type tree :PROBABLE-ACTION)
162 (generate-probable-action tree []))
163 ([tree others]
164 (assert-type tree :PROBABLE-ACTION)
165 (let
166 [chances (generate (nth tree 1))
167 total (generate (nth tree 2))
168 action (generate-action (nth tree 3) others)]
169 ;; TODO: could almost certainly be done better with macro syntax
170 (list 'if
171 (list '< (list 'rand total) chances)
172 action))))
173
174 (defn generate-action
175 "From this `tree`, assumed to be a syntactically correct action,
176 generate and return the appropriate clojure fragment."
177 [tree others]
178 (case (first tree)
179 :ACTIONS (generate-action (first tree) others)
180 :SIMPLE-ACTION (generate-simple-action tree others)
181 :PROBABLE-ACTION (generate-probable-action tree others)
182 (throw (Exception. (str "Not a known action type: " (first tree))))))
183
184 (defn generate-multiple-actions
185 "From this `tree`, assumed to be one or more syntactically correct actions,
186 generate and return the appropriate clojure fragment."
187 [tree]
188 (assert-type tree :ACTIONS)
189 (generate-action (first (rest tree)) (second (rest tree))))
190
191 (defn generate-disjunct-value
192 "Generate a disjunct value. Essentially what we need here is to generate a
193 flat list of values, since the `member` has already been taken care of."
194 [tree]
195 (assert-type tree :DISJUNCT-VALUE)
196 (if (= (count tree) 4)
197 (cons (generate (second tree)) (generate (nth tree 3)))
198 (list (generate (second tree)))))
199
200 (defn generate-numeric-expression
201 "From this `tree`, assumed to be a syntactically correct numeric expression,
202 generate and return the appropriate clojure fragment."
203 [tree]
204 (assert-type tree :NUMERIC-EXPRESSION)
205 (case (count tree)
206 4 (let [[p operator expression] (rest tree)
207 property (if (number? p) p (list p 'cell))]
208 (list (generate operator) (generate property) (generate expression)))
209 (case (first (second tree))
210 :SYMBOL (list (keyword (second (second tree))) 'cell)
211 (generate (second tree)))))
212
213 (defn generate-neighbours-condition
214 "Generate code for a condition which refers to neighbours."
215 ([tree]
216 (assert-type tree :NEIGHBOURS-CONDITION)
217 (case (first (second tree))
218 :NUMBER (read-string (second (second tree)))
219 :QUANTIFIER (generate-neighbours-condition tree (first (second (second tree))))
220 :QUALIFIER (cons (generate (second tree)) (rest (generate (nth tree 2))))))
221 ([tree quantifier-type]
222 (let [quantifier (second tree)
223 pc (generate (nth tree 4))]
224 (case quantifier-type
225 :NUMBER (generate-neighbours-condition '= (read-string (second (second quantifier))) pc 1)
226 :SOME (generate-neighbours-condition '> 0 pc 1)
227 :MORE (let [value (generate (nth quantifier 3))]
228 (generate-neighbours-condition '> value pc 1))
229 :LESS (let [value (generate (nth quantifier 3))]
230 (generate-neighbours-condition '< value pc 1)))))
231 ([comp1 quantity property-condition distance]
232 (list comp1
233 (list 'count
234 (list 'remove 'false?
235 (list 'map (list 'fn ['cell] property-condition)
236 (list 'mw-engine.utils/get-neighbours 'world 'cell distance)))) quantity))
237 ([comp1 quantity property-condition]
238 (generate-neighbours-condition comp1 quantity property-condition 1)))
239
240 (defn generate-within-condition
241 "Generate code for a condition which refers to neighbours within a specified distance.
242 NOTE THAT there's clearly masses of commonality between this and
243 `generate-neighbours-condition`, and that some refactoring is almost certainly
244 desirable. It may be that it's better to simplify a `NEIGHBOURS-CONDITION`
245 into a `WITHIN-CONDITION` in the simplification stage."
246 ([tree]
247 (assert-type tree :WITHIN-CONDITION)
248 (case (first (second tree))
249 :QUANTIFIER (generate-within-condition tree (first (second (second tree))))
250 :QUALIFIER (TODO "qualified within... help!")))
251 ([tree quantifier-type]
252 (let [quantifier (second tree)
253 distance (generate (nth tree 4))
254 pc (generate (nth tree 6))]
255 (case quantifier-type
256 :NUMBER (generate-neighbours-condition '= (read-string (second (second quantifier))) pc distance)
257 :SOME (generate-neighbours-condition '> 0 pc distance)
258 :MORE (let [value (generate (nth quantifier 3))]
259 (generate-neighbours-condition '> value pc distance))
260 :LESS (let [value (generate (nth quantifier 3))]
261 (generate-neighbours-condition '< value pc distance))))))
262
263 (defn- generate-disjunct-expression
264 [tree]
265 (assert-type tree :DISJUNCT-EXPRESSION)
266 (try
267 (set (map generate (rest tree)))
268 (catch Exception x
269 (throw
270 (ex-info
271 "Failed to compile :DISJUNCT-EXPRESSION"
272 {:tree tree}
273 x)))))
274
275 ;;; Flow rules. A flow rule DOES NOT return a modified world; instead, it
276 ;;; returns a PLAN to modify the world, in the form of a sequence of `flows`.
277 ;;; It is only when the plan is executed that the world is modified.
278 ;;;
279 ;;; so we're looking at something like
280 ;;; (fn [cell world])
281 ;;; (if (= (:state cell) (or (:house cell) :house))
282
283 (defn generate-flow
284 [tree]
285 (assert-type tree :FLOW-RULE))
286
287 ;;; Top level; only function anything outside this file (except tests) should
288 ;;; really call.
289
290 (defn generate
291 "Generate code for this (fragment of a) parse tree"
292 [tree]
293 (if
294 (coll? tree)
295 (case (first tree)
296 :ACTIONS (generate-multiple-actions tree)
297 :COMPARATIVE (generate (second tree))
298 :COMPARATIVE-QUALIFIER (generate (second tree))
299 :CONDITION (generate-condition tree)
300 :CONDITIONS (generate-conditions tree)
301 :CONJUNCT-CONDITION (generate-conjunct-condition tree)
302 :DISJUNCT-CONDITION (generate-disjunct-condition tree)
303 :DISJUNCT-EXPRESSION (generate-disjunct-expression tree)
304 :DISJUNCT-VALUE (generate-disjunct-value tree)
305 :EQUIVALENCE '=
306 :EXPRESSION (generate (second tree))
307 :FLOW-RULE (generate-flow tree)
308 :LESS '<
309 :MORE '>
310 :NEGATED-QUALIFIER (case (generate (second tree))
311 = 'not=
312 > '<
313 < '>)
314 :NEIGHBOURS-CONDITION (generate-neighbours-condition tree)
315 :NUMERIC-EXPRESSION (generate-numeric-expression tree)
316 :NUMBER (read-string (second tree))
317 :OPERATOR (symbol (second tree))
318 :PROBABLE-ACTION (generate-probable-action tree)
319 :PROPERTY (list (generate (second tree)) 'cell) ;; dubious - may not be right
320 :PROPERTY-CONDITION (generate-property-condition tree)
321 :QUALIFIER (generate-qualifier tree)
322 :RULE (generate-rule tree)
323 :SIMPLE-ACTION (generate-simple-action tree)
324 :SYMBOL (keyword (second tree))
325 :VALUE (generate (second tree))
326 :WITHIN-CONDITION (generate-within-condition tree)
327 (map generate tree))
328 tree))