simon/mw-parser
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Substantially closer to the declarative parser fully working, but not

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

15
src/mw_parser/declarative.clj
View file

@ -11,7 +11,7 @@
;; (1) rule text ;; (1) rule text
;; (2) cursor showing where in the rule text the error occurred ;; (2) cursor showing where in the rule text the error occurred
;; (3) the reason for the error ;; (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 (def grammar
@ -171,7 +171,11 @@
(assert-type tree :PROPERTY-CONDITION) (assert-type tree :PROPERTY-CONDITION)
(let [property (generate (nth tree 1)) (let [property (generate (nth tree 1))
qualifier (generate (nth tree 2)) 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 (case expression-type
:DISJUNCT-EXPRESSION (generate-disjunct-property-condition tree property qualifier expression) :DISJUNCT-EXPRESSION (generate-disjunct-property-condition tree property qualifier expression)
:RANGE-EXPRESSION (generate-ranged-property-condition tree property expression) :RANGE-EXPRESSION (generate-ranged-property-condition tree property expression)
@ -207,9 +211,13 @@
(defn generate-numeric-expression (defn generate-numeric-expression
[tree] [tree]
(assert-type tree :NUMERIC-EXPRESSION) (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)) (case (first (second tree))
:SYMBOL (list (keyword (second (second tree))) 'cell) :SYMBOL (list (keyword (second (second tree))) 'cell)
(generate (second tree)))) (generate (second tree)))))
(defn generate-neighbours-condition (defn generate-neighbours-condition
@ -270,6 +278,7 @@
:SIMPLE-ACTION (generate-simple-action tree) :SIMPLE-ACTION (generate-simple-action tree)
:SYMBOL (keyword (second tree)) :SYMBOL (keyword (second tree))
:VALUE (generate (second tree)) :VALUE (generate (second tree))
:OPERATOR (symbol (second tree))
(map generate tree)) (map generate tree))
tree)) tree))

50
test/mw_parser/declarative_test.clj
View file

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