Substantially closer to the declarative parser fully working, but not

yet perfect.
This commit is contained in:
simon 2016-08-10 13:30:15 +01:00
parent 00e8a25144
commit 1c6ceb899c
2 changed files with 353 additions and 340 deletions
src/mw_parser
test/mw_parser

View file

@ -11,7 +11,7 @@
;; (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")
(def bad-parse-error "I did not understand:\n '%s'\n %s\n %s")
(def grammar
@ -171,7 +171,11 @@
(assert-type tree :PROPERTY-CONDITION)
(let [property (generate (nth tree 1))
qualifier (generate (nth tree 2))
expression (generate (nth tree 3))]
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)
@ -207,9 +211,13 @@
(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 (second tree)))))
(defn generate-neighbours-condition
@ -270,6 +278,7 @@
:SIMPLE-ACTION (generate-simple-action tree)
:SYMBOL (keyword (second tree))
:VALUE (generate (second tree))
:OPERATOR (symbol (second tree))
(map generate tree))
tree))

View file

@ -39,6 +39,10 @@
'(:sealevel cell))
))
(deftest comparative-tests
(testing "Parsing comparatives."
))
(deftest lhs-generators-tests
(testing "Generating left-hand-side fragments of rule functions from appropriate fragments of parse trees"
(is (generate
@ -180,14 +184,13 @@
(is (nil? (apply afn (list {:altitude 200} nil)))
"Rule does not fire when condition is not met")))
;; TODO: this one is very tricky and will require a rethink of the way conditions are parsed.
;; (testing "Property is more than property"
;; (let [afn (compile-rule "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")
;; (is (nil? (apply afn (list {:deer 3 :wolves 2} nil)))
;; "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")]
(is (= (apply afn (list {:deer 2 :wolves 3} nil))
{:deer 0 :wolves 3})
"Rule fires when condition is met")
(is (nil? (apply afn (list {:deer 3 :wolves 2} nil)))
"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")]
@ -231,6 +234,7 @@
"Middle cell has eight neighbours, so rule does not fire.")))
(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")
world (transform-world
(make-world 3 3)
@ -307,7 +311,7 @@
(is (nil? (apply afn (list {:x 1 :y 1} world)))
"Middle cell of world has three high neighbours, so rule should not fire.")))
;; some neighbours have property equal to value
;; 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")
world (transform-world
@ -330,7 +334,7 @@
(is (nil? (apply afn (list {:x 0 :y 1} world)))
"Left hand side of world has no high neighbours, so rule should not fire.")))
;; more than number neighbours have property more than numeric-value
;; 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")
world (transform-world
@ -342,7 +346,7 @@
(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.")))
;; fewer than number neighbours have property more than numeric-value
;; 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")
world (transform-world
@ -354,7 +358,7 @@
(is (nil? (apply afn (list {:x 1 :y 1} world)))
"Middle cell of world has three high neighbours, so rule should not fire.")))
;; some neighbours have property more than numeric-value
;; 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")
world (transform-world
@ -366,7 +370,7 @@
(is (nil? (apply afn (list {:x 0 :y 1} world)))
"Left hand side of world has no high neighbours, so rule should not fire.")))
;; more than number neighbours have property less than numeric-value
;; 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")
world (transform-world
@ -378,7 +382,7 @@
(is (nil? (apply afn (list {:x 2 :y 1} world)))
"Middle cell of the strip has only three low neighbours, so rule should not fire.")))
;; fewer than number neighbours have property less than numeric-value
;; 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")
world (transform-world
@ -390,7 +394,7 @@
(is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach)
"Middle cell of the strip has only three low neighbours, so rule should fire.")))
;; some neighbours have property less than numeric-value
;; 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")
world (transform-world
@ -403,18 +407,18 @@
"Left of world is all high, so rule should not fire.")))
;; 'single action' already tested in 'condition' tests above
;; action and actions
;; '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")]
(is (= (apply afn (list {:state :new} nil))
{:state :grassland :fertility 0})
"Both actions are executed")))
;; 'property should be symbolic-value' and 'property should be numeric-value'
;; already tested in tests above
;; 'property should be symbolic-value' and 'property should be numeric-value'
;; already tested in tests above
;; number chance in number property should be value
;; 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")]
(is (= (:state (apply afn (list {:state :forest} nil))) :climax)
@ -423,7 +427,7 @@
(is (nil? (apply afn (list {:state :forest} nil)))
"zero chance in five should never fire")))
;; property operator numeric-value
;; property operator numeric-value
(testing "Arithmetic action: addition of number"
(let [afn (compile-rule "if state is climax then fertility should be fertility + 1")]
(is (= (:fertility
@ -487,7 +491,7 @@
1)
"Action is executed")))
;; simple within distance
;; 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")
world (make-world 5 5)]
@ -497,7 +501,7 @@
(is (nil? (apply afn (list {:x 1 :y 1} world)))
"Middle cell has twenty-four neighbours within two, so rule does not fire.")))
;; comparator within distance
;; 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")
;; 5x5 world, strip of high ground two cells wide down left hand side