diff --git a/docs/cloverage/index.html b/docs/cloverage/index.html index 90cbc82..784925b 100644 --- a/docs/cloverage/index.html +++ b/docs/cloverage/index.html @@ -91,37 +91,37 @@ mw-parser.generate
732
187
-79.65 % + style="width:75.6989247311828%; + float:left;"> 704
226
+75.70 %
139
140
6
30
-82.86 % -31832175 + style="width:21.08108108108108%; + float:left;"> 39 +78.92 % +32824185 mw-parser.simplify
72
19
-79.12 % + style="width:85.81560283687944%; + float:left;"> 121
20
+85.82 %
19
1
32
2
5
-80.00 % -84725 +87.18 % +91639 mw-parser.utils
Totals: -89.47 % +88.29 % -92.25 % +90.99 % diff --git a/docs/cloverage/mw_parser/declarative.clj.html b/docs/cloverage/mw_parser/declarative.clj.html index 939e864..f8e95a9 100644 --- a/docs/cloverage/mw_parser/declarative.clj.html +++ b/docs/cloverage/mw_parser/declarative.clj.html @@ -26,7 +26,7 @@ 007              [mw-parser.generate :refer [generate]]
- 008              [mw-parser.simplify :refer [simplify-rule]] + 008              [mw-parser.simplify :refer [simplify]]
009              [mw-parser.utils :refer [rule?]] @@ -443,7 +443,7 @@ 146     (let [rule (trim rule-text)
- 147           tree (simplify-rule (parse-rule rule)) + 147           tree (simplify (parse-rule rule))
148           afn (if (rule? tree) (eval (generate tree)) diff --git a/docs/cloverage/mw_parser/generate.clj.html b/docs/cloverage/mw_parser/generate.clj.html index f901a2f..ee2d23d 100644 --- a/docs/cloverage/mw_parser/generate.clj.html +++ b/docs/cloverage/mw_parser/generate.clj.html @@ -14,79 +14,79 @@ 003   mw-parser.generate
- 004    (:require [mw-parser.utils :refer [assert-type TODO]] + 004    (:require [clojure.pprint :refer [pprint]]
- 005              [mw-parser.errors :as pe])) + 005              [clojure.tools.trace :refer [deftrace]] +
+ + 006              [mw-parser.utils :refer [assert-type TODO]] +
+ + 007              [mw-parser.errors :as pe]))
- 006   + 008  
- 007  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + 009  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- 008  ;; + 010  ;;
- 009  ;; This program is free software; you can redistribute it and/or + 011  ;; This program is free software; you can redistribute it and/or
- 010  ;; modify it under the terms of the GNU General Public License + 012  ;; modify it under the terms of the GNU General Public License
- 011  ;; as published by the Free Software Foundation; either version 2 + 013  ;; as published by the Free Software Foundation; either version 2
- 012  ;; of the License, or (at your option) any later version. + 014  ;; of the License, or (at your option) any later version.
- 013  ;; + 015  ;;
- 014  ;; This program is distributed in the hope that it will be useful, + 016  ;; This program is distributed in the hope that it will be useful,
- 015  ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + 017  ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
- 016  ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the + 018  ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- 017  ;; GNU General Public License for more details. + 019  ;; GNU General Public License for more details.
- 018  ;; + 020  ;;
- 019  ;; You should have received a copy of the GNU General Public License + 021  ;; You should have received a copy of the GNU General Public License
- 020  ;; along with this program; if not, write to the Free Software + 022  ;; along with this program; if not, write to the Free Software
- 021  ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, + 023  ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
- 022  ;; USA. + 024  ;; USA.
- 023  ;; + 025  ;;
- 024  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + 026  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- 025   -
- - 026   + 027  
- 027  (declare generate generate-action) -
- - 028   + 028  (declare generate generate-action)
029   @@ -106,83 +106,83 @@ 034    (assert-type tree :RULE)
+ + 035    (vary-meta +
- 035    (list 'fn ['cell 'world] (list 'if (generate (nth tree 2)) (generate (nth tree 3))))) -
- - 036   -
- - 037   + 036     (list 'fn ['cell 'world] (list 'when (generate (nth tree 2)) (generate (nth tree 3))))
- 038  (defn generate-conditions + 037     merge +
+ + 038     {:rule-type
- 039    "From this `tree`, assumed to be a syntactically correct conditions clause, + 039      :production})) +
+ + 040   +
+ + 041  (defn generate-conditions
- 040    generate and return the appropriate clojure fragment." + 042    "From this `tree`, assumed to be a syntactically correct conditions clause,
- 041    [tree] + 043    generate and return the appropriate clojure fragment." +
+ + 044    [tree]
- 042    (assert-type tree :CONDITIONS) + 045    (assert-type tree :CONDITIONS)
- 043    (generate (second tree))) + 046    (generate (second tree)))
- 044   -
- - 045   + 047  
- 046  (defn generate-condition + 048  (defn generate-condition
- 047    "From this `tree`, assumed to be a syntactically correct condition clause, + 049    "From this `tree`, assumed to be a syntactically correct condition clause,
- 048    generate and return the appropriate clojure fragment." + 050    generate and return the appropriate clojure fragment."
- 049    [tree] + 051    [tree]
- 050    (assert-type tree :CONDITION) + 052    (assert-type tree :CONDITION)
- 051    (generate (second tree))) + 053    (generate (second tree)))
- 052   -
- - 053   + 054  
- 054  (defn generate-conjunct-condition + 055  (defn generate-conjunct-condition
- 055    "From this `tree`, assumed to be a syntactically conjunct correct condition clause, + 056    "From this `tree`, assumed to be a syntactically conjunct correct condition clause,
- 056    generate and return the appropriate clojure fragment." + 057    generate and return the appropriate clojure fragment."
- 057    [tree] + 058    [tree]
- 058    (assert-type tree :CONJUNCT-CONDITION) + 059    (assert-type tree :CONJUNCT-CONDITION)
- 059    (cons 'and (map generate (rest tree)))) -
- - 060   + 060    (cons 'and (map generate (rest tree))))
061   @@ -208,755 +208,785 @@ 068  
- - 069   -
- 070  (defn generate-ranged-property-condition + 069  (defn generate-ranged-property-condition
- 071    "From this `tree`, assumed to be a syntactically property condition clause for + 070    "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 + 071    this `property` where the `expression` is a numeric range, generate and return
- 073    the appropriate clojure fragment." + 072    the appropriate clojure fragment."
- 074    [tree property expression] + 073    [tree property expression]
- 075    (assert-type tree :PROPERTY-CONDITION) + 074    (assert-type tree :PROPERTY-CONDITION)
- 076    (assert-type (nth tree 3) :RANGE-EXPRESSION) + 075    (assert-type (nth tree 3) :RANGE-EXPRESSION)
- 077    (let [l1 (generate (nth expression 2)) + 076    (let [l1 (generate (nth expression 2))
- 078          l2 (generate (nth expression 4)) + 077          l2 (generate (nth expression 4))
- 079          pv (list property 'cell)] + 078          pv (list property 'cell)]
- 080      (list 'let ['lower (list 'min l1 l2) + 079      (list 'let ['lower (list 'min l1 l2)
- 081                  'upper (list 'max l1 l2)] + 080                  'upper (list 'max l1 l2)]
- 082            (list 'and (list '>= pv 'lower) (list '<= pv 'upper))))) + 081            (list 'and (list '>= pv 'lower) (list '<= pv 'upper)))))
- 083   -
- - 084   + 082  
- 085  (defn generate-disjunct-property-condition + 083  (defn generate-disjunct-property-condition
- 086    "From this `tree`, assumed to be a syntactically property condition clause + 084    "From this `tree`, assumed to be a syntactically property condition clause
- 087    where the expression is a a disjunction, generate and return + 085    where the expression is a a disjunction, generate and return
- 088    the appropriate clojure fragment. + 086    the appropriate clojure fragment.
- 089    TODO: this is definitely still wrong!" + 087    TODO: this is definitely still wrong!"
- 090    ([tree] + 088    ([tree]
- 091     (let [property (generate (second tree)) + 089     (let [property (generate (second tree))
- 092           qualifier (generate (nth tree 2)) + 090           qualifier (generate (nth tree 2))
- 093           expression (generate (nth tree 3))] + 091           expression (generate (nth tree 3))]
- 094       (generate-disjunct-property-condition tree property qualifier expression))) + 092       (generate-disjunct-property-condition tree property qualifier expression)))
- 095    ([_tree property qualifier expression] + 093    ([_tree property qualifier expression]
- - 096     (let [e (list 'some (list 'fn ['i] '(= i value)) (list 'quote expression))] -
- - 097       (list 'let ['value (list property 'cell)] + + 094     (let [e (list expression (list property 'cell))]
- 098             (if (= qualifier '=) e + 095       (if (= qualifier '=) e
- 099                 (list 'not e)))))) + 096           (list 'not e)))))
- 100   -
- - 101   + 097  
- 102  (defn generate-property-condition + 098  (defn generate-property-condition
- 103    "From this `tree`, assumed to be a syntactically property condition clause, + 099    "From this `tree`, assumed to be a syntactically property condition clause,
- 104    generate and return the appropriate clojure fragment." + 100    generate and return the appropriate clojure fragment."
- 105    ([tree] + 101    ([tree]
- 106     (assert-type tree :PROPERTY-CONDITION) + 102     (assert-type tree :PROPERTY-CONDITION)
- 107     (if + 103     (if
- 108      (and (= (count tree) 2) (= (first (second tree)) :SYMBOL)) + 104      (and (= (count tree) 2) (= (first (second tree)) :SYMBOL))
- 109       ;; it's a shorthand for 'state equal to symbol'. This should probably have + 105       ;; it's a shorthand for 'state equal to symbol'. This should probably have
- 110       ;; been handled in simplify... + 106       ;; been handled in simplify...
- 111       (generate-property-condition + 107       (generate-property-condition
- 112        (list + 108        (list
- 113         :PROPERTY-CONDITION + 109         :PROPERTY-CONDITION
- 114         '(:SYMBOL "state") + 110         '(:SYMBOL "state")
- 115         '(:QUALIFIER (:EQUIVALENCE (:EQUAL "equal to"))) + 111         '(:QUALIFIER (:EQUIVALENCE (:EQUAL "equal to")))
- 116         (second tree))) + 112         (second tree)))
- 117       ;; otherwise... + 113       ;; otherwise...
- 118       (generate-property-condition tree (first (nth tree 3))))) + 114       (generate-property-condition tree (first (nth tree 3)))))
- 119    ([tree expression-type] + 115    ([tree expression-type]
- 120     (assert-type tree :PROPERTY-CONDITION) + 116     (assert-type tree :PROPERTY-CONDITION)
- 121     (let [property (generate (second tree)) + 117     (let [property (generate (second tree))
- 122           qualifier (generate (nth tree 2)) + 118           qualifier (generate (nth tree 2))
- 123           e (generate (nth tree 3)) + 119           e (generate (nth tree 3))
- 124           expression (cond + 120           expression (cond
- 125                        (and (not (= qualifier '=)) (keyword? e)) (list 'or (list e 'cell) e) + 121                        (and (not (= qualifier '=)) (keyword? e)) (list 'or (list e 'cell) e)
- 126                        (and (not (= qualifier 'not=)) (keyword? e)) (list 'or (list e 'cell) e) + 122                        (and (not (= qualifier 'not=)) (keyword? e)) (list 'or (list e 'cell) e)
- 127                        :else e)] + 123                        :else e)]
- 128       (case expression-type + 124       (case expression-type
- 129         :DISJUNCT-EXPRESSION (generate-disjunct-property-condition tree property qualifier expression) + 125         :DISJUNCT-EXPRESSION (generate-disjunct-property-condition tree property qualifier expression)
- 130         :RANGE-EXPRESSION (generate-ranged-property-condition tree property expression) + 126         :RANGE-EXPRESSION (generate-ranged-property-condition tree property expression)
- 131         (list qualifier (list property 'cell) expression))))) + 127         (list qualifier (list property 'cell) expression)))))
- 132   + 128  
- 133  (defn generate-qualifier + 129  (defn generate-qualifier
- 134    "From this `tree`, assumed to be a syntactically correct qualifier, + 130    "From this `tree`, assumed to be a syntactically correct qualifier,
- 135    generate and return the appropriate clojure fragment." + 131    generate and return the appropriate clojure fragment."
- 136    [tree] + 132    [tree]
- 137    (if + 133    (if
- 138     (= (count tree) 2) + 134     (= (count tree) 2)
- 139      (generate (second tree)) + 135      (generate (second tree))
- 140      ;; else + 136      ;; else
- 141      (generate (nth tree 2)))) + 137      (generate (nth tree 2))))
- 142   + 138  
- 143  (defn generate-simple-action + 139  (defn generate-simple-action
- 144    "From this `tree`, assumed to be a syntactically correct simple action, + 140    "From this `tree`, assumed to be a syntactically correct simple action,
- 145    generate and return the appropriate clojure fragment." + 141    generate and return the appropriate clojure fragment."
- 146    ([tree] + 142    ([tree]
- 147     (assert-type tree :SIMPLE-ACTION) + 143     (assert-type tree :SIMPLE-ACTION)
- 148     (generate-simple-action tree [])) + 144     (generate-simple-action tree []))
- 149    ([tree others] + 145    ([tree others]
- 150     (assert-type tree :SIMPLE-ACTION) + 146     (assert-type tree :SIMPLE-ACTION)
- 151     (let [property (generate (second tree)) + 147     (let [property (generate (second tree))
- 152           expression (generate (nth tree 3))] + 148           expression (generate (nth tree 3))]
- 153       (if (or (= property :x) (= property :y)) + 149       (if (or (= property :x) (= property :y))
- 154         (throw (Exception. pe/reserved-properties-error)) + 150         (throw (Exception. pe/reserved-properties-error))
- 155         (list 'merge + 151         (list 'merge
- 156               (if (empty? others) 'cell + 152               (if (empty? others) 'cell
- 157                 ;; else + 153                 ;; else
- 158                   (generate others)) + 154                   (generate others))
- 159               {property expression}))))) + 155               {property expression})))))
- 160   + 156  
- 161  (defn generate-probable-action + 157  (defn generate-probable-action
- 162    "From this `tree`, assumed to be a syntactically correct probable action, + 158    "From this `tree`, assumed to be a syntactically correct probable action,
- 163    generate and return the appropriate clojure fragment." + 159    generate and return the appropriate clojure fragment."
- 164    ([tree] + 160    ([tree]
- 165     (assert-type tree :PROBABLE-ACTION) + 161     (assert-type tree :PROBABLE-ACTION)
- 166     (generate-probable-action tree [])) + 162     (generate-probable-action tree []))
- 167    ([tree others] + 163    ([tree others]
- 168     (assert-type tree :PROBABLE-ACTION) + 164     (assert-type tree :PROBABLE-ACTION)
- 169     (let + 165     (let
- 170      [chances (generate (nth tree 1)) + 166      [chances (generate (nth tree 1))
- 171       total (generate (nth tree 2)) + 167       total (generate (nth tree 2))
- 172       action (generate-action (nth tree 3) others)] + 168       action (generate-action (nth tree 3) others)]
- 173      ;; TODO: could almost certainly be done better with macro syntax + 169      ;; TODO: could almost certainly be done better with macro syntax
- 174       (list 'if + 170       (list 'if
- 175             (list '< (list 'rand total) chances) + 171             (list '< (list 'rand total) chances)
- 176             action)))) + 172             action))))
- 177   + 173  
- 178  (defn generate-action + 174  (defn generate-action
- 179    "From this `tree`, assumed to be a syntactically correct action, + 175    "From this `tree`, assumed to be a syntactically correct action,
- 180    generate and return the appropriate clojure fragment." + 176    generate and return the appropriate clojure fragment."
- 181    [tree others] + 177    [tree others]
- 182    (case (first tree) + 178    (case (first tree)
- 183      :ACTIONS (generate-action (first tree) others) + 179      :ACTIONS (generate-action (first tree) others)
- 184      :SIMPLE-ACTION (generate-simple-action tree others) + 180      :SIMPLE-ACTION (generate-simple-action tree others)
- 185      :PROBABLE-ACTION (generate-probable-action tree others) + 181      :PROBABLE-ACTION (generate-probable-action tree others)
- 186      (throw (Exception. (str "Not a known action type: " (first tree)))))) + 182      (throw (Exception. (str "Not a known action type: " (first tree))))))
- 187   + 183  
- 188  (defn generate-multiple-actions + 184  (defn generate-multiple-actions
- 189    "From this `tree`, assumed to be one or more syntactically correct actions, + 185    "From this `tree`, assumed to be one or more syntactically correct actions,
- 190    generate and return the appropriate clojure fragment." + 186    generate and return the appropriate clojure fragment."
- 191    [tree] + 187    [tree]
- 192    (assert-type tree :ACTIONS) + 188    (assert-type tree :ACTIONS)
- 193    (generate-action (first (rest tree)) (second (rest tree)))) + 189    (generate-action (first (rest tree)) (second (rest tree))))
- 194   + 190  
- 195  (defn generate-disjunct-value + 191  (defn generate-disjunct-value
- 196    "Generate a disjunct value. Essentially what we need here is to generate a + 192    "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." + 193    flat list of values, since the `member` has already been taken care of."
- 198    [tree] + 194    [tree]
- - 199    (assert-type tree :DISJUNCT-VALUE) + + 195    (assert-type tree :DISJUNCT-VALUE)
- - 200    (if (= (count tree) 4) + + 196    (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)) + + 197      (cons (generate (second tree)) (generate (nth tree 3)))
- 222       :NUMBER (read-string (second (second tree))) + 198      (list (generate (second tree)))))
- - 223       :QUANTIFIER (generate-neighbours-condition tree (first (second (second tree)))) + + 199  
- - 224       :QUALIFIER (cons (generate (second tree)) (rest (generate (nth tree 2)))))) + + 200  (defn generate-numeric-expression
- 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))))) + 201    "From this `tree`, assumed to be a syntactically correct numeric expression,
- 235    ([comp1 quantity property-condition distance] + 202    generate and return the appropriate clojure fragment."
- - 236     (list comp1 -
- - 237           (list 'count + + 203    [tree]
- 238                 (list 'remove 'false? + 204    (assert-type tree :NUMERIC-EXPRESSION)
- - 239                       (list 'map (list 'fn ['cell] property-condition) + + 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)))
- 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)) + 209      (case (first (second tree))
- 254       :QUANTIFIER (generate-within-condition tree (first (second (second tree)))) + 210        :SYMBOL (list (keyword (second (second tree))) 'cell)
- - 255       :QUALIFIER (TODO "qualified within... help!"))) + + 211        (generate (second tree))))) +
+ + 212   +
+ + 213  (defn generate-neighbours-condition
- 256    ([tree quantifier-type] + 214    "Generate code for a condition which refers to neighbours." +
+ + 215    ([tree]
- 257     (let [quantifier (second 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)
- 258           distance (generate (nth tree 4)) -
- - 259           pc (generate (nth tree 6))] + 223           pc (generate (nth tree 4))]
- 260       (case quantifier-type + 224       (case quantifier-type
- 261         :NUMBER (generate-neighbours-condition '= (read-string (second (second quantifier))) pc distance) -
- - 262         :SOME (generate-neighbours-condition '> 0 pc distance) + 225         :NUMBER (generate-neighbours-condition '= (read-string (second (second quantifier))) pc 1)
- 263         :MORE (let [value (generate (nth quantifier 3))] -
- - 264                 (generate-neighbours-condition '> value pc distance)) + 226         :SOME (generate-neighbours-condition '> 0 pc 1)
- 265         :LESS (let [value (generate (nth quantifier 3))] + 227         :MORE (let [value (generate (nth quantifier 3))]
- 266                 (generate-neighbours-condition '< value pc distance)))))) + 228                 (generate-neighbours-condition '> value pc 1))
- - 267   + + 229         :LESS (let [value (generate (nth quantifier 3))]
- - 268  (defn generate-flow + + 230                 (generate-neighbours-condition '< value pc 1)))))
- 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 + 231    ([comp1 quantity property-condition distance]
- 276     (coll? tree) -
- - 277      (case (first tree) + 232     (list comp1
- 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) + 233           (list 'count
- 309        (map generate tree)) + 234                 (list 'remove 'false?
- - 310      tree)) + + 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)))
- 311   + 239   +
+ + 240  (defn generate-within-condition
- 312  ;;; Flow rules. A flow rule DOES NOT return a modified world; instead, it  + 241    "Generate code for a condition which refers to neighbours within a specified distance.
- 313  ;;; returns a PLAN to modify the world, in the form of a sequence of `flows`. + 242    NOTE THAT there's clearly masses of commonality between this and
- 314  ;;; It is only when the plan is executed that the world is modified. + 243    `generate-neighbours-condition`, and that some refactoring is almost certainly
- 315  ;;; + 244    desirable. It may be that it's better to simplify a `NEIGHBOURS-CONDITION`
- 316  ;;; so we're looking at something like + 245    into a `WITHIN-CONDITION` in the simplification stage."
- 317  ;;; (fn [cell world]) + 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!")))
- 318  ;;;    (if (= (:state cell) (or (:house cell) :house)) + 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))
diff --git a/docs/cloverage/mw_parser/simplify.clj.html b/docs/cloverage/mw_parser/simplify.clj.html index 30b49a9..203a304 100644 --- a/docs/cloverage/mw_parser/simplify.clj.html +++ b/docs/cloverage/mw_parser/simplify.clj.html @@ -85,176 +85,197 @@ 027  
- - 028  (declare simplify-flow simplify-rule) + + 028  (declare simplify)
029  
- - 030  ;; (defn simplify-qualifier -
- - 031  ;;   "Given that this `tree` fragment represents a qualifier, what -
- - 032  ;;   qualifier is that?" -
- - 033  ;;   [tree] -
- - 034  ;;   (cond -
- - 035  ;;     (empty? tree) nil -
- - 036  ;;     (and (coll? tree) -
- - 037  ;;          (#{:EQUIVALENCE :COMPARATIVE} (first tree))) tree -
- - 038  ;;     (coll? (first tree)) (or (simplify-qualifier (first tree)) -
- - 039  ;;                              (simplify-qualifier (rest tree))) -
- - 040  ;;     (coll? tree) (simplify-qualifier (rest tree)) -
- - 041  ;;     :else tree)) -
- - 042   -
- 043  (defn simplify-second-of-two + 030  (defn simplify-second-of-two
- 044    "There are a number of possible simplifications such that if the `tree` has + 031    "There are a number of possible simplifications such that if the `tree` has
- 045    only two elements, the second is semantically sufficient." + 032    only two elements, the second is semantically sufficient."
- 046    [tree] + 033    [tree]
- 047    (if (= (count tree) 2) (simplify-rule (nth tree 1)) tree)) + 034    (if (= (count tree) 2) (simplify (nth tree 1)) tree))
- 048   -
- - 049  ;; (defn simplify-quantifier -
- - 050  ;;   "If this quantifier is a number, 'simplifiy' it into a comparative whose operator is '=' -
- - 051  ;;   and whose quantity is that number. This is actually more complicated but makes generation easier." -
- - 052  ;;   [tree] -
- - 053  ;;   (if (number? (second tree)) [:COMPARATIVE '= (second tree)] (simplify-rule (second tree)))) -
- - 054   + 035  
- 055  (defn simplify-rule + 036  (defn simplify-chained-list
- 056    "Simplify/canonicalise this `tree`. Opportunistically replace complex fragments with + 037    "Some parse trees take the form 
- 057    semantically identical simpler fragments" + 038     `[:X [:Y 1] :NOISE :NOISE [:X [:Y 2] :NOISE :NOISE [:X [:Y 3]]]]`
- 058    [tree] -
- - 059    (if -
- - 060     (coll? tree) -
- - 061      (case (first tree) -
- - 062        :ACTION (simplify-second-of-two tree) -
- - 063        :ACTIONS (cons (first tree) (simplify-rule (rest tree))) + 039     where what's wanted is `[:X [:Y 1] [:Y 2] [:Y 2]]` -- :DISJUNCT-VALUE is a case
- 064        :CHANCE-IN nil -
- - 065        :COMPARATIVE (simplify-second-of-two tree) -
- - 066        :CONDITION (simplify-second-of-two tree) -
- - 067        :CONDITIONS (simplify-second-of-two tree) -
- - 068        :EXPRESSION (simplify-second-of-two tree) -
- - 069        :PROPERTY (simplify-second-of-two tree) -
- - 070        :PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree) + 040     in point. This takes such a parse `tree`, where `branch-tag` is the tag of
- 071        :SPACE nil + 041     the enclosing form and `leaf-tag` is the tag of the form to be collected, and 
- 072        :THEN nil + 042     returns the desired form."
- 073        :AND nil + 043    [tree branch-tag leaf-tag] +
+ + 044    (cons
- 074        :VALUE (simplify-second-of-two tree) + 045     (first tree) +
+ + 046     (reverse +
+ + 047      (loop [chain (rest tree) v '()] +
+ + 048        (let [car (first chain)]
- 075        (remove nil? (map simplify-rule tree))) + 049          (cond (empty? chain) v
- - 076      tree)) + + 050                (coll? car) (let [caar (first car)]
- - 077   + + 051                              (cond
- - 078  (defn simplify-determiner-condition + + 052                                (= branch-tag caar) (recur car v) +
+ + 053                                (= leaf-tag caar) (recur
- 079    [tree] + 054                                                   (rest chain) +
+ + 055                                                   (cons (simplify car) v)) +
+ + 056                                :else (recur (rest chain) v))) +
+ + 057                :else (recur (rest chain) v))))))) +
+ + 058   +
+ + 059  (defn simplify +
+ + 060    "Simplify/canonicalise this `tree`. Opportunistically replace complex fragments with +
+ + 061    semantically identical simpler fragments" +
+ + 062    [tree] +
+ + 063    (if +
+ + 064     (coll? tree) +
+ + 065      (case (first tree) +
+ + 066        :ACTION (simplify-second-of-two tree) +
+ + 067        :ACTIONS (cons (first tree) (simplify (rest tree))) +
+ + 068        :AND nil +
+ + 069        :CHANCE-IN nil +
+ + 070        :COMPARATIVE (simplify-second-of-two tree) +
+ + 071        :CONDITION (simplify-second-of-two tree) +
+ + 072        :CONDITIONS (simplify-second-of-two tree) +
+ + 073        :DISJUNCT-EXPRESSION (simplify-chained-list tree :DISJUNCT-VALUE :VALUE) +
+ + 074        :EXPRESSION (simplify-second-of-two tree) +
+ + 075        :IN nil +
+ + 076        :PROPERTY (simplify-second-of-two tree) +
+ + 077        :PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree) +
+ + 078        :OR nil +
+ + 079        :SPACE nil +
+ + 080        :THEN nil +
+ + 081        :VALUE (simplify-second-of-two tree) +
+ + 082        (remove nil? (map simplify tree))) +
+ + 083      tree)) +
+ + 084   +
+ + 085  (defn simplify-determiner-condition +
+ + 086    [tree]
- 080    (apply vector + 087    (apply vector
- 081           (cons :DETERMINER-CONDITION + 088           (cons :DETERMINER-CONDITION
- 082                 (cons + 089                 (cons
- 083                  (simplify-second-of-two (second tree)) + 090                  (simplify-second-of-two (second tree))
- 084                  (rest (rest tree)))))) + 091                  (rest (rest tree))))))
diff --git a/docs/codox/index.html b/docs/codox/index.html index 8e7cd0c..6a7a94b 100644 --- a/docs/codox/index.html +++ b/docs/codox/index.html @@ -7,5 +7,5 @@

Public variables and functions:

mw-parser.flow

A very simple parser which parses flow rules.

Public variables and functions:

mw-parser.generate

Generate Clojure source from simplified parse trees.

Public variables and functions:

mw-parser.simplify

Simplify a parse tree.

-

Public variables and functions:

mw-parser.utils

Utilities used in more than one namespace within the parser.

+

Public variables and functions:

mw-parser.utils

Utilities used in more than one namespace within the parser.

Public variables and functions:

\ No newline at end of file diff --git a/docs/codox/mw-parser.generate.html b/docs/codox/mw-parser.generate.html index f85e733..2577cc0 100644 --- a/docs/codox/mw-parser.generate.html +++ b/docs/codox/mw-parser.generate.html @@ -2,22 +2,22 @@ ""> mw-parser.generate documentation

Project

Topics

Namespaces

Public Vars

mw-parser.generate

Generate Clojure source from simplified parse trees.

generate

(generate tree)

Generate code for this (fragment of a) parse tree

-
view source

generate-action

(generate-action tree others)

From this tree, assumed to be a syntactically correct action, generate and return the appropriate clojure fragment.

-
view source

generate-condition

(generate-condition tree)

From this tree, assumed to be a syntactically correct condition clause, generate and return the appropriate clojure fragment.

-
view source

generate-conditions

(generate-conditions tree)

From this tree, assumed to be a syntactically correct conditions clause, generate and return the appropriate clojure fragment.

-
view source

generate-conjunct-condition

(generate-conjunct-condition tree)

From this tree, assumed to be a syntactically conjunct correct condition clause, generate and return the appropriate clojure fragment.

+
view source

generate-action

(generate-action tree others)

From this tree, assumed to be a syntactically correct action, generate and return the appropriate clojure fragment.

+
view source

generate-condition

(generate-condition tree)

From this tree, assumed to be a syntactically correct condition clause, generate and return the appropriate clojure fragment.

+
view source

generate-conditions

(generate-conditions tree)

From this tree, assumed to be a syntactically correct conditions clause, generate and return the appropriate clojure fragment.

+
view source

generate-conjunct-condition

(generate-conjunct-condition tree)

From this tree, assumed to be a syntactically conjunct correct condition clause, generate and return the appropriate clojure fragment.

view source

generate-disjunct-condition

(generate-disjunct-condition tree)

From this tree, assumed to be a syntactically correct disjunct condition clause, generate and return the appropriate clojure fragment.

-
view source

generate-disjunct-property-condition

(generate-disjunct-property-condition tree)(generate-disjunct-property-condition _tree property qualifier expression)

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!

-
view source

generate-disjunct-value

(generate-disjunct-value tree)

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.

-
view source

generate-flow

(generate-flow tree)

TODO: write docs

-
view source

generate-multiple-actions

(generate-multiple-actions tree)

From this tree, assumed to be one or more syntactically correct actions, generate and return the appropriate clojure fragment.

-
view source

generate-neighbours-condition

(generate-neighbours-condition tree)(generate-neighbours-condition tree quantifier-type)(generate-neighbours-condition comp1 quantity property-condition distance)(generate-neighbours-condition comp1 quantity property-condition)

Generate code for a condition which refers to neighbours.

-
view source

generate-numeric-expression

(generate-numeric-expression tree)

From this tree, assumed to be a syntactically correct numeric expression, generate and return the appropriate clojure fragment.

-
view source

generate-probable-action

(generate-probable-action tree)(generate-probable-action tree others)

From this tree, assumed to be a syntactically correct probable action, generate and return the appropriate clojure fragment.

-
view source

generate-property-condition

(generate-property-condition tree)(generate-property-condition tree expression-type)

From this tree, assumed to be a syntactically property condition clause, generate and return the appropriate clojure fragment.

-
view source

generate-qualifier

(generate-qualifier tree)

From this tree, assumed to be a syntactically correct qualifier, generate and return the appropriate clojure fragment.

-
view source

generate-ranged-property-condition

(generate-ranged-property-condition tree property expression)

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.

-
view source

generate-rule

(generate-rule tree)

From this tree, assumed to be a syntactically correct rule specification, generate and return the appropriate rule as a function of two arguments.

-
view source

generate-simple-action

(generate-simple-action tree)(generate-simple-action tree others)

From this tree, assumed to be a syntactically correct simple action, generate and return the appropriate clojure fragment.

-
view source

generate-within-condition

(generate-within-condition tree)(generate-within-condition tree quantifier-type)

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.

-
view source
\ No newline at end of file +
view source

generate-disjunct-property-condition

(generate-disjunct-property-condition tree)(generate-disjunct-property-condition _tree property qualifier expression)

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!

+
view source

generate-disjunct-value

(generate-disjunct-value tree)

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.

+
view source

generate-flow

(generate-flow tree)

TODO: write docs

+
view source

generate-multiple-actions

(generate-multiple-actions tree)

From this tree, assumed to be one or more syntactically correct actions, generate and return the appropriate clojure fragment.

+
view source

generate-neighbours-condition

(generate-neighbours-condition tree)(generate-neighbours-condition tree quantifier-type)(generate-neighbours-condition comp1 quantity property-condition distance)(generate-neighbours-condition comp1 quantity property-condition)

Generate code for a condition which refers to neighbours.

+
view source

generate-numeric-expression

(generate-numeric-expression tree)

From this tree, assumed to be a syntactically correct numeric expression, generate and return the appropriate clojure fragment.

+
view source

generate-probable-action

(generate-probable-action tree)(generate-probable-action tree others)

From this tree, assumed to be a syntactically correct probable action, generate and return the appropriate clojure fragment.

+
view source

generate-property-condition

(generate-property-condition tree)(generate-property-condition tree expression-type)

From this tree, assumed to be a syntactically property condition clause, generate and return the appropriate clojure fragment.

+
view source

generate-qualifier

(generate-qualifier tree)

From this tree, assumed to be a syntactically correct qualifier, generate and return the appropriate clojure fragment.

+
view source

generate-ranged-property-condition

(generate-ranged-property-condition tree property expression)

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.

+
view source

generate-rule

(generate-rule tree)

From this tree, assumed to be a syntactically correct rule specification, generate and return the appropriate rule as a function of two arguments.

+
view source

generate-simple-action

(generate-simple-action tree)(generate-simple-action tree others)

From this tree, assumed to be a syntactically correct simple action, generate and return the appropriate clojure fragment.

+
view source

generate-within-condition

(generate-within-condition tree)(generate-within-condition tree quantifier-type)

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.

+
view source
\ No newline at end of file diff --git a/docs/codox/mw-parser.simplify.html b/docs/codox/mw-parser.simplify.html index 4cf8d3f..bc5d755 100644 --- a/docs/codox/mw-parser.simplify.html +++ b/docs/codox/mw-parser.simplify.html @@ -1,8 +1,8 @@ -mw-parser.simplify documentation

Project

Topics

Namespaces

Public Vars

mw-parser.simplify

Simplify a parse tree.

-

simplify-determiner-condition

(simplify-determiner-condition tree)

TODO: write docs

-
view source

simplify-flow

TODO: write docs

-
view source

simplify-rule

(simplify-rule tree)

Simplify/canonicalise this tree. Opportunistically replace complex fragments with semantically identical simpler fragments

-
view source

simplify-second-of-two

(simplify-second-of-two tree)

There are a number of possible simplifications such that if the tree has only two elements, the second is semantically sufficient.

-
view source
\ No newline at end of file +mw-parser.simplify documentation

Project

Topics

Namespaces

Public Vars

mw-parser.simplify

Simplify a parse tree.

+

simplify

(simplify tree)

Simplify/canonicalise this tree. Opportunistically replace complex fragments with semantically identical simpler fragments

+
view source

simplify-chained-list

(simplify-chained-list tree branch-tag leaf-tag)

Some parse trees take the form [:X [:Y 1] :NOISE :NOISE [:X [:Y 2] :NOISE :NOISE [:X [:Y 3]]]] where what’s wanted is [:X [:Y 1] [:Y 2] [:Y 2]] – :DISJUNCT-VALUE is a case in point. This takes such a parse tree, where branch-tag is the tag of the enclosing form and leaf-tag is the tag of the form to be collected, and returns the desired form.

+
view source

simplify-determiner-condition

(simplify-determiner-condition tree)

TODO: write docs

+
view source

simplify-second-of-two

(simplify-second-of-two tree)

There are a number of possible simplifications such that if the tree has only two elements, the second is semantically sufficient.

+
view source
\ No newline at end of file diff --git a/docs/codox/mw-parser.utils.html b/docs/codox/mw-parser.utils.html index 5035017..f5bd3e8 100644 --- a/docs/codox/mw-parser.utils.html +++ b/docs/codox/mw-parser.utils.html @@ -3,7 +3,7 @@ mw-parser.utils documentation

Project

Topics

Namespaces

Public Vars

mw-parser.utils

Utilities used in more than one namespace within the parser.

assert-type

(assert-type tree-fragment type)

If tree-fragment is not a tree fragment of the expected type, throw an exception.

view source

rule?

(rule? maybe-rule)

Return true if the argument appears to be a parsed rule tree, else false.

-
view source

search-tree

(search-tree tree tag)

Return the first element of this tree which has this tag in a depth-first, left-to-right search

+
view source

search-tree

(search-tree tree tag)

Return the first element of this tree which has this tag in a depth-first, left-to-right search

view source

suitable-fragment?

(suitable-fragment? tree-fragment type)

Return true if tree-fragment appears to be a tree fragment of the expected type.

-
view source

TODO

(TODO message)

Marker to indicate I’m not yet finished!

-
view source
\ No newline at end of file +
view source

TODO

(TODO message)

Marker to indicate I’m not yet finished!

+
view source
\ No newline at end of file diff --git a/docs/uberdoc.html b/docs/uberdoc.html new file mode 100644 index 0000000..697d93a --- /dev/null +++ b/docs/uberdoc.html @@ -0,0 +1,4020 @@ + +mw-parser -- Marginalia

mw-parser

0.2.0-SNAPSHOT


Parser for production rules for MicroWorld engine

+

dependencies

org.clojure/clojure
1.11.1
org.clojure/tools.trace
0.7.11
instaparse
1.4.12
mw-engine
0.2.0-SNAPSHOT
trptr/java-wrapper
0.2.3



(this space intentionally left almost blank)

namespaces

 

mw-parser.simplify

toc

Simplify a parse tree.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+ mw-parser.simplify)

mw-parser: a rule parser for MicroWorld.

+ +

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.

+ +

Copyright (C) 2014 Simon Brooke

+
+
(declare simplify)

There are a number of possible simplifications such that if the tree has + only two elements, the second is semantically sufficient.

+
(defn simplify-second-of-two
+  [tree]
+  (if (= (count tree) 2) (simplify (nth tree 1)) tree))

Some parse trees take the form + [:X [:Y 1] :NOISE :NOISE [:X [:Y 2] :NOISE :NOISE [:X [:Y 3]]]] + where what's wanted is [:X [:Y 1] [:Y 2] [:Y 2]] -- :DISJUNCT-VALUE is a case + in point. This takes such a parse tree, where branch-tag is the tag of + the enclosing form and leaf-tag is the tag of the form to be collected, and + returns the desired form.

+
(defn simplify-chained-list
+  [tree branch-tag leaf-tag]
+  (cons
+   (first tree)
+   (reverse
+    (loop [chain (rest tree) v '()]
+      (let [car (first chain)]
+        (cond (empty? chain) v
+              (coll? car) (let [caar (first car)]
+                            (cond
+                              (= branch-tag caar) (recur car v)
+                              (= leaf-tag caar) (recur
+                                                 (rest chain)
+                                                 (cons (simplify car) v))
+                              :else (recur (rest chain) v)))
+              :else (recur (rest chain) v)))))))

Simplify/canonicalise this tree. Opportunistically replace complex fragments with + semantically identical simpler fragments

+
(defn simplify
+  [tree]
+  (if
+   (coll? tree)
+    (case (first tree)
+      :ACTION (simplify-second-of-two tree)
+      :ACTIONS (cons (first tree) (simplify (rest tree)))
+      :AND nil
+      :CHANCE-IN nil
+      :COMPARATIVE (simplify-second-of-two tree)
+      :CONDITION (simplify-second-of-two tree)
+      :CONDITIONS (simplify-second-of-two tree)
+      :DISJUNCT-EXPRESSION (simplify-chained-list tree :DISJUNCT-VALUE :VALUE)
+      :EXPRESSION (simplify-second-of-two tree)
+      :IN nil
+      :PROPERTY (simplify-second-of-two tree)
+      :PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree)
+      :OR nil
+      :SPACE nil
+      :THEN nil
+      :VALUE (simplify-second-of-two tree)
+      (remove nil? (map simplify tree)))
+    tree))
+
(defn simplify-determiner-condition
+  [tree]
+  (apply vector
+         (cons :DETERMINER-CONDITION
+               (cons
+                (simplify-second-of-two (second tree))
+                (rest (rest tree))))))
 

mw-parser.bulk

toc

parse multiple rules from a stream, possibly a file.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-parser.bulk
+  (:use mw-parser.core
+        mw-engine.utils
+        clojure.java.io
+        [clojure.string :only [split trim]])
+  (:import (java.io BufferedReader StringReader)))

mw-parser: a rule parser for MicroWorld.

+ +

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.

+ +

Copyright (C) 2014 Simon Brooke

+

Is this line a comment?

+
(defn comment?
+  [line]
+  (or (empty? (trim line)) (member? (first line) '(nil \# \;))))

Parse rules from successive lines in this string, assumed to have multiple + lines delimited by the new-line character. Return a list of S-expressions.

+
(defn parse-string
+  [string]
+        ;; TODO: tried to do this using with-open, but couldn't make it work.
+  (map #(parse-rule (trim %)) (remove comment? (split string #"\n"))))

Parse rules from successive lines in the file loaded from this filename. + Return a list of S-expressions.

+
(defn parse-file
+  [filename]
+  (parse-string (slurp filename)))

Compile each non-comment line of this string into an executable anonymous + function, and return the sequence of such functions.

+
(defn compile-string
+  [string]
+  (map #(compile-rule % true) (remove comment? (split string #"\n"))))

Compile each non-comment line of the file indicated by this filename into + an executable anonymous function, and return the sequence of such functions.

+
(defn compile-file
+  [filename]
+  (compile-string (slurp filename)))
 

mw-parser.utils

toc

Utilities used in more than one namespace within the parser.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-parser.utils)

mw-parser: a rule parser for MicroWorld.

+ +

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.

+ +

Copyright (C) 2014 Simon Brooke

+

Return true if tree-fragment appears to be a tree fragment of the expected type.

+
(defn suitable-fragment?
+  [tree-fragment type]
+  (and (coll? tree-fragment)
+       (keyword? type)
+       (= (first tree-fragment) type)))

Return true if the argument appears to be a parsed rule tree, else false.

+
(defn rule?
+  [maybe-rule]
+  (suitable-fragment? maybe-rule :RULE))

Marker to indicate I'm not yet finished!

+
(defn TODO
+  [message]
+  message)

If tree-fragment is not a tree fragment of the expected type, throw an exception.

+
(defn assert-type
+  [tree-fragment type]
+  (assert (suitable-fragment? tree-fragment type)
+          (throw (Exception. (format "Expected a %s fragment" type)))))

Return the first element of this tree which has this tag in a depth-first, left-to-right search

+
(defn search-tree
+  [tree tag]
+  (cond 
+    (= (first tree) tag) tree
+    :else (first
+            (remove nil?
+                    (map
+                      #(search-tree % tag)
+                      (filter coll? (rest tree)))))))
 

mw-parser.flow

toc

A very simple parser which parses flow rules.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+ mw-parser.flow
+  (:require [clojure.string :refer [join]]
+            [mw-parser.declarative :refer [build-parser]]
+            [mw-parser.simplify :refer [simplify-second-of-two]]))

Grammar for flow rules.

+ +

My initial conception of this would be that production rules + (if-then rules) and flow rules (flow-from-to rules) would be + entirely separate, presented to the parser as separate text + files, and parsed and compiled by different chains of functions.

+ +

This appears not to be necessary. Flow rules are easy to parse + with the same parser as production rules -- a lot of the grammar + is intentionally common -- and the rules are easily discriminated + at the compilation ('generate') stage.

+ +

The basic rule I want to be able to compile at this stage is the 'mutual + aid' rule:

+ +

flow 1 food from house having food > 1 to house with least food within 2

+
(def flow-grammar
+  (join "\n" ["FLOW-RULE := FLOW SPACE QUANTITY SPACE PROPERTY SPACE FROM SPACE SOURCE SPACE TO-HOW SPACE DESTINATION;"
+              "PERCENTAGE := NUMBER #'%';"
+              "QUANTITY := PERCENTAGE | NUMBER | EXPRESSION | SOME;"
+              "SOURCE := STATE | STATE SPACE WITH SPACE CONDITIONS;"
+              "DESTINATION := STATE | STATE SPACE WITH SPACE FLOW-CONDITIONS | STATE SPACE WITHIN SPACE VALUE SPACE WITH SPACE FLOW-CONDITIONS;"
+              "DETERMINER := MOST | LEAST;"
+              "DETERMINER-CONDITION := DETERMINER SPACE PROPERTY | DETERMINER SPACE PROPERTY;"
+              "FLOW-CONDITIONS := DETERMINER-CONDITION | CONDITIONS"
+              "STATE := SYMBOL;"
+              "TO-HOW := TO | TO-EACH | TO-FIRST;"
+              "TO-EACH := TO SPACE EACH | TO SPACE ALL;"
+              "TO-FIRST := TO SPACE FIRST"]))

Parse the argument, assumed to be a string in the correct syntax, and return a parse tree.

+
(def parse-flow
+  (build-parser flow-grammar))
+
(defn simplify-flow
+  [tree]
+  (if (coll? tree)
+    (case (first tree)
+      :CONDITION (simplify-second-of-two tree)
+      :CONDITIONS (simplify-second-of-two tree)
+      :DETERMINER (simplify-second-of-two tree)
+;;      :DETERMINER-CONDITION (simplify-determiner-condition tree)
+      :EXPRESSION (simplify-second-of-two tree)
+      :FLOW nil
+;;      :FLOW-CONDITIONS (simplify-second-of-two tree)
+      :PROPERTY (simplify-second-of-two tree)
+      :PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree)
+      :SPACE nil
+      :QUANTITY (simplify-second-of-two tree)
+      :STATE (list :PROPERTY-CONDITION
+                   (list :SYMBOL "state")
+                   '(:QUALIFIER
+                     (:EQUIVALENCE
+                      (:IS "is")))
+                   (list :EXPRESSION
+                         (list :VALUE (second tree))))
+      (remove nil? (map simplify-flow tree)))
+    tree))
 

mw-parser.core

toc

A very simple parser which parses production rules.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-parser.core
+  (:use mw-engine.utils
+        [clojure.string :only [split trim triml]])
+  (:gen-class))

mw-parser: a rule parser for MicroWorld.

+ +

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.

+ +

Copyright (C) 2014 Simon Brooke

+ +

A very simple parser which parses production rules of the following forms:

+ +
    +
  • "if altitude is less than 100 and state is forest then state should be climax and deer should be 3"
    • +
  • "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3"
    • +
  • "if altitude is 100 or fertility is 25 then state should be heath"
    • +
  • "if deer is more than 2 and wolves is 0 and fertility is more than 20 then deer should be deer + 2"
    • +
  • "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves"
    • +
  • "if state is grassland and 4 neighbours have state equal to water then state should be village"
    • +
  • "if state is forest and fertility is between 55 and 75 then state should be climax"
    • +
  • "if 6 neighbours have state equal to water then state should be village"
    • +
  • "if state is in grassland or pasture or heath and 4 neighbours are water then state should be village"
    • +
  • "if state is forest or state is climax and some neighbours have state equal to fire then 3 in 5 chance that state should be fire"
    • +
  • "if state is pasture and more than 3 neighbours have state equal to scrub then state should be scrub" +*
    • +
+ +

it generates rules in the form expected by mw-engine.core, q.v.

+ +

It is, as I say, very simple; it generates a complete rule, or it fails completely, returning nil. +Very occasionally it generates a wrong rule - one which is not a correct translation of the rule +semantics - but that is buggy behaviour, which I'll try to fix over the next few weeks, not a +design fault.

+ +

More significantly it does not generate useful error messages on failure.

+ +

This parser is now obsolete, but is retained in the codebase for now in +case it is of use to anyone. Prefer the declarative.clj parser.

+
+
(declare parse-conditions)
+(declare parse-not-condition)
+(declare parse-simple-condition)

a regular expression which matches string representation of positive numbers

+
(def re-number #"^[0-9.]*$")

error thrown when an attempt is made to set a reserved property

+
(def reserved-properties-error
+  "The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions")

error thrown when a rule cannot be parsed

+
(def bad-parse-error "I did not understand '%s'")

If this token appears to represent an explicit number, return that number; + otherwise, make a keyword of it and return that.

+
(defn- keyword-or-numeric
+  [token]
+  (cond
+    (re-matches re-number token) (read-string token)
+    (keyword? token) token
+    true (keyword token)))

Generally all functions in this file with names beginning 'parse-' take a +sequence of tokens (and in some cases other optional arguments) and return a +vector comprising

+ +
    +
  1. A code fragment parsed from the front of the sequence of tokens, and
    2. +
  2. the remaining tokens which were not consumed in constructing that fragment.
    3. +
+ +

In every case if the function cannot parse the desired construct from the +front of the sequence of tokens it returns nil.

+

Parse a number.

+
(defn parse-numeric-value
+  [[value & remainder]]
+  (if (and value (re-matches re-number value)) [(read-string value) remainder]))

Parse a token assumed to be the name of a property of the current cell, + whose value is assumed to be an integer.

+
(defn parse-property-int
+  [[value & remainder]]
+  (if value [(list 'get-int 'cell (keyword value)) remainder]))

Parse a token assumed to be the name of a property of the current cell.

+
(defn parse-property-value
+  [[value & remainder]]
+  (if value [(list (keyword value) 'cell) remainder]))

Parse a token assumed to be a simple token value.

+
(defn parse-token-value
+  [[value & remainder]]
+  (if value [(keyword value) remainder]))

Parse a value from the first of these tokens. If expect-int is true, return + an integer or something which will evaluate to an integer.

+
(defn parse-simple-value
+  ([tokens expect-int]
+    (or
+        (parse-numeric-value tokens)
+        (cond expect-int
+          (parse-property-int tokens)
+          true (parse-token-value tokens))))
+  ([tokens]
+    (parse-simple-value tokens false)))

Parse a single value from this single token and return just the generated + code, not a pair.

+
(defn gen-token-value
+  [token expect-int]
+  (first (parse-simple-value (list token) expect-int)))

Parse a list of values from among these tokens. If expect-int is true, return + integers or things which will evaluate to integers.

+
(defn parse-disjunct-value
+  [[OR token & tokens] expect-int]
+  (cond (member? OR '("or" "in"))
+    (let [value (first (parse-simple-value (list token) expect-int))
+          seek-others (= (first tokens) "or")]
+      (cond seek-others
+        (let [[others remainder] (parse-disjunct-value tokens expect-int)]
+          [(cons value others) remainder])
+        true
+        [(list value) tokens]))))

Parse a value from among these tokens. If expect-int is true, return + an integer or something which will evaluate to an integer.

+
(defn parse-value
+  ([tokens expect-int]
+    (or
+      (parse-disjunct-value tokens expect-int)
+      (parse-simple-value tokens expect-int)))
+  ([tokens]
+    (parse-value tokens false)))

Parses a condition of the form '[property] in [value] or [value]...'

+
(defn parse-member-condition
+  [[property IS IN & rest]]
+  (if (and (member? IS '("is" "are")) (= IN "in"))
+    (let [[l remainder] (parse-disjunct-value (cons "in" rest) false)]
+      [(list 'member? (list (keyword property) 'cell) (list 'quote l)) remainder])))

Parse '[property] less than [value]'.

+
(defn- parse-less-condition
+  [[property IS LESS THAN & rest]]
+  (cond (and (member? IS '("is" "are")) (member? LESS '("less" "fewer")) (= THAN "than"))
+    (let [[value remainder] (parse-value rest true)]
+        [(list '< (list 'get-int 'cell (keyword property)) value) remainder])))

Parse '[property] more than [value]'.

+
(defn- parse-more-condition
+  [[property IS MORE THAN & rest]]
+  (cond (and (member? IS '("is" "are")) (member? MORE '("more" "greater")) (= THAN "than"))
+    (let [[value remainder] (parse-value rest true)]
+        [(list '> (list 'get-int 'cell (keyword property)) value) remainder])))
+
(defn- parse-between-condition
+  [[p IS BETWEEN v1 AND v2 & rest]]
+  (cond (and (member? IS '("is" "are")) (= BETWEEN "between") (= AND "and") (not (nil? v2)))
+    (let [property (first (parse-simple-value (list p) true))
+          value1 (first (parse-simple-value (list v1) true))
+          value2 (first (parse-simple-value (list v2) true))]
+      [(list 'or
+            (list '< value1 property value2)
+            (list '> value1 property value2)) rest])))

Parse clauses of the form 'x is y', 'x is in y or z...', + 'x is between y and z', 'x is more than y' or 'x is less than y'. + It is necessary to disambiguate whether value is a numeric or keyword.

+
(defn- parse-is-condition
+  [[property IS value & rest]]
+  (cond
+    (member? IS '("is" "are"))
+    (let [tokens (cons property (cons value rest))]
+      (cond
+        (re-matches re-number value) [(list '= (list 'get-int 'cell (keyword property)) (read-string value)) rest]
+        value [(list '= (list (keyword property) 'cell) (keyword value)) rest]))))

Parse the negation of a simple condition.

+
(defn- parse-not-condition
+  [[property IS NOT & rest]]
+  (cond (and (member? IS '("is" "are")) (= NOT "not"))
+    (let [partial (parse-simple-condition (cons property (cons "is" rest)))]
+      (cond partial
+        (let [[condition remainder] partial]
+          [(list 'not condition) remainder])))))
+
(defn- gen-neighbours-condition
+  ([comp1 quantity property value remainder comp2 distance]
+    [(list comp1
+         (list 'count
+               (list 'get-neighbours-with-property-value 'world
+                     '(cell :x) '(cell :y) distance
+                     (keyword property) (keyword-or-numeric value) comp2))
+         quantity)
+           remainder])
+  ([comp1 quantity property value remainder comp2]
+    (gen-neighbours-condition comp1 quantity property value remainder comp2 1)))

Parse conditions of the form '...more than 6 neighbours are [condition]'

+
(defn parse-comparator-neighbours-condition
+  [[MORE THAN n NEIGHBOURS WITHIN distance have-or-are & rest]]
+  (let [quantity (first (parse-numeric-value (list n)))
+        comparator (cond (= MORE "more") '>
+                     (member? MORE '("fewer" "less")) '<)]
+    (cond
+      (not= WITHIN "within")
+      (parse-comparator-neighbours-condition
+        (flatten
+          ;; two tokens were mis-parsed as 'within distance' that weren't
+          ;; actually 'within' and a distance. Splice in 'within 1' and try
+          ;; again.
+          (list MORE THAN n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest)))
+      (and quantity
+           comparator
+           (= THAN "than")
+           (= NEIGHBOURS "neighbours"))
+      (cond
+        (= have-or-are "are")
+        (let [[value & remainder] rest
+              dist (gen-token-value distance true)]
+          (gen-neighbours-condition comparator quantity :state value remainder = dist))
+        (= have-or-are "have")
+        (let [[property comp1 comp2 value & remainder] rest
+              dist (gen-token-value distance true)]
+          (cond (and (= comp1 "equal") (= comp2 "to"))
+            (gen-neighbours-condition comparator quantity property
+                                      value remainder = dist)
+            (and (= comp1 "more") (= comp2 "than"))
+            (gen-neighbours-condition comparator quantity property
+                                      value remainder > dist)
+            (and (= comp1 "less") (= comp2 "than"))
+            (gen-neighbours-condition comparator quantity property
+                                      value remainder < dist)))))))
+
(defn parse-some-neighbours-condition
+  [[SOME NEIGHBOURS & rest]]
+  (cond
+    (and (= SOME "some") (= NEIGHBOURS "neighbours"))
+    (parse-comparator-neighbours-condition (concat '("more" "than" "0" "neighbours") rest))))

Parse conditions of the form '...6 neighbours are [condition]'

+
(defn parse-simple-neighbours-condition
+  [[n NEIGHBOURS WITHIN distance have-or-are & rest]]
+  (let [quantity (first (parse-numeric-value (list n)))]
+    (cond
+      (and quantity (= NEIGHBOURS "neighbours"))
+      (cond
+        (not= WITHIN "within")
+        (parse-simple-neighbours-condition
+          (flatten
+            ;; two tokens were mis-parsed as 'within distance' that weren't
+            ;; actually 'within' and a distance. Splice in 'within 1' and try
+            ;; again.
+            (list n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest)))
+        (= have-or-are "are")
+        (let [[value & remainder] rest
+              dist (gen-token-value distance true)]
+          (gen-neighbours-condition '= quantity :state value remainder = dist))
+        (= have-or-are "have")
+        (let [[property comp1 comp2 value & remainder] rest
+              dist (gen-token-value distance true)]
+          (cond (and (= comp1 "equal") (= comp2 "to"))
+            (gen-neighbours-condition '= quantity property value remainder =
+                                      dist)
+            (and (= comp1 "more") (= comp2 "than"))
+            (gen-neighbours-condition '= quantity property value remainder >
+                                      dist)
+            (and (= comp1 "less") (= comp2 "than"))
+            (gen-neighbours-condition '= quantity property value remainder <
+                                      dist)))))))

Parse conditions referring to neighbours

+
(defn parse-neighbours-condition
+  [tokens]
+  (or
+    (parse-simple-neighbours-condition tokens)
+    (parse-comparator-neighbours-condition tokens)
+    (parse-some-neighbours-condition tokens)))

Parse conditions of the form '[property] [comparison] [value]'.

+
(defn parse-simple-condition
+  [tokens]
+  (or
+    (parse-neighbours-condition tokens)
+    (parse-member-condition tokens)
+    (parse-not-condition tokens)
+    (parse-less-condition tokens)
+    (parse-more-condition tokens)
+    (parse-between-condition tokens)
+    (parse-is-condition tokens)))

Parse '... or [condition]' from tokens, where left is the already parsed first disjunct.

+
(defn- parse-disjunction-condition
+  [left tokens]
+  (let [partial (parse-conditions tokens)]
+    (if partial
+      (let [[right remainder] partial]
+        [(list 'or left right) remainder]))))

Parse '... and [condition]' from tokens, where left is the already parsed first conjunct.

+
(defn- parse-conjunction-condition
+  [left tokens]
+  (let [partial (parse-conditions tokens)]
+    (if partial
+      (let [[right remainder] partial]
+        [(list 'and left right) remainder]))))

Parse conditions from tokens, where conditions may be linked by either 'and' or 'or'.

+
(defn- parse-conditions
+  [tokens]
+  (let [partial (parse-simple-condition tokens)]
+    (if partial
+      (let [[left [next & remainder]] partial]
+        (cond
+          (= next "and") (parse-conjunction-condition left remainder)
+          (= next "or") (parse-disjunction-condition left remainder)
+          true partial)))))

Parse the left hand side ('if...') of a production rule.

+
(defn- parse-left-hand-side
+ [[IF & tokens]]
+ (if
+   (= IF "if")
+   (parse-conditions tokens)))

Parse actions of the form '[property] should be [property] [arithmetic-operator] [value]', + e.g. 'fertility should be fertility + 1', or 'deer should be deer - wolves'.

+
(defn- parse-arithmetic-action
+  [previous [prop1 SHOULD BE prop2 operator value & rest]]
+  (cond
+    (member? prop1 '("x" "y"))
+    (throw
+      (Exception. reserved-properties-error))
+    (and (= SHOULD "should")
+           (= BE "be")
+           (member? operator '("+" "-" "*" "/")))
+    [(list 'merge (or previous 'cell)
+           {(keyword prop1) (list 'int
+                                  (list (symbol operator) (list 'get-int 'cell (keyword prop2))
+                                        (cond
+                                          (re-matches re-number value) (read-string value)
+                                          true (list 'get-int 'cell (keyword value)))))}) rest]))

Parse actions of the form '[property] should be [value].'

+
(defn- parse-set-action
+  [previous [property SHOULD BE value & rest]]
+  (cond
+    (member? property '("x" "y"))
+    (throw
+      (Exception. reserved-properties-error))
+    (and (= SHOULD "should") (= BE "be"))
+    [(list 'merge (or previous 'cell)
+           {(keyword property) (cond (re-matches re-number value) (read-string value) true (keyword value))}) rest]))
+
(defn- parse-simple-action [previous tokens]
+  (or (parse-arithmetic-action previous tokens)
+      (parse-set-action previous tokens)))

Parse actions from tokens.

+
(defn- parse-actions
+  [previous tokens]
+  (let [[left remainder] (parse-simple-action previous tokens)]
+    (cond left
+          (cond (= (first remainder) "and")
+                (parse-actions left (rest remainder))
+                true (list left)))))

Parse a probability of an action from this collection of tokens

+
(defn- parse-probability
+  [previous [n CHANCE IN m & tokens]]
+  (cond
+    (and (= CHANCE "chance")(= IN "in"))
+    (let [[action remainder] (parse-actions previous tokens)]
+      (cond action
+        [(list 'cond
+              (list '<
+                    (list 'rand
+                          (first (parse-simple-value (list m) true)))
+                    (first (parse-simple-value (list n) true)))
+              action) remainder]))))

Parse the right hand side ('then...') of a production rule.

+
(defn- parse-right-hand-side
+  [[THEN & tokens]]
+  (if (= THEN "then")
+    (or
+      (parse-probability nil tokens)
+      (parse-actions nil tokens))))

Parse a complete rule from this line, expected to be either a string or a + sequence of string tokens. Return the rule in the form of an S-expression.

+ +

Throws an exception if parsing fails.

+
(defn parse-rule
+  [line]
+  (cond
+   (string? line)
+   (let [rule (parse-rule (split (triml line) #"\s+"))]
+     (cond rule rule
+       true (throw (Exception. (format bad-parse-error line)))))
+   true
+   (let [[left remainder] (parse-left-hand-side line)
+              [right junk] (parse-right-hand-side remainder)]
+     (cond
+       ;; there should be a valide left hand side and a valid right hand side
+       ;; there shouldn't be anything left over (junk should be empty)
+       (and left right (empty? junk))
+       (list 'fn ['cell 'world] (list 'if left right))))))

Parse this rule-text, a string conforming to the grammar of MicroWorld rules, + into Clojure source, and then compile it into an anonymous + function object, getting round the problem of binding mw-engine.utils in + the compiling environment. If return-tuple? is present and true, return + a list comprising the anonymous function compiled, and the function from + which it was compiled.

+ +

Throws an exception if parsing fails.

+
(defn compile-rule
+  ([rule-text return-tuple?]
+    (do
+      (use 'mw-engine.utils)
+      (let [afn (eval (parse-rule rule-text))]
+        (cond
+          (and afn return-tuple?)(list afn (trim rule-text))
+          true afn))))
+  ([rule-text]
+    (compile-rule rule-text false)))
 

mw-parser.errors

toc

Display parse errors in a format which makes it easy for the user + to see where the error occurred.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-parser.errors)

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.

+

error thrown when an attempt is made to set a reserved property

+
(def reserved-properties-error
+  "The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions")

error thrown when a rule cannot be parsed. Slots are for +(1) rule text +(2) cursor showing where in the rule text the error occurred +(3) the reason for the error

+
(def bad-parse-error "I did not understand:\n  '%s'\n  %s\n  %s")

Attempt to explain the reason for the parse error.

+
(defn- explain-parse-error-reason
+  [reason]
+  (str "Expecting one of (" (apply str (map #(str (:expecting %) " ") reason)) ")"))
+
(defn- parser-error-to-map
+  [parser-error]
+  (let [m (reduce (fn [map item](merge map {(first item)(second item)})) {} parser-error)
+        reason (map
+                 #(reduce (fn [map item] (merge {(first item) (second item)} map)) {} %)
+                 (:reason m))]
+    (merge m {:reason reason})))

Construct a helpful error message from this parser-error, and throw an exception with that message.

+
(defn throw-parse-exception
+  [parser-error]
+  (assert (coll? parser-error) "Expected a paser error structure?")
+  (let
+    [
+      ;; the error structure is a list, such that each element is a list of two items, and
+      ;; the first element in each sublist is a keyword. Easier to work with it as a map
+     error-map (parser-error-to-map parser-error)
+     text (:text error-map)
+     reason (explain-parse-error-reason (:reason error-map))
+      ;; rules have only one line, by definition; we're interested in the column
+     column (if (:column error-map)(:column error-map) 0)
+      ;; create a cursor to point to that column
+     cursor (apply str (reverse (conj (repeat column " ") "^")))
+     message (format bad-parse-error text cursor reason)
+     ]
+  (throw (Exception. message))))
 

mw-parser.generate

toc

Generate Clojure source from simplified parse trees.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+ mw-parser.generate
+  (:require [clojure.pprint :refer [pprint]]
+            [clojure.tools.trace :refer [deftrace]]
+            [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)

From this tree, assumed to be a syntactically correct rule specification, + generate and return the appropriate rule as a function of two arguments.

+
(defn generate-rule
+  [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}))

From this tree, assumed to be a syntactically correct conditions clause, + generate and return the appropriate clojure fragment.

+
(defn generate-conditions
+  [tree]
+  (assert-type tree :CONDITIONS)
+  (generate (second tree)))

From this tree, assumed to be a syntactically correct condition clause, + generate and return the appropriate clojure fragment.

+
(defn generate-condition
+  [tree]
+  (assert-type tree :CONDITION)
+  (generate (second tree)))

From this tree, assumed to be a syntactically conjunct correct condition clause, + generate and return the appropriate clojure fragment.

+
(defn generate-conjunct-condition
+  [tree]
+  (assert-type tree :CONJUNCT-CONDITION)
+  (cons 'and (map generate (rest tree))))

From this tree, assumed to be a syntactically correct disjunct condition clause, + generate and return the appropriate clojure fragment.

+
(defn generate-disjunct-condition
+  [tree]
+  (assert-type tree :DISJUNCT-CONDITION)
+  (cons 'or (map generate (rest tree))))

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.

+
(defn generate-ranged-property-condition
+  [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)))))

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!

+
(defn generate-disjunct-property-condition
+  ([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)))))

From this tree, assumed to be a syntactically property condition clause, + generate and return the appropriate clojure fragment.

+
(defn generate-property-condition
+  ([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)))))

From this tree, assumed to be a syntactically correct qualifier, + generate and return the appropriate clojure fragment.

+
(defn generate-qualifier
+  [tree]
+  (if
+   (= (count tree) 2)
+    (generate (second tree))
+    ;; else
+    (generate (nth tree 2))))

From this tree, assumed to be a syntactically correct simple action, + generate and return the appropriate clojure fragment.

+
(defn generate-simple-action
+  ([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})))))

From this tree, assumed to be a syntactically correct probable action, + generate and return the appropriate clojure fragment.

+
(defn generate-probable-action
+  ([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))))

From this tree, assumed to be a syntactically correct action, + generate and return the appropriate clojure fragment.

+
(defn generate-action
+  [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))))))

From this tree, assumed to be one or more syntactically correct actions, + generate and return the appropriate clojure fragment.

+
(defn generate-multiple-actions
+  [tree]
+  (assert-type tree :ACTIONS)
+  (generate-action (first (rest tree)) (second (rest tree))))

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.

+
(defn generate-disjunct-value
+  [tree]
+  (assert-type tree :DISJUNCT-VALUE)
+  (if (= (count tree) 4)
+    (cons (generate (second tree)) (generate (nth tree 3)))
+    (list (generate (second tree)))))

From this tree, assumed to be a syntactically correct numeric expression, + generate and return the appropriate clojure fragment.

+
(defn generate-numeric-expression
+  [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)))))

Generate code for a condition which refers to neighbours.

+
(defn generate-neighbours-condition
+  ([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)))

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.

+
(defn generate-within-condition
+  ([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 generate-flow
+  [tree]
+  (assert-type tree :FLOW-RULE))

Top level; only function anything outside this file (except tests) should +really call.

+

Generate code for this (fragment of a) parse tree

+
(defn generate
+  [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)
+      :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))
 

mw-parser.declarative

toc

A very simple parser which parses production rules.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+ mw-parser.declarative
+  (:require [instaparse.core :refer [parser]]
+            [clojure.string :refer [join trim]]
+            [mw-parser.errors :refer [throw-parse-exception]]
+            [mw-parser.generate :refer [generate]]
+            [mw-parser.simplify :refer [simplify]]
+            [mw-parser.utils :refer [rule?]]
+            [trptr.java-wrapper.locale :refer [get-default]])
+  (:import [java.util Locale]))

mw-parser: a rule parser for MicroWorld.

+ +

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.

+ +

Copyright (C) 2014 Simon Brooke

+

Basic rule language grammar.

+ +

in order to simplify translation into other natural languages, all + TOKENS within the parser should be unambiguou.

+
(def rule-grammar
+  (join "\n" ["RULE := IF SPACE CONDITIONS SPACE THEN SPACE ACTIONS;"
+              "ACTIONS := ACTION | ACTION SPACE AND SPACE ACTIONS"
+              "ACTION := SIMPLE-ACTION | PROBABLE-ACTION;"
+              "PROBABLE-ACTION := VALUE SPACE CHANCE-IN SPACE VALUE SPACE SIMPLE-ACTION;"
+              "SIMPLE-ACTION := SYMBOL SPACE BECOMES SPACE EXPRESSION;"]))

Grammar rules used both in the rule grammar and in the flow grammar

+
(def common-grammar
+  (join "\n" ["COMPARATIVE := MORE | LESS;"
+              "COMPARATIVE-QUALIFIER := IS SPACE COMPARATIVE SPACE THAN | COMPARATIVE SPACE THAN;"
+              "CONDITION := WITHIN-CONDITION | NEIGHBOURS-CONDITION | PROPERTY-CONDITION;"
+              "CONDITIONS := DISJUNCT-CONDITION | CONJUNCT-CONDITION | CONDITION ;"
+              "CONJUNCT-CONDITION := CONDITION SPACE AND SPACE CONDITIONS;"
+              "DISJUNCT-CONDITION := CONDITION SPACE OR SPACE CONDITIONS;"
+              "DISJUNCT-EXPRESSION := IN SPACE DISJUNCT-VALUE;"
+              "DISJUNCT-VALUE := VALUE | VALUE SPACE OR SPACE DISJUNCT-VALUE;"
+              "EQUIVALENCE := IS SPACE EQUAL | EQUAL | IS ;"
+              "EXPRESSION := SIMPLE-EXPRESSION | RANGE-EXPRESSION | NUMERIC-EXPRESSION | DISJUNCT-EXPRESSION | VALUE;"
+              "NEGATED-QUALIFIER := QUALIFIER SPACE NOT | NOT SPACE QUALIFIER;"
+              "NEIGHBOURS-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE IS SPACE PROPERTY-CONDITION | QUALIFIER SPACE NEIGHBOURS-CONDITION;"
+              "NUMBER := #'[0-9]+' | #'[0-9]+.[0-9]+';"
+              "NUMERIC-EXPRESSION := VALUE | VALUE SPACE OPERATOR SPACE NUMERIC-EXPRESSION;"
+              "OPERATOR := '+' | '-' | '*' | '/';"
+              "PROPERTY := SYMBOL;"
+              "PROPERTY-CONDITION := PROPERTY SPACE QUALIFIER SPACE EXPRESSION | VALUE;"
+              "PROPERTY-CONDITION-OR-EXPRESSION := PROPERTY-CONDITION | EXPRESSION;"
+              "QUALIFIER := COMPARATIVE-QUALIFIER | NEGATED-QUALIFIER | EQUIVALENCE | IS SPACE QUALIFIER;"
+              "QUANTIFIER := NUMBER | SOME | NONE | ALL | COMPARATIVE SPACE THAN SPACE NUMBER;"
+              "RANGE-EXPRESSION := BETWEEN SPACE NUMERIC-EXPRESSION SPACE AND SPACE NUMERIC-EXPRESSION;"
+              "SIMPLE-EXPRESSION := QUALIFIER SPACE EXPRESSION | VALUE;"
+              "SPACE := #'\\s+';"
+              "VALUE := SYMBOL | NUMBER;"
+              "VALUE := SYMBOL | NUMBER;"
+              "WITHIN-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE WITHIN SPACE NUMBER SPACE IS SPACE PROPERTY-CONDITION-OR-EXPRESSION;"
+              ]))

English language keyword literals used in rules - both in production + rules (this namespace) and in flow rules (see mw-parser.flow).

+ +
  It's a long term aim that the rule language should be easy to 
+  internationalise; this isn't a full solution but it's a step towards
+  a solution.
+
+
(def keywords-en
+  (join "\n" ["ALL := 'all'" 
+              "AND := 'and';" 
+              "BECOMES := 'should be' | 'becomes';" 
+              "BETWEEN := 'between';" 
+              "CHANCE-IN := 'chance in';" 
+              "EACH := 'each' | 'every' | 'all';"
+              "EQUAL := 'equal to';" 
+              "FIRST := 'first';"
+              "FLOW := 'flow' | 'move';" 
+              "FROM := 'from';"
+              "IF := 'if';" 
+              "IN := 'in';" 
+              "IS := 'is' | 'are' | 'have' | 'has';" 
+              "LEAST := 'least';"
+              "LESS := 'less' | 'fewer';" 
+              "MORE := 'more' | 'greater';" 
+              "MOST := 'most';"
+              "NEIGHBOURS := 'neighbour' | 'neighbor' | 'neighbours' | 'neighbors';" 
+              "NONE := 'no';" 
+              "NOT := 'not';" 
+              "OR := 'or';" 
+              "SOME := 'some';" 
+              ;; SYMBOL is in the per-language file so that languages that use
+              ;; (e.g.) Cyrillic characters can change the definition.
+              "SYMBOL := #'[a-z]+';" 
+              "THAN := 'than';" 
+              "THEN := 'then';" 
+              "TO := 'to';"
+              "WITH := 'with' | 'where' | 'having';"
+              "WITHIN := 'within';"]))

For now, just return keywords-en; plan is to have resource files of + keywords for different languages in a resource directory, but that isn't + done yet. It's probably not going to work easily for languages that use + non-latin alphabets, anyway.

+
(defn keywords-for-locale
+  ([]
+   (keywords-for-locale (get-default)))
+  ([^Locale _locale]
+   keywords-en))

Compose this grammar fragment g with the common grammar fragments to + make a complete grammar, and return a parser for that complete grammar.

+
(defmacro build-parser 
+  [g]
+  `(parser (join "\n" [~g common-grammar (keywords-for-locale)])))

Parse the argument, assumed to be a string in the correct syntax, and return a parse tree.

+
(def parse-rule
+  (build-parser rule-grammar))

Parse this rule-text, a string conforming to the grammar of MicroWorld rules, + into Clojure source, and then compile it into an anonymous + function object, getting round the problem of binding mw-engine.utils in + the compiling environment. If return-tuple? is present and true, return + a list comprising the anonymous function compiled, and the function from + which it was compiled.

+ +

Throws an exception if parsing fails.

+
(defn compile-rule
+  ([rule-text return-tuple?]
+   (assert (string? rule-text))
+   (let [rule (trim rule-text)
+         tree (simplify (parse-rule rule))
+         afn (if (rule? tree) (eval (generate tree))
+               ;; else
+                 (throw-parse-exception tree))]
+     (if return-tuple?
+       (list afn rule)
+       ;; else
+       afn)))
+  ([rule-text]
+   (compile-rule rule-text false)))
 
Generated by Marginalia.  Syntax highlighting provided by Alex Gorbatchev's SyntaxHighlighter
\ No newline at end of file diff --git a/src/mw_parser/core.clj b/src/mw_parser/core.clj index 820f353..db623ba 100644 --- a/src/mw_parser/core.clj +++ b/src/mw_parser/core.clj @@ -1,4 +1,7 @@ -(ns ^{:doc "A very simple parser which parses production rules." +(ns ^{:doc "A very simple parser which parses production rules. + + **NOTE**: This parser is obsolete and is superceded by the + declarative parser, q.v." :author "Simon Brooke"} mw-parser.core (:use mw-engine.utils diff --git a/src/mw_parser/declarative.clj b/src/mw_parser/declarative.clj index fb79e89..a8da7fb 100644 --- a/src/mw_parser/declarative.clj +++ b/src/mw_parser/declarative.clj @@ -5,7 +5,7 @@ [clojure.string :refer [join trim]] [mw-parser.errors :refer [throw-parse-exception]] [mw-parser.generate :refer [generate]] - [mw-parser.simplify :refer [simplify-rule]] + [mw-parser.simplify :refer [simplify]] [mw-parser.utils :refer [rule?]] [trptr.java-wrapper.locale :refer [get-default]]) (:import [java.util Locale])) @@ -144,7 +144,7 @@ ([rule-text return-tuple?] (assert (string? rule-text)) (let [rule (trim rule-text) - tree (simplify-rule (parse-rule rule)) + tree (simplify (parse-rule rule)) afn (if (rule? tree) (eval (generate tree)) ;; else (throw-parse-exception tree))] diff --git a/src/mw_parser/generate.clj b/src/mw_parser/generate.clj index 32d11f5..94e6504 100644 --- a/src/mw_parser/generate.clj +++ b/src/mw_parser/generate.clj @@ -1,7 +1,9 @@ (ns ^{:doc "Generate Clojure source from simplified parse trees." :author "Simon Brooke"} mw-parser.generate - (:require [mw-parser.utils :refer [assert-type TODO]] + (:require [clojure.pprint :refer [pprint]] + [clojure.tools.trace :refer [deftrace]] + [mw-parser.utils :refer [assert-type TODO]] [mw-parser.errors :as pe])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -23,17 +25,18 @@ ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (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))))) - + (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, @@ -42,7 +45,6 @@ (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." @@ -50,7 +52,6 @@ (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." @@ -58,7 +59,6 @@ (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." @@ -66,7 +66,6 @@ (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 @@ -81,7 +80,6 @@ '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 @@ -93,11 +91,9 @@ 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)))))) - + (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, @@ -241,7 +237,6 @@ ([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 @@ -265,9 +260,32 @@ :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 generate-flow [tree] - (assert-type tree :WITHIN-CONDITION)) + (assert-type tree :FLOW-RULE)) + +;;; Top level; only function anything outside this file (except tests) should +;;; really call. (defn generate "Generate code for this (fragment of a) parse tree" @@ -282,7 +300,7 @@ :CONDITIONS (generate-conditions tree) :CONJUNCT-CONDITION (generate-conjunct-condition tree) :DISJUNCT-CONDITION (generate-disjunct-condition tree) - :DISJUNCT-EXPRESSION (generate (nth tree 2)) + :DISJUNCT-EXPRESSION (generate-disjunct-expression tree) :DISJUNCT-VALUE (generate-disjunct-value tree) :EQUIVALENCE '= :EXPRESSION (generate (second tree)) @@ -308,11 +326,3 @@ :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)) \ No newline at end of file diff --git a/src/mw_parser/simplify.clj b/src/mw_parser/simplify.clj index 7c5b45a..643a23e 100644 --- a/src/mw_parser/simplify.clj +++ b/src/mw_parser/simplify.clj @@ -25,34 +25,38 @@ ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(declare simplify-flow simplify-rule) - -;; (defn simplify-qualifier -;; "Given that this `tree` fragment represents a qualifier, what -;; qualifier is that?" -;; [tree] -;; (cond -;; (empty? tree) nil -;; (and (coll? tree) -;; (#{:EQUIVALENCE :COMPARATIVE} (first tree))) tree -;; (coll? (first tree)) (or (simplify-qualifier (first tree)) -;; (simplify-qualifier (rest tree))) -;; (coll? tree) (simplify-qualifier (rest tree)) -;; :else tree)) +(declare simplify) (defn simplify-second-of-two "There are a number of possible simplifications such that if the `tree` has only two elements, the second is semantically sufficient." [tree] - (if (= (count tree) 2) (simplify-rule (nth tree 1)) tree)) + (if (= (count tree) 2) (simplify (nth tree 1)) tree)) -;; (defn simplify-quantifier -;; "If this quantifier is a number, 'simplifiy' it into a comparative whose operator is '=' -;; and whose quantity is that number. This is actually more complicated but makes generation easier." -;; [tree] -;; (if (number? (second tree)) [:COMPARATIVE '= (second tree)] (simplify-rule (second tree)))) +(defn simplify-chained-list + "Some parse trees take the form + `[:X [:Y 1] :NOISE :NOISE [:X [:Y 2] :NOISE :NOISE [:X [:Y 3]]]]` + where what's wanted is `[:X [:Y 1] [:Y 2] [:Y 2]]` -- :DISJUNCT-VALUE is a case + in point. This takes such a parse `tree`, where `branch-tag` is the tag of + the enclosing form and `leaf-tag` is the tag of the form to be collected, and + returns the desired form." + [tree branch-tag leaf-tag] + (cons + (first tree) + (reverse + (loop [chain (rest tree) v '()] + (let [car (first chain)] + (cond (empty? chain) v + (coll? car) (let [caar (first car)] + (cond + (= branch-tag caar) (recur car v) + (= leaf-tag caar) (recur + (rest chain) + (cons (simplify car) v)) + :else (recur (rest chain) v))) + :else (recur (rest chain) v))))))) -(defn simplify-rule +(defn simplify "Simplify/canonicalise this `tree`. Opportunistically replace complex fragments with semantically identical simpler fragments" [tree] @@ -60,19 +64,22 @@ (coll? tree) (case (first tree) :ACTION (simplify-second-of-two tree) - :ACTIONS (cons (first tree) (simplify-rule (rest tree))) + :ACTIONS (cons (first tree) (simplify (rest tree))) + :AND nil :CHANCE-IN nil :COMPARATIVE (simplify-second-of-two tree) :CONDITION (simplify-second-of-two tree) :CONDITIONS (simplify-second-of-two tree) + :DISJUNCT-EXPRESSION (simplify-chained-list tree :DISJUNCT-VALUE :VALUE) :EXPRESSION (simplify-second-of-two tree) + :IN nil :PROPERTY (simplify-second-of-two tree) :PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree) + :OR nil :SPACE nil :THEN nil - :AND nil :VALUE (simplify-second-of-two tree) - (remove nil? (map simplify-rule tree))) + (remove nil? (map simplify tree))) tree)) (defn simplify-determiner-condition diff --git a/test/mw_parser/core_test.clj b/test/mw_parser/core_test.clj index f0e152e..4ff8be6 100644 --- a/test/mw_parser/core_test.clj +++ b/test/mw_parser/core_test.clj @@ -1,9 +1,10 @@ (ns mw-parser.core-test - (:use clojure.pprint - mw-engine.core - mw-engine.world) - (:require [clojure.test :refer :all] - [mw-parser.core :refer :all])) + (:require [clojure.test :refer [deftest is testing]] + [mw-engine.core :refer [transform-world]] + [mw-engine.world :refer [make-world]] + [mw-parser.core :refer [compile-rule parse-property-value + parse-rule parse-simple-value + parse-value]])) (deftest primitives-tests (testing "Simple functions supporting the parser" @@ -356,8 +357,7 @@ "Rule fires when condition is met (strip of altitude 0 down right hand side)") (is (nil? (apply afn (list {:x 0 :y 1} world))) "Left of world is all high, so rule should not fire."))) - - + ;; 'single action' already tested in 'condition' tests above ;; action and actions (testing "Conjunction of actions" diff --git a/test/mw_parser/generate_test.clj b/test/mw_parser/generate_test.clj index eacd48c..5220b98 100644 --- a/test/mw_parser/generate_test.clj +++ b/test/mw_parser/generate_test.clj @@ -1,57 +1,87 @@ -(ns mw-parser.generate-test - (:use clojure.pprint - mw-engine.core - mw-engine.world - mw-engine.utils - mw-parser.utils) - (:require [clojure.test :refer :all] - [mw-parser.generate :refer :all])) +(ns mw-parser.generate-test + (:require [clojure.test :refer [deftest is testing]] + [mw-parser.generate :refer [generate]])) +;; TODO: these tests are badly written and many (all?!?) of them were not +;; actually firing. rewrite ALL to the pattern: +;; +;; (let [actual ... +;; expected ...] +;; (is (= actual expected))) (deftest expressions-tests (testing "Generating primitive expressions." - (is (generate '(:NUMERIC-EXPRESSION (:NUMBER "50"))) 50) - (is (generate '(:NUMERIC-EXPRESSION (:SYMBOL "sealevel"))) - '(:sealevel cell)) - )) - + (is (= (generate '(:NUMERIC-EXPRESSION (:NUMBER "50"))) 50)) + (is (= (generate '(:NUMERIC-EXPRESSION (:SYMBOL "sealevel"))) + '(:sealevel cell))))) (deftest lhs-generators-tests (testing "Generating left-hand-side fragments of rule functions from appropriate fragments of parse trees" - (is (generate - '(:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest"))) - '(= (:state cell) :forest)) - (is (generate + (let [expected '(= (:state cell) (or (:forest cell) :forest)) + actual (generate + '(:PROPERTY-CONDITION + (:SYMBOL "state") + [:EQUIVALENCE [:IS "is"]] + (:SYMBOL "forest")))] + (is (= actual expected))) + (is (= (generate '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:EQUIVALENCE [:IS "is"]] (:NUMBER "10"))) - '(= (:fertility cell) 10)) - (is (generate '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:COMPARATIVE [:LESS "less"]] (:NUMBER "10"))) - '(< (:fertility cell) 10)) - (is (generate '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:COMPARATIVE [:MORE "more"]] (:NUMBER "10"))) - '(> (:fertility cell) 10)) - (is (generate '(:CONJUNCT-CONDITION (:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest")) (:AND "and") (:PROPERTY-CONDITION (:SYMBOL "fertility") [:EQUIVALENCE [:IS "is"]] (:NUMBER "10")))) - '(and (= (:state cell) :forest) (= (:fertility cell) 10))) - (is (generate '(:DISJUNCT-CONDITION (:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest")) (:OR "or") (:PROPERTY-CONDITION (:SYMBOL "fertility") [:EQUIVALENCE [:IS "is"]] (:NUMBER "10")))) - '(or (= (:state cell) :forest) (= (:fertility cell) 10))) - (is (generate '(:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:DISJUNCT-EXPRESSION (:IN "in") (:DISJUNCT-VALUE (:SYMBOL "grassland") (:OR "or") (:DISJUNCT-VALUE (:SYMBOL "pasture") (:OR "or") (:DISJUNCT-VALUE (:SYMBOL "heath"))))))) - '(let [value (:state cell)] (some (fn [i] (= i value)) (quote (:grassland :pasture :heath))))) - (is (generate '(:PROPERTY-CONDITION (:SYMBOL "altitude") [:EQUIVALENCE [:IS "is"]] (:RANGE-EXPRESSION (:BETWEEN "between") (:NUMERIC-EXPRESSION (:NUMBER "50")) (:AND "and") (:NUMERIC-EXPRESSION (:NUMBER "100"))))) - '(let [lower (min 50 100) upper (max 50 100)] (and (>= (:altitude cell) lower) (<= (:altitude cell) upper)))) - )) - + '(= (:fertility cell) 10))) + (is (= (generate '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:COMPARATIVE [:LESS "less"]] (:NUMBER "10"))) + '(< (:fertility cell) 10))) + (is (= (generate '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:COMPARATIVE [:MORE "more"]] (:NUMBER "10"))) + '(> (:fertility cell) 10))) + (is (= (generate '(:CONJUNCT-CONDITION + (:PROPERTY-CONDITION + (:SYMBOL "state") + (:QUALIFIER (:EQUIVALENCE (:IS "is"))) + (:SYMBOL "forest")) + (:PROPERTY-CONDITION + (:SYMBOL "fertility") + (:QUALIFIER (:EQUIVALENCE (:IS "is"))) + (:NUMBER "10")))) + '(and (= (:state cell) (or (:forest cell) :forest)) (= (:fertility cell) 10)))) + (is (= (generate '(:DISJUNCT-CONDITION (:PROPERTY-CONDITION (:SYMBOL "state") (:EQUIVALENCE (:IS "is")) (:SYMBOL "forest")) (:PROPERTY-CONDITION (:SYMBOL "fertility") (:EQUIVALENCE (:IS "is")) (:NUMBER "10")))) + '(or (= (:state cell) (or (:forest cell) :forest)) (= (:fertility cell) 10)))) + (is (= (generate '(:PROPERTY-CONDITION + (:SYMBOL "state") + (:QUALIFIER (:EQUIVALENCE (:IS "is"))) + (:DISJUNCT-EXPRESSION + (:SYMBOL "heath") + (:SYMBOL "scrub") + (:SYMBOL "forest")))) + '(#{:scrub :forest :heath} (:state cell)))) + (is (= (generate '(:PROPERTY-CONDITION (:SYMBOL "altitude") [:EQUIVALENCE [:IS "is"]] (:RANGE-EXPRESSION (:BETWEEN "between") (:NUMERIC-EXPRESSION (:NUMBER "50")) (:AND "and") (:NUMERIC-EXPRESSION (:NUMBER "100"))))) + '(let [lower (min 50 100) upper (max 50 100)] (and (>= (:altitude cell) lower) (<= (:altitude cell) upper))))))) (deftest rhs-generators-tests (testing "Generating right-hand-side fragments of rule functions from appropriate fragments of parse trees" - (is (generate + (is (= (generate '(:SIMPLE-ACTION (:SYMBOL "state") (:BECOMES "should be") (:SYMBOL "climax"))) - '(merge cell {:state :climax})) - (is (generate + '(merge cell {:state :climax}))) + (is (= (generate '(:SIMPLE-ACTION (:SYMBOL "fertility") (:BECOMES "should be") (:NUMBER "10"))) - '(merge cell {:fertility 10})) - )) - + '(merge cell {:fertility 10}))))) (deftest full-generation-tests (testing "Full rule generation from pre-parsed tree" - (is (generate '(:RULE (:IF "if") (:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest")) (:SIMPLE-ACTION (:SYMBOL "state") (:BECOMES "should be") (:SYMBOL "climax")))) - '(fn [cell world] (if (= (:state cell) :forest) (merge cell {:state :climax})))) - )) + (let [rule '(:RULE + (:IF "if") + (:PROPERTY-CONDITION + (:SYMBOL "state") + (:QUALIFIER (:EQUIVALENCE (:IS "is"))) + (:SYMBOL "forest")) + (:ACTIONS + (:SIMPLE-ACTION + (:SYMBOL "state") + (:BECOMES "should be") + (:SYMBOL "climax")))) + expected '(fn [cell world] + (when + (= (:state cell) (or (:forest cell) :forest)) + (merge cell {:state :climax}))) + actual (generate rule) + expected-meta {:rule-type :production} + actual-meta (meta actual)] + (is (= actual expected)) + (is (= actual-meta expected-meta))))) diff --git a/test/mw_parser/simplify_test.clj b/test/mw_parser/simplify_test.clj new file mode 100644 index 0000000..a585567 --- /dev/null +++ b/test/mw_parser/simplify_test.clj @@ -0,0 +1,98 @@ +(ns mw-parser.simplify-test + (:require [clojure.test :refer [deftest is testing]] + [mw-parser.declarative :refer [parse-rule]] + [mw-parser.simplify :refer [simplify]] + [mw-parser.utils :refer [search-tree]])) + +((deftest disjunct-condition-test + (testing "Generation of disjunct conditions has been producing wrong + output -- in a way which didn't actually alter the + correctness of the rule -- since the beginning, and because + of inadequate and badly written tests, I didn't know it." + (let [expected '(:DISJUNCT-CONDITION + (:PROPERTY-CONDITION + (:SYMBOL "state") + (:QUALIFIER (:EQUIVALENCE (:IS "is"))) + (:SYMBOL "forest")) + (:PROPERTY-CONDITION + (:SYMBOL "fertility") + (:QUALIFIER (:EQUIVALENCE (:IS "is"))) + (:NUMBER "10"))) + actual (simplify [:DISJUNCT-CONDITION + [:CONDITION + [:PROPERTY-CONDITION + [:PROPERTY [:SYMBOL "state"]] + [:SPACE " "] + [:QUALIFIER [:EQUIVALENCE [:IS "is"]]] + [:SPACE " "] + [:EXPRESSION [:VALUE [:SYMBOL "forest"]]]]] + [:SPACE " "] + [:OR "or"] + [:SPACE " "] + [:CONDITIONS + [:CONDITION + [:PROPERTY-CONDITION + [:PROPERTY [:SYMBOL "fertility"]] + [:SPACE " "] + [:QUALIFIER [:EQUIVALENCE [:IS "is"]]] + [:SPACE " "] + [:EXPRESSION [:VALUE [:NUMBER "10"]]]]]]])] + (is (= actual expected)))))) + +(deftest conjunct-condition-test + (testing "Conjunct conditions were failing in more or less the same way" + (let [expected '(:CONJUNCT-CONDITION + (:PROPERTY-CONDITION + (:SYMBOL "state") + (:QUALIFIER (:EQUIVALENCE (:IS "is"))) + (:SYMBOL "forest")) + (:PROPERTY-CONDITION + (:SYMBOL "fertility") + (:QUALIFIER (:EQUIVALENCE (:IS "is"))) + (:NUMBER "10"))) + actual (simplify [:CONJUNCT-CONDITION + [:CONDITION + [:PROPERTY-CONDITION + [:PROPERTY [:SYMBOL "state"]] + [:SPACE " "] + [:QUALIFIER [:EQUIVALENCE [:IS "is"]]] + [:SPACE " "] + [:EXPRESSION [:VALUE [:SYMBOL "forest"]]]]] + [:SPACE " "] + [:AND "and"] + [:SPACE " "] + [:CONDITIONS + [:CONDITION + [:PROPERTY-CONDITION + [:PROPERTY [:SYMBOL "fertility"]] + [:SPACE " "] + [:QUALIFIER [:EQUIVALENCE [:IS "is"]]] + [:SPACE " "] + [:EXPRESSION [:VALUE [:NUMBER "10"]]]]]]])] + (is (= actual expected))))) + +((deftest unchained-disjuncts-test + (testing "Disjunct values should not be chained" + (let [wrong '(:DISJUNCT-EXPRESSION + (:IN "in") + (:DISJUNCT-VALUE + (:SYMBOL "heath") + (:DISJUNCT-VALUE + (:SYMBOL "scrub") + (:DISJUNCT-VALUE (:SYMBOL "forest"))))) + parse-tree (search-tree + (parse-rule + "if state is not in heath or scrub or forest then state should be climax") + :DISJUNCT-EXPRESSION) + actual (simplify parse-tree)] + (is (not (= wrong actual)))) + (let [expected '(:DISJUNCT-EXPRESSION + (:SYMBOL "heath") + (:SYMBOL "scrub") + (:SYMBOL "forest")) + parse-tree (search-tree + (parse-rule + "if state is not in heath or scrub or forest then state should be climax") + :DISJUNCT-EXPRESSION) + actual (simplify parse-tree)] + (is (= expected actual)))))) \ No newline at end of file