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