Merge branch 'master' of ssh://goldsmith.journeyman.cc/srv/git/mw-parser

This commit is contained in:
simon 2016-08-03 10:23:16 +01:00
commit d44ba60802
3 changed files with 48 additions and 40 deletions

View file

@ -127,13 +127,19 @@
'upper (list 'max l1 l2)] 'upper (list 'max l1 l2)]
(list 'and (list '>= pv 'lower)(list '<= pv 'upper))))) (list 'and (list '>= pv 'lower)(list '<= pv 'upper)))))
(defn generate-disjunct-condition (defn generate-disjunct-property-condition
"Generate a property condition where the expression is a disjunct expression" "Generate a property condition where the expression is a disjunct expression.
[tree property qualifier expression] TODO: this is definitely still wrong!"
([tree]
(let [property (generate (nth tree 1))
qualifier (generate (nth tree 2))
expression (generate (nth tree 3))]
(generate-disjunct-property-condition tree property qualifier expression)))
([tree property qualifier expression]
(let [e (list 'some (list 'fn ['i] '(= i value)) (list 'quote expression))] (let [e (list 'some (list 'fn ['i] '(= i value)) (list 'quote expression))]
(list 'let ['value (list property 'cell)] (list 'let ['value (list property 'cell)]
(if (= qualifier '=) e (if (= qualifier '=) e
(list 'not e))))) (list 'not e))))))
(defn generate-property-condition (defn generate-property-condition
([tree] ([tree]
@ -145,7 +151,7 @@
qualifier (generate (nth tree 2)) qualifier (generate (nth tree 2))
expression (generate (nth tree 3))] expression (generate (nth tree 3))]
(case expression-type (case expression-type
:DISJUNCT-EXPRESSION (generate-disjunct-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)
(list qualifier (list property 'cell) expression))))) (list qualifier (list property 'cell) expression)))))
@ -160,9 +166,8 @@
(defn generate-multiple-actions (defn generate-multiple-actions
[tree] [tree]
nil) (assert (and (coll? tree)(= (first tree) :ACTIONS)) "Expected an ACTIONS fragment")
;; (assert (and (coll? tree)(= (first tree) :ACTIONS)) "Expected an ACTIONS fragment") (conj 'do (map generate-simple-action (rest tree))))
;; (conj 'do (map
(defn generate-disjunct-value (defn generate-disjunct-value
"Generate a disjunct value. Essentially what we need here is to generate a "Generate a disjunct value. Essentially what we need here is to generate a
@ -269,6 +274,8 @@
(map generate tree)) (map generate tree))
tree)) tree))
(generate '(:PROPERTY-CONDITION (:SYMBOL "wolves") (:QUALIFIER (:COMPARATIVE-QUALIFIER (:IS "are") (:MORE "more") (:THAN "than"))) (:SYMBOL "deer")))
(defn simplify-qualifier (defn simplify-qualifier
"Given that this `tree` fragment represents a qualifier, what "Given that this `tree` fragment represents a qualifier, what

View file

@ -179,13 +179,14 @@
(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")))
(testing "Property is more than property" ;; TODO: this one is very tricky and will require a rethink of the way conditions are parsed.
(let [afn (compile-rule "if wolves are more than deer then deer should be 0")] ;; (testing "Property is more than property"
(is (= (apply afn (list {:deer 2 :wolves 3} nil)) ;; (let [afn (compile-rule "if wolves are more than deer then deer should be 0")]
{:deer 0 :wolves 3}) ;; (is (= (apply afn (list {:deer 2 :wolves 3} nil))
"Rule fires when condition is met") ;; {:deer 0 :wolves 3})
(is (nil? (apply afn (list {:deer 3 :wolves 2} nil))) ;; "Rule fires when condition is met")
"Rule does not fire when condition is not 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" (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")]
@ -195,13 +196,13 @@
(is (nil? (apply afn (list {:altitude 10} nil))) (is (nil? (apply afn (list {:altitude 10} nil)))
"Rule does not fire when condition is not met"))) "Rule does not fire when condition is not met")))
(testing "Property is less than property" ;; (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-rule "if wolves are less than deer then deer should be deer - wolves")]
(is (= (apply afn (list {:deer 3 :wolves 2} nil)) ;; (is (= (apply afn (list {:deer 3 :wolves 2} nil))
{:deer 1 :wolves 2}) ;; {:deer 1 :wolves 2})
"Rule fires when condition is met") ;; "Rule fires when condition is met")
(is (nil? (apply afn (list {:deer 2 :wolves 3} nil))) ;; (is (nil? (apply afn (list {:deer 2 :wolves 3} nil)))
"Rule does not fire when condition is not met"))) ;; "Rule does not fire when condition is not met")))
(testing "Number neighbours have property equal to value" (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-rule "if 3 neighbours have state equal to new then state should be water")