Continued work on cleaning up the parser

src/mw_parser/bulk.clj

@@ -1,10 +1,9 @@
 (ns ^{:doc "parse multiple rules from a stream, possibly a file."
       :author "Simon Brooke"}
   mw-parser.bulk
-  (:require [clojure.string :refer [split trim]]
+  (:require [clojure.string :refer [split]]
-            [mw-engine.utils :refer [member?]]
+            [mw-parser.declarative :refer [compile]]
-            [mw-parser.declarative :refer [compile-rule]])
+            [mw-parser.utils :refer [comment?]]))
-  (:import (java.io BufferedReader StringReader)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;
@@ -29,16 +28,12 @@
 ;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defn comment?
-  "Is this `line` a comment?"
-  [line]
-  (or (empty? (trim line)) (member? (first line) '(nil \# \;))))
 
 (defn parse-string
   "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."
   [string]
-  (map compile-rule 
+  (map compile 
        (remove comment? (split string #"\n"))))
 
 (defn parse-file
@@ -47,14 +42,8 @@
   [filename]
   (parse-string (slurp filename)))
 
-(defn compile-string
-  "Compile each non-comment line of this `string` into an executable anonymous
-   function, and return the sequence of such functions."
-  [string]
-  (map #(compile-rule % true) (remove comment? (split string #"\n"))))
-
 (defn compile-file
   "Compile each non-comment line of the file indicated by this `filename` into
    an executable anonymous function, and return the sequence of such functions."
   [filename]
-  (compile-string (slurp filename)))
+  (compile (slurp filename) true))

src/mw_parser/declarative.clj

@@ -1,13 +1,12 @@
 (ns ^{:doc "A very simple parser which parses production rules."
       :author "Simon Brooke"}
  mw-parser.declarative
-  (:require [clojure.string :refer [join split trim]]
+  (:require [clojure.string :refer [join split split-lines 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?]]
+            [mw-parser.utils :refer [comment?]]
             [trptr.java-wrapper.locale :refer [get-default]])
   (:import [java.util Locale]))
 
@@ -148,7 +147,7 @@
         ";;" nil
         (throw (ex-info "Rule text was not recognised" {:text text}))))))
 
-(defn compile-rule
+(defn compile
   "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
@@ -158,20 +157,23 @@
 
    Throws an exception if parsing fails."
   ([rule-text return-tuple?]
-   (let [src (trim rule-text)
+   (let [lines (remove comment? (split-lines rule-text))]
-         parse-tree (simplify (parse src))
+     (if (> (count lines) 1)
-         fn' (generate parse-tree)
+       (map #(compile % return-tuple?) lines)
-         afn (try
+       (let [src (trim rule-text)
-               (if (= 'fn (first fn'))
+             parse-tree (simplify (parse src))
-                 (vary-meta (eval fn') merge (meta fn'))
+             fn' (generate parse-tree)
-                 (throw (Exception. (format "Parse of `%s` did not return a functionn" src))))
+             afn (try
-               (catch Exception any (throw (ex-info (.getMessage any)
+                   (if (= 'fn (first fn'))
-                                                    {:src src
+                     (vary-meta (eval fn') merge (meta fn'))
-                                                     :parse parse-tree
+                     (throw (Exception. (format "Parse of `%s` did not return a functionn" src))))
-                                                     :fn fn'}))))]
+                   (catch Exception any (throw (ex-info (.getMessage any)
-     (if
+                                                        {:src src
-      return-tuple?
+                                                         :parse parse-tree
-       (list afn (trim rule-text))
+                                                         :fn fn'}))))]
-       afn)))
+         (if
+          return-tuple?
+           (vary-meta (list afn src fn') merge (meta afn))
+           afn)))))
   ([rule-text]
-   (compile-rule rule-text false)))
+   (compile rule-text false)))

src/mw_parser/utils.clj

@@ -1,6 +1,8 @@
 (ns ^{:doc "Utilities used in more than one namespace within the parser."
       :author "Simon Brooke"}
-  mw-parser.utils)
+  mw-parser.utils 
+  (:require [clojure.string :refer [trim]]
+            [mw-engine.utils :refer [member?]]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;
@@ -25,6 +27,10 @@
 ;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(defn comment?
+  "Is this `line` a comment?"
+  [line]
+  (or (empty? (trim line)) (member? (first line) '(nil \# \;))))
 
 (defn suitable-fragment?
   "Return `true` if `tree-fragment` appears to be a tree fragment of the expected `type`."

test/mw_parser/declarative_test.clj

@@ -3,7 +3,7 @@
             [mw-engine.core :refer [transform-world]]
             [mw-engine.utils :refer [get-cell]]
             [mw-engine.world :refer [make-world]]
-            [mw-parser.declarative :refer [compile-rule parse-rule]]
+            [mw-parser.declarative :refer [compile parse-rule]]
             [mw-parser.utils :refer [rule?]]))
 
 (deftest rules-tests
@@ -34,18 +34,18 @@
 (deftest exception-tests
   (testing "Constructions which should cause exceptions to be thrown"
     (is (thrown-with-msg? Exception #"^I did not understand.*"
-                          (compile-rule "the quick brown fox jumped over the lazy dog"))
+                          (compile "the quick brown fox jumped over the lazy dog"))
         "Exception thrown if rule text does not match grammar")
     (is (thrown-with-msg? Exception #"^I did not understand.*"
-                          (compile-rule "if i have a cat on my lap then everything is fine"))
+                          (compile "if i have a cat on my lap then everything is fine"))
         "Exception thrown if rule text does not match grammar")
     (is (thrown-with-msg?
          Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions"
-         (compile-rule "if state is new then x should be 0"))
+         (compile "if state is new then x should be 0"))
         "Exception thrown on attempt to set 'x'")
     (is (thrown-with-msg?
          Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions"
-         (compile-rule "if state is new then y should be 0"))
+         (compile "if state is new then y should be 0"))
         "Exception thrown on attempt to set 'y'")))
 
 
@@ -53,7 +53,7 @@
   ;; these are, in so far as possible, the same as the correctness-tests in core-tests - i.e., the two compilers
   ;; compile the same language.
   (testing "Simplest possible rule"
-    (let [afn (compile-rule "if state is new then state should be grassland")]
+    (let [afn (compile "if state is new then state should be grassland")]
       (is (= (apply afn (list {:state :new} nil))
              {:state :grassland})
           "Rule fires when condition is met")
@@ -61,7 +61,7 @@
           "Rule doesn't fire when condition isn't met")))
 
   (testing "Condition conjunction rule"
-    (let [afn (compile-rule "if state is new and altitude is 0 then state should be water")]
+    (let [afn (compile "if state is new and altitude is 0 then state should be water")]
       (is (= (apply afn (list {:state :new :altitude 0} nil))
              {:state :water :altitude 0})
           "Rule fires when conditions are met")
@@ -71,7 +71,7 @@
           "Rule does not fire: first condition not met")))
 
   (testing "Condition disjunction rule"
-    (let [afn (compile-rule "if state is new or state is waste then state should be grassland")]
+    (let [afn (compile "if state is new or state is waste then state should be grassland")]
       (is (= (apply afn (list {:state :new} nil))
              {:state :grassland})
           "Rule fires: first condition met")
@@ -82,7 +82,7 @@
           "Rule does not fire: neither condition met")))
 
   (testing "Simple negation rule"
-    (let [afn (compile-rule "if state is not new then state should be grassland")]
+    (let [afn (compile "if state is not new then state should be grassland")]
       (is (nil? (apply afn (list {:state :new} nil)))
           "Rule doesn't fire when condition isn't met")
       (is (= (apply afn (list {:state :forest} nil))
@@ -92,15 +92,15 @@
   (testing "Can't set x or y properties"
     (is (thrown-with-msg?
          Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions"
-         (compile-rule "if state is new then x should be 0"))
+         (compile "if state is new then x should be 0"))
         "Exception thrown on attempt to set 'x'")
     (is (thrown-with-msg?
          Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions"
-         (compile-rule "if state is new then y should be 0"))
+         (compile "if state is new then y should be 0"))
         "Exception thrown on attempt to set 'y'"))
 
   (testing "Simple list membership rule"
-    (let [afn (compile-rule "if state is in heath or scrub or forest then state should be climax")]
+    (let [afn (compile "if state is in heath or scrub or forest then state should be climax")]
       (is (= (apply afn (list {:state :heath} nil))
              {:state :climax})
           "Rule fires when condition is met")
@@ -114,7 +114,7 @@
           "Rule does not fire when condition is not met")))
 
   (testing "Negated list membership rule"
-    (let [afn (compile-rule "if state is not in heath or scrub or forest then state should be climax")]
+    (let [afn (compile "if state is not in heath or scrub or forest then state should be climax")]
       (is (nil? (apply afn (list {:state :heath} nil)))
           "Rule does not fire when condition is not met")
       (is (nil? (apply afn (list {:state :scrub} nil)))
@@ -126,7 +126,7 @@
           "Rule fires when condition is met")))
 
   (testing "Property is more than numeric-value"
-    (let [afn (compile-rule "if altitude is more than 200 then state should be snow")]
+    (let [afn (compile "if altitude is more than 200 then state should be snow")]
       (is (= (apply afn (list {:altitude 201} nil))
              {:state :snow :altitude 201})
           "Rule fires when condition is met")
@@ -134,7 +134,7 @@
           "Rule does not fire when condition is not met")))
 
   (testing "Property is more than property"
-    (let [afn (compile-rule "if wolves are more than deer then deer should be 0")]
+    (let [afn (compile "if wolves are more than deer then deer should be 0")]
       (is (= (apply afn (list {:deer 2 :wolves 3} nil))
              {:deer 0 :wolves 3})
           "Rule fires when condition is met")
@@ -142,7 +142,7 @@
           "Rule does not fire when condition is not met")))
 
   (testing "Property is less than numeric-value"
-    (let [afn (compile-rule "if altitude is less than 10 then state should be water")]
+    (let [afn (compile "if altitude is less than 10 then state should be water")]
       (is (= (apply afn (list {:altitude 9} nil))
              {:state :water :altitude 9})
           "Rule fires when condition is met")
@@ -150,7 +150,7 @@
           "Rule does not fire when condition is not met")))
 
   (testing "Property is less than property"
-    (let [afn (compile-rule "if wolves are less than deer then deer should be deer - wolves")]
+    (let [afn (compile "if wolves are less than deer then deer should be deer - wolves")]
       (is (= (apply afn (list {:deer 3 :wolves 2} nil))
              {:deer 1 :wolves 2})
           "Rule fires when condition is met")
@@ -158,14 +158,14 @@
           "Rule does not fire when condition is not met")))
 
   (testing "Number neighbours have property equal to value"
-    (let [afn (compile-rule "if 3 neighbours have state equal to new then state should be water")
+    (let [afn (compile "if 3 neighbours have state equal to new then state should be water")
           world (make-world 3 3)]
       (is (= (apply afn (list {:x 0 :y 0} world))
              {:state :water :x 0 :y 0})
           "Rule fires when condition is met (in a new world all cells are new, corner cell has three neighbours)")
       (is (nil? (apply afn (list {:x 1 :y 1} world)))
           "Middle cell has eight neighbours, so rule does not fire."))
-    (let [afn (compile-rule "if 3 neighbours are new then state should be water")
+    (let [afn (compile "if 3 neighbours are new then state should be water")
           world (make-world 3 3)]
       ;; 'are new' and 'is new' should be the same as 'have state equal to new'
       (is (= (apply afn (list {:x 0 :y 0} world))
@@ -173,7 +173,7 @@
           "Rule fires when condition is met (in a new world all cells are new, corner cell has three neighbours)")
       (is (nil? (apply afn (list {:x 1 :y 1} world)))
           "Middle cell has eight neighbours, so rule does not fire."))
-    (let [afn (compile-rule "if 3 neighbours is new then state should be water")
+    (let [afn (compile "if 3 neighbours is new then state should be water")
           world (make-world 3 3)]
       ;; 'are new' and 'is new' should be the same as 'have state equal to new'
       (is (= (apply afn (list {:x 0 :y 0} world))
@@ -184,76 +184,76 @@
 
   (testing "Number neighbours have property more than numeric-value"
     ;; if 3 neighbours have altitude more than 10 then state should be beach
-    (let [afn (compile-rule "if 3 neighbours have altitude more than 10 then state should be beach")
+    (let [afn (compile "if 3 neighbours have altitude more than 10 then state should be beach")
           world (transform-world
                  (make-world 3 3)
-                 (list (compile-rule "if x is 2 then altitude should be 11")
+                 (list (compile "if x is 2 then altitude should be 11")
-                       (compile-rule "if x is less than 2 then altitude should be 0")))]
+                       (compile "if x is less than 2 then altitude should be 0")))]
       (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
           "Rule fires when condition is met (strip of altitude 11 down right hand side)")
       (is (nil? (apply afn (list {:x 2 :y 1} world)))
           "Middle cell of the strip has only two high neighbours, so rule should not fire.")))
 
   (testing "Number neighbours have property less than numeric-value"
-    (let [afn (compile-rule "if 5 neighbours have altitude less than 10 then state should be beach")
+    (let [afn (compile "if 5 neighbours have altitude less than 10 then state should be beach")
           world (transform-world
                  (make-world 3 3)
-                 (list (compile-rule "if x is 2 then altitude should be 11")
+                 (list (compile "if x is 2 then altitude should be 11")
-                       (compile-rule "if x is less than 2 then altitude should be 0")))]
+                       (compile "if x is less than 2 then altitude should be 0")))]
       (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
           "Rule fires when condition is met (strip of altitude 11 down right hand side)")
       (is (nil? (apply afn (list {:x 2 :y 1} world)))
           "Middle cell of the strip has two high neighbours, so rule should not fire.")))
 
   (testing "More than number neighbours have property equal to numeric-value"
-    (let [afn (compile-rule "if more than 2 neighbours have altitude equal to 11 then state should be beach")
+    (let [afn (compile "if more than 2 neighbours have altitude equal to 11 then state should be beach")
           world (transform-world
                  (make-world 3 3)
-                 (list (compile-rule "if x is 2 then altitude should be 11")
+                 (list (compile "if x is 2 then altitude should be 11")
-                       (compile-rule "if x is less than 2 then altitude should be 0")))]
+                       (compile "if x is less than 2 then altitude should be 0")))]
       (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
           "Rule fires when condition is met (strip of altitude 11 down right hand side)")
       (is (nil? (apply afn (list {:x 2 :y 1} world)))
           "Middle cell of the strip has only two high neighbours, so rule should not fire.")))
 
   (testing "More than number neighbours have property equal to symbolic-value"
-    (let [afn (compile-rule "if more than 2 neighbours have state equal to grassland then state should be beach")
+    (let [afn (compile "if more than 2 neighbours have state equal to grassland then state should be beach")
           world (transform-world
                  (make-world 3 3)
-                 (list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland")
+                 (list (compile "if x is 2 then altitude should be 11 and state should be grassland")
-                       (compile-rule "if x is less than 2 then altitude should be 0 and state should be water")))]
+                       (compile "if x is less than 2 then altitude should be 0 and state should be water")))]
       (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
           "Rule fires when condition is met (strip of altitude 11 down right hand side)")
       (is (nil? (apply afn (list {:x 2 :y 1} world)))
           "Middle cell of the strip has only two high neighbours, so rule should not fire."))
-    (let [afn (compile-rule "if more than 2 neighbours are grassland then state should be beach")
+    (let [afn (compile "if more than 2 neighbours are grassland then state should be beach")
           ;; 'are grassland' should mean the same as 'have state equal to grassland'.
           world (transform-world
                  (make-world 3 3)
-                 (list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland")
+                 (list (compile "if x is 2 then altitude should be 11 and state should be grassland")
-                       (compile-rule "if x is less than 2 then altitude should be 0 and state should be water")))]
+                       (compile "if x is less than 2 then altitude should be 0 and state should be water")))]
       (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
           "Rule fires when condition is met (strip of altitude 11 down right hand side)")
       (is (nil? (apply afn (list {:x 2 :y 1} world)))
           "Middle cell of the strip has only two high neighbours, so rule should not fire.")))
 
   (testing "Fewer than number neighbours have property equal to numeric-value"
-    (let [afn (compile-rule "if fewer than 3 neighbours have altitude equal to 11 then state should be beach")
+    (let [afn (compile "if fewer than 3 neighbours have altitude equal to 11 then state should be beach")
           world (transform-world
                  (make-world 3 3)
-                 (list (compile-rule "if x is 2 then altitude should be 11")
+                 (list (compile "if x is 2 then altitude should be 11")
-                       (compile-rule "if x is less than 2 then altitude should be 0")))]
+                       (compile "if x is less than 2 then altitude should be 0")))]
       (is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach)
           "Rule fires when condition is met (Middle cell of the strip has only two high neighbours)")
       (is (nil? (apply afn (list {:x 1 :y 1} world)))
           "Middle cell of world has three high neighbours, so rule should not fire.")))
 
   (testing "Fewer than number neighbours have property equal to symbolic-value"
-    (let [afn (compile-rule "if fewer than 3 neighbours have state equal to grassland then state should be beach")
+    (let [afn (compile "if fewer than 3 neighbours have state equal to grassland then state should be beach")
           world (transform-world
                  (make-world 3 3)
-                 (list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland")
+                 (list (compile "if x is 2 then altitude should be 11 and state should be grassland")
-                       (compile-rule "if x is less than 2 then altitude should be 0 and state should be water")))]
+                       (compile "if x is less than 2 then altitude should be 0 and state should be water")))]
       (is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach)
           "Rule fires when condition is met (Middle cell of the strip has only two high neighbours)")
       (is (nil? (apply afn (list {:x 1 :y 1} world)))
@@ -261,22 +261,22 @@
 
   ;; some neighbours have property equal to value
   (testing "Some neighbours have property equal to numeric-value"
-    (let [afn (compile-rule "if some neighbours have altitude equal to 11 then state should be beach")
+    (let [afn (compile "if some neighbours have altitude equal to 11 then state should be beach")
           world (transform-world
                  (make-world 3 3)
-                 (list (compile-rule "if x is 2 then altitude should be 11")
+                 (list (compile "if x is 2 then altitude should be 11")
-                       (compile-rule "if x is less than 2 then altitude should be 0")))]
+                       (compile "if x is less than 2 then altitude should be 0")))]
       (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
           "Rule fires when condition is met (strip of altitude 11 down right hand side)")
       (is (nil? (apply afn (list {:x 0 :y 1} world)))
           "Left hand side of world has no high neighbours, so rule should not fire.")))
 
   (testing "Some neighbours have property equal to symbolic-value"
-    (let [afn (compile-rule "if some neighbours have state equal to grassland then state should be beach")
+    (let [afn (compile "if some neighbours have state equal to grassland then state should be beach")
           world (transform-world
                  (make-world 3 3)
-                 (list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland")
+                 (list (compile "if x is 2 then altitude should be 11 and state should be grassland")
-                       (compile-rule "if x is less than 2 then altitude should be 0 and state should be water")))]
+                       (compile "if x is less than 2 then altitude should be 0 and state should be water")))]
       (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
           "Rule fires when condition is met (strip of altitude 11 down right hand side)")
       (is (nil? (apply afn (list {:x 0 :y 1} world)))
@@ -284,11 +284,11 @@
 
   ;; more than number neighbours have property more than numeric-value
   (testing "More than number neighbours have property more than symbolic-value"
-    (let [afn (compile-rule "if more than 2 neighbours have altitude more than 10 then state should be beach")
+    (let [afn (compile "if more than 2 neighbours have altitude more than 10 then state should be beach")
           world (transform-world
                  (make-world 3 3)
-                 (list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland")
+                 (list (compile "if x is 2 then altitude should be 11 and state should be grassland")
-                       (compile-rule "if x is less than 2 then altitude should be 0 and state should be water")))]
+                       (compile "if x is less than 2 then altitude should be 0 and state should be water")))]
       (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
           "Rule fires when condition is met (strip of altitude 11 down right hand side)")
       (is (nil? (apply afn (list {:x 2 :y 1} world)))
@@ -296,11 +296,11 @@
 
   ;; fewer than number neighbours have property more than numeric-value
   (testing "Fewer than number neighbours have property more than numeric-value"
-    (let [afn (compile-rule "if fewer than 3 neighbours have altitude more than 10 then state should be beach")
+    (let [afn (compile "if fewer than 3 neighbours have altitude more than 10 then state should be beach")
           world (transform-world
                  (make-world 3 3)
-                 (list (compile-rule "if x is 2 then altitude should be 11")
+                 (list (compile "if x is 2 then altitude should be 11")
-                       (compile-rule "if x is less than 2 then altitude should be 0")))]
+                       (compile "if x is less than 2 then altitude should be 0")))]
       (is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach)
           "Rule fires when condition is met (Middle cell of the strip has only two high neighbours)")
       (is (nil? (apply afn (list {:x 1 :y 1} world)))
@@ -308,11 +308,11 @@
 
   ;; some neighbours have property more than numeric-value
   (testing "Some neighbours have property more than numeric-value"
-    (let [afn (compile-rule "if some neighbours have altitude more than 10 then state should be beach")
+    (let [afn (compile "if some neighbours have altitude more than 10 then state should be beach")
           world (transform-world
                  (make-world 3 3)
-                 (list (compile-rule "if x is 2 then altitude should be 11")
+                 (list (compile "if x is 2 then altitude should be 11")
-                       (compile-rule "if x is less than 2 then altitude should be 0")))]
+                       (compile "if x is less than 2 then altitude should be 0")))]
       (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
           "Rule fires when condition is met (strip of altitude 11 down right hand side)")
       (is (nil? (apply afn (list {:x 0 :y 1} world)))
@@ -320,11 +320,11 @@
 
   ;; more than number neighbours have property less than numeric-value
   (testing "More than number neighbours have property less than numeric-value"
-    (let [afn (compile-rule "if more than 4 neighbours have altitude less than 10 then state should be beach")
+    (let [afn (compile "if more than 4 neighbours have altitude less than 10 then state should be beach")
           world (transform-world
                  (make-world 3 3)
-                 (list (compile-rule "if x is 2 then altitude should be 11")
+                 (list (compile "if x is 2 then altitude should be 11")
-                       (compile-rule "if x is less than 2 then altitude should be 0")))]
+                       (compile "if x is less than 2 then altitude should be 0")))]
       (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
           "Rule fires when condition is met (strip of altitude 11 down right hand side)")
       (is (nil? (apply afn (list {:x 2 :y 1} world)))
@@ -332,11 +332,11 @@
 
   ;; fewer than number neighbours have property less than numeric-value
   (testing "Fewer than number neighbours have property less than numeric-value"
-    (let [afn (compile-rule "if fewer than 4 neighbours have altitude less than 10 then state should be beach")
+    (let [afn (compile "if fewer than 4 neighbours have altitude less than 10 then state should be beach")
           world (transform-world
                  (make-world 3 3)
-                 (list (compile-rule "if x is 2 then altitude should be 11")
+                 (list (compile "if x is 2 then altitude should be 11")
-                       (compile-rule "if x is less than 2 then altitude should be 0")))]
+                       (compile "if x is less than 2 then altitude should be 0")))]
       (is (nil? (apply afn (list {:x 1 :y 1} world)))
           "Centre cell has five low neighbours, so rule should not fire")
       (is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach)
@@ -344,11 +344,11 @@
 
   ;; some neighbours have property less than numeric-value
   (testing "Some number neighbours have property less than numeric-value"
-    (let [afn (compile-rule "if some neighbours have altitude less than 10 then state should be beach")
+    (let [afn (compile "if some neighbours have altitude less than 10 then state should be beach")
           world (transform-world
                  (make-world 3 3)
-                 (list (compile-rule "if x is less than 2 then altitude should be 11")
+                 (list (compile "if x is less than 2 then altitude should be 11")
-                       (compile-rule "if x is 2 then altitude should be 0")))]
+                       (compile "if x is 2 then altitude should be 0")))]
       (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
           "Rule fires when condition is met (strip of altitude 0 down right hand side)")
       (is (nil? (apply afn (list {:x 0 :y 1} world)))
@@ -358,7 +358,7 @@
   ;; 'single action' already tested in 'condition' tests above
   ;; action and actions
   (testing "Conjunction of actions"
-    (let [afn (compile-rule "if state is new then state should be grassland and fertility should be 0")]
+    (let [afn (compile "if state is new then state should be grassland and fertility should be 0")]
       (is (= (apply afn (list {:state :new} nil))
              {:state :grassland :fertility 0})
           "Both actions are executed")))
@@ -368,23 +368,23 @@
 
   ;; number chance in number property should be value
   (testing "Syntax of probability rule - action of real probability very hard to test"
-    (let [afn (compile-rule "if state is forest then 5 chance in 5 state should be climax")]
+    (let [afn (compile "if state is forest then 5 chance in 5 state should be climax")]
       (is (= (:state (apply afn (list {:state :forest} nil))) :climax)
           "five chance in five should fire every time"))
-    (let [afn (compile-rule "if state is forest then 0 chance in 5 state should be climax")]
+    (let [afn (compile "if state is forest then 0 chance in 5 state should be climax")]
       (is (nil? (apply afn (list {:state :forest} nil)))
           "zero chance in five should never fire")))
 
   ;; property operator numeric-value
   (testing "Arithmetic action: addition of number"
-    (let [afn (compile-rule "if state is climax then fertility should be fertility + 1")]
+    (let [afn (compile "if state is climax then fertility should be fertility + 1")]
       (is (= (:fertility
               (apply afn (list {:state :climax :fertility 0} nil)))
              1)
           "Addition is executed")))
 
   (testing "Arithmetic action: addition of property value"
-    (let [afn (compile-rule "if state is climax then fertility should be fertility + leaffall")]
+    (let [afn (compile "if state is climax then fertility should be fertility + leaffall")]
       (is (= (:fertility
               (apply afn
                      (list {:state :climax
@@ -394,14 +394,14 @@
           "Addition is executed")))
 
   (testing "Arithmetic action: subtraction of number"
-    (let [afn (compile-rule "if state is crop then fertility should be fertility - 1")]
+    (let [afn (compile "if state is crop then fertility should be fertility - 1")]
       (is (= (:fertility
               (apply afn (list {:state :crop :fertility 2} nil)))
              1)
           "Action is executed")))
 
   (testing "Arithmetic action: subtraction of property value"
-    (let [afn (compile-rule "if wolves are more than 0 then deer should be deer - wolves")]
+    (let [afn (compile "if wolves are more than 0 then deer should be deer - wolves")]
       (is (= (:deer
               (apply afn
                      (list {:deer 3
@@ -410,14 +410,14 @@
           "Action is executed")))
 
   (testing "Arithmetic action: multiplication by number"
-    (let [afn (compile-rule "if deer are more than 1 then deer should be deer * 2")]
+    (let [afn (compile "if deer are more than 1 then deer should be deer * 2")]
       (is (= (:deer
               (apply afn (list {:deer 2} nil)))
              4)
           "Action is executed")))
 
   (testing "Arithmetic action: multiplication by property value"
-    (let [afn (compile-rule "if state is crop then deer should be deer * deer")]
+    (let [afn (compile "if state is crop then deer should be deer * deer")]
       (is (= (:deer
               (apply afn
                      (list {:state :crop :deer 2} nil)))
@@ -425,14 +425,14 @@
           "Action is executed")))
 
   (testing "Arithmetic action: division by number"
-    (let [afn (compile-rule "if wolves are more than 0 then deer should be deer / 2")]
+    (let [afn (compile "if wolves are more than 0 then deer should be deer / 2")]
       (is (= (:deer
               (apply afn (list {:deer 2 :wolves 1} nil)))
              1)
           "Action is executed")))
 
   (testing "Arithmetic action: division by property value"
-    (let [afn (compile-rule "if wolves are more than 0 then deer should be deer / wolves")]
+    (let [afn (compile "if wolves are more than 0 then deer should be deer / wolves")]
       (is (= (:deer
               (apply afn
                      (list {:deer 2 :wolves 2} nil)))
@@ -441,7 +441,7 @@
 
   ;; simple within distance
   (testing "Number neighbours within distance have property equal to value"
-    (let [afn (compile-rule "if 8 neighbours within 2 have state equal to new then state should be water")
+    (let [afn (compile "if 8 neighbours within 2 have state equal to new then state should be water")
           world (make-world 5 5)]
       (is (= (apply afn (list {:x 0 :y 0} world))
              {:state :water :x 0 :y 0})
@@ -451,7 +451,7 @@
 
   ;; comparator within distance
   (testing "More than number neighbours within distance have property equal to symbolic-value"
-    (let [afn (compile-rule "if more than 7 neighbours within 2 have state equal to grassland and more than 7 neighbours within 2 have state equal to water then state should be beach")
+    (let [afn (compile "if more than 7 neighbours within 2 have state equal to grassland and more than 7 neighbours within 2 have state equal to water then state should be beach")
           ;; 5x5 world, strip of high ground two cells wide down left hand side
           ;; xxooo
           ;; xxooo
@@ -460,8 +460,8 @@
           ;; xxooo
           world (transform-world
                  (make-world 5 5)
-                 (list (compile-rule "if x is less than 2 then altitude should be 11 and state should be grassland")
+                 (list (compile "if x is less than 2 then altitude should be 11 and state should be grassland")
-                       (compile-rule "if x is more than 1 then altitude should be 0 and state should be water")))]
+                       (compile "if x is more than 1 then altitude should be 0 and state should be water")))]
       (is (= (:state (apply afn (list {:x 2 :y 2} world))) :beach)
           "Rule fires when condition is met (strip of altitude 11 down right hand side)")
       (is (nil? (apply afn (list {:x 0 :y 1} world)))
@@ -469,11 +469,11 @@
 
 (deftest regression-tests
   (testing "Rule in default set which failed on switchover to declarative rules"
-    (let [afn (compile-rule "if state is scrub then 1 chance in 1 state should be forest")
+    (let [afn (compile "if state is scrub then 1 chance in 1 state should be forest")
           world (transform-world
                  (make-world 3 3)
-                 (list (compile-rule "if x is 2 then altitude should be 11")
+                 (list (compile "if x is 2 then altitude should be 11")
-                       (compile-rule "if x is less than 2 then state should be scrub")))]
+                       (compile "if x is less than 2 then state should be scrub")))]
       (is (= (:state (apply afn (list (get-cell world 1 1) world))) :forest)
           "Centre cell is scrub, so rule should fire")
       (is (= (apply afn (list (get-cell world 2 1) world)) nil)

test/mw_parser/generate_test.clj

@@ -1,13 +1,16 @@
-(ns mw-parser.generate-test 
+(ns mw-parser.generate-test
-  (:require [clojure.test :refer [deftest is testing]]
+  (:require [clojure.pprint :as pprint]
+            [clojure.test :refer [deftest is testing]]
+            [mw-engine.core :refer [apply-rule]]
+            [mw-engine.utils :refer [get-cell]]
+            [mw-parser.declarative :refer [compile parse]]
             [mw-parser.generate :refer [generate]]
-            [mw-parser.declarative :refer [parse]]
             [mw-parser.simplify :refer [simplify]]))
 
 (deftest expressions-tests
   (testing "Generating primitive expressions."
     (let [actual (generate '(:NUMERIC-EXPRESSION (:NUMBER "50")))
-          expected 50] 
+          expected 50]
       (is (= actual expected)))
     (let [actual (generate '(:NUMERIC-EXPRESSION (:SYMBOL "sealevel")))
           expected '(:sealevel cell)]
@@ -17,18 +20,18 @@
   (testing "Generating left-hand-side fragments of rule functions from appropriate fragments of parse trees"
     (let [expected '(= (:state cell) (or (:forest cell) :forest))
           actual (generate
-           '(:PROPERTY-CONDITION 
+                  '(:PROPERTY-CONDITION
-             (:SYMBOL "state") 
+                    (:SYMBOL "state")
-             [:EQUIVALENCE [:IS "is"]] 
+                    [:EQUIVALENCE [:IS "is"]]
-             (:SYMBOL "forest")))] 
+                    (:SYMBOL "forest")))]
       (is (= actual expected)))
     (is (= (generate
-         '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:EQUIVALENCE [:IS "is"]] (:NUMBER "10")))
+            '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:EQUIVALENCE [:IS "is"]] (:NUMBER "10")))
-        '(= (:fertility cell) 10)))
+           '(= (:fertility cell) 10)))
     (is (= (generate '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:COMPARATIVE [:LESS "less"]] (:NUMBER "10")))
-        '(< (:fertility cell) 10)))
+           '(< (:fertility cell) 10)))
     (is (= (generate '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:COMPARATIVE [:MORE "more"]] (:NUMBER "10")))
-        '(> (:fertility cell) 10)))
+           '(> (:fertility cell) 10)))
     (is (= (generate '(:CONJUNCT-CONDITION
                        (:PROPERTY-CONDITION
                         (:SYMBOL "state")
@@ -38,9 +41,9 @@
                         (:SYMBOL "fertility")
                         (:QUALIFIER (:EQUIVALENCE (:IS "is")))
                         (:NUMBER "10"))))
-        '(and (= (:state cell) (or (:forest cell) :forest)) (= (:fertility cell) 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))))
+           '(or (= (:state cell) (or (:forest cell) :forest)) (= (:fertility cell) 10))))
     (is (= (generate '(:PROPERTY-CONDITION
                        (:SYMBOL "state")
                        (:QUALIFIER (:EQUIVALENCE (:IS "is")))
@@ -48,18 +51,18 @@
                         (:SYMBOL "heath")
                         (:SYMBOL "scrub")
                         (:SYMBOL "forest"))))
-        '(#{:scrub :forest :heath} (:state cell))))
+           '(#{: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)))))))
+           '(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
-         '(:SIMPLE-ACTION (:SYMBOL "state") (:BECOMES "should be") (:SYMBOL "climax")))
+            '(:SIMPLE-ACTION (:SYMBOL "state") (:BECOMES "should be") (:SYMBOL "climax")))
-        '(merge cell {:state :climax})))
+           '(merge cell {:state :climax})))
     (is (= (generate
-         '(:SIMPLE-ACTION (:SYMBOL "fertility") (:BECOMES "should be") (:NUMBER "10")))
+            '(: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"
@@ -75,8 +78,8 @@
                    (:BECOMES "should be")
                    (:SYMBOL "climax"))))
           expected '(fn [cell world]
-                      (when 
+                      (when
-                       (= (:state cell) (or (:forest cell) :forest)) 
+                       (= (:state cell) (or (:forest cell) :forest))
                         (merge cell {:state :climax})))
           actual (generate rule)
           expected-meta {:rule-type :production}
@@ -87,16 +90,35 @@
 (deftest metadata-tests
   (testing "Rules have correct metadata"
     (let [expected :production
-        actual (:rule-type
+          actual (:rule-type
-                (meta
+                  (meta
-                (generate 
+                   (generate
-                 (simplify 
+                    (simplify
-                  (parse "if state is house then state should be waste")))))]
+                     (parse "if state is house then state should be waste")))))]
-    (is (= actual expected)))
+      (is (= actual expected)))
     (let [expected :flow
-            actual (:rule-type
+          actual (:rule-type
-                    (meta
+                  (meta
-                     (generate
+                   (generate
-                      (simplify
+                    (simplify
-                       (parse "flow 10% food from house to house within 2 with least food")))))]
+                     (parse "flow 10% food from house to house within 2 with least food")))))]
-        (is (= actual expected)))))
+      (is (= actual expected)))))
+
+(deftest chance-bug-test
+  (testing "exception thrown when evaluating``"
+    (let [cell {:y 1, :generation 10,
+                :state :scrub, :gradient 85,
+                :x 1, :altitude 92}
+          world [[{:y 0, :state :new, :x 0} {:y 0, :state :new, :x 1} {:y 0, :state :new, :x 2}]
+                 [{:y 1, :state :new, :x 0} cell {:y 1, :state :new, :x 2}]
+                 [{:y 2, :state :new, :x 0} {:y 2, :state :new, :x 1} {:y 2, :state :new, :x 2}]]
+          rule (compile "if state is scrub then 1 chance in 5 state should be forest")
+          expected #{:scrub :forest}
+          cell' (reduce
+              (fn [c i] (merge (or (apply-rule world c rule) c) {:i i}))
+              cell
+              (range 20))
+          actual (:state cell')]
+      (pprint/pprint cell')
+      (is (expected actual)))))
+