324 lines
12 KiB
Clojure
324 lines
12 KiB
Clojure
(ns ^{:doc "Generate Clojure source from simplified parse trees."
|
|
:author "Simon Brooke"}
|
|
mw-parser.generate
|
|
(:require [mw-engine.utils :refer []]
|
|
[mw-parser.utils :refer [assert-type TODO]]
|
|
[mw-parser.errors :as pe]))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;
|
|
;; This program is free software; you can redistribute it and/or
|
|
;; modify it under the terms of the GNU General Public License
|
|
;; as published by the Free Software Foundation; either version 2
|
|
;; of the License, or (at your option) any later version.
|
|
;;
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
;;
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program; if not, write to the Free Software
|
|
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
|
|
;; USA.
|
|
;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
(declare generate generate-action)
|
|
|
|
|
|
(defn generate-rule
|
|
"From this `tree`, assumed to be a syntactically correct rule specification,
|
|
generate and return the appropriate rule as a function of two arguments."
|
|
[tree]
|
|
(assert-type tree :RULE)
|
|
(list 'fn ['cell 'world] (list 'if (generate (nth tree 2)) (generate (nth tree 3)))))
|
|
|
|
|
|
(defn generate-conditions
|
|
"From this `tree`, assumed to be a syntactically correct conditions clause,
|
|
generate and return the appropriate clojure fragment."
|
|
[tree]
|
|
(assert-type tree :CONDITIONS)
|
|
(generate (second tree)))
|
|
|
|
|
|
(defn generate-condition
|
|
"From this `tree`, assumed to be a syntactically correct condition clause,
|
|
generate and return the appropriate clojure fragment."
|
|
[tree]
|
|
(assert-type tree :CONDITION)
|
|
(generate (second tree)))
|
|
|
|
|
|
(defn generate-conjunct-condition
|
|
"From this `tree`, assumed to be a syntactically conjunct correct condition clause,
|
|
generate and return the appropriate clojure fragment."
|
|
[tree]
|
|
(assert-type tree :CONJUNCT-CONDITION)
|
|
(cons 'and (map generate (rest tree))))
|
|
|
|
|
|
(defn generate-disjunct-condition
|
|
"From this `tree`, assumed to be a syntactically correct disjunct condition clause,
|
|
generate and return the appropriate clojure fragment."
|
|
[tree]
|
|
(assert-type tree :DISJUNCT-CONDITION)
|
|
(cons 'or (map generate (rest tree))))
|
|
|
|
|
|
(defn generate-ranged-property-condition
|
|
"From this `tree`, assumed to be a syntactically property condition clause for
|
|
this `property` where the `expression` is a numeric range, generate and return
|
|
the appropriate clojure fragment."
|
|
[tree property expression]
|
|
(assert-type tree :PROPERTY-CONDITION)
|
|
(assert-type (nth tree 3) :RANGE-EXPRESSION)
|
|
(let [l1 (generate (nth expression 2))
|
|
l2 (generate (nth expression 4))
|
|
pv (list property 'cell)]
|
|
(list 'let ['lower (list 'min l1 l2)
|
|
'upper (list 'max l1 l2)]
|
|
(list 'and (list '>= pv 'lower)(list '<= pv 'upper)))))
|
|
|
|
|
|
(defn generate-disjunct-property-condition
|
|
"From this `tree`, assumed to be a syntactically property condition clause
|
|
where the expression is a a disjunction, generate and return
|
|
the appropriate clojure fragment.
|
|
TODO: this is definitely still wrong!"
|
|
([tree]
|
|
(let [property (generate (second tree))
|
|
qualifier (generate (nth tree 2))
|
|
expression (generate (nth tree 3))]
|
|
(generate-disjunct-property-condition tree property qualifier expression)))
|
|
([_tree property qualifier expression]
|
|
(let [e (list 'some (list 'fn ['i] '(= i value)) (list 'quote expression))]
|
|
(list 'let ['value (list property 'cell)]
|
|
(if (= qualifier '=) e
|
|
(list 'not e))))))
|
|
|
|
|
|
(defn generate-property-condition
|
|
"From this `tree`, assumed to be a syntactically property condition clause,
|
|
generate and return the appropriate clojure fragment."
|
|
([tree]
|
|
(assert-type tree :PROPERTY-CONDITION)
|
|
(if
|
|
(and (= (count tree) 2) (= (first (second tree)) :SYMBOL))
|
|
;; it's a shorthand for 'state equal to symbol'. This should probably have
|
|
;; been handled in simplify...
|
|
(generate-property-condition
|
|
(list
|
|
:PROPERTY-CONDITION
|
|
'(:SYMBOL "state")
|
|
'(:QUALIFIER (:EQUIVALENCE (:EQUAL "equal to")))
|
|
(second tree)))
|
|
;; otherwise...
|
|
(generate-property-condition tree (first (nth tree 3)))))
|
|
([tree expression-type]
|
|
(assert-type tree :PROPERTY-CONDITION)
|
|
(let [property (generate (second tree))
|
|
qualifier (generate (nth tree 2))
|
|
e (generate (nth tree 3))
|
|
expression (cond
|
|
(and (not (= qualifier '=)) (keyword? e)) (list 'or (list e 'cell) e)
|
|
(and (not (= qualifier 'not=)) (keyword? e)) (list 'or (list e 'cell) e)
|
|
:else e)]
|
|
(case expression-type
|
|
:DISJUNCT-EXPRESSION (generate-disjunct-property-condition tree property qualifier expression)
|
|
:RANGE-EXPRESSION (generate-ranged-property-condition tree property expression)
|
|
(list qualifier (list property 'cell) expression)))))
|
|
|
|
|
|
(defn generate-qualifier
|
|
"From this `tree`, assumed to be a syntactically correct qualifier,
|
|
generate and return the appropriate clojure fragment."
|
|
[tree]
|
|
(if
|
|
(= (count tree) 2)
|
|
(generate (second tree))
|
|
;; else
|
|
(generate (nth tree 2))))
|
|
|
|
|
|
(defn generate-simple-action
|
|
"From this `tree`, assumed to be a syntactically correct simple action,
|
|
generate and return the appropriate clojure fragment."
|
|
([tree]
|
|
(assert-type tree :SIMPLE-ACTION)
|
|
(generate-simple-action tree []))
|
|
([tree others]
|
|
(assert-type tree :SIMPLE-ACTION)
|
|
(let [property (generate (second tree))
|
|
expression (generate (nth tree 3))]
|
|
(if (or (= property :x) (= property :y))
|
|
(throw (Exception. pe/reserved-properties-error))
|
|
(list 'merge
|
|
(if (empty? others) 'cell
|
|
;; else
|
|
(generate others))
|
|
{property expression})))))
|
|
|
|
|
|
(defn generate-probable-action
|
|
"From this `tree`, assumed to be a syntactically correct probable action,
|
|
generate and return the appropriate clojure fragment."
|
|
([tree]
|
|
(assert-type tree :PROBABLE-ACTION)
|
|
(generate-probable-action tree []))
|
|
([tree others]
|
|
(assert-type tree :PROBABLE-ACTION)
|
|
(let
|
|
[chances (generate (nth tree 1))
|
|
total (generate (nth tree 2))
|
|
action (generate-action (nth tree 3) others)]
|
|
;; TODO: could almost certainly be done better with macro syntax
|
|
(list 'if
|
|
(list '< (list 'rand total) chances)
|
|
action))))
|
|
|
|
|
|
(defn generate-action
|
|
"From this `tree`, assumed to be a syntactically correct action,
|
|
generate and return the appropriate clojure fragment."
|
|
[tree others]
|
|
(case (first tree)
|
|
:ACTIONS (generate-action (first tree) others)
|
|
:SIMPLE-ACTION (generate-simple-action tree others)
|
|
:PROBABLE-ACTION (generate-probable-action tree others)
|
|
(throw (Exception. (str "Not a known action type: " (first tree))))))
|
|
|
|
|
|
(defn generate-multiple-actions
|
|
"From this `tree`, assumed to be one or more syntactically correct actions,
|
|
generate and return the appropriate clojure fragment."
|
|
[tree]
|
|
(assert-type tree :ACTIONS)
|
|
(generate-action (first (rest tree)) (second (rest tree))))
|
|
|
|
(defn generate-disjunct-value
|
|
"Generate a disjunct value. Essentially what we need here is to generate a
|
|
flat list of values, since the `member` has already been taken care of."
|
|
[tree]
|
|
(assert-type tree :DISJUNCT-VALUE)
|
|
(if (= (count tree) 4)
|
|
(cons (generate (second tree)) (generate (nth tree 3)))
|
|
(list (generate (second tree)))))
|
|
|
|
|
|
(defn generate-numeric-expression
|
|
"From this `tree`, assumed to be a syntactically correct numeric expression,
|
|
generate and return the appropriate clojure fragment."
|
|
[tree]
|
|
(assert-type tree :NUMERIC-EXPRESSION)
|
|
(case (count tree)
|
|
4 (let [[p operator expression] (rest tree)
|
|
property (if (number? p) p (list p 'cell))]
|
|
(list (generate operator) (generate property) (generate expression)))
|
|
(case (first (second tree))
|
|
:SYMBOL (list (keyword (second (second tree))) 'cell)
|
|
(generate (second tree)))))
|
|
|
|
|
|
(defn generate-neighbours-condition
|
|
"Generate code for a condition which refers to neighbours."
|
|
([tree]
|
|
(assert-type tree :NEIGHBOURS-CONDITION)
|
|
(case (first (second tree))
|
|
:NUMBER (read-string (second (second tree)))
|
|
:QUANTIFIER (generate-neighbours-condition tree (first (second (second tree))))
|
|
:QUALIFIER (cons (generate (second tree)) (rest (generate (nth tree 2))))))
|
|
([tree quantifier-type]
|
|
(let [quantifier (second tree)
|
|
pc (generate (nth tree 4))]
|
|
(case quantifier-type
|
|
:NUMBER (generate-neighbours-condition '= (read-string (second (second quantifier))) pc 1)
|
|
:SOME (generate-neighbours-condition '> 0 pc 1)
|
|
:MORE (let [value (generate (nth quantifier 3))]
|
|
(generate-neighbours-condition '> value pc 1))
|
|
:LESS (let [value (generate (nth quantifier 3))]
|
|
(generate-neighbours-condition '< value pc 1))
|
|
)))
|
|
([comp1 quantity property-condition distance]
|
|
(list comp1
|
|
(list 'count
|
|
(list 'remove 'false?
|
|
(list 'map (list 'fn ['cell] property-condition)
|
|
(list 'mw-engine.utils/get-neighbours 'world 'cell distance)))) quantity))
|
|
([comp1 quantity property-condition]
|
|
(generate-neighbours-condition comp1 quantity property-condition 1)))
|
|
|
|
|
|
(defn generate-within-condition
|
|
"Generate code for a condition which refers to neighbours within a specified distance.
|
|
NOTE THAT there's clearly masses of commonality between this and
|
|
`generate-neighbours-condition`, and that some refactoring is almost certainly
|
|
desirable. It may be that it's better to simplify a `NEIGHBOURS-CONDITION`
|
|
into a `WITHIN-CONDITION` in the simplification stage."
|
|
([tree]
|
|
(assert-type tree :WITHIN-CONDITION)
|
|
(case (first (second tree))
|
|
:QUANTIFIER (generate-within-condition tree (first (second (second tree))))
|
|
:QUALIFIER (TODO "qualified within... help!")))
|
|
([tree quantifier-type]
|
|
(let [quantifier (second tree)
|
|
distance (generate (nth tree 4))
|
|
pc (generate (nth tree 6))]
|
|
(case quantifier-type
|
|
:NUMBER (generate-neighbours-condition '= (read-string (second (second quantifier))) pc distance)
|
|
:SOME (generate-neighbours-condition '> 0 pc distance)
|
|
:MORE (let [value (generate (nth quantifier 3))]
|
|
(generate-neighbours-condition '> value pc distance))
|
|
:LESS (let [value (generate (nth quantifier 3))]
|
|
(generate-neighbours-condition '< value pc distance))
|
|
))))
|
|
|
|
|
|
(defn generate
|
|
"Generate code for this (fragment of a) parse tree"
|
|
[tree]
|
|
(if
|
|
(coll? tree)
|
|
(case (first tree)
|
|
:ACTIONS (generate-multiple-actions tree)
|
|
:COMPARATIVE (generate (second tree))
|
|
:COMPARATIVE-QUALIFIER (generate (second tree))
|
|
:CONDITION (generate-condition tree)
|
|
:CONDITIONS (generate-conditions tree)
|
|
:CONJUNCT-CONDITION (generate-conjunct-condition tree)
|
|
:DISJUNCT-CONDITION (generate-disjunct-condition tree)
|
|
:DISJUNCT-EXPRESSION (generate (nth tree 2))
|
|
:DISJUNCT-VALUE (generate-disjunct-value tree)
|
|
:EQUIVALENCE '=
|
|
:EXPRESSION (generate (second tree))
|
|
:LESS '<
|
|
:MORE '>
|
|
:NEGATED-QUALIFIER (case (generate (second tree))
|
|
= 'not=
|
|
> '<
|
|
< '>)
|
|
:NEIGHBOURS-CONDITION (generate-neighbours-condition tree)
|
|
:NUMERIC-EXPRESSION (generate-numeric-expression tree)
|
|
:NUMBER (read-string (second tree))
|
|
:OPERATOR (symbol (second tree))
|
|
:PROBABLE-ACTION (generate-probable-action tree)
|
|
:PROPERTY (list (generate (second tree)) 'cell) ;; dubious - may not be right
|
|
:PROPERTY-CONDITION (generate-property-condition tree)
|
|
:QUALIFIER (generate-qualifier tree)
|
|
:RULE (generate-rule tree)
|
|
:SIMPLE-ACTION (generate-simple-action tree)
|
|
:SYMBOL (keyword (second tree))
|
|
:VALUE (generate (second tree))
|
|
:WITHIN-CONDITION (generate-within-condition tree)
|
|
(map generate tree))
|
|
tree))
|
|
|
|
;;; Flow rules. A flow rule DOES NOT return a modified world; instead, it
|
|
;;; returns a PLAN to modify the world, in the form of a sequence of `flows`.
|
|
;;; It is only when the plan is executed that the world is modified.
|
|
;;;
|
|
;;; so we're looking at something like
|
|
;;; (fn [cell world])
|
|
;;; (if (= (:state cell) (or (:house cell) :house)) |