Started work on generating code from flow rules.

src/mw_parser/core.clj

@@ -3,11 +3,10 @@
             **NOTE**: This parser is obsolete and is superceded by the 
             declarative parser, q.v."
       :author "Simon Brooke"}
-  mw-parser.core
-  (:use mw-engine.utils
-        [clojure.string :only [split trim triml]])
-  (:gen-class)
-)
+ mw-parser.core
+  (:require [clojure.string :only [split trim triml]]
+            [mw-engine.utils :refer [member?]])
+  (:gen-class))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;
@@ -81,7 +80,7 @@
   (cond
     (re-matches re-number token) (read-string token)
     (keyword? token) token
-    true (keyword token)))
+    :else (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
@@ -97,35 +96,34 @@
 (defn parse-numeric-value
   "Parse a number."
   [[value & remainder]]
-  (if (and value (re-matches re-number value)) [(read-string value) remainder]))
+  (when (and value (re-matches re-number value)) [(read-string value) remainder]))
 
 (defn parse-property-int
   "Parse a token assumed to be the name of a property of the current cell,
   whose value is assumed to be an integer."
   [[value & remainder]]
-  (if value [(list 'get-int 'cell (keyword value)) remainder]))
+  (when value [(list 'get-int 'cell (keyword value)) remainder]))
 
 (defn parse-property-value
   "Parse a token assumed to be the name of a property of the current cell."
   [[value & remainder]]
-  (if value [(list (keyword value) 'cell) remainder]))
+  (when value [(list (keyword value) 'cell) remainder]))
 
 (defn parse-token-value
   "Parse a token assumed to be a simple token value."
   [[value & remainder]]
-  (if value [(keyword value) remainder]))
+  (when value [(keyword value) remainder]))
 
 (defn parse-simple-value
   "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."
   ([tokens expect-int]
-    (or
-        (parse-numeric-value tokens)
-        (cond expect-int
-          (parse-property-int tokens)
-          true (parse-token-value tokens))))
+   (or
+    (parse-numeric-value tokens)
+    (cond expect-int (parse-property-int tokens)
+          :else (parse-token-value tokens))))
   ([tokens]
-    (parse-simple-value tokens false)))
+   (parse-simple-value tokens false)))
 
 (defn gen-token-value
   "Parse a single value from this single token and return just the generated
@@ -138,28 +136,28 @@
    integers or things which will evaluate to integers."
   [[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]))))
+        (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])
+                :else
+                [(list value) tokens]))))
 
 (defn parse-value
   "Parse a value from among these `tokens`. If `expect-int` is true, return
    an integer or something which will evaluate to an integer."
   ([tokens expect-int]
-    (or
-      (parse-disjunct-value tokens expect-int)
-      (parse-simple-value tokens expect-int)))
+   (or
+    (parse-disjunct-value tokens expect-int)
+    (parse-simple-value tokens expect-int)))
   ([tokens]
-    (parse-value tokens false)))
+   (parse-value tokens false)))
 
 (defn parse-member-condition
   "Parses a condition of the form '[property] in [value] or [value]...'"
   [[property IS IN & rest]]
-  (if (and (member? IS '("is" "are")) (= IN "in"))
+  (when (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])))
 
@@ -167,73 +165,72 @@
   "Parse '[property] less than [value]'."
   [[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])))
+        (let [[value remainder] (parse-value rest true)]
+          [(list '< (list 'get-int 'cell (keyword property)) value) remainder])))
 
 (defn- parse-more-condition
   "Parse '[property] more than [value]'."
   [[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])))
+        (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])))
+        (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])))
 
 (defn- parse-is-condition
   "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."
   [[property IS value & rest]]
-  (cond
+  (when
     (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]))))
+    (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])))
 
 (defn- parse-not-condition
   "Parse the negation of a simple 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])))))
+        (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])
+   [(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)))
+   (gen-neighbours-condition comp1 quantity property value remainder comp2 1)))
 
 (defn parse-comparator-neighbours-condition
   "Parse conditions of the form '...more than 6 neighbours are [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")) '<)]
