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

View file

@ -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))

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)