(ns ^{:doc "Generate Clojure source from simplified parse trees." :author "Simon Brooke"} mw-parser.generate (:require [mw-parser.errors :as pe] [mw-parser.utils :refer [assert-type search-tree TODO]])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; 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) (vary-meta (list 'fn ['cell 'world] (list 'when (generate (nth tree 2)) (generate (nth tree 3)))) merge {:rule-type :production})) (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 expression (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-disjunct-expression [tree] (assert-type tree :DISJUNCT-EXPRESSION) (try (set (map generate (rest tree))) (catch Exception x (throw (ex-info "Failed to compile :DISJUNCT-EXPRESSION" {:tree tree} x))))) ;;; 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)) (defn flow-rule "Generate a flow rule for this `quantity` of this `property` from this `source` to this `destination`." [source property quantity-frag destinations] (vary-meta (list 'fn ['cell 'world] (list 'when (list 'and source (list 'pos? (list 'cell property))) (list 'map (list 'fn ['d] {:source (list 'select-keys 'cell [:x :y]) :destination (list 'select-keys 'd [:x :y]) :property property :quantity quantity-frag}) destinations))) merge {:rule-type :flow})) (defn generate-quantity-accessor "Generate a code fragment which will generate the appropriate quantity of the `property` specified in a rule, from this `q-clause`." [q-clause property] (case (first q-clause) ;; TODO :EXPRESSION still needed :NUMBER (generate q-clause) :PERCENTAGE (let [multiplier (/ (generate (second q-clause)) 100)] (list '* multiplier (list property 'cell))) :SIMPLE-EXPRESSION (if (= (count q-clause) 2) (generate-quantity-accessor (second q-clause) property) (throw (ex-info (format "Cannot yet handle q-clause of form: `%s`" q-clause) {:clause q-clause :property property}))) :SOME (list 'rand (list property 'cell)) (throw (ex-info (format "Unexpected QUANTITY type: `%s`" (first q-clause)) {:clause q-clause :property property})))) (defn generate-target-state-filter [clause targets-frag] (assert-type clause :DESTINATION) (list 'filter (list 'fn ['cell] (generate-property-condition (search-tree (search-tree clause :TARGET) :PROPERTY-CONDITION))) targets-frag)) (defn generate-dest-accessor [clause] (let [dc (search-tree clause :DETERMINER-CONDITION) range (search-tree clause :RANGE) distance (if range (generate (nth range 2)) 1)] (list 'let ['candidates (generate-target-state-filter clause (list 'mw-engine.utils/get-neighbours 'world 'cell distance))] (if dc (list 'list (let [determiner (first (second (search-tree dc :DETERMINER))) prop (generate (nth dc 2))] (case determiner :LEAST (list 'mw-engine.utils/get-least-cell 'candidates prop) :MOST (list 'mw-engine.utils/get-most-cell 'candidates prop)))) 'candidates)))) (defn generate-flow [tree] (assert-type tree :FLOW-RULE) (let [clauses (reduce #(assoc %1 (first %2) %2) {} (rest tree)) source-accessor (generate (:SOURCE clauses)) property (generate (:SYMBOL clauses)) quantity (generate-quantity-accessor (second (:QUANTITY clauses)) property) dest-accessor (generate-dest-accessor (:DESTINATION clauses))] (flow-rule source-accessor property quantity dest-accessor))) ;;; Top level; only function anything outside this file (except tests) should ;;; really call. (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-disjunct-expression tree) :DISJUNCT-VALUE (generate-disjunct-value tree) :EQUIVALENCE '= :EXPRESSION (generate (second tree)) :FLOW-RULE (generate-flow 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) :QUANTITY (generate (second tree)) :RULE (generate-rule tree) :SIMPLE-ACTION (generate-simple-action tree) :SOURCE (generate (second tree)) :SYMBOL (keyword (second tree)) :VALUE (generate (second tree)) :WITHIN-CONDITION (generate-within-condition tree) (map generate tree)) tree))