+                         (member? MORE '("fewer" "less")) '<)]
     (cond
       (not= WITHIN "within")
       (parse-comparator-neighbours-condition
-        (flatten
+       (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)))
+        (list MORE THAN n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest)))
       (and quantity
            comparator
            (= THAN "than")
@@ -247,15 +244,14 @@
         (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)
-            ))))))
+                (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]]
@@ -272,11 +268,11 @@
       (cond
         (not= WITHIN "within")
         (parse-simple-neighbours-condition
-          (flatten
+         (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)))
+          (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)]
@@ -285,42 +281,40 @@
         (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)
-            ))))))
+                (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)))))))
 
 (defn parse-neighbours-condition
   "Parse conditions referring to neighbours"
   [tokens]
   (or
-    (parse-simple-neighbours-condition tokens)
-    (parse-comparator-neighbours-condition tokens)
-    (parse-some-neighbours-condition tokens)
-    ))
+   (parse-simple-neighbours-condition tokens)
+   (parse-comparator-neighbours-condition tokens)
+   (parse-some-neighbours-condition tokens)))
 
 (defn parse-simple-condition
   "Parse conditions of the form '[property] [comparison] [value]'."
   [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-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)))
 
 (defn- parse-disjunction-condition
   "Parse '... or [condition]' from `tokens`, where `left` is the already parsed first disjunct."
   [left tokens]
   (let [partial (parse-conditions tokens)]
-    (if partial
+    (when partial
       (let [[right remainder] partial]
         [(list 'or left right) remainder]))))
 
@@ -328,7 +322,7 @@
   "Parse '... and [condition]' from `tokens`, where `left` is the already parsed first conjunct."
   [left tokens]
   (let [partial (parse-conditions tokens)]
-    (if partial
+    (when partial
       (let [[right remainder] partial]
         [(list 'and left right) remainder]))))
 
@@ -336,19 +330,19 @@
   "Parse conditions from `tokens`, where conditions may be linked by either 'and' or 'or'."
   [tokens]
   (let [partial (parse-simple-condition tokens)]
-    (if partial
+    (when partial
       (let [[left [next & remainder]] partial]
         (cond
           (= next "and") (parse-conjunction-condition left remainder)
           (= next "or") (parse-disjunction-condition left remainder)
-          true partial)))))
+          :else partial)))))
 
 (defn- parse-left-hand-side
- "Parse the left hand side ('if...') of a production rule."
- [[IF & tokens]]
- (if
+  "Parse the left hand side ('if...') of a production rule."
+  [[IF & tokens]]
+  (when
    (= IF "if")
-   (parse-conditions tokens)))
+    (parse-conditions tokens)))
 
 (defn- parse-arithmetic-action
   "Parse actions of the form '[property] should be [property] [arithmetic-operator] [value]',
@@ -357,16 +351,19 @@
   (cond
     (member? prop1 '("x" "y"))
     (throw
-      (Exception. reserved-properties-error))
+     (Exception. reserved-properties-error))
     (and (= SHOULD "should")
-           (= BE "be")
-           (member? operator '("+" "-" "*" "/")))
+         (= 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]))
+                                  (list (symbol operator)
+                                        (list 'get-int 'cell (keyword prop2))
+                                        (if
+                                         (re-matches re-number value)
+                                          (read-string value)
+                                          (list 'get-int 'cell (keyword value)))))})
+     rest]))
 
 (defn- parse-set-action
   "Parse actions of the form '[property] should be [value].'"
@@ -374,10 +371,13 @@
   (cond
     (member? property '("x" "y"))
     (throw
-      (Exception. reserved-properties-error))
+     (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]))
+           {(keyword property) (if
+                                (re-matches re-number value)
+                                 (read-string value)
+                                 (keyword value))}) rest]))
 
 (defn- parse-simple-action [previous tokens]
   (or (parse-arithmetic-action previous tokens)
@@ -390,29 +390,29 @@
     (cond left
           (cond (= (first remainder) "and")
                 (parse-actions left (rest remainder))
-                true (list left)))))
+                :else (list left)))))
 
 (defn- parse-probability
   "Parse a probability of an action from this collection of tokens"
   [previous [n CHANCE IN m & tokens]]
   (cond
-    (and (= CHANCE "chance")(= IN "in"))
+    (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]))))
+            [(list 'cond
+                   (list '<
+                         (list 'rand
+                               (first (parse-simple-value (list m) true)))
+                         (first (parse-simple-value (list n) true)))
+                   action) remainder]))))
 
 (defn- parse-right-hand-side
   "Parse the right hand side ('then...') of a production rule."
   [[THEN & tokens]]
-  (if (= THEN "then")
+  (when (= THEN "then")
     (or
-      (parse-probability nil tokens)
-      (parse-actions nil tokens))))
+     (parse-probability nil tokens)
+     (parse-actions nil tokens))))
 
 (defn parse-rule
   "Parse a complete rule from this `line`, expected to be either a string or a
@@ -420,18 +420,16 @@
 
    Throws an exception if parsing fails."
   [line]
-  (cond
-   (string? line)
-   (let [rule (parse-rule (split (triml line) #"\s+"))]
-     (cond rule rule
-       true (throw (Exception. (format bad-parse-error line)))))
-   true
+  (if
+   (string? line) (let [rule (parse-rule (split (triml line) #"\s+"))]
+                    (if rule rule
+                        (throw (Exception. (format bad-parse-error line)))))
    (let [[left remainder] (parse-left-hand-side line)
-              [right junk] (parse-right-hand-side remainder)]
-     (cond
+         [right junk] (parse-right-hand-side remainder)]
+     (when
        ;; 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))
+      (and left right (empty? junk))
        (list 'fn ['cell 'world] (list 'if left right))))))
 
 (defn compile-rule
@@ -444,11 +442,10 @@
 
    Throws an exception if parsing fails."
   ([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))))
+   (let [afn (eval (parse-rule rule-text))]
+     (if
+      (and afn return-tuple?)
+       (list afn (trim rule-text))
+       afn)))
   ([rule-text]
-    (compile-rule rule-text false)))
+   (compile-rule rule-text false)))

src/mw_parser/declarative.clj

@@ -1,9 +1,10 @@
 (ns ^{:doc "A very simple parser which parses production rules."
       :author "Simon Brooke"}
  mw-parser.declarative
-  (:require [instaparse.core :refer [parser]]
-            [clojure.string :refer [join trim]]
+  (:require [clojure.string :refer [join split trim]]
+            [instaparse.core :refer [parser]]
             [mw-parser.errors :refer [throw-parse-exception]]
+            [mw-parser.flow :refer [flow-grammar]]
             [mw-parser.generate :refer [generate]]
             [mw-parser.simplify :refer [simplify]]
             [mw-parser.utils :refer [rule?]]
@@ -71,8 +72,7 @@
               "SPACE := #'\\s+';"
               "VALUE := SYMBOL | NUMBER;"
               "VALUE := SYMBOL | NUMBER;"
-              "WITHIN-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE WITHIN SPACE NUMBER SPACE IS SPACE PROPERTY-CONDITION-OR-EXPRESSION;"
-              ]))
+              "WITHIN-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE WITHIN SPACE NUMBER SPACE IS SPACE PROPERTY-CONDITION-OR-EXPRESSION;"]))
 
 (def keywords-en
   "English language keyword literals used in rules - both in production
@@ -81,33 +81,33 @@
       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."
-  (join "\n" ["ALL := 'all'" 
-              "AND := 'and';" 
-              "BECOMES := 'should be' | 'becomes';" 
-              "BETWEEN := 'between';" 
-              "CHANCE-IN := 'chance in';" 
+  (join "\n" ["ALL := 'all'"
+              "AND := 'and';"
+              "BECOMES := 'should be' | 'becomes';"
+              "BETWEEN := 'between';"
+              "CHANCE-IN := 'chance in';"
               "EACH := 'each' | 'every' | 'all';"
-              "EQUAL := 'equal to';" 
+              "EQUAL := 'equal to';"
               "FIRST := 'first';"
-              "FLOW := 'flow' | 'move';" 
+              "FLOW := 'flow' | 'move';"
               "FROM := 'from';"
-              "IF := 'if';" 
-              "IN := 'in';" 
-              "IS := 'is' | 'are' | 'have' | 'has';" 
+              "IF := 'if';"
+              "IN := 'in';"
+              "IS := 'is' | 'are' | 'have' | 'has';"
               "LEAST := 'least';"
-              "LESS := 'less' | 'fewer';" 
-              "MORE := 'more' | 'greater';" 
+              "LESS := 'less' | 'fewer';"
+              "MORE := 'more' | 'greater';"
               "MOST := 'most';"
-              "NEIGHBOURS := 'neighbour' | 'neighbor' | 'neighbours' | 'neighbors';" 
-              "NONE := 'no';" 
-              "NOT := 'not';" 
-              "OR := 'or';" 
-              "SOME := 'some';" 
+              "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';" 
+              "SYMBOL := #'[a-z]+';"
+              "THAN := 'than';"
+              "THEN := 'then';"
               "TO := 'to';"
               "WITH := 'with' | 'where' | 'having';"
               "WITHIN := 'within';"]))
@@ -122,7 +122,7 @@
   ([^Locale _locale]
    keywords-en))
 
-(defmacro build-parser 
+(defmacro build-parser
   "Compose this grammar fragment `g` with the common grammar fragments to 
    make a complete grammar, and return a parser for that complete grammar."
   [g]
@@ -132,6 +132,22 @@
   "Parse the argument, assumed to be a string in the correct syntax, and return a parse tree."
   (build-parser rule-grammar))
 
+(def parse-flow
+  "Parse the argument, assumed to be a string in the correct syntax, and return a parse tree."
+  (build-parser flow-grammar))
+
+(defn parse
+  "Top level parser function: parse this `text` as either a production or a flow rule; 
+   return a raw parse tree."
+  [^String rule-text]
+  (let [text (trim rule-text)]
+    (when-not (zero? (count text))
+      (case (first (split text #"\s+"))
+        "if" (parse-rule text)
+        "flow" (parse-flow text)
+        ";;" nil
+        (throw (ex-info "Rule text was not recognised" {:text text}))))))
+
 (defn compile-rule
   "Parse this `rule-text`, a string conforming to the grammar of MicroWorld rules,
   into Clojure source, and then compile it into an anonymous

src/mw_parser/flow.clj

@@ -1,9 +1,7 @@
 (ns ^{:doc "A very simple parser which parses flow rules."
       :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]]))
+  (:require [clojure.string :refer [join]]))
 
 (def flow-grammar
   "Grammar for flow rules.
@@ -21,7 +19,7 @@
    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`
+   `flow 1 food from house to house within 2 with least food`
    "
   (join "\n" ["FLOW-RULE := FLOW SPACE QUANTITY SPACE PROPERTY SPACE FROM SPACE SOURCE SPACE TO-HOW SPACE DESTINATION;"
               "PERCENTAGE := NUMBER #'%';"
@@ -35,33 +33,3 @@
               "TO-HOW := TO | TO-EACH | TO-FIRST;"
               "TO-EACH := TO SPACE EACH | TO SPACE ALL;"
               "TO-FIRST := TO SPACE FIRST"]))
-
-(def parse-flow
-  "Parse the argument, assumed to be a string in the correct syntax, and return a parse tree."
-  (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))
-

src/mw_parser/generate.clj

@@ -280,9 +280,23 @@
 ;;; (fn [cell world])
 ;;;    (if (= (:state cell) (or (:house cell) :house))
 
+(defmacro flow-rule
+  [source property quantity-frag destinations]
+  `(fn [cell world]
+     (when (and ~source (pos? cell ~property))
+       (map 
+       (fn [d] {:source (select-keys cell [:x :y])
+                :destination (select-keys d [:x :y])
+                :property ~property
+                :quantity ~quantity-frag})
+        ~destinations))))
+
 (defn generate-flow
   [tree]
-  (assert-type tree :FLOW-RULE))
+  (assert-type tree :FLOW-RULE)
+  (let [clauses (reduce #(assoc %1 (first %2) %2) {} (rest tree))]
+    (list 'fn ['cell 'world] 
+          (list 'when (generate (:SOURCE clauses))))))
 
 ;;; Top level; only function anything outside this file (except tests) should 
 ;;; really call.