From 1c6ceb899c013da8d26052e71e49626d39bdae08 Mon Sep 17 00:00:00 2001 From: simon Date: Wed, 10 Aug 2016 13:30:15 +0100 Subject: [PATCH 01/26] Substantially closer to the declarative parser fully working, but not yet perfect. --- src/mw_parser/declarative.clj | 19 +- test/mw_parser/declarative_test.clj | 674 ++++++++++++++-------------- 2 files changed, 353 insertions(+), 340 deletions(-) diff --git a/src/mw_parser/declarative.clj b/src/mw_parser/declarative.clj index 8bea7dd..1624446 100644 --- a/src/mw_parser/declarative.clj +++ b/src/mw_parser/declarative.clj @@ -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 (first (second tree)) - :SYMBOL (list (keyword (second (second tree))) 'cell) - (generate (second tree)))) + (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))))) (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)) diff --git a/test/mw_parser/declarative_test.clj b/test/mw_parser/declarative_test.clj index 86cb449..1e8e451 100644 --- a/test/mw_parser/declarative_test.clj +++ b/test/mw_parser/declarative_test.clj @@ -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 @@ -100,418 +104,418 @@ ;; 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")] - (is (= (apply afn (list {:state :new} nil)) - {:state :grassland}) - "Rule fires when condition is met") - (is (nil? (apply afn (list {:state :forest} nil))) - "Rule doesn't fire when condition isn't met"))) + (let [afn (compile-rule "if state is new then state should be grassland")] + (is (= (apply afn (list {:state :new} nil)) + {:state :grassland}) + "Rule fires when condition is met") + (is (nil? (apply afn (list {:state :forest} nil))) + "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")] - (is (= (apply afn (list {:state :new :altitude 0} nil)) - {:state :water :altitude 0}) - "Rule fires when conditions are met") - (is (nil? (apply afn (list {:state :new :altitude 5} nil))) - "Rule does not fire: second condition not met") - (is (nil? (apply afn (list {:state :forest :altitude 0} nil))) - "Rule does not fire: first condition not met"))) + (let [afn (compile-rule "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") + (is (nil? (apply afn (list {:state :new :altitude 5} nil))) + "Rule does not fire: second condition not met") + (is (nil? (apply afn (list {:state :forest :altitude 0} nil))) + "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")] - (is (= (apply afn (list {:state :new} nil)) - {:state :grassland}) - "Rule fires: first condition met") - (is (= (apply afn (list {:state :waste} nil)) - {:state :grassland}) - "Rule fires: second condition met") - (is (nil? (apply afn (list {:state :forest} nil))) - "Rule does not fire: neither condition met"))) + (let [afn (compile-rule "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") + (is (= (apply afn (list {:state :waste} nil)) + {:state :grassland}) + "Rule fires: second condition met") + (is (nil? (apply afn (list {:state :forest} nil))) + "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")] - (is (nil? (apply afn (list {:state :new} nil))) - "Rule doesn't fire when condition isn't met") - (is (= (apply afn (list {:state :forest} nil)) - {:state :grassland}) - "Rule fires when condition is met"))) + (let [afn (compile-rule "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)) + {:state :grassland}) + "Rule fires when condition is met"))) (testing "Can't set x or y properties" - (is (thrown-with-msg? + (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")) - "Exception thrown on attempt to set 'x'") - (is (thrown-with-msg? + "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")) - "Exception thrown on attempt to set 'y'")) + "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")] - (is (= (apply afn (list {:state :heath} nil)) - {:state :climax}) - "Rule fires when condition is met") - (is (= (apply afn (list {:state :scrub} nil)) - {:state :climax}) - "Rule fires when condition is met") - (is (= (apply afn (list {:state :forest} nil)) - {:state :climax}) - "Rule fires when condition is met") - (is (nil? (apply afn (list {:state :grassland} nil))) - "Rule does not fire when condition is not met"))) + (let [afn (compile-rule "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") + (is (= (apply afn (list {:state :scrub} nil)) + {:state :climax}) + "Rule fires when condition is met") + (is (= (apply afn (list {:state :forest} nil)) + {:state :climax}) + "Rule fires when condition is met") + (is (nil? (apply afn (list {:state :grassland} nil))) + "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")] - (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))) - "Rule does not fire when condition is not met") - (is (nil? (apply afn (list {:state :forest} nil))) - "Rule does not fire when condition is not met") - (is (= (apply afn (list {:state :grassland} nil)) - {:state :climax}) - "Rule fires when condition is met"))) + (let [afn (compile-rule "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))) + "Rule does not fire when condition is not met") + (is (nil? (apply afn (list {:state :forest} nil))) + "Rule does not fire when condition is not met") + (is (= (apply afn (list {:state :grassland} nil)) + {:state :climax}) + "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")] - (is (= (apply afn (list {:altitude 201} nil)) - {:state :snow :altitude 201}) - "Rule fires when condition is met") - (is (nil? (apply afn (list {:altitude 200} nil))) - "Rule does not fire when condition is not met"))) + (let [afn (compile-rule "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") + (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")] - (is (= (apply afn (list {:altitude 9} nil)) - {:state :water :altitude 9}) - "Rule fires when condition is met") - (is (nil? (apply afn (list {:altitude 10} nil))) - "Rule does not fire when condition is not met"))) + (let [afn (compile-rule "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") + (is (nil? (apply afn (list {:altitude 10} nil))) + "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")] - (is (= (apply afn (list {:deer 3 :wolves 2} nil)) - {:deer 1 :wolves 2}) - "Rule fires when condition is met") - (is (nil? (apply afn (list {:deer 2 :wolves 3} nil))) - "Rule does not fire when condition is not met"))) + (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)) + {:deer 1 :wolves 2}) + "Rule fires when condition is met") + (is (nil? (apply afn (list {:deer 2 :wolves 3} nil))) + "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") - 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") - 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)) - {: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 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)) - {: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 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") + 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)) + {: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 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)) + {: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."))) (testing "Number neighbours have property more than numeric-value" - (let [afn (compile-rule "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") - (compile-rule "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."))) + ;; 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) + (list (compile-rule "if x is 2 then altitude should be 11") + (compile-rule "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") - world (transform-world - (make-world 3 3) - (list (compile-rule "if x is 2 then altitude should be 11") - (compile-rule "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."))) + (let [afn (compile-rule "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") + (compile-rule "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") - world (transform-world - (make-world 3 3) - (list (compile-rule "if x is 2 then altitude should be 11") - (compile-rule "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."))) + (let [afn (compile-rule "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") + (compile-rule "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") - world (transform-world - (make-world 3 3) - (list (compile-rule "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")))] - (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") - ;; '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") - (compile-rule "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 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") + (compile-rule "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") + ;; '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") + (compile-rule "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") - world (transform-world - (make-world 3 3) - (list (compile-rule "if x is 2 then altitude should be 11") - (compile-rule "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."))) + (let [afn (compile-rule "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") + (compile-rule "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") - world (transform-world - (make-world 3 3) - (list (compile-rule "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")))] - (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."))) + (let [afn (compile-rule "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") + (compile-rule "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))) + "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 - (make-world 3 3) - (list (compile-rule "if x is 2 then altitude should be 11") - (compile-rule "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."))) + (let [afn (compile-rule "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") + (compile-rule "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") - world (transform-world - (make-world 3 3) - (list (compile-rule "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")))] - (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."))) + (let [afn (compile-rule "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") + (compile-rule "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))) + "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 - (make-world 3 3) - (list (compile-rule "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")))] - (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 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") + (compile-rule "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."))) -;; 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 - (make-world 3 3) - (list (compile-rule "if x is 2 then altitude should be 11") - (compile-rule "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."))) + (let [afn (compile-rule "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") + (compile-rule "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."))) -;; 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 - (make-world 3 3) - (list (compile-rule "if x is 2 then altitude should be 11") - (compile-rule "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."))) + (let [afn (compile-rule "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") + (compile-rule "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."))) -;; 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 - (make-world 3 3) - (list (compile-rule "if x is 2 then altitude should be 11") - (compile-rule "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 three low neighbours, so rule should not fire."))) + (let [afn (compile-rule "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") + (compile-rule "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 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 - (make-world 3 3) - (list (compile-rule "if x is 2 then altitude should be 11") - (compile-rule "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) - "Middle cell of the strip has only three low neighbours, so rule should fire."))) + (let [afn (compile-rule "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") + (compile-rule "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) + "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 - (make-world 3 3) - (list (compile-rule "if x is less than 2 then altitude should be 11") - (compile-rule "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))) - "Left of world is all high, so rule should not fire."))) + (let [afn (compile-rule "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") + (compile-rule "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))) + "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"))) + (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) - "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")] - (is (nil? (apply afn (list {:state :forest} nil))) - "zero chance in five should never fire"))) + (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) + "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")] + (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 - (apply afn (list {:state :climax :fertility 0} nil))) - 1) - "Addition is executed"))) + (let [afn (compile-rule "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 + leaf-fall")] - (is (= (:fertility - (apply afn - (list {:state :climax - :fertility 0 - :leaf-fall 1} nil))) - 1) - "Addition is executed"))) + (let [afn (compile-rule "if state is climax then fertility should be fertility + leaf-fall")] + (is (= (:fertility + (apply afn + (list {:state :climax + :fertility 0 + :leaf-fall 1} nil))) + 1) + "Addition is executed"))) (testing "Arithmetic action: subtraction of number" - (let [afn (compile-rule "if state is crop then fertility should be fertility - 1")] - (is (= (:fertility - (apply afn (list {:state :crop :fertility 2} nil))) - 1) - "Action is executed"))) + (let [afn (compile-rule "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")] - (is (= (:deer - (apply afn - (list {:deer 3 - :wolves 2} nil))) - 1) - "Action is executed"))) + (let [afn (compile-rule "if wolves are more than 0 then deer should be deer - wolves")] + (is (= (:deer + (apply afn + (list {:deer 3 + :wolves 2} nil))) + 1) + "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")] - (is (= (:deer - (apply afn (list {:deer 2} nil))) - 4) - "Action is executed"))) + (let [afn (compile-rule "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")] - (is (= (:deer - (apply afn - (list {:state :crop :deer 2} nil))) - 4) - "Action is executed"))) + (let [afn (compile-rule "if state is crop then deer should be deer * deer")] + (is (= (:deer + (apply afn + (list {:state :crop :deer 2} nil))) + 4) + "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")] - (is (= (:deer - (apply afn (list {:deer 2 :wolves 1} nil))) - 1) - "Action is executed"))) + (let [afn (compile-rule "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")] - (is (= (:deer - (apply afn - (list {:deer 2 :wolves 2} nil))) - 1) - "Action is executed"))) + (let [afn (compile-rule "if wolves are more than 0 then deer should be deer / wolves")] + (is (= (:deer + (apply afn + (list {:deer 2 :wolves 2} nil))) + 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)] - (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 eight neighbours within two)") - (is (nil? (apply afn (list {:x 1 :y 1} world))) - "Middle cell has twenty-four neighbours within two, so rule does not fire."))) + (let [afn (compile-rule "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}) + "Rule fires when condition is met (in a new world all cells are new, corner cell has eight neighbours within two)") + (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 - ;; xxooo - ;; xxooo - ;; xxooo - ;; xxooo - ;; 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") - (compile-rule "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))) - "Middle cell of the strip has only two high neighbours, so rule should not fire.")) + (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 + ;; xxooo + ;; xxooo + ;; xxooo + ;; xxooo + ;; 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") + (compile-rule "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))) + "Middle cell of the strip has only two high neighbours, so rule should not fire.")) )) From 9836cbff5060f8f44ed64dd3bbd6babda2bf7f9a Mon Sep 17 00:00:00 2001 From: simon Date: Wed, 10 Aug 2016 19:23:16 +0100 Subject: [PATCH 02/26] All tests pass. I should now be able to ditch the old parser and use the new, but first I want to do some major code restructuring. --- src/mw_parser/declarative.clj | 156 +++++++++++++++++++++------- test/mw_parser/declarative_test.clj | 4 +- 2 files changed, 123 insertions(+), 37 deletions(-) diff --git a/src/mw_parser/declarative.clj b/src/mw_parser/declarative.clj index 1624446..baa9ab5 100644 --- a/src/mw_parser/declarative.clj +++ b/src/mw_parser/declarative.clj @@ -18,12 +18,13 @@ ;; in order to simplify translation into other natural languages, all ;; TOKENS within the parser should be unambiguous "RULE := IF SPACE CONDITIONS SPACE THEN SPACE ACTIONS; - CONDITIONS := DISJUNCT-CONDITION | CONJUNCT-CONDITION | PROPERTY-CONDITION | NEIGHBOURS-CONDITION ; + CONDITIONS := DISJUNCT-CONDITION | CONJUNCT-CONDITION | CONDITION ; DISJUNCT-CONDITION := CONDITION SPACE OR SPACE CONDITIONS; CONJUNCT-CONDITION := CONDITION SPACE AND SPACE CONDITIONS; - CONDITION := NEIGHBOURS-CONDITION | PROPERTY-CONDITION; - WITHIN-CONDITION := NEIGHBOURS-CONDITION SPACE WITHIN SPACE NUMERIC-EXPRESSION; - NEIGHBOURS-CONDITION := WITHIN-CONDITION | QUANTIFIER SPACE NEIGHBOURS SPACE IS SPACE PROPERTY-CONDITION | QUANTIFIER SPACE NEIGHBOURS IS EXPRESSION | QUALIFIER SPACE NEIGHBOURS-CONDITION; + CONDITION := WITHIN-CONDITION | NEIGHBOURS-CONDITION | PROPERTY-CONDITION; + WITHIN-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE WITHIN SPACE NUMBER SPACE IS SPACE PROPERTY-CONDITION-OR-EXPRESSION; + NEIGHBOURS-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE IS SPACE PROPERTY-CONDITION | QUALIFIER SPACE NEIGHBOURS-CONDITION; + PROPERTY-CONDITION-OR-EXPRESSION := PROPERTY-CONDITION | EXPRESSION; PROPERTY-CONDITION := PROPERTY SPACE QUALIFIER SPACE EXPRESSION | VALUE; EXPRESSION := SIMPLE-EXPRESSION | RANGE-EXPRESSION | NUMERIC-EXPRESSION | DISJUNCT-EXPRESSION | VALUE; SIMPLE-EXPRESSION := QUALIFIER SPACE EXPRESSION | VALUE; @@ -31,7 +32,7 @@ RANGE-EXPRESSION := BETWEEN SPACE NUMERIC-EXPRESSION SPACE AND SPACE NUMERIC-EXPRESSION; NUMERIC-EXPRESSION := VALUE | VALUE SPACE OPERATOR SPACE NUMERIC-EXPRESSION; NEGATED-QUALIFIER := QUALIFIER SPACE NOT | NOT SPACE QUALIFIER; - COMPARATIVE-QUALIFIER := IS SPACE COMPARATIVE SPACE THAN; + COMPARATIVE-QUALIFIER := IS SPACE COMPARATIVE SPACE THAN | COMPARATIVE SPACE THAN; QUALIFIER := COMPARATIVE-QUALIFIER | NEGATED-QUALIFIER | EQUIVALENCE | IS SPACE QUALIFIER; QUANTIFIER := NUMBER | SOME | NONE | ALL | COMPARATIVE SPACE THAN SPACE NUMBER; EQUIVALENCE := IS SPACE EQUAL | EQUAL | IS ; @@ -59,12 +60,13 @@ IS := 'is' | 'are' | 'have' | 'has'; NUMBER := #'[0-9]+' | #'[0-9]+.[0-9]+'; SYMBOL := #'[a-z]+'; - ACTIONS := ACTION | ACTION SPACE 'and' SPACE ACTIONS + ACTIONS := ACTION | ACTION SPACE AND SPACE ACTIONS ACTION := SIMPLE-ACTION | PROBABLE-ACTION; - PROBABLE-ACTION := VALUE SPACE 'chance in' SPACE VALUE SPACE SIMPLE-ACTION; - SIMPLE-ACTION := SYMBOL SPACE BECOMES SPACE EXPRESSION - BECOMES := 'should be' - SPACE := #' *'" + PROBABLE-ACTION := VALUE SPACE CHANCE-IN SPACE VALUE SPACE SIMPLE-ACTION; + SIMPLE-ACTION := SYMBOL SPACE BECOMES SPACE EXPRESSION; + CHANCE-IN := 'chance in'; + BECOMES := 'should be' | 'becomes'; + SPACE := #' *'"; ) (defn TODO @@ -73,7 +75,7 @@ message) -(declare generate simplify) +(declare generate generate-action simplify) (defn suitable-fragment? @@ -90,6 +92,18 @@ (throw (Exception. (format "Expected a %s fragment" type))))) +(defn search-tree + "Return the first element of this tree which has this tag in a depth-first, left-to-right search" + [tree tag] + (cond + (= (first tree) tag) tree + :else (first + (remove nil? + (map + #(search-tree % tag) + (rest tree)))))) + + (defn generate-rule "From this `tree`, assumed to be a syntactically correct rule specification, generate and return the appropriate rule as a function of two arguments." @@ -103,25 +117,25 @@ generate and return the appropriate clojure fragment." [tree] (assert-type tree :CONDITIONS) - (generate (nth tree 1))) + (generate (second tree))) (defn generate-condition [tree] (assert-type tree :CONDITION) - (generate (nth tree 1))) + (generate (second tree))) (defn generate-conjunct-condition [tree] (assert-type tree :CONJUNCT-CONDITION) - (list 'and (generate (nth tree 1))(generate (nth tree 3)))) + (cons 'and (map generate (rest tree)))) (defn generate-disjunct-condition [tree] (assert-type tree :DISJUNCT-CONDITION) - (list 'or (generate (nth tree 1))(generate (nth tree 3)))) + (cons 'or (map generate (rest tree)))) (defn generate-ranged-property-condition @@ -141,7 +155,7 @@ "Generate a property condition where the expression is a disjunct expression. TODO: this is definitely still wrong!" ([tree] - (let [property (generate (nth tree 1)) + (let [property (generate (second tree)) qualifier (generate (nth tree 2)) expression (generate (nth tree 3))] (generate-disjunct-property-condition tree property qualifier expression))) @@ -169,7 +183,7 @@ (generate-property-condition tree (first (nth tree 3))))) ([tree expression-type] (assert-type tree :PROPERTY-CONDITION) - (let [property (generate (nth tree 1)) + (let [property (generate (second tree)) qualifier (generate (nth tree 2)) e (generate (nth tree 3)) expression (cond @@ -182,21 +196,61 @@ (list qualifier (list property 'cell) expression))))) -(defn generate-simple-action +(defn generate-qualifier [tree] - (assert-type tree :SIMPLE-ACTION) - (let [property (generate (nth tree 1)) - expression (generate (nth tree 3))] - (if (or (= property :x) (= property :y)) - (throw (Exception. reserved-properties-error)) - (list 'merge 'cell {property expression})))) + (if + (= (count tree) 2) + (generate (second tree)) + ;; else + (generate (nth tree 2)))) + + +(defn generate-simple-action + ([tree] + (assert-type tree :SIMPLE-ACTION) + (generate-simple-action tree [])) + ([tree others] + (assert-type tree :SIMPLE-ACTION) + (let [property (generate (second tree)) + expression (generate (nth tree 3))] + (if (or (= property :x) (= property :y)) + (throw (Exception. reserved-properties-error)) + (list 'merge + (if (empty? others) 'cell + ;; else + (generate others)) + {property expression}))))) + + +(defn generate-probable-action + ([tree] + (assert-type tree :PROBABLE-ACTION) + (generate-probable-action tree [])) + ([tree others] + (assert-type tree :PROBABLE-ACTION) + (let + [chances (generate (nth tree 1)) + total (generate (nth tree 2)) + action (generate-action (nth tree 3) others)] + ;; TODO: could almost certainly be done better with macro syntax + (list 'if + (list '< (list 'rand total) chances) + action)))) + + +(defn generate-action + [tree others] + (case (first tree) + :ACTIONS (generate-action (first tree) others) + :SIMPLE-ACTION (generate-simple-action tree others) + :PROBABLE-ACTION (generate-probable-action tree others) + (throw (Exception. (str "Not a known action type: " (first tree)))))) (defn generate-multiple-actions [tree] - (assert (and (coll? tree)(= (first tree) :ACTIONS)) "Expected an ACTIONS fragment") - (conj 'do (map generate-simple-action (rest tree)))) - + (assert-type tree :ACTIONS) + (generate-action (first (rest tree)) (second (rest tree)))) (defn generate-disjunct-value "Generate a disjunct value. Essentially what we need here is to generate a @@ -224,7 +278,9 @@ "Generate code for a condition which refers to neighbours." ([tree] (assert-type tree :NEIGHBOURS-CONDITION) - (generate-neighbours-condition tree (first (second (second tree))))) + (case (first (second tree)) + :QUANTIFIER (generate-neighbours-condition tree (first (second (second tree)))) + :QUALIFIER (cons (generate (second tree)) (rest (generate (nth tree 2)))))) ([tree quantifier-type] (let [quantifier (second tree) pc (generate (nth tree 4))] @@ -234,7 +290,8 @@ :MORE (let [value (generate (nth quantifier 3))] (generate-neighbours-condition '> value pc 1)) :LESS (let [value (generate (nth quantifier 3))] - (generate-neighbours-condition '< value pc 1))))) + (generate-neighbours-condition '< value pc 1)) + ))) ([comp1 quantity property-condition distance] (list comp1 (list 'count @@ -245,6 +302,31 @@ (generate-neighbours-condition comp1 quantity property-condition 1))) +(defn generate-within-condition + "Generate code for a condition which refers to neighbours within a specified distance. + NOTE THAT there's clearly masses of commonality between this and + `generate-neighbours-condition`, and that some refactoring is almost certainly + desirable. It may be that it's better to simplify a `NEIGHBOURS-CONDITION` + into a `WITHIN-CONDITION` in the simplification stage." + ([tree] + (assert-type tree :WITHIN-CONDITION) + (case (first (second tree)) + :QUANTIFIER (generate-within-condition tree (first (second (second tree)))) + :QUALIFIER (TODO "qualified within... help!"))) + ([tree quantifier-type] + (let [quantifier (second tree) + distance (generate (nth tree 4)) + pc (generate (nth tree 6))] + (case quantifier-type + :NUMBER (generate-neighbours-condition '= (read-string (second (second quantifier))) pc distance) + :SOME (generate-neighbours-condition '> 0 pc distance) + :MORE (let [value (generate (nth quantifier 3))] + (generate-neighbours-condition '> value pc distance)) + :LESS (let [value (generate (nth quantifier 3))] + (generate-neighbours-condition '< value pc distance)) + )))) + + (defn generate "Generate code for this (fragment of a) parse tree" [tree] @@ -253,7 +335,7 @@ (case (first tree) :ACTIONS (generate-multiple-actions tree) :COMPARATIVE (generate (second tree)) - :COMPARATIVE-QUALIFIER (generate (nth tree 2)) + :COMPARATIVE-QUALIFIER (generate (second tree)) :CONDITION (generate-condition tree) :CONDITIONS (generate-conditions tree) :CONJUNCT-CONDITION (generate-conjunct-condition tree) @@ -271,14 +353,16 @@ :NEIGHBOURS-CONDITION (generate-neighbours-condition tree) :NUMERIC-EXPRESSION (generate-numeric-expression tree) :NUMBER (read-string (second tree)) + :OPERATOR (symbol (second tree)) + :PROBABLE-ACTION (generate-probable-action tree) :PROPERTY (list (generate (second tree)) 'cell) ;; dubious - may not be right :PROPERTY-CONDITION (generate-property-condition tree) - :QUALIFIER (generate (second tree)) + :QUALIFIER (generate-qualifier tree) :RULE (generate-rule tree) :SIMPLE-ACTION (generate-simple-action tree) :SYMBOL (keyword (second tree)) :VALUE (generate (second tree)) - :OPERATOR (symbol (second tree)) + :WITHIN-CONDITION (generate-within-condition tree) (map generate tree)) tree)) @@ -300,7 +384,7 @@ "There are a number of possible simplifications such that if the `tree` has only two elements, the second is semantically sufficient." [tree] - (if (= (count tree) 2) (simplify (nth tree 1)) tree)) + (if (= (count tree) 2) (simplify (second tree)) tree)) (defn rule? @@ -316,15 +400,17 @@ (coll? tree) (case (first tree) :ACTION (simplify-second-of-two tree) - :ACTIONS (simplify-second-of-two tree) + :ACTIONS (cons (first tree) (simplify (rest tree))) + :CHANCE-IN nil :COMPARATIVE (simplify-second-of-two tree) :CONDITION (simplify-second-of-two tree) :CONDITIONS (simplify-second-of-two tree) :EXPRESSION (simplify-second-of-two tree) - :NOT nil ;; TODO is this right?!? It looks wrong :PROPERTY (simplify-second-of-two tree) + :PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree) :SPACE nil :THEN nil + :AND nil :VALUE (simplify-second-of-two tree) (remove nil? (map simplify tree))) tree)) diff --git a/test/mw_parser/declarative_test.clj b/test/mw_parser/declarative_test.clj index 1e8e451..38365ee 100644 --- a/test/mw_parser/declarative_test.clj +++ b/test/mw_parser/declarative_test.clj @@ -436,12 +436,12 @@ "Addition is executed"))) (testing "Arithmetic action: addition of property value" - (let [afn (compile-rule "if state is climax then fertility should be fertility + leaf-fall")] + (let [afn (compile-rule "if state is climax then fertility should be fertility + leaffall")] (is (= (:fertility (apply afn (list {:state :climax :fertility 0 - :leaf-fall 1} nil))) + :leaffall 1} nil))) 1) "Addition is executed"))) From d2a73ba40865fc654579816b4f6df7924b7b1271 Mon Sep 17 00:00:00 2001 From: simon Date: Wed, 10 Aug 2016 20:11:17 +0100 Subject: [PATCH 03/26] Major restructuring, switched over to use the new declarative parser. Some rules in the bulk test file no longer parse, but all rules in the demonstration rule-sets do. --- src/mw_parser/bulk.clj | 2 +- src/mw_parser/declarative.clj | 418 ++-------------------------- src/mw_parser/errors.clj | 45 +++ src/mw_parser/generate.clj | 270 ++++++++++++++++++ src/mw_parser/simplify.clj | 48 ++++ src/mw_parser/utils.clj | 39 +++ test/mw_parser/declarative_test.clj | 53 +--- test/mw_parser/generate_test.clj | 57 ++++ 8 files changed, 488 insertions(+), 444 deletions(-) create mode 100644 src/mw_parser/errors.clj create mode 100644 src/mw_parser/generate.clj create mode 100644 src/mw_parser/simplify.clj create mode 100644 src/mw_parser/utils.clj create mode 100644 test/mw_parser/generate_test.clj diff --git a/src/mw_parser/bulk.clj b/src/mw_parser/bulk.clj index b4674ec..00ecd14 100644 --- a/src/mw_parser/bulk.clj +++ b/src/mw_parser/bulk.clj @@ -2,7 +2,7 @@ ;; objective is to parse rules out of a block of text from a textarea (ns mw-parser.bulk - (:use mw-parser.core + (:use mw-parser.declarative mw-engine.utils clojure.java.io [clojure.string :only [split trim]]) diff --git a/src/mw_parser/declarative.clj b/src/mw_parser/declarative.clj index baa9ab5..69792a4 100644 --- a/src/mw_parser/declarative.clj +++ b/src/mw_parser/declarative.clj @@ -1,19 +1,13 @@ (ns mw-parser.declarative (:use mw-engine.utils + mw-parser.utils + [mw-parser.errors :as pe] + [mw-parser.generate :as pg] + [mw-parser.simplify :as ps] [clojure.string :only [split trim triml]]) (:require [instaparse.core :as insta])) -;; error thrown when an attempt is made to set a reserved property -(def reserved-properties-error - "The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions") -;; error thrown when a rule cannot be parsed. Slots are for -;; (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 grammar ;; in order to simplify translation into other natural languages, all ;; TOKENS within the parser should be unambiguous @@ -69,395 +63,33 @@ SPACE := #' *'"; ) -(defn TODO - "Marker to indicate I'm not yet finished!" - [message] - message) - - -(declare generate generate-action simplify) - - -(defn suitable-fragment? - "Return `true` if `tree-fragment` appears to be a tree fragment of the expected `type`." - [tree-fragment type] - (and (coll? tree-fragment) - (= (first tree-fragment) type))) - - -(defn assert-type - "If `tree-fragment` is not a tree fragment of the expected `type`, throw an exception." - [tree-fragment type] - (assert (suitable-fragment? tree-fragment type) - (throw (Exception. (format "Expected a %s fragment" type))))) - - -(defn search-tree - "Return the first element of this tree which has this tag in a depth-first, left-to-right search" - [tree tag] - (cond - (= (first tree) tag) tree - :else (first - (remove nil? - (map - #(search-tree % tag) - (rest tree)))))) - - -(defn generate-rule - "From this `tree`, assumed to be a syntactically correct rule specification, - generate and return the appropriate rule as a function of two arguments." - [tree] - (assert-type tree :RULE) - (list 'fn ['cell 'world] (list 'if (generate (nth tree 2)) (generate (nth tree 3))))) - - -(defn generate-conditions - "From this `tree`, assumed to be a syntactically correct conditions clause, - generate and return the appropriate clojure fragment." - [tree] - (assert-type tree :CONDITIONS) - (generate (second tree))) - - -(defn generate-condition - [tree] - (assert-type tree :CONDITION) - (generate (second tree))) - - -(defn generate-conjunct-condition - [tree] - (assert-type tree :CONJUNCT-CONDITION) - (cons 'and (map generate (rest tree)))) - - -(defn generate-disjunct-condition - [tree] - (assert-type tree :DISJUNCT-CONDITION) - (cons 'or (map generate (rest tree)))) - - -(defn generate-ranged-property-condition - "Generate a property condition where the expression is a numeric range" - [tree property expression] - (assert-type tree :PROPERTY-CONDITION) - (assert-type (nth tree 3) :RANGE-EXPRESSION) - (let [l1 (generate (nth expression 2)) - l2 (generate (nth expression 4)) - pv (list property 'cell)] - (list 'let ['lower (list 'min l1 l2) - 'upper (list 'max l1 l2)] - (list 'and (list '>= pv 'lower)(list '<= pv 'upper))))) - - -(defn generate-disjunct-property-condition - "Generate a property condition where the expression is a disjunct expression. - TODO: this is definitely still wrong!" - ([tree] - (let [property (generate (second tree)) - 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))] - (list 'let ['value (list property 'cell)] - (if (= qualifier '=) e - (list 'not e)))))) - - -(defn generate-property-condition - ([tree] - (assert-type tree :PROPERTY-CONDITION) - (if - (and (= (count tree) 2) (= (first (second tree)) :SYMBOL)) - ;; it's a shorthand for 'state equal to symbol'. This should probably have - ;; been handled in simplify... - (generate-property-condition - (list - :PROPERTY-CONDITION - '(:SYMBOL "state") - '(:QUALIFIER (:EQUIVALENCE (:EQUAL "equal to"))) - (second tree))) - ;; otherwise... - (generate-property-condition tree (first (nth tree 3))))) - ([tree expression-type] - (assert-type tree :PROPERTY-CONDITION) - (let [property (generate (second tree)) - qualifier (generate (nth tree 2)) - 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) - (list qualifier (list property 'cell) expression))))) - - -(defn generate-qualifier - [tree] - (if - (= (count tree) 2) - (generate (second tree)) - ;; else - (generate (nth tree 2)))) - - -(defn generate-simple-action - ([tree] - (assert-type tree :SIMPLE-ACTION) - (generate-simple-action tree [])) - ([tree others] - (assert-type tree :SIMPLE-ACTION) - (let [property (generate (second tree)) - expression (generate (nth tree 3))] - (if (or (= property :x) (= property :y)) - (throw (Exception. reserved-properties-error)) - (list 'merge - (if (empty? others) 'cell - ;; else - (generate others)) - {property expression}))))) - - -(defn generate-probable-action - ([tree] - (assert-type tree :PROBABLE-ACTION) - (generate-probable-action tree [])) - ([tree others] - (assert-type tree :PROBABLE-ACTION) - (let - [chances (generate (nth tree 1)) - total (generate (nth tree 2)) - action (generate-action (nth tree 3) others)] - ;; TODO: could almost certainly be done better with macro syntax - (list 'if - (list '< (list 'rand total) chances) - action)))) - - -(defn generate-action - [tree others] - (case (first tree) - :ACTIONS (generate-action (first tree) others) - :SIMPLE-ACTION (generate-simple-action tree others) - :PROBABLE-ACTION (generate-probable-action tree others) - (throw (Exception. (str "Not a known action type: " (first tree)))))) - - -(defn generate-multiple-actions - [tree] - (assert-type tree :ACTIONS) - (generate-action (first (rest tree)) (second (rest tree)))) - -(defn generate-disjunct-value - "Generate a disjunct value. Essentially what we need here is to generate a - flat list of values, since the `member` has already been taken care of." - [tree] - (assert-type tree :DISJUNCT-VALUE) - (if (= (count tree) 4) - (cons (generate (second tree)) (generate (nth tree 3))) - (list (generate (second tree))))) - - -(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))))) - - -(defn generate-neighbours-condition - "Generate code for a condition which refers to neighbours." - ([tree] - (assert-type tree :NEIGHBOURS-CONDITION) - (case (first (second tree)) - :QUANTIFIER (generate-neighbours-condition tree (first (second (second tree)))) - :QUALIFIER (cons (generate (second tree)) (rest (generate (nth tree 2)))))) - ([tree quantifier-type] - (let [quantifier (second tree) - pc (generate (nth tree 4))] - (case quantifier-type - :NUMBER (generate-neighbours-condition '= (read-string (second (second quantifier))) pc 1) - :SOME (generate-neighbours-condition '> 0 pc 1) - :MORE (let [value (generate (nth quantifier 3))] - (generate-neighbours-condition '> value pc 1)) - :LESS (let [value (generate (nth quantifier 3))] - (generate-neighbours-condition '< value pc 1)) - ))) - ([comp1 quantity property-condition distance] - (list comp1 - (list 'count - (list 'remove 'false? - (list 'map (list 'fn ['cell] property-condition) - (list 'mw-engine.utils/get-neighbours 'world 'cell distance)))) quantity)) - ([comp1 quantity property-condition] - (generate-neighbours-condition comp1 quantity property-condition 1))) - - -(defn generate-within-condition - "Generate code for a condition which refers to neighbours within a specified distance. - NOTE THAT there's clearly masses of commonality between this and - `generate-neighbours-condition`, and that some refactoring is almost certainly - desirable. It may be that it's better to simplify a `NEIGHBOURS-CONDITION` - into a `WITHIN-CONDITION` in the simplification stage." - ([tree] - (assert-type tree :WITHIN-CONDITION) - (case (first (second tree)) - :QUANTIFIER (generate-within-condition tree (first (second (second tree)))) - :QUALIFIER (TODO "qualified within... help!"))) - ([tree quantifier-type] - (let [quantifier (second tree) - distance (generate (nth tree 4)) - pc (generate (nth tree 6))] - (case quantifier-type - :NUMBER (generate-neighbours-condition '= (read-string (second (second quantifier))) pc distance) - :SOME (generate-neighbours-condition '> 0 pc distance) - :MORE (let [value (generate (nth quantifier 3))] - (generate-neighbours-condition '> value pc distance)) - :LESS (let [value (generate (nth quantifier 3))] - (generate-neighbours-condition '< value pc distance)) - )))) - - -(defn generate - "Generate code for this (fragment of a) parse tree" - [tree] - (if - (coll? tree) - (case (first tree) - :ACTIONS (generate-multiple-actions tree) - :COMPARATIVE (generate (second tree)) - :COMPARATIVE-QUALIFIER (generate (second tree)) - :CONDITION (generate-condition tree) - :CONDITIONS (generate-conditions tree) - :CONJUNCT-CONDITION (generate-conjunct-condition tree) - :DISJUNCT-CONDITION (generate-disjunct-condition tree) - :DISJUNCT-EXPRESSION (generate (nth tree 2)) - :DISJUNCT-VALUE (generate-disjunct-value tree) - :EQUIVALENCE '= - :EXPRESSION (generate (second tree)) - :LESS '< - :MORE '> - :NEGATED-QUALIFIER (case (generate (second tree)) - = 'not= - > '< - < '>) - :NEIGHBOURS-CONDITION (generate-neighbours-condition tree) - :NUMERIC-EXPRESSION (generate-numeric-expression tree) - :NUMBER (read-string (second tree)) - :OPERATOR (symbol (second tree)) - :PROBABLE-ACTION (generate-probable-action tree) - :PROPERTY (list (generate (second tree)) 'cell) ;; dubious - may not be right - :PROPERTY-CONDITION (generate-property-condition tree) - :QUALIFIER (generate-qualifier tree) - :RULE (generate-rule tree) - :SIMPLE-ACTION (generate-simple-action tree) - :SYMBOL (keyword (second tree)) - :VALUE (generate (second tree)) - :WITHIN-CONDITION (generate-within-condition tree) - (map generate tree)) - tree)) - - -(defn simplify-qualifier - "Given that this `tree` fragment represents a qualifier, what - qualifier is that?" - [tree] - (cond - (empty? tree) nil - (and (coll? tree) - (member? (first tree) '(:EQUIVALENCE :COMPARATIVE))) tree - (coll? (first tree)) (or (simplify-qualifier (first tree)) - (simplify-qualifier (rest tree))) - (coll? tree) (simplify-qualifier (rest tree)) - true tree)) - -(defn simplify-second-of-two - "There are a number of possible simplifications such that if the `tree` has - only two elements, the second is semantically sufficient." - [tree] - (if (= (count tree) 2) (simplify (second tree)) tree)) - - -(defn rule? - "Return true if the argument appears to be a parsed rule tree, else false." - [maybe-rule] - (and (coll? maybe-rule) (= (first maybe-rule) :RULE))) - -(defn simplify - "Simplify/canonicalise this `tree`. Opportunistically replace complex fragments with - semantically identical simpler fragments" - [tree] - (if - (coll? tree) - (case (first tree) - :ACTION (simplify-second-of-two tree) - :ACTIONS (cons (first tree) (simplify (rest tree))) - :CHANCE-IN nil - :COMPARATIVE (simplify-second-of-two tree) - :CONDITION (simplify-second-of-two tree) - :CONDITIONS (simplify-second-of-two tree) - :EXPRESSION (simplify-second-of-two tree) - :PROPERTY (simplify-second-of-two tree) - :PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree) - :SPACE nil - :THEN nil - :AND nil - :VALUE (simplify-second-of-two tree) - (remove nil? (map simplify tree))) - tree)) (def parse-rule "Parse the argument, assumed to be a string in the correct syntax, and return a parse tree." (insta/parser grammar)) -(defn explain-parse-error-reason - "Attempt to explain the reason for the parse error." - [reason] - (str "Expecting one of (" (apply str (map #(str (:expecting %) " ") reason)) ")")) - -(defn parser-error-to-map - [parser-error] - (let [m (reduce (fn [map item](merge map {(first item)(second item)})) {} parser-error) - reason (map - #(reduce (fn [map item] (merge {(first item) (second item)} map)) {} %) - (:reason m))] - (merge m {:reason reason}))) - -(defn throw-parse-exception - "Construct a helpful error message from this `parser-error`, and throw an exception with that message." - [parser-error] - (assert (coll? parser-error) "Expected a paser error structure?") - (let - [ - ;; the error structure is a list, such that each element is a list of two items, and - ;; the first element in each sublist is a keyword. Easier to work with it as a map - error-map (parser-error-to-map parser-error) - text (:text error-map) - reason (explain-parse-error-reason (:reason error-map)) - ;; rules have only one line, by definition; we're interested in the column - column (if (:column error-map)(:column error-map) 0) - ;; create a cursor to point to that column - cursor (apply str (reverse (conj (repeat column " ") "^"))) - message (format bad-parse-error text cursor reason) - ] - (throw (Exception. message)))) (defn compile-rule - "Compile this `rule`, assumed to be a string with appropriate syntax, into a function of two arguments, - a `cell` and a `world`, having the same semantics." - [rule] - (assert (string? rule)) - (let [tree (simplify (parse-rule rule))] - (if (rule? tree) (eval (generate tree)) - (throw-parse-exception tree)))) + "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 + the compiling environment. If `return-tuple?` is present and true, return + a list comprising the anonymous function compiled, and the function from + which it was compiled. + + Throws an exception if parsing fails." + ([rule-text return-tuple?] + (assert (string? rule-text)) + (let [rule (trim rule-text) + tree (ps/simplify (parse-rule rule)) + afn (if (rule? tree) (eval (pg/generate tree)) + ;; else + (pe/throw-parse-exception tree))] + (if return-tuple? + (list afn rule) + ;; else + afn))) + ([rule-text] + (compile-rule rule-text false))) diff --git a/src/mw_parser/errors.clj b/src/mw_parser/errors.clj new file mode 100644 index 0000000..8db5f6c --- /dev/null +++ b/src/mw_parser/errors.clj @@ -0,0 +1,45 @@ +(ns mw-parser.errors) + +;; error thrown when an attempt is made to set a reserved property +(def reserved-properties-error + "The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions") +;; error thrown when a rule cannot be parsed. Slots are for +;; (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") + + +(defn- explain-parse-error-reason + "Attempt to explain the reason for the parse error." + [reason] + (str "Expecting one of (" (apply str (map #(str (:expecting %) " ") reason)) ")")) + + +(defn- parser-error-to-map + [parser-error] + (let [m (reduce (fn [map item](merge map {(first item)(second item)})) {} parser-error) + reason (map + #(reduce (fn [map item] (merge {(first item) (second item)} map)) {} %) + (:reason m))] + (merge m {:reason reason}))) + + +(defn throw-parse-exception + "Construct a helpful error message from this `parser-error`, and throw an exception with that message." + [parser-error] + (assert (coll? parser-error) "Expected a paser error structure?") + (let + [ + ;; the error structure is a list, such that each element is a list of two items, and + ;; the first element in each sublist is a keyword. Easier to work with it as a map + error-map (parser-error-to-map parser-error) + text (:text error-map) + reason (explain-parse-error-reason (:reason error-map)) + ;; rules have only one line, by definition; we're interested in the column + column (if (:column error-map)(:column error-map) 0) + ;; create a cursor to point to that column + cursor (apply str (reverse (conj (repeat column " ") "^"))) + message (format bad-parse-error text cursor reason) + ] + (throw (Exception. message)))) diff --git a/src/mw_parser/generate.clj b/src/mw_parser/generate.clj new file mode 100644 index 0000000..d27647d --- /dev/null +++ b/src/mw_parser/generate.clj @@ -0,0 +1,270 @@ +(ns mw-parser.generate + (:use mw-engine.utils + mw-parser.utils + [mw-parser.errors :as pe])) + + +(declare generate generate-action) + + +(defn generate-rule + "From this `tree`, assumed to be a syntactically correct rule specification, + generate and return the appropriate rule as a function of two arguments." + [tree] + (assert-type tree :RULE) + (list 'fn ['cell 'world] (list 'if (generate (nth tree 2)) (generate (nth tree 3))))) + + +(defn generate-conditions + "From this `tree`, assumed to be a syntactically correct conditions clause, + generate and return the appropriate clojure fragment." + [tree] + (assert-type tree :CONDITIONS) + (generate (second tree))) + + +(defn generate-condition + [tree] + (assert-type tree :CONDITION) + (generate (second tree))) + + +(defn generate-conjunct-condition + [tree] + (assert-type tree :CONJUNCT-CONDITION) + (cons 'and (map generate (rest tree)))) + + +(defn generate-disjunct-condition + [tree] + (assert-type tree :DISJUNCT-CONDITION) + (cons 'or (map generate (rest tree)))) + + +(defn generate-ranged-property-condition + "Generate a property condition where the expression is a numeric range" + [tree property expression] + (assert-type tree :PROPERTY-CONDITION) + (assert-type (nth tree 3) :RANGE-EXPRESSION) + (let [l1 (generate (nth expression 2)) + l2 (generate (nth expression 4)) + pv (list property 'cell)] + (list 'let ['lower (list 'min l1 l2) + 'upper (list 'max l1 l2)] + (list 'and (list '>= pv 'lower)(list '<= pv 'upper))))) + + +(defn generate-disjunct-property-condition + "Generate a property condition where the expression is a disjunct expression. + TODO: this is definitely still wrong!" + ([tree] + (let [property (generate (second tree)) + 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))] + (list 'let ['value (list property 'cell)] + (if (= qualifier '=) e + (list 'not e)))))) + + +(defn generate-property-condition + ([tree] + (assert-type tree :PROPERTY-CONDITION) + (if + (and (= (count tree) 2) (= (first (second tree)) :SYMBOL)) + ;; it's a shorthand for 'state equal to symbol'. This should probably have + ;; been handled in simplify... + (generate-property-condition + (list + :PROPERTY-CONDITION + '(:SYMBOL "state") + '(:QUALIFIER (:EQUIVALENCE (:EQUAL "equal to"))) + (second tree))) + ;; otherwise... + (generate-property-condition tree (first (nth tree 3))))) + ([tree expression-type] + (assert-type tree :PROPERTY-CONDITION) + (let [property (generate (second tree)) + qualifier (generate (nth tree 2)) + 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) + (list qualifier (list property 'cell) expression))))) + + +(defn generate-qualifier + [tree] + (if + (= (count tree) 2) + (generate (second tree)) + ;; else + (generate (nth tree 2)))) + + +(defn generate-simple-action + ([tree] + (assert-type tree :SIMPLE-ACTION) + (generate-simple-action tree [])) + ([tree others] + (assert-type tree :SIMPLE-ACTION) + (let [property (generate (second tree)) + expression (generate (nth tree 3))] + (if (or (= property :x) (= property :y)) + (throw (Exception. pe/reserved-properties-error)) + (list 'merge + (if (empty? others) 'cell + ;; else + (generate others)) + {property expression}))))) + + +(defn generate-probable-action + ([tree] + (assert-type tree :PROBABLE-ACTION) + (generate-probable-action tree [])) + ([tree others] + (assert-type tree :PROBABLE-ACTION) + (let + [chances (generate (nth tree 1)) + total (generate (nth tree 2)) + action (generate-action (nth tree 3) others)] + ;; TODO: could almost certainly be done better with macro syntax + (list 'if + (list '< (list 'rand total) chances) + action)))) + + +(defn generate-action + [tree others] + (case (first tree) + :ACTIONS (generate-action (first tree) others) + :SIMPLE-ACTION (generate-simple-action tree others) + :PROBABLE-ACTION (generate-probable-action tree others) + (throw (Exception. (str "Not a known action type: " (first tree)))))) + + +(defn generate-multiple-actions + [tree] + (assert-type tree :ACTIONS) + (generate-action (first (rest tree)) (second (rest tree)))) + +(defn generate-disjunct-value + "Generate a disjunct value. Essentially what we need here is to generate a + flat list of values, since the `member` has already been taken care of." + [tree] + (assert-type tree :DISJUNCT-VALUE) + (if (= (count tree) 4) + (cons (generate (second tree)) (generate (nth tree 3))) + (list (generate (second tree))))) + + +(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))))) + + +(defn generate-neighbours-condition + "Generate code for a condition which refers to neighbours." + ([tree] + (assert-type tree :NEIGHBOURS-CONDITION) + (case (first (second tree)) + :QUANTIFIER (generate-neighbours-condition tree (first (second (second tree)))) + :QUALIFIER (cons (generate (second tree)) (rest (generate (nth tree 2)))))) + ([tree quantifier-type] + (let [quantifier (second tree) + pc (generate (nth tree 4))] + (case quantifier-type + :NUMBER (generate-neighbours-condition '= (read-string (second (second quantifier))) pc 1) + :SOME (generate-neighbours-condition '> 0 pc 1) + :MORE (let [value (generate (nth quantifier 3))] + (generate-neighbours-condition '> value pc 1)) + :LESS (let [value (generate (nth quantifier 3))] + (generate-neighbours-condition '< value pc 1)) + ))) + ([comp1 quantity property-condition distance] + (list comp1 + (list 'count + (list 'remove 'false? + (list 'map (list 'fn ['cell] property-condition) + (list 'mw-engine.utils/get-neighbours 'world 'cell distance)))) quantity)) + ([comp1 quantity property-condition] + (generate-neighbours-condition comp1 quantity property-condition 1))) + + +(defn generate-within-condition + "Generate code for a condition which refers to neighbours within a specified distance. + NOTE THAT there's clearly masses of commonality between this and + `generate-neighbours-condition`, and that some refactoring is almost certainly + desirable. It may be that it's better to simplify a `NEIGHBOURS-CONDITION` + into a `WITHIN-CONDITION` in the simplification stage." + ([tree] + (assert-type tree :WITHIN-CONDITION) + (case (first (second tree)) + :QUANTIFIER (generate-within-condition tree (first (second (second tree)))) + :QUALIFIER (TODO "qualified within... help!"))) + ([tree quantifier-type] + (let [quantifier (second tree) + distance (generate (nth tree 4)) + pc (generate (nth tree 6))] + (case quantifier-type + :NUMBER (generate-neighbours-condition '= (read-string (second (second quantifier))) pc distance) + :SOME (generate-neighbours-condition '> 0 pc distance) + :MORE (let [value (generate (nth quantifier 3))] + (generate-neighbours-condition '> value pc distance)) + :LESS (let [value (generate (nth quantifier 3))] + (generate-neighbours-condition '< value pc distance)) + )))) + + +(defn generate + "Generate code for this (fragment of a) parse tree" + [tree] + (if + (coll? tree) + (case (first tree) + :ACTIONS (generate-multiple-actions tree) + :COMPARATIVE (generate (second tree)) + :COMPARATIVE-QUALIFIER (generate (second tree)) + :CONDITION (generate-condition tree) + :CONDITIONS (generate-conditions tree) + :CONJUNCT-CONDITION (generate-conjunct-condition tree) + :DISJUNCT-CONDITION (generate-disjunct-condition tree) + :DISJUNCT-EXPRESSION (generate (nth tree 2)) + :DISJUNCT-VALUE (generate-disjunct-value tree) + :EQUIVALENCE '= + :EXPRESSION (generate (second tree)) + :LESS '< + :MORE '> + :NEGATED-QUALIFIER (case (generate (second tree)) + = 'not= + > '< + < '>) + :NEIGHBOURS-CONDITION (generate-neighbours-condition tree) + :NUMERIC-EXPRESSION (generate-numeric-expression tree) + :NUMBER (read-string (second tree)) + :OPERATOR (symbol (second tree)) + :PROBABLE-ACTION (generate-probable-action tree) + :PROPERTY (list (generate (second tree)) 'cell) ;; dubious - may not be right + :PROPERTY-CONDITION (generate-property-condition tree) + :QUALIFIER (generate-qualifier tree) + :RULE (generate-rule tree) + :SIMPLE-ACTION (generate-simple-action tree) + :SYMBOL (keyword (second tree)) + :VALUE (generate (second tree)) + :WITHIN-CONDITION (generate-within-condition tree) + (map generate tree)) + tree)) diff --git a/src/mw_parser/simplify.clj b/src/mw_parser/simplify.clj new file mode 100644 index 0000000..3ac2c3c --- /dev/null +++ b/src/mw_parser/simplify.clj @@ -0,0 +1,48 @@ +(ns mw-parser.simplify + (:use mw-engine.utils + mw-parser.utils)) + +(declare simplify) + +(defn simplify-qualifier + "Given that this `tree` fragment represents a qualifier, what + qualifier is that?" + [tree] + (cond + (empty? tree) nil + (and (coll? tree) + (member? (first tree) '(:EQUIVALENCE :COMPARATIVE))) tree + (coll? (first tree)) (or (simplify-qualifier (first tree)) + (simplify-qualifier (rest tree))) + (coll? tree) (simplify-qualifier (rest tree)) + true tree)) + +(defn simplify-second-of-two + "There are a number of possible simplifications such that if the `tree` has + only two elements, the second is semantically sufficient." + [tree] + (if (= (count tree) 2) (simplify (second tree)) tree)) + + +(defn simplify + "Simplify/canonicalise this `tree`. Opportunistically replace complex fragments with + semantically identical simpler fragments" + [tree] + (if + (coll? tree) + (case (first tree) + :ACTION (simplify-second-of-two tree) + :ACTIONS (cons (first tree) (simplify (rest tree))) + :CHANCE-IN nil + :COMPARATIVE (simplify-second-of-two tree) + :CONDITION (simplify-second-of-two tree) + :CONDITIONS (simplify-second-of-two tree) + :EXPRESSION (simplify-second-of-two tree) + :PROPERTY (simplify-second-of-two tree) + :PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree) + :SPACE nil + :THEN nil + :AND nil + :VALUE (simplify-second-of-two tree) + (remove nil? (map simplify tree))) + tree)) diff --git a/src/mw_parser/utils.clj b/src/mw_parser/utils.clj new file mode 100644 index 0000000..14e91c5 --- /dev/null +++ b/src/mw_parser/utils.clj @@ -0,0 +1,39 @@ +(ns mw-parser.utils) + + +(defn rule? + "Return true if the argument appears to be a parsed rule tree, else false." + [maybe-rule] + (and (coll? maybe-rule) (= (first maybe-rule) :RULE))) + + +(defn TODO + "Marker to indicate I'm not yet finished!" + [message] + message) + + +(defn suitable-fragment? + "Return `true` if `tree-fragment` appears to be a tree fragment of the expected `type`." + [tree-fragment type] + (and (coll? tree-fragment) + (= (first tree-fragment) type))) + + +(defn assert-type + "If `tree-fragment` is not a tree fragment of the expected `type`, throw an exception." + [tree-fragment type] + (assert (suitable-fragment? tree-fragment type) + (throw (Exception. (format "Expected a %s fragment" type))))) + + +(defn search-tree + "Return the first element of this tree which has this tag in a depth-first, left-to-right search" + [tree tag] + (cond + (= (first tree) tag) tree + :else (first + (remove nil? + (map + #(search-tree % tag) + (rest tree)))))) diff --git a/test/mw_parser/declarative_test.clj b/test/mw_parser/declarative_test.clj index 38365ee..93ffdbb 100644 --- a/test/mw_parser/declarative_test.clj +++ b/test/mw_parser/declarative_test.clj @@ -2,7 +2,8 @@ (:use clojure.pprint mw-engine.core mw-engine.world - mw-engine.utils) + mw-engine.utils + mw-parser.utils) (:require [clojure.test :refer :all] [mw-parser.declarative :refer :all])) @@ -32,55 +33,6 @@ (is (rule? (parse-rule "if 6 neighbours have state equal to water then state should be village"))) )) -(deftest expressions-tests - (testing "Generating primitive expressions." - (is (generate '(:NUMERIC-EXPRESSION (:NUMBER "50"))) 50) - (is (generate '(:NUMERIC-EXPRESSION (:SYMBOL "sealevel"))) - '(: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 - '(:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest"))) - '(= (:state cell) :forest)) - (is (generate - '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:EQUIVALENCE [:IS "is"]] (:NUMBER "10"))) - '(= (:fertility cell) 10)) - (is (generate '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:COMPARATIVE [:LESS "less"]] (:NUMBER "10"))) - '(< (:fertility cell) 10)) - (is (generate '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:COMPARATIVE [:MORE "more"]] (:NUMBER "10"))) - '(> (:fertility cell) 10)) - (is (generate '(:CONJUNCT-CONDITION (:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest")) (:AND "and") (:PROPERTY-CONDITION (:SYMBOL "fertility") [:EQUIVALENCE [:IS "is"]] (:NUMBER "10")))) - '(and (= (:state cell) :forest) (= (:fertility cell) 10))) - (is (generate '(:DISJUNCT-CONDITION (:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest")) (:OR "or") (:PROPERTY-CONDITION (:SYMBOL "fertility") [:EQUIVALENCE [:IS "is"]] (:NUMBER "10")))) - '(or (= (:state cell) :forest) (= (:fertility cell) 10))) - (is (generate '(:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:DISJUNCT-EXPRESSION (:IN "in") (:DISJUNCT-VALUE (:SYMBOL "grassland") (:OR "or") (:DISJUNCT-VALUE (:SYMBOL "pasture") (:OR "or") (:DISJUNCT-VALUE (:SYMBOL "heath"))))))) - '(let [value (:state cell)] (some (fn [i] (= i value)) (quote (:grassland :pasture :heath))))) - (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)))) - )) - -(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"))) - '(merge cell {:state :climax})) - (is (generate - '(:SIMPLE-ACTION (:SYMBOL "fertility") (:BECOMES "should be") (:NUMBER "10"))) - '(merge cell {:fertility 10})) - )) - -(deftest full-generation-tests - (testing "Full rule generation from pre-parsed tree" - (is (generate '(:RULE (:IF "if") (:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest")) (:SIMPLE-ACTION (:SYMBOL "state") (:BECOMES "should be") (:SYMBOL "climax")))) - '(fn [cell world] (if (= (:state cell) :forest) (merge cell {:state :climax})))) - )) - (deftest exception-tests (testing "Constructions which should cause exceptions to be thrown" @@ -100,6 +52,7 @@ "Exception thrown on attempt to set 'y'") )) + (deftest correctness-tests ;; 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. diff --git a/test/mw_parser/generate_test.clj b/test/mw_parser/generate_test.clj new file mode 100644 index 0000000..eacd48c --- /dev/null +++ b/test/mw_parser/generate_test.clj @@ -0,0 +1,57 @@ +(ns mw-parser.generate-test + (:use clojure.pprint + mw-engine.core + mw-engine.world + mw-engine.utils + mw-parser.utils) + (:require [clojure.test :refer :all] + [mw-parser.generate :refer :all])) + + +(deftest expressions-tests + (testing "Generating primitive expressions." + (is (generate '(:NUMERIC-EXPRESSION (:NUMBER "50"))) 50) + (is (generate '(:NUMERIC-EXPRESSION (:SYMBOL "sealevel"))) + '(:sealevel cell)) + )) + + +(deftest lhs-generators-tests + (testing "Generating left-hand-side fragments of rule functions from appropriate fragments of parse trees" + (is (generate + '(:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest"))) + '(= (:state cell) :forest)) + (is (generate + '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:EQUIVALENCE [:IS "is"]] (:NUMBER "10"))) + '(= (:fertility cell) 10)) + (is (generate '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:COMPARATIVE [:LESS "less"]] (:NUMBER "10"))) + '(< (:fertility cell) 10)) + (is (generate '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:COMPARATIVE [:MORE "more"]] (:NUMBER "10"))) + '(> (:fertility cell) 10)) + (is (generate '(:CONJUNCT-CONDITION (:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest")) (:AND "and") (:PROPERTY-CONDITION (:SYMBOL "fertility") [:EQUIVALENCE [:IS "is"]] (:NUMBER "10")))) + '(and (= (:state cell) :forest) (= (:fertility cell) 10))) + (is (generate '(:DISJUNCT-CONDITION (:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest")) (:OR "or") (:PROPERTY-CONDITION (:SYMBOL "fertility") [:EQUIVALENCE [:IS "is"]] (:NUMBER "10")))) + '(or (= (:state cell) :forest) (= (:fertility cell) 10))) + (is (generate '(:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:DISJUNCT-EXPRESSION (:IN "in") (:DISJUNCT-VALUE (:SYMBOL "grassland") (:OR "or") (:DISJUNCT-VALUE (:SYMBOL "pasture") (:OR "or") (:DISJUNCT-VALUE (:SYMBOL "heath"))))))) + '(let [value (:state cell)] (some (fn [i] (= i value)) (quote (:grassland :pasture :heath))))) + (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)))) + )) + + +(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"))) + '(merge cell {:state :climax})) + (is (generate + '(:SIMPLE-ACTION (:SYMBOL "fertility") (:BECOMES "should be") (:NUMBER "10"))) + '(merge cell {:fertility 10})) + )) + + +(deftest full-generation-tests + (testing "Full rule generation from pre-parsed tree" + (is (generate '(:RULE (:IF "if") (:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest")) (:SIMPLE-ACTION (:SYMBOL "state") (:BECOMES "should be") (:SYMBOL "climax")))) + '(fn [cell world] (if (= (:state cell) :forest) (merge cell {:state :climax})))) + )) From 3168c1b2fb718e9a939025060355e890696b13e4 Mon Sep 17 00:00:00 2001 From: simon Date: Sat, 13 Aug 2016 19:45:43 +0100 Subject: [PATCH 04/26] Trying to get code quality up, but in the process I've broken something - I think, the simplifier. --- src/mw_parser/bulk.clj | 27 +++++- src/mw_parser/core.clj | 145 ++++++++++++++++------------ src/mw_parser/declarative.clj | 45 +++++++-- src/mw_parser/errors.clj | 25 ++++- src/mw_parser/generate.clj | 56 ++++++++++- src/mw_parser/simplifier.clj | 92 ------------------ src/mw_parser/simplify.clj | 56 ++++++++--- src/mw_parser/utils.clj | 23 ++++- test/mw_parser/declarative_test.clj | 12 +++ 9 files changed, 298 insertions(+), 183 deletions(-) delete mode 100644 src/mw_parser/simplifier.clj diff --git a/src/mw_parser/bulk.clj b/src/mw_parser/bulk.clj index 00ecd14..2aba74c 100644 --- a/src/mw_parser/bulk.clj +++ b/src/mw_parser/bulk.clj @@ -1,13 +1,32 @@ -;; parse multiple rules from a stream, possibly a file - although the real -;; objective is to parse rules out of a block of text from a textarea - -(ns mw-parser.bulk +(ns ^{:doc "parse multiple rules from a stream, possibly a file." + :author "Simon Brooke"} + mw-parser.bulk (:use mw-parser.declarative mw-engine.utils clojure.java.io [clojure.string :only [split trim]]) (:import (java.io BufferedReader StringReader))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;; USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (defn comment? "Is this `line` a comment?" [line] diff --git a/src/mw_parser/core.clj b/src/mw_parser/core.clj index aafd595..f130f81 100644 --- a/src/mw_parser/core.clj +++ b/src/mw_parser/core.clj @@ -1,3 +1,30 @@ +(ns ^{:doc "A very simple parser which parses production rules." + :author "Simon Brooke"} + mw-parser.core + (:use mw-engine.utils + [clojure.string :only [split trim triml]]) + (:gen-class) +) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;; USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;; A very simple parser which parses production rules of the following forms: ;; ;; * "if altitude is less than 100 and state is forest then state should be climax and deer should be 3" @@ -11,35 +38,31 @@ ;; * "if state is in grassland or pasture or heath and 4 neighbours are water then state should be village" ;; * "if state is forest or state is climax and some neighbours have state equal to fire then 3 in 5 chance that state should be fire" ;; * "if state is pasture and more than 3 neighbours have state equal to scrub then state should be scrub" -;; * +;; * ;; ;; it generates rules in the form expected by `mw-engine.core`, q.v. ;; -;; It is, as I say, very simple; it generates a complete rule, or it fails completely, returning nil. +;; It is, as I say, very simple; it generates a complete rule, or it fails completely, returning nil. ;; Very occasionally it generates a wrong rule - one which is not a correct translation of the rule ;; semantics - but that is buggy behaviour, which I'll try to fix over the next few weeks, not a ;; design fault. ;; ;; More significantly it does not generate useful error messages on failure. ;; -;; This is the parser that is actually used currently; but see also insta.clj, +;; This is the parser that is actually used currently; but see also insta.clj, ;; which is potentially a much better parser but does not quite work yet. - -(ns mw-parser.core - (:use mw-engine.utils - [clojure.string :only [split trim triml]]) - (:gen-class) -) +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (declare parse-conditions) (declare parse-not-condition) (declare parse-simple-condition) -;; a regular expression which matches string representation of numbers +;; a regular expression which matches string representation of positive numbers (def re-number #"^[0-9.]*$") ;; error thrown when an attempt is made to set a reserved property -(def reserved-properties-error +(def reserved-properties-error "The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions") ;; error thrown when a rule cannot be parsed (def bad-parse-error "I did not understand '%s'") @@ -48,12 +71,12 @@ "If this token appears to represent an explicit number, return that number; otherwise, make a keyword of it and return that." [token] - (cond + (cond (re-matches re-number token) (read-string token) (keyword? token) token true (keyword token))) -;; Generally all functions in this file with names beginning 'parse-' take a +;; Generally all functions in this file with names beginning 'parse-' take a ;; sequence of tokens (and in some cases other optional arguments) and return a ;; vector comprising ;; @@ -70,7 +93,7 @@ (if (and value (re-matches re-number value)) [(read-string value) remainder])) (defn parse-property-int - "Parse a token assumed to be the name of a property of the current cell, + "Parse a token assumed to be the name of a property of the current cell, whose value is assumed to be an integer." [[value & remainder]] (if value [(list 'get-int 'cell (keyword value)) remainder])) @@ -115,12 +138,12 @@ [(cons value others) remainder]) true [(list value) tokens])))) - -(defn parse-value + +(defn parse-value "Parse a value from among these `tokens`. If `expect-int` is true, return an integer or something which will evaluate to an integer." ([tokens expect-int] - (or + (or (parse-disjunct-value tokens expect-int) (parse-simple-value tokens expect-int))) ([tokens] @@ -158,18 +181,18 @@ (list '> value1 property value2)) rest]))) (defn- parse-is-condition - "Parse clauses of the form 'x is y', 'x is in y or z...', + "Parse clauses of the form 'x is y', 'x is in y or z...', 'x is between y and z', 'x is more than y' or 'x is less than y'. It is necessary to disambiguate whether value is a numeric or keyword." [[property IS value & rest]] - (cond + (cond (member? IS '("is" "are")) (let [tokens (cons property (cons value rest))] - (cond + (cond (re-matches re-number value) [(list '= (list 'get-int 'cell (keyword property)) (read-string value)) rest] value [(list '= (list (keyword property) 'cell) (keyword value)) rest])))) -(defn- parse-not-condition +(defn- parse-not-condition "Parse the negation of a simple condition." [[property IS NOT & rest]] (cond (and (member? IS '("is" "are")) (= NOT "not")) @@ -179,11 +202,11 @@ [(list 'not condition) remainder]))))) (defn- gen-neighbours-condition - ([comp1 quantity property value remainder comp2 distance] - [(list comp1 + ([comp1 quantity property value remainder comp2 distance] + [(list comp1 (list 'count - (list 'get-neighbours-with-property-value 'world - '(cell :x) '(cell :y) distance + (list 'get-neighbours-with-property-value 'world + '(cell :x) '(cell :y) distance (keyword property) (keyword-or-numeric value) comp2)) quantity) remainder]) @@ -195,21 +218,21 @@ [[MORE THAN n NEIGHBOURS WITHIN distance have-or-are & rest]] (let [quantity (first (parse-numeric-value (list n))) comparator (cond (= MORE "more") '> - (member? MORE '("fewer" "less")) '<)] + (member? MORE '("fewer" "less")) '<)] (cond (not= WITHIN "within") - (parse-comparator-neighbours-condition - (flatten + (parse-comparator-neighbours-condition + (flatten ;; two tokens were mis-parsed as 'within distance' that weren't ;; actually 'within' and a distance. Splice in 'within 1' and try ;; again. (list MORE THAN n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest))) - (and quantity + (and quantity comparator (= THAN "than") (= NEIGHBOURS "neighbours")) (cond - (= have-or-are "are") + (= have-or-are "are") (let [[value & remainder] rest dist (gen-token-value distance true)] (gen-neighbours-condition comparator quantity :state value remainder = dist)) @@ -217,16 +240,16 @@ (let [[property comp1 comp2 value & remainder] rest dist (gen-token-value distance true)] (cond (and (= comp1 "equal") (= comp2 "to")) - (gen-neighbours-condition comparator quantity property + (gen-neighbours-condition comparator quantity property value remainder = dist) (and (= comp1 "more") (= comp2 "than")) - (gen-neighbours-condition comparator quantity property + (gen-neighbours-condition comparator quantity property value remainder > dist) (and (= comp1 "less") (= comp2 "than")) - (gen-neighbours-condition comparator quantity property + (gen-neighbours-condition comparator quantity property value remainder < dist) )))))) - + (defn parse-some-neighbours-condition [[SOME NEIGHBOURS & rest]] (cond @@ -236,18 +259,18 @@ (defn parse-simple-neighbours-condition "Parse conditions of the form '...6 neighbours are [condition]'" [[n NEIGHBOURS WITHIN distance have-or-are & rest]] - (let [quantity (first (parse-numeric-value (list n)))] + (let [quantity (first (parse-numeric-value (list n)))] (cond (and quantity (= NEIGHBOURS "neighbours")) (cond (not= WITHIN "within") (parse-simple-neighbours-condition - (flatten + (flatten ;; two tokens were mis-parsed as 'within distance' that weren't ;; actually 'within' and a distance. Splice in 'within 1' and try ;; again. (list n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest))) - (= have-or-are "are") + (= have-or-are "are") (let [[value & remainder] rest dist (gen-token-value distance true)] (gen-neighbours-condition '= quantity :state value remainder = dist)) @@ -255,16 +278,16 @@ (let [[property comp1 comp2 value & remainder] rest dist (gen-token-value distance true)] (cond (and (= comp1 "equal") (= comp2 "to")) - (gen-neighbours-condition '= quantity property value remainder = + (gen-neighbours-condition '= quantity property value remainder = dist) (and (= comp1 "more") (= comp2 "than")) - (gen-neighbours-condition '= quantity property value remainder > + (gen-neighbours-condition '= quantity property value remainder > dist) (and (= comp1 "less") (= comp2 "than")) - (gen-neighbours-condition '= quantity property value remainder < + (gen-neighbours-condition '= quantity property value remainder < dist) )))))) - + (defn parse-neighbours-condition "Parse conditions referring to neighbours" [tokens] @@ -320,30 +343,30 @@ (= IF "if") (parse-conditions tokens))) -(defn- parse-arithmetic-action +(defn- parse-arithmetic-action "Parse actions of the form '[property] should be [property] [arithmetic-operator] [value]', e.g. 'fertility should be fertility + 1', or 'deer should be deer - wolves'." [previous [prop1 SHOULD BE prop2 operator value & rest]] (cond (member? prop1 '("x" "y")) - (throw + (throw (Exception. reserved-properties-error)) (and (= SHOULD "should") (= BE "be") (member? operator '("+" "-" "*" "/"))) [(list 'merge (or previous 'cell) - {(keyword prop1) (list 'int + {(keyword prop1) (list 'int (list (symbol operator) (list 'get-int 'cell (keyword prop2)) (cond (re-matches re-number value) (read-string value) true (list 'get-int 'cell (keyword value)))))}) rest])) -(defn- parse-set-action +(defn- parse-set-action "Parse actions of the form '[property] should be [value].'" [previous [property SHOULD BE value & rest]] - (cond + (cond (member? property '("x" "y")) - (throw + (throw (Exception. reserved-properties-error)) (and (= SHOULD "should") (= BE "be")) [(list 'merge (or previous 'cell) @@ -362,19 +385,19 @@ (parse-actions left (rest remainder)) true (list left))))) -(defn- parse-probability +(defn- parse-probability "Parse a probability of an action from this collection of tokens" [previous [n CHANCE IN m & tokens]] - (cond + (cond (and (= CHANCE "chance")(= IN "in")) (let [[action remainder] (parse-actions previous tokens)] (cond action - [(list 'cond - (list '< - (list 'rand + [(list 'cond + (list '< + (list 'rand (first (parse-simple-value (list m) true))) - (first (parse-simple-value (list n) true))) - action) remainder])))) + (first (parse-simple-value (list n) true))) + action) remainder])))) (defn- parse-right-hand-side "Parse the right hand side ('then...') of a production rule." @@ -384,27 +407,27 @@ (parse-probability nil tokens) (parse-actions nil tokens)))) -(defn parse-rule - "Parse a complete rule from this `line`, expected to be either a string or a +(defn parse-rule + "Parse a complete rule from this `line`, expected to be either a string or a sequence of string tokens. Return the rule in the form of an S-expression. Throws an exception if parsing fails." [line] (cond - (string? line) + (string? line) (let [rule (parse-rule (split (triml line) #"\s+"))] (cond rule rule true (throw (Exception. (format bad-parse-error line))))) - true + true (let [[left remainder] (parse-left-hand-side line) [right junk] (parse-right-hand-side remainder)] - (cond + (cond ;; there should be a valide left hand side and a valid right hand side ;; there shouldn't be anything left over (junk should be empty) (and left right (empty? junk)) (list 'fn ['cell 'world] (list 'if left right)))))) -(defn compile-rule +(defn compile-rule "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 @@ -417,7 +440,7 @@ (do (use 'mw-engine.utils) (let [afn (eval (parse-rule rule-text))] - (cond + (cond (and afn return-tuple?)(list afn (trim rule-text)) true afn)))) ([rule-text] diff --git a/src/mw_parser/declarative.clj b/src/mw_parser/declarative.clj index 69792a4..410b247 100644 --- a/src/mw_parser/declarative.clj +++ b/src/mw_parser/declarative.clj @@ -1,11 +1,31 @@ -(ns mw-parser.declarative - (:use mw-engine.utils - mw-parser.utils - [mw-parser.errors :as pe] - [mw-parser.generate :as pg] - [mw-parser.simplify :as ps] - [clojure.string :only [split trim triml]]) - (:require [instaparse.core :as insta])) +(ns ^{:doc "A very simple parser which parses production rules." + :author "Simon Brooke"} + mw-parser.declarative + (:require [instaparse.core :as insta] + [clojure.string :refer [split trim triml]] + [mw-parser.errors :as pe] + [mw-parser.generate :as pg] + [mw-parser.simplify :as ps] + [mw-parser.utils :refer [rule?]])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;; USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def grammar @@ -93,3 +113,12 @@ (compile-rule rule-text false))) +(ps/simplify + (parse-rule + "if more than 2 neighbours have altitude equal to 11 then state should be beach")) + +(pg/generate + (ps/simplify + (parse-rule + "if more than 2 neighbours have altitude equal to 11 then state should be beach"))) + diff --git a/src/mw_parser/errors.clj b/src/mw_parser/errors.clj index 8db5f6c..6e5efbe 100644 --- a/src/mw_parser/errors.clj +++ b/src/mw_parser/errors.clj @@ -1,4 +1,27 @@ -(ns mw-parser.errors) +(ns ^{:doc "Display parse errors in a format which makes it easy for the user + to see where the error occurred." + :author "Simon Brooke"} + mw-parser.errors) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;; USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; error thrown when an attempt is made to set a reserved property (def reserved-properties-error diff --git a/src/mw_parser/generate.clj b/src/mw_parser/generate.clj index d27647d..3c86b02 100644 --- a/src/mw_parser/generate.clj +++ b/src/mw_parser/generate.clj @@ -1,8 +1,29 @@ -(ns mw-parser.generate - (:use mw-engine.utils - mw-parser.utils +(ns ^{:doc "Generate Clojure source from simplified parse trees." + :author "Simon Brooke"} + mw-parser.generate + (:require [mw-engine.utils :refer []] + [mw-parser.utils :refer [assert-type TODO]] [mw-parser.errors :as pe])) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;; USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (declare generate generate-action) @@ -24,6 +45,8 @@ (defn generate-condition + "From this `tree`, assumed to be a syntactically correct condition clause, + generate and return the appropriate clojure fragment." [tree] (assert-type tree :CONDITION) (generate (second tree))) @@ -31,18 +54,24 @@ (defn generate-conjunct-condition [tree] + "From this `tree`, assumed to be a syntactically conjunct correct condition clause, + generate and return the appropriate clojure fragment." (assert-type tree :CONJUNCT-CONDITION) (cons 'and (map generate (rest tree)))) (defn generate-disjunct-condition + "From this `tree`, assumed to be a syntactically correct disjunct condition clause, + generate and return the appropriate clojure fragment." [tree] (assert-type tree :DISJUNCT-CONDITION) (cons 'or (map generate (rest tree)))) (defn generate-ranged-property-condition - "Generate a property condition where the expression is a numeric range" + "From this `tree`, assumed to be a syntactically property condition clause for + this `property` where the `expression` is a numeric range, generate and return + the appropriate clojure fragment." [tree property expression] (assert-type tree :PROPERTY-CONDITION) (assert-type (nth tree 3) :RANGE-EXPRESSION) @@ -55,7 +84,9 @@ (defn generate-disjunct-property-condition - "Generate a property condition where the expression is a disjunct expression. + "From this `tree`, assumed to be a syntactically property condition clause + where the expression is a a disjunction, generate and return + the appropriate clojure fragment. TODO: this is definitely still wrong!" ([tree] (let [property (generate (second tree)) @@ -70,6 +101,8 @@ (defn generate-property-condition + "From this `tree`, assumed to be a syntactically property condition clause, + generate and return the appropriate clojure fragment." ([tree] (assert-type tree :PROPERTY-CONDITION) (if @@ -100,6 +133,8 @@ (defn generate-qualifier + "From this `tree`, assumed to be a syntactically correct qualifier, + generate and return the appropriate clojure fragment." [tree] (if (= (count tree) 2) @@ -109,6 +144,8 @@ (defn generate-simple-action + "From this `tree`, assumed to be a syntactically correct simple action, + generate and return the appropriate clojure fragment." ([tree] (assert-type tree :SIMPLE-ACTION) (generate-simple-action tree [])) @@ -126,6 +163,8 @@ (defn generate-probable-action + "From this `tree`, assumed to be a syntactically correct probable action, + generate and return the appropriate clojure fragment." ([tree] (assert-type tree :PROBABLE-ACTION) (generate-probable-action tree [])) @@ -142,6 +181,8 @@ (defn generate-action + "From this `tree`, assumed to be a syntactically correct action, + generate and return the appropriate clojure fragment." [tree others] (case (first tree) :ACTIONS (generate-action (first tree) others) @@ -151,6 +192,8 @@ (defn generate-multiple-actions + "From this `tree`, assumed to be one or more syntactically correct actions, + generate and return the appropriate clojure fragment." [tree] (assert-type tree :ACTIONS) (generate-action (first (rest tree)) (second (rest tree)))) @@ -166,6 +209,8 @@ (defn generate-numeric-expression + "From this `tree`, assumed to be a syntactically correct numeric expression, + generate and return the appropriate clojure fragment." [tree] (assert-type tree :NUMERIC-EXPRESSION) (case (count tree) @@ -182,6 +227,7 @@ ([tree] (assert-type tree :NEIGHBOURS-CONDITION) (case (first (second tree)) + :NUMBER (read-string (second (second tree))) :QUANTIFIER (generate-neighbours-condition tree (first (second (second tree)))) :QUALIFIER (cons (generate (second tree)) (rest (generate (nth tree 2)))))) ([tree quantifier-type] diff --git a/src/mw_parser/simplifier.clj b/src/mw_parser/simplifier.clj deleted file mode 100644 index 9943256..0000000 --- a/src/mw_parser/simplifier.clj +++ /dev/null @@ -1,92 +0,0 @@ -(ns mw-parser.simplifier - (:use mw-engine.utils - mw-parser.parser)) - -(declare simplify) - -(defn simplify-qualifier - "Given that this `tree` fragment represents a qualifier, what - qualifier is that?" - [tree] - (cond - (empty? tree) nil - (and (coll? tree) - (member? (first tree) '(:EQUIVALENCE :COMPARATIVE))) tree - (coll? (first tree)) (or (simplify-qualifier (first tree)) - (simplify-qualifier (rest tree))) - (coll? tree) (simplify-qualifier (rest tree)) - true tree)) - -(defn simplify-second-of-two - "There are a number of possible simplifications such that if the `tree` has - only two elements, the second is semantically sufficient." - [tree] - (if (= (count tree) 2) (simplify (nth tree 1)) tree)) - - -(defn simplify-some - "'some' is the same as 'more than zero'" - [tree] - [:COMPARATIVE '> 0]) - -(defn simplify-none - "'none' is the same as 'zero'" - [tree] - [:COMPARATIVE '= 0]) - -(defn simplify-all - "'all' isn't actually the same as 'eight', because cells at the edges of the world have - fewer than eight neighbours; but it's a simplifying (ha!) assumption for now." - [tree] - [:COMPARATIVE '= 8]) - -(defn simplify-quantifier - "If this quantifier is a number, 'simplifiy' it into a comparative whose operator is '=' - and whose quantity is that number. This is actually more complicated but makes generation easier." - [tree] - (if (number? (second tree)) [:COMPARATIVE '= (second tree)] (simplify (second tree)))) - -(defn simplify - "Simplify/canonicalise this `tree`. Opportunistically replace complex fragments with - semantically identical simpler fragments" - [tree] - (if - (coll? tree) - (case (first tree) - :SPACE nil - :QUALIFIER (simplify-qualifier tree) - :CONDITIONS (simplify-second-of-two tree) - :CONDITION (simplify-second-of-two tree) - :EXPRESSION (simplify-second-of-two tree) - :COMPARATIVE (simplify-second-of-two tree) - :QUANTIFIER (simplify-quantifier tree) - :VALUE (simplify-second-of-two tree) - :PROPERTY (simplify-second-of-two tree) - :ACTIONS (simplify-second-of-two tree) - :ACTION (simplify-second-of-two tree) - :ALL (simplify-all tree) - :SOME (simplify-some tree) - :NONE (simplify-none tree) - (remove nil? (map simplify tree))) - tree)) - -(simplify (parse-rule "if state is climax and 4 neighbours have state equal to fire then 3 chance in 5 state should be fire")) -(simplify (parse-rule "if state is climax and no neighbours have state equal to fire then 3 chance in 5 state should be fire")) - -(simplify (parse-rule "if state is in grassland or pasture or heath and more than 4 neighbours have state equal to water then state should be village")) - -(simplify (parse-rule "if 6 neighbours have state equal to water then state should be village")) - -(simplify (parse-rule "if fertility is between 55 and 75 then state should be climax")) - -(simplify (parse-rule "if state is forest then state should be climax")) - - -(simplify (parse-rule "if state is in grassland or pasture or heath and more than 4 neighbours have state equal to water then state should be village")) -(simplify (parse-rule "if altitude is less than 100 and state is forest then state should be climax and deer should be 3")) -(simplify (parse-rule "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3")) -(simplify (parse-rule "if altitude is 100 or fertility is 25 then state should be heath")) - -(simplify (parse-rule "if deer is more than 2 and wolves is 0 and fertility is more than 20 then deer should be deer + 2")) -(simplify (parse-rule "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves")) -(simplify (parse-rule "if state is grassland and 4 neighbours have state equal to water then state should be village")) diff --git a/src/mw_parser/simplify.clj b/src/mw_parser/simplify.clj index 3ac2c3c..1a5e8c6 100644 --- a/src/mw_parser/simplify.clj +++ b/src/mw_parser/simplify.clj @@ -1,12 +1,33 @@ -(ns mw-parser.simplify - (:use mw-engine.utils - mw-parser.utils)) +(ns ^{:doc "Simplify a parse tree." + :author "Simon Brooke"} + mw-parser.simplify + (:require [mw-engine.utils :refer [member?]])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;; USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (declare simplify) (defn simplify-qualifier "Given that this `tree` fragment represents a qualifier, what - qualifier is that?" + qualifier is that?" [tree] (cond (empty? tree) nil @@ -19,9 +40,16 @@ (defn simplify-second-of-two "There are a number of possible simplifications such that if the `tree` has - only two elements, the second is semantically sufficient." + only two elements, the second is semantically sufficient." [tree] - (if (= (count tree) 2) (simplify (second tree)) tree)) + (if (= (count tree) 2) (simplify (nth tree 1)) tree)) + + +(defn simplify-quantifier + "If this quantifier is a number, 'simplifiy' it into a comparative whose operator is '=' + and whose quantity is that number. This is actually more complicated but makes generation easier." + [tree] + (if (number? (second tree)) [:COMPARATIVE '= (second tree)] (simplify (second tree)))) (defn simplify @@ -31,18 +59,24 @@ (if (coll? tree) (case (first tree) + ;; 'all' isn't actually the same as 'eight', because cells at the edges of the world have + ;; fewer than eight neighbours; but it's a simplifying (ha!) assumption for now." + ;; TODO: fix this so it actually works. + :ALL [:COMPARATIVE '= 8] :ACTION (simplify-second-of-two tree) - :ACTIONS (cons (first tree) (simplify (rest tree))) - :CHANCE-IN nil + :ACTIONS (simplify-second-of-two tree) :COMPARATIVE (simplify-second-of-two tree) :CONDITION (simplify-second-of-two tree) :CONDITIONS (simplify-second-of-two tree) :EXPRESSION (simplify-second-of-two tree) + :NONE [:COMPARATIVE '= 0] + :NUMBER tree :PROPERTY (simplify-second-of-two tree) - :PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree) + :QUALIFIER (simplify-qualifier tree) + :QUANTIFIER (simplify-quantifier tree) + :SOME [:COMPARATIVE '> 0] :SPACE nil - :THEN nil - :AND nil :VALUE (simplify-second-of-two tree) (remove nil? (map simplify tree))) tree)) + diff --git a/src/mw_parser/utils.clj b/src/mw_parser/utils.clj index 14e91c5..42f8995 100644 --- a/src/mw_parser/utils.clj +++ b/src/mw_parser/utils.clj @@ -1,4 +1,25 @@ -(ns mw-parser.utils) +(ns ^{:doc "Utilities used in more than one namespace within the parser." + :author "Simon Brooke"} + mw-parser.utils) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;; USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn rule? diff --git a/test/mw_parser/declarative_test.clj b/test/mw_parser/declarative_test.clj index 93ffdbb..d5c6fd3 100644 --- a/test/mw_parser/declarative_test.clj +++ b/test/mw_parser/declarative_test.clj @@ -472,3 +472,15 @@ (is (nil? (apply afn (list {:x 0 :y 1} world))) "Middle cell of the strip has only two high neighbours, so rule should not fire.")) )) + +(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 5 state should be forest") + world (transform-world + (make-world 3 3) + (list (compile-rule "if x is 2 then altitude should be 11") + (compile-rule "if x is less than 2 then state should be scrub")))] + (is (= (:state (apply afn (list {:x 1 :y 1} world))) :forest) + "Centre cell is scrub, so rule should fire") + (is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach) + "Middle cell of the strip is not scrub, so rule should not fire.")))) From ca9553fe83396638a66927ae6944f2d0be6cee60 Mon Sep 17 00:00:00 2001 From: simon Date: Sat, 13 Aug 2016 23:20:34 +0100 Subject: [PATCH 05/26] Back to no exceptions in test, still two test failures which need to be investigated. --- src/mw_parser/declarative.clj | 10 ---------- src/mw_parser/simplify.clj | 15 +++++---------- 2 files changed, 5 insertions(+), 20 deletions(-) diff --git a/src/mw_parser/declarative.clj b/src/mw_parser/declarative.clj index 410b247..81325fd 100644 --- a/src/mw_parser/declarative.clj +++ b/src/mw_parser/declarative.clj @@ -112,13 +112,3 @@ ([rule-text] (compile-rule rule-text false))) - -(ps/simplify - (parse-rule - "if more than 2 neighbours have altitude equal to 11 then state should be beach")) - -(pg/generate - (ps/simplify - (parse-rule - "if more than 2 neighbours have altitude equal to 11 then state should be beach"))) - diff --git a/src/mw_parser/simplify.clj b/src/mw_parser/simplify.clj index 1a5e8c6..843ed80 100644 --- a/src/mw_parser/simplify.clj +++ b/src/mw_parser/simplify.clj @@ -59,23 +59,18 @@ (if (coll? tree) (case (first tree) - ;; 'all' isn't actually the same as 'eight', because cells at the edges of the world have - ;; fewer than eight neighbours; but it's a simplifying (ha!) assumption for now." - ;; TODO: fix this so it actually works. - :ALL [:COMPARATIVE '= 8] :ACTION (simplify-second-of-two tree) - :ACTIONS (simplify-second-of-two tree) + :ACTIONS (cons (first tree) (simplify (rest tree))) + :CHANCE-IN nil :COMPARATIVE (simplify-second-of-two tree) :CONDITION (simplify-second-of-two tree) :CONDITIONS (simplify-second-of-two tree) :EXPRESSION (simplify-second-of-two tree) - :NONE [:COMPARATIVE '= 0] - :NUMBER tree :PROPERTY (simplify-second-of-two tree) - :QUALIFIER (simplify-qualifier tree) - :QUANTIFIER (simplify-quantifier tree) - :SOME [:COMPARATIVE '> 0] + :PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree) :SPACE nil + :THEN nil + :AND nil :VALUE (simplify-second-of-two tree) (remove nil? (map simplify tree))) tree)) From 948bd7e5f2dfa21e33e5bb8902e248623eaecf5b Mon Sep 17 00:00:00 2001 From: simon Date: Sun, 21 Aug 2016 13:50:54 +0100 Subject: [PATCH 06/26] Standardised header comments in line with current best practice. --- src/mw_parser/bulk.clj | 36 ++++++++------- src/mw_parser/core.clj | 92 ++++++++++++++++++++------------------ src/mw_parser/simplify.clj | 36 ++++++++------- src/mw_parser/utils.clj | 36 ++++++++------- 4 files changed, 108 insertions(+), 92 deletions(-) diff --git a/src/mw_parser/bulk.clj b/src/mw_parser/bulk.clj index 2aba74c..cff7b49 100644 --- a/src/mw_parser/bulk.clj +++ b/src/mw_parser/bulk.clj @@ -8,22 +8,26 @@ (:import (java.io BufferedReader StringReader))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License -;; as published by the Free Software Foundation; either version 2 -;; of the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -;; USA. -;; +;;;; +;;;; mw-parser: a rule parser for MicroWorld. +;;;; +;;;; This program is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU General Public License +;;;; as published by the Free Software Foundation; either version 2 +;;;; of the License, or (at your option) any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this program; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;;;; USA. +;;;; +;;;; Copyright (C) 2014 Simon Brooke +;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/src/mw_parser/core.clj b/src/mw_parser/core.clj index f130f81..820f353 100644 --- a/src/mw_parser/core.clj +++ b/src/mw_parser/core.clj @@ -7,51 +7,55 @@ ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License -;; as published by the Free Software Foundation; either version 2 -;; of the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -;; USA. -;; +;;;; +;;;; mw-parser: a rule parser for MicroWorld. +;;;; +;;;; This program is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU General Public License +;;;; as published by the Free Software Foundation; either version 2 +;;;; of the License, or (at your option) any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this program; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;;;; USA. +;;;; +;;;; Copyright (C) 2014 Simon Brooke +;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; A very simple parser which parses production rules of the following forms: -;; -;; * "if altitude is less than 100 and state is forest then state should be climax and deer should be 3" -;; * "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3" -;; * "if altitude is 100 or fertility is 25 then state should be heath" -;; * "if deer is more than 2 and wolves is 0 and fertility is more than 20 then deer should be deer + 2" -;; * "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves" -;; * "if state is grassland and 4 neighbours have state equal to water then state should be village" -;; * "if state is forest and fertility is between 55 and 75 then state should be climax" -;; * "if 6 neighbours have state equal to water then state should be village" -;; * "if state is in grassland or pasture or heath and 4 neighbours are water then state should be village" -;; * "if state is forest or state is climax and some neighbours have state equal to fire then 3 in 5 chance that state should be fire" -;; * "if state is pasture and more than 3 neighbours have state equal to scrub then state should be scrub" -;; * -;; -;; it generates rules in the form expected by `mw-engine.core`, q.v. -;; -;; It is, as I say, very simple; it generates a complete rule, or it fails completely, returning nil. -;; Very occasionally it generates a wrong rule - one which is not a correct translation of the rule -;; semantics - but that is buggy behaviour, which I'll try to fix over the next few weeks, not a -;; design fault. -;; -;; More significantly it does not generate useful error messages on failure. -;; -;; This is the parser that is actually used currently; but see also insta.clj, -;; which is potentially a much better parser but does not quite work yet. -;; +;;;; +;;;; A very simple parser which parses production rules of the following forms: +;;;; +;;;; * "if altitude is less than 100 and state is forest then state should be climax and deer should be 3" +;;;; * "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3" +;;;; * "if altitude is 100 or fertility is 25 then state should be heath" +;;;; * "if deer is more than 2 and wolves is 0 and fertility is more than 20 then deer should be deer + 2" +;;;; * "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves" +;;;; * "if state is grassland and 4 neighbours have state equal to water then state should be village" +;;;; * "if state is forest and fertility is between 55 and 75 then state should be climax" +;;;; * "if 6 neighbours have state equal to water then state should be village" +;;;; * "if state is in grassland or pasture or heath and 4 neighbours are water then state should be village" +;;;; * "if state is forest or state is climax and some neighbours have state equal to fire then 3 in 5 chance that state should be fire" +;;;; * "if state is pasture and more than 3 neighbours have state equal to scrub then state should be scrub" +;;;; * +;;;; +;;;; it generates rules in the form expected by `mw-engine.core`, q.v. +;;;; +;;;; It is, as I say, very simple; it generates a complete rule, or it fails completely, returning nil. +;;;; Very occasionally it generates a wrong rule - one which is not a correct translation of the rule +;;;; semantics - but that is buggy behaviour, which I'll try to fix over the next few weeks, not a +;;;; design fault. +;;;; +;;;; More significantly it does not generate useful error messages on failure. +;;;; +;;;; This parser is now obsolete, but is retained in the codebase for now in +;;;; case it is of use to anyone. Prefer the declarative.clj parser. +;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (declare parse-conditions) diff --git a/src/mw_parser/simplify.clj b/src/mw_parser/simplify.clj index 843ed80..00529a8 100644 --- a/src/mw_parser/simplify.clj +++ b/src/mw_parser/simplify.clj @@ -4,22 +4,26 @@ (:require [mw-engine.utils :refer [member?]])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License -;; as published by the Free Software Foundation; either version 2 -;; of the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -;; USA. -;; +;;;; +;;;; mw-parser: a rule parser for MicroWorld. +;;;; +;;;; This program is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU General Public License +;;;; as published by the Free Software Foundation; either version 2 +;;;; of the License, or (at your option) any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this program; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;;;; USA. +;;;; +;;;; Copyright (C) 2014 Simon Brooke +;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/src/mw_parser/utils.clj b/src/mw_parser/utils.clj index 42f8995..e8bdca8 100644 --- a/src/mw_parser/utils.clj +++ b/src/mw_parser/utils.clj @@ -3,22 +3,26 @@ mw-parser.utils) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License -;; as published by the Free Software Foundation; either version 2 -;; of the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -;; USA. -;; +;;;; +;;;; mw-parser: a rule parser for MicroWorld. +;;;; +;;;; This program is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU General Public License +;;;; as published by the Free Software Foundation; either version 2 +;;;; of the License, or (at your option) any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this program; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;;;; USA. +;;;; +;;;; Copyright (C) 2014 Simon Brooke +;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; From ddf967088ebbe399a60c2b669263bd2f5cf5138a Mon Sep 17 00:00:00 2001 From: simon Date: Sun, 21 Aug 2016 13:51:56 +0100 Subject: [PATCH 07/26] Standarised header comments --- src/mw_parser/declarative.clj | 36 +++++++++++++++++++---------------- 1 file changed, 20 insertions(+), 16 deletions(-) diff --git a/src/mw_parser/declarative.clj b/src/mw_parser/declarative.clj index 81325fd..62e1b03 100644 --- a/src/mw_parser/declarative.clj +++ b/src/mw_parser/declarative.clj @@ -9,22 +9,26 @@ [mw-parser.utils :refer [rule?]])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License -;; as published by the Free Software Foundation; either version 2 -;; of the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -;; USA. -;; +;;;; +;;;; mw-parser: a rule parser for MicroWorld. +;;;; +;;;; This program is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU General Public License +;;;; as published by the Free Software Foundation; either version 2 +;;;; of the License, or (at your option) any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this program; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;;;; USA. +;;;; +;;;; Copyright (C) 2014 Simon Brooke +;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; From 88d707a32eb9fc899688cf5ce29217d8147e5dc3 Mon Sep 17 00:00:00 2001 From: simon Date: Fri, 23 Sep 2016 12:53:00 +0100 Subject: [PATCH 08/26] Fixed all failing tests. Two issues: 1. The regression test failures were both errors in the tests rather than in the code under test; 2. The failure in the 'bulk' test relates to the fact that the new declarative parser cannot cope with trailing whitespace. --- resources/rules.txt | 10 +++++----- src/mw_parser/bulk.clj | 2 +- test/mw_parser/bulk_test.clj | 15 ++++++++------- test/mw_parser/declarative_test.clj | 7 ++++--- 4 files changed, 18 insertions(+), 16 deletions(-) diff --git a/resources/rules.txt b/resources/rules.txt index 0356227..d7f2d5f 100644 --- a/resources/rules.txt +++ b/resources/rules.txt @@ -6,19 +6,19 @@ ## Vegetation rules ;; rules which populate the world with plants -;; Occasionally, passing birds plant tree seeds into grassland +;; Occasionally, passing birds plant tree seeds into grassland if state is grassland then 1 chance in 10 state should be heath ;; heath below the treeline grows gradually into forest -if state is heath and altitude is less than 120 then state should be scrub +if state is heath and altitude is less than 120 then state should be scrub if state is scrub then 1 chance in 5 state should be forest ;; Forest on fertile land grows to climax -if state is forest and fertility is more than 5 and altitude is less than 70 then state should be climax - +if state is forest and fertility is more than 5 and altitude is less than 70 then state should be climax + ;; Climax forest occasionally catches fire (e.g. lightning strikes) if state is climax then 1 chance in 500 state should be fire @@ -40,7 +40,7 @@ if state is waste then state should be grassland ## Potential blockers -;; Forest increases soil fertility. +;; Forest increases soil fertility. if state is in forest or climax then fertility should be fertility + 1 diff --git a/src/mw_parser/bulk.clj b/src/mw_parser/bulk.clj index cff7b49..45540e8 100644 --- a/src/mw_parser/bulk.clj +++ b/src/mw_parser/bulk.clj @@ -41,7 +41,7 @@ lines delimited by the new-line character. Return a list of S-expressions." [string] ;; TODO: tried to do this using with-open, but couldn't make it work. - (map parse-rule (remove comment? (split string #"\n")))) + (map #(parse-rule (trim %)) (remove comment? (split string #"\n")))) (defn parse-file "Parse rules from successive lines in the file loaded from this `filename`. diff --git a/test/mw_parser/bulk_test.clj b/test/mw_parser/bulk_test.clj index e80acc7..1155361 100644 --- a/test/mw_parser/bulk_test.clj +++ b/test/mw_parser/bulk_test.clj @@ -7,18 +7,19 @@ (testing "Bulk (file) parsing and compilation" (is (= (count (parse-file (as-file "resources/rules.txt"))) 15) "Should parse all rules and throw no exceptions") - (is (empty? - (remove #(= % 'fn) - (map first - (parse-file + (is (empty? + (remove #(= % ':RULE) + (map first + (parse-file (as-file "resources/rules.txt"))))) "all parsed rules should be lambda sexprs") (is (= (count (compile-file (as-file "resources/rules.txt"))) 15) "Should compile all rules and throw no exceptions") (is (empty? - (remove ifn? - (map first - (compile-file + (remove ifn? + (map first + (compile-file (as-file "resources/rules.txt"))))) "all compiled rules should be ifns") )) + diff --git a/test/mw_parser/declarative_test.clj b/test/mw_parser/declarative_test.clj index d5c6fd3..bc7485f 100644 --- a/test/mw_parser/declarative_test.clj +++ b/test/mw_parser/declarative_test.clj @@ -475,12 +475,13 @@ (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 5 state should be forest") + (let [afn (compile-rule "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") (compile-rule "if x is less than 2 then state should be scrub")))] - (is (= (:state (apply afn (list {:x 1 :y 1} world))) :forest) + (is (= (:state (apply afn (list (get-cell world 1 1) world))) :forest) "Centre cell is scrub, so rule should fire") - (is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach) + (is (= (apply afn (list (get-cell world 2 1) world)) nil) "Middle cell of the strip is not scrub, so rule should not fire.")))) + From a68a3c91357209061902fb850de57d4807d1f538 Mon Sep 17 00:00:00 2001 From: simon Date: Tue, 27 Dec 2016 15:53:29 +0000 Subject: [PATCH 09/26] Revert to using 'core' parser rather than new declarative parser, which still has bugs. --- src/mw_parser/bulk.clj | 2 +- test/mw_parser/bulk_test.clj | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/mw_parser/bulk.clj b/src/mw_parser/bulk.clj index 45540e8..2dfa6c4 100644 --- a/src/mw_parser/bulk.clj +++ b/src/mw_parser/bulk.clj @@ -1,7 +1,7 @@ (ns ^{:doc "parse multiple rules from a stream, possibly a file." :author "Simon Brooke"} mw-parser.bulk - (:use mw-parser.declarative + (:use mw-parser.core mw-engine.utils clojure.java.io [clojure.string :only [split trim]]) diff --git a/test/mw_parser/bulk_test.clj b/test/mw_parser/bulk_test.clj index 1155361..cc7bcfa 100644 --- a/test/mw_parser/bulk_test.clj +++ b/test/mw_parser/bulk_test.clj @@ -8,7 +8,7 @@ (is (= (count (parse-file (as-file "resources/rules.txt"))) 15) "Should parse all rules and throw no exceptions") (is (empty? - (remove #(= % ':RULE) + (remove #(= % 'fn) (map first (parse-file (as-file "resources/rules.txt"))))) From 508961540189ec78aec7cd7d5eb99041757df193 Mon Sep 17 00:00:00 2001 From: simon Date: Tue, 27 Dec 2016 16:19:01 +0000 Subject: [PATCH 10/26] Upversioned from 0.1.5-SNAPSHOT to 0.1.5 for release --- project.clj | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/project.clj b/project.clj index d48db45..8aa9f8e 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject mw-parser "0.1.5-SNAPSHOT" +(defproject mw-parser "0.1.5" :description "Parser for production rules for MicroWorld engine" :url "http://www.journeyman.cc/microworld" :manifest { @@ -14,5 +14,5 @@ :dependencies [[org.clojure/clojure "1.6.0"] [org.clojure/tools.trace "0.7.9"] [instaparse "1.4.1"] - [mw-engine "0.1.5-SNAPSHOT"] + [mw-engine "0.1.5"] ]) From 11090d63efb6c94a06d14026a115ec8e927b7f44 Mon Sep 17 00:00:00 2001 From: simon Date: Tue, 27 Dec 2016 16:19:27 +0000 Subject: [PATCH 11/26] Upversioned from 0.1.5 to 0.1.6-SNAPSHOT --- project.clj | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/project.clj b/project.clj index 8aa9f8e..930784f 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject mw-parser "0.1.5" +(defproject mw-parser "0.1.6-SNAPSHOT" :description "Parser for production rules for MicroWorld engine" :url "http://www.journeyman.cc/microworld" :manifest { @@ -14,5 +14,5 @@ :dependencies [[org.clojure/clojure "1.6.0"] [org.clojure/tools.trace "0.7.9"] [instaparse "1.4.1"] - [mw-engine "0.1.5"] + [mw-engine "0.1.6-SNAPSHOT"] ]) From 22b179a675e42b26a5a5d3a0f7f68894719f907e Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Thu, 9 Dec 2021 20:10:01 +0000 Subject: [PATCH 12/26] Tackling bit-rot --- .gitignore | 6 + docs/uberdoc.html | 3882 +++++++++++++++++++++++++++++++++++++++++++++ project.clj | 6 +- 3 files changed, 3891 insertions(+), 3 deletions(-) create mode 100644 .gitignore create mode 100644 docs/uberdoc.html diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..7c53947 --- /dev/null +++ b/.gitignore @@ -0,0 +1,6 @@ +buildall.tmp.* +.lein-failures +.lein-repl-history +target/ +pom.xml + diff --git a/docs/uberdoc.html b/docs/uberdoc.html new file mode 100644 index 0000000..fb3bf73 --- /dev/null +++ b/docs/uberdoc.html @@ -0,0 +1,3882 @@ + +mw-parser -- Marginalia

mw-parser

0.1.6-SNAPSHOT


Parser for production rules for MicroWorld engine

+

dependencies

org.clojure/clojure
1.8.0
org.clojure/tools.trace
0.7.9
instaparse
1.4.1
mw-engine
0.1.6-SNAPSHOT



(this space intentionally left almost blank)

namespaces

 

mw-parser.declarative

toc

A very simple parser which parses production rules.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-parser.declarative
+  (:require [instaparse.core :as insta]
+            [clojure.string :refer [split trim triml]]
+            [mw-parser.errors :as pe]
+            [mw-parser.generate :as pg]
+            [mw-parser.simplify :as ps]
+            [mw-parser.utils :refer [rule?]]))

mw-parser: a rule parser for MicroWorld.

+ +

This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version.

+ +

This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details.

+ +

You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +USA.

+ +

Copyright (C) 2014 Simon Brooke

+
+
(def grammar
+  ;; in order to simplify translation into other natural languages, all
+  ;; TOKENS within the parser should be unambiguous
+  "RULE := IF SPACE CONDITIONS SPACE THEN SPACE ACTIONS;
+   CONDITIONS := DISJUNCT-CONDITION | CONJUNCT-CONDITION | CONDITION ;
+   DISJUNCT-CONDITION := CONDITION SPACE OR SPACE CONDITIONS;
+   CONJUNCT-CONDITION := CONDITION SPACE AND SPACE CONDITIONS;
+   CONDITION := WITHIN-CONDITION | NEIGHBOURS-CONDITION | PROPERTY-CONDITION;
+   WITHIN-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE WITHIN SPACE NUMBER SPACE IS SPACE PROPERTY-CONDITION-OR-EXPRESSION;
+   NEIGHBOURS-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE IS SPACE PROPERTY-CONDITION | QUALIFIER SPACE NEIGHBOURS-CONDITION;
+   PROPERTY-CONDITION-OR-EXPRESSION := PROPERTY-CONDITION | EXPRESSION;
+   PROPERTY-CONDITION := PROPERTY SPACE QUALIFIER SPACE EXPRESSION | VALUE;
+   EXPRESSION := SIMPLE-EXPRESSION | RANGE-EXPRESSION | NUMERIC-EXPRESSION | DISJUNCT-EXPRESSION | VALUE;
+   SIMPLE-EXPRESSION := QUALIFIER SPACE EXPRESSION | VALUE;
+   DISJUNCT-EXPRESSION := IN SPACE DISJUNCT-VALUE;
+   RANGE-EXPRESSION := BETWEEN SPACE NUMERIC-EXPRESSION SPACE AND SPACE NUMERIC-EXPRESSION;
+   NUMERIC-EXPRESSION := VALUE | VALUE SPACE OPERATOR SPACE NUMERIC-EXPRESSION;
+   NEGATED-QUALIFIER := QUALIFIER SPACE NOT | NOT SPACE QUALIFIER;
+   COMPARATIVE-QUALIFIER := IS SPACE COMPARATIVE SPACE THAN | COMPARATIVE SPACE THAN;
+   QUALIFIER := COMPARATIVE-QUALIFIER | NEGATED-QUALIFIER | EQUIVALENCE | IS SPACE QUALIFIER;
+   QUANTIFIER := NUMBER | SOME | NONE | ALL | COMPARATIVE SPACE THAN SPACE NUMBER;
+   EQUIVALENCE := IS SPACE EQUAL | EQUAL | IS ;
+   COMPARATIVE := MORE | LESS;
+   DISJUNCT-VALUE := VALUE | VALUE SPACE OR SPACE DISJUNCT-VALUE;
+   IF := 'if';
+   THEN := 'then';
+   THAN := 'than';
+   OR := 'or';
+   NOT := 'not';
+   AND := 'and';
+   SOME := 'some';
+   NONE := 'no';
+   ALL := 'all'
+   BETWEEN := 'between';
+   WITHIN := 'within';
+   IN := 'in';
+   MORE := 'more' | 'greater';
+   LESS := 'less' | 'fewer';
+   OPERATOR := '+' | '-' | '*' | '/';
+   NEIGHBOURS := 'neighbour' | 'neighbor' | 'neighbours' | 'neighbors';
+   PROPERTY := SYMBOL;
+   VALUE := SYMBOL | NUMBER;
+   EQUAL := 'equal to';
+   IS := 'is' | 'are' | 'have' | 'has';
+   NUMBER := #'[0-9]+' | #'[0-9]+.[0-9]+';
+   SYMBOL := #'[a-z]+';
+   ACTIONS := ACTION | ACTION SPACE AND SPACE ACTIONS
+   ACTION := SIMPLE-ACTION | PROBABLE-ACTION;
+   PROBABLE-ACTION := VALUE SPACE CHANCE-IN SPACE VALUE SPACE SIMPLE-ACTION;
+   SIMPLE-ACTION := SYMBOL SPACE BECOMES SPACE EXPRESSION;
+   CHANCE-IN := 'chance in';
+   BECOMES := 'should be' | 'becomes';
+   SPACE := #' *'";)

Parse the argument, assumed to be a string in the correct syntax, and return a parse tree.

+
(def parse-rule
+  (insta/parser grammar))

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 + the compiling environment. If return-tuple? is present and true, return + a list comprising the anonymous function compiled, and the function from + which it was compiled.

+ +

Throws an exception if parsing fails.

+
(defn compile-rule
+  ([rule-text return-tuple?]
+   (assert (string? rule-text))
+   (let [rule (trim rule-text)
+         tree (ps/simplify (parse-rule rule))
+         afn (if (rule? tree) (eval (pg/generate tree))
+               ;; else
+               (pe/throw-parse-exception tree))]
+     (if return-tuple?
+       (list afn rule)
+       ;; else
+       afn)))
+  ([rule-text]
+   (compile-rule rule-text false)))
 

mw-parser.generate

toc

Generate Clojure source from simplified parse trees.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-parser.generate
+  (:require [mw-engine.utils :refer []]
+        [mw-parser.utils :refer [assert-type TODO]]
+        [mw-parser.errors :as pe]))

This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version.

+ +

This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details.

+ +

You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +USA.

+
+
(declare generate generate-action)

From this tree, assumed to be a syntactically correct rule specification, + generate and return the appropriate rule as a function of two arguments.

+
(defn generate-rule
+  [tree]
+  (assert-type tree :RULE)
+  (list 'fn ['cell 'world] (list 'if (generate (nth tree 2)) (generate (nth tree 3)))))

From this tree, assumed to be a syntactically correct conditions clause, + generate and return the appropriate clojure fragment.

+
(defn generate-conditions
+  [tree]
+  (assert-type tree :CONDITIONS)
+  (generate (second tree)))

From this tree, assumed to be a syntactically correct condition clause, + generate and return the appropriate clojure fragment.

+
(defn generate-condition
+  [tree]
+  (assert-type tree :CONDITION)
+  (generate (second tree)))
+
(defn generate-conjunct-condition
+  [tree]
+  "From this `tree`, assumed to be a syntactically conjunct correct condition clause,
+  generate and return the appropriate clojure fragment."
+  (assert-type tree :CONJUNCT-CONDITION)
+  (cons 'and (map generate (rest tree))))

From this tree, assumed to be a syntactically correct disjunct condition clause, + generate and return the appropriate clojure fragment.

+
(defn generate-disjunct-condition
+  [tree]
+  (assert-type tree :DISJUNCT-CONDITION)
+  (cons 'or (map generate (rest tree))))

From this tree, assumed to be a syntactically property condition clause for + this property where the expression is a numeric range, generate and return + the appropriate clojure fragment.

+
(defn generate-ranged-property-condition
+  [tree property expression]
+   (assert-type tree :PROPERTY-CONDITION)
+   (assert-type (nth tree 3) :RANGE-EXPRESSION)
+   (let [l1 (generate (nth expression 2))
+         l2 (generate (nth expression 4))
+         pv (list property 'cell)]
+     (list 'let ['lower (list 'min l1 l2)
+                 'upper (list 'max l1 l2)]
+           (list 'and (list '>= pv 'lower)(list '<= pv 'upper)))))

From this tree, assumed to be a syntactically property condition clause + where the expression is a a disjunction, generate and return + the appropriate clojure fragment. + TODO: this is definitely still wrong!

+
(defn generate-disjunct-property-condition
+  ([tree]
+   (let [property (generate (second tree))
+         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))]
+     (list 'let ['value (list property 'cell)]
+           (if (= qualifier '=) e
+             (list 'not e))))))

From this tree, assumed to be a syntactically property condition clause, + generate and return the appropriate clojure fragment.

+
(defn generate-property-condition
+  ([tree]
+   (assert-type tree :PROPERTY-CONDITION)
+   (if
+     (and (= (count tree) 2) (= (first (second tree)) :SYMBOL))
+     ;; it's a shorthand for 'state equal to symbol'. This should probably have
+     ;; been handled in simplify...
+     (generate-property-condition
+       (list
+         :PROPERTY-CONDITION
+         '(:SYMBOL "state")
+         '(:QUALIFIER (:EQUIVALENCE (:EQUAL "equal to")))
+         (second tree)))
+     ;; otherwise...
+     (generate-property-condition tree (first (nth tree 3)))))
+  ([tree expression-type]
+   (assert-type tree :PROPERTY-CONDITION)
+   (let [property (generate (second tree))
+         qualifier (generate (nth tree 2))
+         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)
+       (list qualifier (list property 'cell) expression)))))

From this tree, assumed to be a syntactically correct qualifier, + generate and return the appropriate clojure fragment.

+
(defn generate-qualifier
+  [tree]
+  (if
+    (= (count tree) 2)
+    (generate (second tree))
+    ;; else
+    (generate (nth tree 2))))

From this tree, assumed to be a syntactically correct simple action, + generate and return the appropriate clojure fragment.

+
(defn generate-simple-action
+  ([tree]
+   (assert-type tree :SIMPLE-ACTION)
+   (generate-simple-action tree []))
+  ([tree others]
+   (assert-type tree :SIMPLE-ACTION)
+   (let [property (generate (second tree))
+         expression (generate (nth tree 3))]
+     (if (or (= property :x) (= property :y))
+       (throw (Exception. pe/reserved-properties-error))
+       (list 'merge
+             (if (empty? others) 'cell
+               ;; else
+               (generate others))
+             {property expression})))))

From this tree, assumed to be a syntactically correct probable action, + generate and return the appropriate clojure fragment.

+
(defn generate-probable-action
+  ([tree]
+   (assert-type tree :PROBABLE-ACTION)
+   (generate-probable-action tree []))
+  ([tree others]
+   (assert-type tree :PROBABLE-ACTION)
+  (let
+    [chances (generate (nth tree 1))
+     total (generate (nth tree 2))
+     action (generate-action (nth tree 3) others)]
+    ;; TODO: could almost certainly be done better with macro syntax
+    (list 'if
+          (list '< (list 'rand total) chances)
+          action))))

From this tree, assumed to be a syntactically correct action, + generate and return the appropriate clojure fragment.

+
(defn generate-action
+  [tree others]
+  (case (first tree)
+    :ACTIONS (generate-action (first tree) others)
+    :SIMPLE-ACTION (generate-simple-action tree others)
+    :PROBABLE-ACTION (generate-probable-action tree others)
+    (throw (Exception. (str "Not a known action type: " (first tree))))))

From this tree, assumed to be one or more syntactically correct actions, + generate and return the appropriate clojure fragment.

+
(defn generate-multiple-actions
+  [tree]
+  (assert-type tree :ACTIONS)
+  (generate-action (first (rest tree)) (second (rest tree))))

Generate a disjunct value. Essentially what we need here is to generate a + flat list of values, since the member has already been taken care of.

+
(defn generate-disjunct-value
+  [tree]
+  (assert-type tree :DISJUNCT-VALUE)
+  (if (= (count tree) 4)
+    (cons (generate (second tree)) (generate (nth tree 3)))
+    (list (generate (second tree)))))

From this tree, assumed to be a syntactically correct numeric expression, + generate and return the appropriate clojure fragment.

+
(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 code for a condition which refers to neighbours.

+
(defn generate-neighbours-condition
+  ([tree]
+   (assert-type tree :NEIGHBOURS-CONDITION)
+   (case (first (second tree))
+     :NUMBER (read-string (second (second tree)))
+     :QUANTIFIER (generate-neighbours-condition tree (first (second (second tree))))
+     :QUALIFIER (cons (generate (second tree)) (rest (generate (nth tree 2))))))
+  ([tree quantifier-type]
+   (let [quantifier (second tree)
+         pc (generate (nth tree 4))]
+     (case quantifier-type
+       :NUMBER (generate-neighbours-condition '= (read-string (second (second quantifier))) pc 1)
+       :SOME (generate-neighbours-condition '> 0 pc 1)
+       :MORE (let [value (generate (nth quantifier 3))]
+               (generate-neighbours-condition '> value pc 1))
+       :LESS (let [value (generate (nth quantifier 3))]
+               (generate-neighbours-condition '< value pc 1)))))
+  ([comp1 quantity property-condition distance]
+   (list comp1
+         (list 'count
+               (list 'remove 'false?
+                     (list 'map (list 'fn ['cell] property-condition)
+                           (list 'mw-engine.utils/get-neighbours 'world 'cell distance)))) quantity))
+  ([comp1 quantity property-condition]
+   (generate-neighbours-condition comp1 quantity property-condition 1)))

Generate code for a condition which refers to neighbours within a specified distance. + NOTE THAT there's clearly masses of commonality between this and + generate-neighbours-condition, and that some refactoring is almost certainly + desirable. It may be that it's better to simplify a NEIGHBOURS-CONDITION + into a WITHIN-CONDITION in the simplification stage.

+
(defn generate-within-condition
+  ([tree]
+  (assert-type tree :WITHIN-CONDITION)
+    (case (first (second tree))
+      :QUANTIFIER (generate-within-condition tree (first (second (second tree))))
+      :QUALIFIER (TODO "qualified within... help!")))
+  ([tree quantifier-type]
+   (let [quantifier (second tree)
+         distance (generate (nth tree 4))
+         pc (generate (nth tree 6))]
+     (case quantifier-type
+       :NUMBER (generate-neighbours-condition '= (read-string (second (second quantifier))) pc distance)
+       :SOME (generate-neighbours-condition '> 0 pc distance)
+       :MORE (let [value (generate (nth quantifier 3))]
+               (generate-neighbours-condition '> value pc distance))
+       :LESS (let [value (generate (nth quantifier 3))]
+               (generate-neighbours-condition '< value pc distance))))))

Generate code for this (fragment of a) parse tree

+
(defn generate
+  [tree]
+  (if
+    (coll? tree)
+    (case (first tree)
+      :ACTIONS (generate-multiple-actions tree)
+      :COMPARATIVE (generate (second tree))
+      :COMPARATIVE-QUALIFIER (generate (second tree))
+      :CONDITION (generate-condition tree)
+      :CONDITIONS (generate-conditions tree)
+      :CONJUNCT-CONDITION (generate-conjunct-condition tree)
+      :DISJUNCT-CONDITION (generate-disjunct-condition tree)
+      :DISJUNCT-EXPRESSION (generate (nth tree 2))
+      :DISJUNCT-VALUE (generate-disjunct-value tree)
+      :EQUIVALENCE '=
+      :EXPRESSION (generate (second tree))
+      :LESS '<
+      :MORE '>
+      :NEGATED-QUALIFIER (case (generate (second tree))
+                                 = 'not=
+                                 > '<
+                                 < '>)
+      :NEIGHBOURS-CONDITION (generate-neighbours-condition tree)
+      :NUMERIC-EXPRESSION (generate-numeric-expression tree)
+      :NUMBER (read-string (second tree))
+      :OPERATOR (symbol (second tree))
+      :PROBABLE-ACTION (generate-probable-action tree)
+      :PROPERTY (list (generate (second tree)) 'cell) ;; dubious - may not be right
+      :PROPERTY-CONDITION (generate-property-condition tree)
+      :QUALIFIER (generate-qualifier tree)
+      :RULE (generate-rule tree)
+      :SIMPLE-ACTION (generate-simple-action tree)
+      :SYMBOL (keyword (second tree))
+      :VALUE (generate (second tree))
+      :WITHIN-CONDITION (generate-within-condition tree)
+      (map generate tree))
+    tree))
 

mw-parser.errors

toc

Display parse errors in a format which makes it easy for the user + to see where the error occurred.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-parser.errors)

This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version.

+ +

This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details.

+ +

You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +USA.

+

error thrown when an attempt is made to set a reserved property

+
(def reserved-properties-error
+  "The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions")

error thrown when a rule cannot be parsed. Slots are for +(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")

Attempt to explain the reason for the parse error.

+
(defn- explain-parse-error-reason
+  [reason]
+  (str "Expecting one of (" (apply str (map #(str (:expecting %) " ") reason)) ")"))
+
(defn- parser-error-to-map
+  [parser-error]
+  (let [m (reduce (fn [map item](merge map {(first item)(second item)})) {} parser-error)
+        reason (map
+                 #(reduce (fn [map item] (merge {(first item) (second item)} map)) {} %)
+                 (:reason m))]
+    (merge m {:reason reason})))

Construct a helpful error message from this parser-error, and throw an exception with that message.

+
(defn throw-parse-exception
+  [parser-error]
+  (assert (coll? parser-error) "Expected a paser error structure?")
+  (let
+    [
+      ;; the error structure is a list, such that each element is a list of two items, and
+      ;; the first element in each sublist is a keyword. Easier to work with it as a map
+     error-map (parser-error-to-map parser-error)
+     text (:text error-map)
+     reason (explain-parse-error-reason (:reason error-map))
+      ;; rules have only one line, by definition; we're interested in the column
+     column (if (:column error-map)(:column error-map) 0)
+      ;; create a cursor to point to that column
+     cursor (apply str (reverse (conj (repeat column " ") "^")))
+     message (format bad-parse-error text cursor reason)
+     ]
+  (throw (Exception. message))))
 

mw-parser.core

toc

A very simple parser which parses production rules.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-parser.core
+  (:use mw-engine.utils
+        [clojure.string :only [split trim triml]])
+  (:gen-class))

mw-parser: a rule parser for MicroWorld.

+ +

This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version.

+ +

This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details.

+ +

You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +USA.

+ +

Copyright (C) 2014 Simon Brooke

+ +

A very simple parser which parses production rules of the following forms:

+ +
    +
  • "if altitude is less than 100 and state is forest then state should be climax and deer should be 3"
    • +
  • "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3"
    • +
  • "if altitude is 100 or fertility is 25 then state should be heath"
    • +
  • "if deer is more than 2 and wolves is 0 and fertility is more than 20 then deer should be deer + 2"
    • +
  • "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves"
    • +
  • "if state is grassland and 4 neighbours have state equal to water then state should be village"
    • +
  • "if state is forest and fertility is between 55 and 75 then state should be climax"
    • +
  • "if 6 neighbours have state equal to water then state should be village"
    • +
  • "if state is in grassland or pasture or heath and 4 neighbours are water then state should be village"
    • +
  • "if state is forest or state is climax and some neighbours have state equal to fire then 3 in 5 chance that state should be fire"
    • +
  • "if state is pasture and more than 3 neighbours have state equal to scrub then state should be scrub" +*
    • +
+ +

it generates rules in the form expected by mw-engine.core, q.v.

+ +

It is, as I say, very simple; it generates a complete rule, or it fails completely, returning nil. +Very occasionally it generates a wrong rule - one which is not a correct translation of the rule +semantics - but that is buggy behaviour, which I'll try to fix over the next few weeks, not a +design fault.

+ +

More significantly it does not generate useful error messages on failure.

+ +

This parser is now obsolete, but is retained in the codebase for now in +case it is of use to anyone. Prefer the declarative.clj parser.

+
+
(declare parse-conditions)
+(declare parse-not-condition)
+(declare parse-simple-condition)

a regular expression which matches string representation of positive numbers

+
(def re-number #"^[0-9.]*$")

error thrown when an attempt is made to set a reserved property

+
(def reserved-properties-error
+  "The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions")

error thrown when a rule cannot be parsed

+
(def bad-parse-error "I did not understand '%s'")

If this token appears to represent an explicit number, return that number; + otherwise, make a keyword of it and return that.

+
(defn- keyword-or-numeric
+  [token]
+  (cond
+    (re-matches re-number token) (read-string token)
+    (keyword? token) token
+    true (keyword token)))

Generally all functions in this file with names beginning 'parse-' take a +sequence of tokens (and in some cases other optional arguments) and return a +vector comprising

+ +
    +
  1. A code fragment parsed from the front of the sequence of tokens, and
    2. +
  2. the remaining tokens which were not consumed in constructing that fragment.
    3. +
+ +

In every case if the function cannot parse the desired construct from the +front of the sequence of tokens it returns nil.

+

Parse a number.

+
(defn parse-numeric-value
+  [[value & remainder]]
+  (if (and value (re-matches re-number value)) [(read-string value) remainder]))

Parse a token assumed to be the name of a property of the current cell, + whose value is assumed to be an integer.

+
(defn parse-property-int
+  [[value & remainder]]
+  (if value [(list 'get-int 'cell (keyword value)) remainder]))

Parse a token assumed to be the name of a property of the current cell.

+
(defn parse-property-value
+  [[value & remainder]]
+  (if value [(list (keyword value) 'cell) remainder]))

Parse a token assumed to be a simple token value.

+
(defn parse-token-value
+  [[value & remainder]]
+  (if value [(keyword value) remainder]))

Parse a value from the first of these tokens. If expect-int is true, return + an integer or something which will evaluate to an integer.

+
(defn parse-simple-value
+  ([tokens expect-int]
+    (or
+        (parse-numeric-value tokens)
+        (cond expect-int
+          (parse-property-int tokens)
+          true (parse-token-value tokens))))
+  ([tokens]
+    (parse-simple-value tokens false)))

Parse a single value from this single token and return just the generated + code, not a pair.

+
(defn gen-token-value
+  [token expect-int]
+  (first (parse-simple-value (list token) expect-int)))

Parse a list of values from among these tokens. If expect-int is true, return + integers or things which will evaluate to integers.

+
(defn parse-disjunct-value
+  [[OR token & tokens] expect-int]
+  (cond (member? OR '("or" "in"))
+    (let [value (first (parse-simple-value (list token) expect-int))
+          seek-others (= (first tokens) "or")]
+      (cond seek-others
+        (let [[others remainder] (parse-disjunct-value tokens expect-int)]
+          [(cons value others) remainder])
+        true
+        [(list value) tokens]))))

Parse a value from among these tokens. If expect-int is true, return + an integer or something which will evaluate to an integer.

+
(defn parse-value
+  ([tokens expect-int]
+    (or
+      (parse-disjunct-value tokens expect-int)
+      (parse-simple-value tokens expect-int)))
+  ([tokens]
+    (parse-value tokens false)))

Parses a condition of the form '[property] in [value] or [value]...'

+
(defn parse-member-condition
+  [[property IS IN & rest]]
+  (if (and (member? IS '("is" "are")) (= IN "in"))
+    (let [[l remainder] (parse-disjunct-value (cons "in" rest) false)]
+      [(list 'member? (list (keyword property) 'cell) (list 'quote l)) remainder])))

Parse '[property] less than [value]'.

+
(defn- parse-less-condition
+  [[property IS LESS THAN & rest]]
+  (cond (and (member? IS '("is" "are")) (member? LESS '("less" "fewer")) (= THAN "than"))
+    (let [[value remainder] (parse-value rest true)]
+        [(list '< (list 'get-int 'cell (keyword property)) value) remainder])))

Parse '[property] more than [value]'.

+
(defn- parse-more-condition
+  [[property IS MORE THAN & rest]]
+  (cond (and (member? IS '("is" "are")) (member? MORE '("more" "greater")) (= THAN "than"))
+    (let [[value remainder] (parse-value rest true)]
+        [(list '> (list 'get-int 'cell (keyword property)) value) remainder])))
+
(defn- parse-between-condition
+  [[p IS BETWEEN v1 AND v2 & rest]]
+  (cond (and (member? IS '("is" "are")) (= BETWEEN "between") (= AND "and") (not (nil? v2)))
+    (let [property (first (parse-simple-value (list p) true))
+          value1 (first (parse-simple-value (list v1) true))
+          value2 (first (parse-simple-value (list v2) true))]
+      [(list 'or
+            (list '< value1 property value2)
+            (list '> value1 property value2)) rest])))

Parse clauses of the form 'x is y', 'x is in y or z...', + 'x is between y and z', 'x is more than y' or 'x is less than y'. + It is necessary to disambiguate whether value is a numeric or keyword.

+
(defn- parse-is-condition
+  [[property IS value & rest]]
+  (cond
+    (member? IS '("is" "are"))
+    (let [tokens (cons property (cons value rest))]
+      (cond
+        (re-matches re-number value) [(list '= (list 'get-int 'cell (keyword property)) (read-string value)) rest]
+        value [(list '= (list (keyword property) 'cell) (keyword value)) rest]))))

Parse the negation of a simple condition.

+
(defn- parse-not-condition
+  [[property IS NOT & rest]]
+  (cond (and (member? IS '("is" "are")) (= NOT "not"))
+    (let [partial (parse-simple-condition (cons property (cons "is" rest)))]
+      (cond partial
+        (let [[condition remainder] partial]
+          [(list 'not condition) remainder])))))
+
(defn- gen-neighbours-condition
+  ([comp1 quantity property value remainder comp2 distance]
+    [(list comp1
+         (list 'count
+               (list 'get-neighbours-with-property-value 'world
+                     '(cell :x) '(cell :y) distance
+                     (keyword property) (keyword-or-numeric value) comp2))
+         quantity)
+           remainder])
+  ([comp1 quantity property value remainder comp2]
+    (gen-neighbours-condition comp1 quantity property value remainder comp2 1)))

Parse conditions of the form '...more than 6 neighbours are [condition]'

+
(defn parse-comparator-neighbours-condition
+  [[MORE THAN n NEIGHBOURS WITHIN distance have-or-are & rest]]
+  (let [quantity (first (parse-numeric-value (list n)))
+        comparator (cond (= MORE "more") '>
+                     (member? MORE '("fewer" "less")) '<)]
+    (cond
+      (not= WITHIN "within")
+      (parse-comparator-neighbours-condition
+        (flatten
+          ;; two tokens were mis-parsed as 'within distance' that weren't
+          ;; actually 'within' and a distance. Splice in 'within 1' and try
+          ;; again.
+          (list MORE THAN n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest)))
+      (and quantity
+           comparator
+           (= THAN "than")
+           (= NEIGHBOURS "neighbours"))
+      (cond
+        (= have-or-are "are")
+        (let [[value & remainder] rest
+              dist (gen-token-value distance true)]
+          (gen-neighbours-condition comparator quantity :state value remainder = dist))
+        (= have-or-are "have")
+        (let [[property comp1 comp2 value & remainder] rest
+              dist (gen-token-value distance true)]
+          (cond (and (= comp1 "equal") (= comp2 "to"))
+            (gen-neighbours-condition comparator quantity property
+                                      value remainder = dist)
+            (and (= comp1 "more") (= comp2 "than"))
+            (gen-neighbours-condition comparator quantity property
+                                      value remainder > dist)
+            (and (= comp1 "less") (= comp2 "than"))
+            (gen-neighbours-condition comparator quantity property
+                                      value remainder < dist)))))))
+
(defn parse-some-neighbours-condition
+  [[SOME NEIGHBOURS & rest]]
+  (cond
+    (and (= SOME "some") (= NEIGHBOURS "neighbours"))
+    (parse-comparator-neighbours-condition (concat '("more" "than" "0" "neighbours") rest))))

Parse conditions of the form '...6 neighbours are [condition]'

+
(defn parse-simple-neighbours-condition
+  [[n NEIGHBOURS WITHIN distance have-or-are & rest]]
+  (let [quantity (first (parse-numeric-value (list n)))]
+    (cond
+      (and quantity (= NEIGHBOURS "neighbours"))
+      (cond
+        (not= WITHIN "within")
+        (parse-simple-neighbours-condition
+          (flatten
+            ;; two tokens were mis-parsed as 'within distance' that weren't
+            ;; actually 'within' and a distance. Splice in 'within 1' and try
+            ;; again.
+            (list n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest)))
+        (= have-or-are "are")
+        (let [[value & remainder] rest
+              dist (gen-token-value distance true)]
+          (gen-neighbours-condition '= quantity :state value remainder = dist))
+        (= have-or-are "have")
+        (let [[property comp1 comp2 value & remainder] rest
+              dist (gen-token-value distance true)]
+          (cond (and (= comp1 "equal") (= comp2 "to"))
+            (gen-neighbours-condition '= quantity property value remainder =
+                                      dist)
+            (and (= comp1 "more") (= comp2 "than"))
+            (gen-neighbours-condition '= quantity property value remainder >
+                                      dist)
+            (and (= comp1 "less") (= comp2 "than"))
+            (gen-neighbours-condition '= quantity property value remainder <
+                                      dist)))))))

Parse conditions referring to neighbours

+
(defn parse-neighbours-condition
+  [tokens]
+  (or
+    (parse-simple-neighbours-condition tokens)
+    (parse-comparator-neighbours-condition tokens)
+    (parse-some-neighbours-condition tokens)))

Parse conditions of the form '[property] [comparison] [value]'.

+
(defn parse-simple-condition
+  [tokens]
+  (or
+    (parse-neighbours-condition tokens)
+    (parse-member-condition tokens)
+    (parse-not-condition tokens)
+    (parse-less-condition tokens)
+    (parse-more-condition tokens)
+    (parse-between-condition tokens)
+    (parse-is-condition tokens)))

Parse '... or [condition]' from tokens, where left is the already parsed first disjunct.

+
(defn- parse-disjunction-condition
+  [left tokens]
+  (let [partial (parse-conditions tokens)]
+    (if partial
+      (let [[right remainder] partial]
+        [(list 'or left right) remainder]))))

Parse '... and [condition]' from tokens, where left is the already parsed first conjunct.

+
(defn- parse-conjunction-condition
+  [left tokens]
+  (let [partial (parse-conditions tokens)]
+    (if partial
+      (let [[right remainder] partial]
+        [(list 'and left right) remainder]))))

Parse conditions from tokens, where conditions may be linked by either 'and' or 'or'.

+
(defn- parse-conditions
+  [tokens]
+  (let [partial (parse-simple-condition tokens)]
+    (if partial
+      (let [[left [next & remainder]] partial]
+        (cond
+          (= next "and") (parse-conjunction-condition left remainder)
+          (= next "or") (parse-disjunction-condition left remainder)
+          true partial)))))

Parse the left hand side ('if...') of a production rule.

+
(defn- parse-left-hand-side
+ [[IF & tokens]]
+ (if
+   (= IF "if")
+   (parse-conditions tokens)))

Parse actions of the form '[property] should be [property] [arithmetic-operator] [value]', + e.g. 'fertility should be fertility + 1', or 'deer should be deer - wolves'.

+
(defn- parse-arithmetic-action
+  [previous [prop1 SHOULD BE prop2 operator value & rest]]
+  (cond
+    (member? prop1 '("x" "y"))
+    (throw
+      (Exception. reserved-properties-error))
+    (and (= SHOULD "should")
+           (= BE "be")
+           (member? operator '("+" "-" "*" "/")))
+    [(list 'merge (or previous 'cell)
+           {(keyword prop1) (list 'int
+                                  (list (symbol operator) (list 'get-int 'cell (keyword prop2))
+                                        (cond
+                                          (re-matches re-number value) (read-string value)
+                                          true (list 'get-int 'cell (keyword value)))))}) rest]))

Parse actions of the form '[property] should be [value].'

+
(defn- parse-set-action
+  [previous [property SHOULD BE value & rest]]
+  (cond
+    (member? property '("x" "y"))
+    (throw
+      (Exception. reserved-properties-error))
+    (and (= SHOULD "should") (= BE "be"))
+    [(list 'merge (or previous 'cell)
+           {(keyword property) (cond (re-matches re-number value) (read-string value) true (keyword value))}) rest]))
+
(defn- parse-simple-action [previous tokens]
+  (or (parse-arithmetic-action previous tokens)
+      (parse-set-action previous tokens)))

Parse actions from tokens.

+
(defn- parse-actions
+  [previous tokens]
+  (let [[left remainder] (parse-simple-action previous tokens)]
+    (cond left
+          (cond (= (first remainder) "and")
+                (parse-actions left (rest remainder))
+                true (list left)))))

Parse a probability of an action from this collection of tokens

+
(defn- parse-probability
+  [previous [n CHANCE IN m & tokens]]
+  (cond
+    (and (= CHANCE "chance")(= IN "in"))
+    (let [[action remainder] (parse-actions previous tokens)]
+      (cond action
+        [(list 'cond
+              (list '<
+                    (list 'rand
+                          (first (parse-simple-value (list m) true)))
+                    (first (parse-simple-value (list n) true)))
+              action) remainder]))))

Parse the right hand side ('then...') of a production rule.

+
(defn- parse-right-hand-side
+  [[THEN & tokens]]
+  (if (= THEN "then")
+    (or
+      (parse-probability nil tokens)
+      (parse-actions nil tokens))))

Parse a complete rule from this line, expected to be either a string or a + sequence of string tokens. Return the rule in the form of an S-expression.

+ +

Throws an exception if parsing fails.

+
(defn parse-rule
+  [line]
+  (cond
+   (string? line)
+   (let [rule (parse-rule (split (triml line) #"\s+"))]
+     (cond rule rule
+       true (throw (Exception. (format bad-parse-error line)))))
+   true
+   (let [[left remainder] (parse-left-hand-side line)
+              [right junk] (parse-right-hand-side remainder)]
+     (cond
+       ;; there should be a valide left hand side and a valid right hand side
+       ;; there shouldn't be anything left over (junk should be empty)
+       (and left right (empty? junk))
+       (list 'fn ['cell 'world] (list 'if left right))))))

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 + the compiling environment. If return-tuple? is present and true, return + a list comprising the anonymous function compiled, and the function from + which it was compiled.

+ +

Throws an exception if parsing fails.

+
(defn compile-rule
+  ([rule-text return-tuple?]
+    (do
+      (use 'mw-engine.utils)
+      (let [afn (eval (parse-rule rule-text))]
+        (cond
+          (and afn return-tuple?)(list afn (trim rule-text))
+          true afn))))
+  ([rule-text]
+    (compile-rule rule-text false)))
 

mw-parser.bulk

toc

parse multiple rules from a stream, possibly a file.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-parser.bulk
+  (:use mw-parser.core
+        mw-engine.utils
+        clojure.java.io
+        [clojure.string :only [split trim]])
+  (:import (java.io BufferedReader StringReader)))

mw-parser: a rule parser for MicroWorld.

+ +

This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version.

+ +

This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details.

+ +

You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +USA.

+ +

Copyright (C) 2014 Simon Brooke

+

Is this line a comment?

+
(defn comment?
+  [line]
+  (or (empty? (trim line)) (member? (first line) '(nil \# \;))))

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.

+
(defn parse-string
+  [string]
+        ;; TODO: tried to do this using with-open, but couldn't make it work.
+  (map #(parse-rule (trim %)) (remove comment? (split string #"\n"))))

Parse rules from successive lines in the file loaded from this filename. + Return a list of S-expressions.

+
(defn parse-file
+  [filename]
+  (parse-string (slurp filename)))

Compile each non-comment line of this string into an executable anonymous + function, and return the sequence of such functions.

+
(defn compile-string
+  [string]
+  (map #(compile-rule % true) (remove comment? (split string #"\n"))))

Compile each non-comment line of the file indicated by this filename into + an executable anonymous function, and return the sequence of such functions.

+
(defn compile-file
+  [filename]
+  (compile-string (slurp filename)))
 

mw-parser.simplify

toc

Simplify a parse tree.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-parser.simplify
+  (:require [mw-engine.utils :refer [member?]]))

mw-parser: a rule parser for MicroWorld.

+ +

This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version.

+ +

This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details.

+ +

You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +USA.

+ +

Copyright (C) 2014 Simon Brooke

+
+
(declare simplify)

Given that this tree fragment represents a qualifier, what + qualifier is that?

+
(defn simplify-qualifier
+  [tree]
+  (cond
+    (empty? tree) nil
+    (and (coll? tree)
+         (member? (first tree) '(:EQUIVALENCE :COMPARATIVE))) tree
+    (coll? (first tree)) (or (simplify-qualifier (first tree))
+                             (simplify-qualifier (rest tree)))
+    (coll? tree) (simplify-qualifier (rest tree))
+    true tree))

There are a number of possible simplifications such that if the tree has + only two elements, the second is semantically sufficient.

+
(defn simplify-second-of-two
+  [tree]
+  (if (= (count tree) 2) (simplify (nth tree 1)) tree))

If this quantifier is a number, 'simplifiy' it into a comparative whose operator is '=' + and whose quantity is that number. This is actually more complicated but makes generation easier.

+
(defn simplify-quantifier
+  [tree]
+  (if (number? (second tree)) [:COMPARATIVE '= (second tree)] (simplify (second tree))))

Simplify/canonicalise this tree. Opportunistically replace complex fragments with + semantically identical simpler fragments

+
(defn simplify
+  [tree]
+  (if
+    (coll? tree)
+    (case (first tree)
+      :ACTION (simplify-second-of-two tree)
+      :ACTIONS (cons (first tree) (simplify (rest tree)))
+      :CHANCE-IN nil
+      :COMPARATIVE (simplify-second-of-two tree)
+      :CONDITION (simplify-second-of-two tree)
+      :CONDITIONS (simplify-second-of-two tree)
+      :EXPRESSION (simplify-second-of-two tree)
+      :PROPERTY (simplify-second-of-two tree)
+      :PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree)
+      :SPACE nil
+      :THEN nil
+      :AND nil
+      :VALUE (simplify-second-of-two tree)
+      (remove nil? (map simplify tree)))
+    tree))
 

mw-parser.utils

toc

Utilities used in more than one namespace within the parser.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-parser.utils)

mw-parser: a rule parser for MicroWorld.

+ +

This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version.

+ +

This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details.

+ +

You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +USA.

+ +

Copyright (C) 2014 Simon Brooke

+

Return true if the argument appears to be a parsed rule tree, else false.

+
(defn rule?
+  [maybe-rule]
+  (and (coll? maybe-rule) (= (first maybe-rule) :RULE)))

Marker to indicate I'm not yet finished!

+
(defn TODO
+  [message]
+  message)

Return true if tree-fragment appears to be a tree fragment of the expected type.

+
(defn suitable-fragment?
+  [tree-fragment type]
+  (and (coll? tree-fragment)
+       (= (first tree-fragment) type)))

If tree-fragment is not a tree fragment of the expected type, throw an exception.

+
(defn assert-type
+  [tree-fragment type]
+  (assert (suitable-fragment? tree-fragment type)
+          (throw (Exception. (format "Expected a %s fragment" type)))))

Return the first element of this tree which has this tag in a depth-first, left-to-right search

+
(defn search-tree
+  [tree tag]
+  (cond
+    (= (first tree) tag) tree
+    :else (first
+            (remove nil?
+                    (map
+                      #(search-tree % tag)
+                      (rest tree))))))
 
Generated by Marginalia.  Syntax highlighting provided by Alex Gorbatchev's SyntaxHighlighter
  • mw-parser.declarative
  • mw-parser.generate
  • mw-parser.errors
  • mw-parser.core
  • mw-parser.bulk
  • mw-parser.simplify
  • mw-parser.utils
\ No newline at end of file diff --git a/project.clj b/project.clj index 930784f..577f08b 100644 --- a/project.clj +++ b/project.clj @@ -11,8 +11,8 @@ :license {:name "GNU General Public License v2" :url "http://www.gnu.org/licenses/gpl-2.0.html"} :plugins [[lein-marginalia "0.7.1"]] - :dependencies [[org.clojure/clojure "1.6.0"] - [org.clojure/tools.trace "0.7.9"] - [instaparse "1.4.1"] + :dependencies [[org.clojure/clojure "1.10.3"] + [org.clojure/tools.trace "0.7.11"] + [instaparse "1.4.10"] [mw-engine "0.1.6-SNAPSHOT"] ]) From 311ebafa5c1cb5a94a123f00d9f7ef181b0ec4aa Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Thu, 9 Dec 2021 20:10:01 +0000 Subject: [PATCH 13/26] Tackling bit-rot --- .gitignore | 6 + docs/uberdoc.html | 3882 +++++++++++++++++++++++++++++++++ project.clj | 6 +- src/mw_parser/declarative.clj | 3 + 4 files changed, 3894 insertions(+), 3 deletions(-) create mode 100644 .gitignore create mode 100644 docs/uberdoc.html diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..7c53947 --- /dev/null +++ b/.gitignore @@ -0,0 +1,6 @@ +buildall.tmp.* +.lein-failures +.lein-repl-history +target/ +pom.xml + diff --git a/docs/uberdoc.html b/docs/uberdoc.html new file mode 100644 index 0000000..fb3bf73 --- /dev/null +++ b/docs/uberdoc.html @@ -0,0 +1,3882 @@ + +mw-parser -- Marginalia

mw-parser

0.1.6-SNAPSHOT


Parser for production rules for MicroWorld engine

+

dependencies

org.clojure/clojure
1.8.0
org.clojure/tools.trace
0.7.9
instaparse
1.4.1
mw-engine
0.1.6-SNAPSHOT



(this space intentionally left almost blank)

namespaces

 

mw-parser.declarative

toc

A very simple parser which parses production rules.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-parser.declarative
+  (:require [instaparse.core :as insta]
+            [clojure.string :refer [split trim triml]]
+            [mw-parser.errors :as pe]
+            [mw-parser.generate :as pg]
+            [mw-parser.simplify :as ps]
+            [mw-parser.utils :refer [rule?]]))

mw-parser: a rule parser for MicroWorld.

+ +

This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version.

+ +

This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details.

+ +

You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +USA.

+ +

Copyright (C) 2014 Simon Brooke

+
+
(def grammar
+  ;; in order to simplify translation into other natural languages, all
+  ;; TOKENS within the parser should be unambiguous
+  "RULE := IF SPACE CONDITIONS SPACE THEN SPACE ACTIONS;
+   CONDITIONS := DISJUNCT-CONDITION | CONJUNCT-CONDITION | CONDITION ;
+   DISJUNCT-CONDITION := CONDITION SPACE OR SPACE CONDITIONS;
+   CONJUNCT-CONDITION := CONDITION SPACE AND SPACE CONDITIONS;
+   CONDITION := WITHIN-CONDITION | NEIGHBOURS-CONDITION | PROPERTY-CONDITION;
+   WITHIN-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE WITHIN SPACE NUMBER SPACE IS SPACE PROPERTY-CONDITION-OR-EXPRESSION;
+   NEIGHBOURS-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE IS SPACE PROPERTY-CONDITION | QUALIFIER SPACE NEIGHBOURS-CONDITION;
+   PROPERTY-CONDITION-OR-EXPRESSION := PROPERTY-CONDITION | EXPRESSION;
+   PROPERTY-CONDITION := PROPERTY SPACE QUALIFIER SPACE EXPRESSION | VALUE;
+   EXPRESSION := SIMPLE-EXPRESSION | RANGE-EXPRESSION | NUMERIC-EXPRESSION | DISJUNCT-EXPRESSION | VALUE;
+   SIMPLE-EXPRESSION := QUALIFIER SPACE EXPRESSION | VALUE;
+   DISJUNCT-EXPRESSION := IN SPACE DISJUNCT-VALUE;
+   RANGE-EXPRESSION := BETWEEN SPACE NUMERIC-EXPRESSION SPACE AND SPACE NUMERIC-EXPRESSION;
+   NUMERIC-EXPRESSION := VALUE | VALUE SPACE OPERATOR SPACE NUMERIC-EXPRESSION;
+   NEGATED-QUALIFIER := QUALIFIER SPACE NOT | NOT SPACE QUALIFIER;
+   COMPARATIVE-QUALIFIER := IS SPACE COMPARATIVE SPACE THAN | COMPARATIVE SPACE THAN;
+   QUALIFIER := COMPARATIVE-QUALIFIER | NEGATED-QUALIFIER | EQUIVALENCE | IS SPACE QUALIFIER;
+   QUANTIFIER := NUMBER | SOME | NONE | ALL | COMPARATIVE SPACE THAN SPACE NUMBER;
+   EQUIVALENCE := IS SPACE EQUAL | EQUAL | IS ;
+   COMPARATIVE := MORE | LESS;
+   DISJUNCT-VALUE := VALUE | VALUE SPACE OR SPACE DISJUNCT-VALUE;
+   IF := 'if';
+   THEN := 'then';
+   THAN := 'than';
+   OR := 'or';
+   NOT := 'not';
+   AND := 'and';
+   SOME := 'some';
+   NONE := 'no';
+   ALL := 'all'
+   BETWEEN := 'between';
+   WITHIN := 'within';
+   IN := 'in';
+   MORE := 'more' | 'greater';
+   LESS := 'less' | 'fewer';
+   OPERATOR := '+' | '-' | '*' | '/';
+   NEIGHBOURS := 'neighbour' | 'neighbor' | 'neighbours' | 'neighbors';
+   PROPERTY := SYMBOL;
+   VALUE := SYMBOL | NUMBER;
+   EQUAL := 'equal to';
+   IS := 'is' | 'are' | 'have' | 'has';
+   NUMBER := #'[0-9]+' | #'[0-9]+.[0-9]+';
+   SYMBOL := #'[a-z]+';
+   ACTIONS := ACTION | ACTION SPACE AND SPACE ACTIONS
+   ACTION := SIMPLE-ACTION | PROBABLE-ACTION;
+   PROBABLE-ACTION := VALUE SPACE CHANCE-IN SPACE VALUE SPACE SIMPLE-ACTION;
+   SIMPLE-ACTION := SYMBOL SPACE BECOMES SPACE EXPRESSION;
+   CHANCE-IN := 'chance in';
+   BECOMES := 'should be' | 'becomes';
+   SPACE := #' *'";)

Parse the argument, assumed to be a string in the correct syntax, and return a parse tree.

+
(def parse-rule
+  (insta/parser grammar))

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 + the compiling environment. If return-tuple? is present and true, return + a list comprising the anonymous function compiled, and the function from + which it was compiled.

+ +

Throws an exception if parsing fails.

+
(defn compile-rule
+  ([rule-text return-tuple?]
+   (assert (string? rule-text))
+   (let [rule (trim rule-text)
+         tree (ps/simplify (parse-rule rule))
+         afn (if (rule? tree) (eval (pg/generate tree))
+               ;; else
+               (pe/throw-parse-exception tree))]
+     (if return-tuple?
+       (list afn rule)
+       ;; else
+       afn)))
+  ([rule-text]
+   (compile-rule rule-text false)))
 

mw-parser.generate

toc

Generate Clojure source from simplified parse trees.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-parser.generate
+  (:require [mw-engine.utils :refer []]
+        [mw-parser.utils :refer [assert-type TODO]]
+        [mw-parser.errors :as pe]))

This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version.

+ +

This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details.

+ +

You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +USA.

+
+
(declare generate generate-action)

From this tree, assumed to be a syntactically correct rule specification, + generate and return the appropriate rule as a function of two arguments.

+
(defn generate-rule
+  [tree]
+  (assert-type tree :RULE)
+  (list 'fn ['cell 'world] (list 'if (generate (nth tree 2)) (generate (nth tree 3)))))

From this tree, assumed to be a syntactically correct conditions clause, + generate and return the appropriate clojure fragment.

+
(defn generate-conditions
+  [tree]
+  (assert-type tree :CONDITIONS)
+  (generate (second tree)))

From this tree, assumed to be a syntactically correct condition clause, + generate and return the appropriate clojure fragment.

+
(defn generate-condition
+  [tree]
+  (assert-type tree :CONDITION)
+  (generate (second tree)))
+
(defn generate-conjunct-condition
+  [tree]
+  "From this `tree`, assumed to be a syntactically conjunct correct condition clause,
+  generate and return the appropriate clojure fragment."
+  (assert-type tree :CONJUNCT-CONDITION)
+  (cons 'and (map generate (rest tree))))

From this tree, assumed to be a syntactically correct disjunct condition clause, + generate and return the appropriate clojure fragment.

+
(defn generate-disjunct-condition
+  [tree]
+  (assert-type tree :DISJUNCT-CONDITION)
+  (cons 'or (map generate (rest tree))))

From this tree, assumed to be a syntactically property condition clause for + this property where the expression is a numeric range, generate and return + the appropriate clojure fragment.

+
(defn generate-ranged-property-condition
+  [tree property expression]
+   (assert-type tree :PROPERTY-CONDITION)
+   (assert-type (nth tree 3) :RANGE-EXPRESSION)
+   (let [l1 (generate (nth expression 2))
+         l2 (generate (nth expression 4))
+         pv (list property 'cell)]
+     (list 'let ['lower (list 'min l1 l2)
+                 'upper (list 'max l1 l2)]
+           (list 'and (list '>= pv 'lower)(list '<= pv 'upper)))))

From this tree, assumed to be a syntactically property condition clause + where the expression is a a disjunction, generate and return + the appropriate clojure fragment. + TODO: this is definitely still wrong!

+
(defn generate-disjunct-property-condition
+  ([tree]
+   (let [property (generate (second tree))
+         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))]
+     (list 'let ['value (list property 'cell)]
+           (if (= qualifier '=) e
+             (list 'not e))))))

From this tree, assumed to be a syntactically property condition clause, + generate and return the appropriate clojure fragment.

+
(defn generate-property-condition
+  ([tree]
+   (assert-type tree :PROPERTY-CONDITION)
+   (if
+     (and (= (count tree) 2) (= (first (second tree)) :SYMBOL))
+     ;; it's a shorthand for 'state equal to symbol'. This should probably have
+     ;; been handled in simplify...
+     (generate-property-condition
+       (list
+         :PROPERTY-CONDITION
+         '(:SYMBOL "state")
+         '(:QUALIFIER (:EQUIVALENCE (:EQUAL "equal to")))
+         (second tree)))
+     ;; otherwise...
+     (generate-property-condition tree (first (nth tree 3)))))
+  ([tree expression-type]
+   (assert-type tree :PROPERTY-CONDITION)
+   (let [property (generate (second tree))
+         qualifier (generate (nth tree 2))
+         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)
+       (list qualifier (list property 'cell) expression)))))

From this tree, assumed to be a syntactically correct qualifier, + generate and return the appropriate clojure fragment.

+
(defn generate-qualifier
+  [tree]
+  (if
+    (= (count tree) 2)
+    (generate (second tree))
+    ;; else
+    (generate (nth tree 2))))

From this tree, assumed to be a syntactically correct simple action, + generate and return the appropriate clojure fragment.

+
(defn generate-simple-action
+  ([tree]
+   (assert-type tree :SIMPLE-ACTION)
+   (generate-simple-action tree []))
+  ([tree others]
+   (assert-type tree :SIMPLE-ACTION)
+   (let [property (generate (second tree))
+         expression (generate (nth tree 3))]
+     (if (or (= property :x) (= property :y))
+       (throw (Exception. pe/reserved-properties-error))
+       (list 'merge
+             (if (empty? others) 'cell
+               ;; else
+               (generate others))
+             {property expression})))))

From this tree, assumed to be a syntactically correct probable action, + generate and return the appropriate clojure fragment.

+
(defn generate-probable-action
+  ([tree]
+   (assert-type tree :PROBABLE-ACTION)
+   (generate-probable-action tree []))
+  ([tree others]
+   (assert-type tree :PROBABLE-ACTION)
+  (let
+    [chances (generate (nth tree 1))
+     total (generate (nth tree 2))
+     action (generate-action (nth tree 3) others)]
+    ;; TODO: could almost certainly be done better with macro syntax
+    (list 'if
+          (list '< (list 'rand total) chances)
+          action))))

From this tree, assumed to be a syntactically correct action, + generate and return the appropriate clojure fragment.

+
(defn generate-action
+  [tree others]
+  (case (first tree)
+    :ACTIONS (generate-action (first tree) others)
+    :SIMPLE-ACTION (generate-simple-action tree others)
+    :PROBABLE-ACTION (generate-probable-action tree others)
+    (throw (Exception. (str "Not a known action type: " (first tree))))))

From this tree, assumed to be one or more syntactically correct actions, + generate and return the appropriate clojure fragment.

+
(defn generate-multiple-actions
+  [tree]
+  (assert-type tree :ACTIONS)
+  (generate-action (first (rest tree)) (second (rest tree))))

Generate a disjunct value. Essentially what we need here is to generate a + flat list of values, since the member has already been taken care of.

+
(defn generate-disjunct-value
+  [tree]
+  (assert-type tree :DISJUNCT-VALUE)
+  (if (= (count tree) 4)
+    (cons (generate (second tree)) (generate (nth tree 3)))
+    (list (generate (second tree)))))

From this tree, assumed to be a syntactically correct numeric expression, + generate and return the appropriate clojure fragment.

+
(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 code for a condition which refers to neighbours.

+
(defn generate-neighbours-condition
+  ([tree]
+   (assert-type tree :NEIGHBOURS-CONDITION)
+   (case (first (second tree))
+     :NUMBER (read-string (second (second tree)))
+     :QUANTIFIER (generate-neighbours-condition tree (first (second (second tree))))
+     :QUALIFIER (cons (generate (second tree)) (rest (generate (nth tree 2))))))
+  ([tree quantifier-type]
+   (let [quantifier (second tree)
+         pc (generate (nth tree 4))]
+     (case quantifier-type
+       :NUMBER (generate-neighbours-condition '= (read-string (second (second quantifier))) pc 1)
+       :SOME (generate-neighbours-condition '> 0 pc 1)
+       :MORE (let [value (generate (nth quantifier 3))]
+               (generate-neighbours-condition '> value pc 1))
+       :LESS (let [value (generate (nth quantifier 3))]
+               (generate-neighbours-condition '< value pc 1)))))
+  ([comp1 quantity property-condition distance]
+   (list comp1
+         (list 'count
+               (list 'remove 'false?
+                     (list 'map (list 'fn ['cell] property-condition)
+                           (list 'mw-engine.utils/get-neighbours 'world 'cell distance)))) quantity))
+  ([comp1 quantity property-condition]
+   (generate-neighbours-condition comp1 quantity property-condition 1)))

Generate code for a condition which refers to neighbours within a specified distance. + NOTE THAT there's clearly masses of commonality between this and + generate-neighbours-condition, and that some refactoring is almost certainly + desirable. It may be that it's better to simplify a NEIGHBOURS-CONDITION + into a WITHIN-CONDITION in the simplification stage.

+
(defn generate-within-condition
+  ([tree]
+  (assert-type tree :WITHIN-CONDITION)
+    (case (first (second tree))
+      :QUANTIFIER (generate-within-condition tree (first (second (second tree))))
+      :QUALIFIER (TODO "qualified within... help!")))
+  ([tree quantifier-type]
+   (let [quantifier (second tree)
+         distance (generate (nth tree 4))
+         pc (generate (nth tree 6))]
+     (case quantifier-type
+       :NUMBER (generate-neighbours-condition '= (read-string (second (second quantifier))) pc distance)
+       :SOME (generate-neighbours-condition '> 0 pc distance)
+       :MORE (let [value (generate (nth quantifier 3))]
+               (generate-neighbours-condition '> value pc distance))
+       :LESS (let [value (generate (nth quantifier 3))]
+               (generate-neighbours-condition '< value pc distance))))))

Generate code for this (fragment of a) parse tree

+
(defn generate
+  [tree]
+  (if
+    (coll? tree)
+    (case (first tree)
+      :ACTIONS (generate-multiple-actions tree)
+      :COMPARATIVE (generate (second tree))
+      :COMPARATIVE-QUALIFIER (generate (second tree))
+      :CONDITION (generate-condition tree)
+      :CONDITIONS (generate-conditions tree)
+      :CONJUNCT-CONDITION (generate-conjunct-condition tree)
+      :DISJUNCT-CONDITION (generate-disjunct-condition tree)
+      :DISJUNCT-EXPRESSION (generate (nth tree 2))
+      :DISJUNCT-VALUE (generate-disjunct-value tree)
+      :EQUIVALENCE '=
+      :EXPRESSION (generate (second tree))
+      :LESS '<
+      :MORE '>
+      :NEGATED-QUALIFIER (case (generate (second tree))
+                                 = 'not=
+                                 > '<
+                                 < '>)
+      :NEIGHBOURS-CONDITION (generate-neighbours-condition tree)
+      :NUMERIC-EXPRESSION (generate-numeric-expression tree)
+      :NUMBER (read-string (second tree))
+      :OPERATOR (symbol (second tree))
+      :PROBABLE-ACTION (generate-probable-action tree)
+      :PROPERTY (list (generate (second tree)) 'cell) ;; dubious - may not be right
+      :PROPERTY-CONDITION (generate-property-condition tree)
+      :QUALIFIER (generate-qualifier tree)
+      :RULE (generate-rule tree)
+      :SIMPLE-ACTION (generate-simple-action tree)
+      :SYMBOL (keyword (second tree))
+      :VALUE (generate (second tree))
+      :WITHIN-CONDITION (generate-within-condition tree)
+      (map generate tree))
+    tree))
 

mw-parser.errors

toc

Display parse errors in a format which makes it easy for the user + to see where the error occurred.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-parser.errors)

This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version.

+ +

This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details.

+ +

You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +USA.

+

error thrown when an attempt is made to set a reserved property

+
(def reserved-properties-error
+  "The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions")

error thrown when a rule cannot be parsed. Slots are for +(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")

Attempt to explain the reason for the parse error.

+
(defn- explain-parse-error-reason
+  [reason]
+  (str "Expecting one of (" (apply str (map #(str (:expecting %) " ") reason)) ")"))
+
(defn- parser-error-to-map
+  [parser-error]
+  (let [m (reduce (fn [map item](merge map {(first item)(second item)})) {} parser-error)
+        reason (map
+                 #(reduce (fn [map item] (merge {(first item) (second item)} map)) {} %)
+                 (:reason m))]
+    (merge m {:reason reason})))

Construct a helpful error message from this parser-error, and throw an exception with that message.

+
(defn throw-parse-exception
+  [parser-error]
+  (assert (coll? parser-error) "Expected a paser error structure?")
+  (let
+    [
+      ;; the error structure is a list, such that each element is a list of two items, and
+      ;; the first element in each sublist is a keyword. Easier to work with it as a map
+     error-map (parser-error-to-map parser-error)
+     text (:text error-map)
+     reason (explain-parse-error-reason (:reason error-map))
+      ;; rules have only one line, by definition; we're interested in the column
+     column (if (:column error-map)(:column error-map) 0)
+      ;; create a cursor to point to that column
+     cursor (apply str (reverse (conj (repeat column " ") "^")))
+     message (format bad-parse-error text cursor reason)
+     ]
+  (throw (Exception. message))))
 

mw-parser.core

toc

A very simple parser which parses production rules.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-parser.core
+  (:use mw-engine.utils
+        [clojure.string :only [split trim triml]])
+  (:gen-class))

mw-parser: a rule parser for MicroWorld.

+ +

This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version.

+ +

This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details.

+ +

You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +USA.

+ +

Copyright (C) 2014 Simon Brooke

+ +

A very simple parser which parses production rules of the following forms:

+ +
    +
  • "if altitude is less than 100 and state is forest then state should be climax and deer should be 3"
    • +
  • "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3"
    • +
  • "if altitude is 100 or fertility is 25 then state should be heath"
    • +
  • "if deer is more than 2 and wolves is 0 and fertility is more than 20 then deer should be deer + 2"
    • +
  • "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves"
    • +
  • "if state is grassland and 4 neighbours have state equal to water then state should be village"
    • +
  • "if state is forest and fertility is between 55 and 75 then state should be climax"
    • +
  • "if 6 neighbours have state equal to water then state should be village"
    • +
  • "if state is in grassland or pasture or heath and 4 neighbours are water then state should be village"
    • +
  • "if state is forest or state is climax and some neighbours have state equal to fire then 3 in 5 chance that state should be fire"
    • +
  • "if state is pasture and more than 3 neighbours have state equal to scrub then state should be scrub" +*
    • +
+ +

it generates rules in the form expected by mw-engine.core, q.v.

+ +

It is, as I say, very simple; it generates a complete rule, or it fails completely, returning nil. +Very occasionally it generates a wrong rule - one which is not a correct translation of the rule +semantics - but that is buggy behaviour, which I'll try to fix over the next few weeks, not a +design fault.

+ +

More significantly it does not generate useful error messages on failure.

+ +

This parser is now obsolete, but is retained in the codebase for now in +case it is of use to anyone. Prefer the declarative.clj parser.

+
+
(declare parse-conditions)
+(declare parse-not-condition)
+(declare parse-simple-condition)

a regular expression which matches string representation of positive numbers

+
(def re-number #"^[0-9.]*$")

error thrown when an attempt is made to set a reserved property

+
(def reserved-properties-error
+  "The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions")

error thrown when a rule cannot be parsed

+
(def bad-parse-error "I did not understand '%s'")

If this token appears to represent an explicit number, return that number; + otherwise, make a keyword of it and return that.

+
(defn- keyword-or-numeric
+  [token]
+  (cond
+    (re-matches re-number token) (read-string token)
+    (keyword? token) token
+    true (keyword token)))

Generally all functions in this file with names beginning 'parse-' take a +sequence of tokens (and in some cases other optional arguments) and return a +vector comprising

+ +
    +
  1. A code fragment parsed from the front of the sequence of tokens, and
    2. +
  2. the remaining tokens which were not consumed in constructing that fragment.
    3. +
+ +

In every case if the function cannot parse the desired construct from the +front of the sequence of tokens it returns nil.

+

Parse a number.

+
(defn parse-numeric-value
+  [[value & remainder]]
+  (if (and value (re-matches re-number value)) [(read-string value) remainder]))

Parse a token assumed to be the name of a property of the current cell, + whose value is assumed to be an integer.

+
(defn parse-property-int
+  [[value & remainder]]
+  (if value [(list 'get-int 'cell (keyword value)) remainder]))

Parse a token assumed to be the name of a property of the current cell.

+
(defn parse-property-value
+  [[value & remainder]]
+  (if value [(list (keyword value) 'cell) remainder]))

Parse a token assumed to be a simple token value.

+
(defn parse-token-value
+  [[value & remainder]]
+  (if value [(keyword value) remainder]))

Parse a value from the first of these tokens. If expect-int is true, return + an integer or something which will evaluate to an integer.

+
(defn parse-simple-value
+  ([tokens expect-int]
+    (or
+        (parse-numeric-value tokens)
+        (cond expect-int
+          (parse-property-int tokens)
+          true (parse-token-value tokens))))
+  ([tokens]
+    (parse-simple-value tokens false)))

Parse a single value from this single token and return just the generated + code, not a pair.

+
(defn gen-token-value
+  [token expect-int]
+  (first (parse-simple-value (list token) expect-int)))

Parse a list of values from among these tokens. If expect-int is true, return + integers or things which will evaluate to integers.

+
(defn parse-disjunct-value
+  [[OR token & tokens] expect-int]
+  (cond (member? OR '("or" "in"))
+    (let [value (first (parse-simple-value (list token) expect-int))
+          seek-others (= (first tokens) "or")]
+      (cond seek-others
+        (let [[others remainder] (parse-disjunct-value tokens expect-int)]
+          [(cons value others) remainder])
+        true
+        [(list value) tokens]))))

Parse a value from among these tokens. If expect-int is true, return + an integer or something which will evaluate to an integer.

+
(defn parse-value
+  ([tokens expect-int]
+    (or
+      (parse-disjunct-value tokens expect-int)
+      (parse-simple-value tokens expect-int)))
+  ([tokens]
+    (parse-value tokens false)))

Parses a condition of the form '[property] in [value] or [value]...'

+
(defn parse-member-condition
+  [[property IS IN & rest]]
+  (if (and (member? IS '("is" "are")) (= IN "in"))
+    (let [[l remainder] (parse-disjunct-value (cons "in" rest) false)]
+      [(list 'member? (list (keyword property) 'cell) (list 'quote l)) remainder])))

Parse '[property] less than [value]'.

+
(defn- parse-less-condition
+  [[property IS LESS THAN & rest]]
+  (cond (and (member? IS '("is" "are")) (member? LESS '("less" "fewer")) (= THAN "than"))
+    (let [[value remainder] (parse-value rest true)]
+        [(list '< (list 'get-int 'cell (keyword property)) value) remainder])))

Parse '[property] more than [value]'.

+
(defn- parse-more-condition
+  [[property IS MORE THAN & rest]]
+  (cond (and (member? IS '("is" "are")) (member? MORE '("more" "greater")) (= THAN "than"))
+    (let [[value remainder] (parse-value rest true)]
+        [(list '> (list 'get-int 'cell (keyword property)) value) remainder])))
+
(defn- parse-between-condition
+  [[p IS BETWEEN v1 AND v2 & rest]]
+  (cond (and (member? IS '("is" "are")) (= BETWEEN "between") (= AND "and") (not (nil? v2)))
+    (let [property (first (parse-simple-value (list p) true))
+          value1 (first (parse-simple-value (list v1) true))
+          value2 (first (parse-simple-value (list v2) true))]
+      [(list 'or
+            (list '< value1 property value2)
+            (list '> value1 property value2)) rest])))

Parse clauses of the form 'x is y', 'x is in y or z...', + 'x is between y and z', 'x is more than y' or 'x is less than y'. + It is necessary to disambiguate whether value is a numeric or keyword.

+
(defn- parse-is-condition
+  [[property IS value & rest]]
+  (cond
+    (member? IS '("is" "are"))
+    (let [tokens (cons property (cons value rest))]
+      (cond
+        (re-matches re-number value) [(list '= (list 'get-int 'cell (keyword property)) (read-string value)) rest]
+        value [(list '= (list (keyword property) 'cell) (keyword value)) rest]))))

Parse the negation of a simple condition.

+
(defn- parse-not-condition
+  [[property IS NOT & rest]]
+  (cond (and (member? IS '("is" "are")) (= NOT "not"))
+    (let [partial (parse-simple-condition (cons property (cons "is" rest)))]
+      (cond partial
+        (let [[condition remainder] partial]
+          [(list 'not condition) remainder])))))
+
(defn- gen-neighbours-condition
+  ([comp1 quantity property value remainder comp2 distance]
+    [(list comp1
+         (list 'count
+               (list 'get-neighbours-with-property-value 'world
+                     '(cell :x) '(cell :y) distance
+                     (keyword property) (keyword-or-numeric value) comp2))
+         quantity)
+           remainder])
+  ([comp1 quantity property value remainder comp2]
+    (gen-neighbours-condition comp1 quantity property value remainder comp2 1)))

Parse conditions of the form '...more than 6 neighbours are [condition]'

+
(defn parse-comparator-neighbours-condition
+  [[MORE THAN n NEIGHBOURS WITHIN distance have-or-are & rest]]
+  (let [quantity (first (parse-numeric-value (list n)))
+        comparator (cond (= MORE "more") '>
+                     (member? MORE '("fewer" "less")) '<)]
+    (cond
+      (not= WITHIN "within")
+      (parse-comparator-neighbours-condition
+        (flatten
+          ;; two tokens were mis-parsed as 'within distance' that weren't
+          ;; actually 'within' and a distance. Splice in 'within 1' and try
+          ;; again.
+          (list MORE THAN n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest)))
+      (and quantity
+           comparator
+           (= THAN "than")
+           (= NEIGHBOURS "neighbours"))
+      (cond
+        (= have-or-are "are")
+        (let [[value & remainder] rest
+              dist (gen-token-value distance true)]
+          (gen-neighbours-condition comparator quantity :state value remainder = dist))
+        (= have-or-are "have")
+        (let [[property comp1 comp2 value & remainder] rest
+              dist (gen-token-value distance true)]
+          (cond (and (= comp1 "equal") (= comp2 "to"))
+            (gen-neighbours-condition comparator quantity property
+                                      value remainder = dist)
+            (and (= comp1 "more") (= comp2 "than"))
+            (gen-neighbours-condition comparator quantity property
+                                      value remainder > dist)
+            (and (= comp1 "less") (= comp2 "than"))
+            (gen-neighbours-condition comparator quantity property
+                                      value remainder < dist)))))))
+
(defn parse-some-neighbours-condition
+  [[SOME NEIGHBOURS & rest]]
+  (cond
+    (and (= SOME "some") (= NEIGHBOURS "neighbours"))
+    (parse-comparator-neighbours-condition (concat '("more" "than" "0" "neighbours") rest))))

Parse conditions of the form '...6 neighbours are [condition]'

+
(defn parse-simple-neighbours-condition
+  [[n NEIGHBOURS WITHIN distance have-or-are & rest]]
+  (let [quantity (first (parse-numeric-value (list n)))]
+    (cond
+      (and quantity (= NEIGHBOURS "neighbours"))
+      (cond
+        (not= WITHIN "within")
+        (parse-simple-neighbours-condition
+          (flatten
+            ;; two tokens were mis-parsed as 'within distance' that weren't
+            ;; actually 'within' and a distance. Splice in 'within 1' and try
+            ;; again.
+            (list n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest)))
+        (= have-or-are "are")
+        (let [[value & remainder] rest
+              dist (gen-token-value distance true)]
+          (gen-neighbours-condition '= quantity :state value remainder = dist))
+        (= have-or-are "have")
+        (let [[property comp1 comp2 value & remainder] rest
+              dist (gen-token-value distance true)]
+          (cond (and (= comp1 "equal") (= comp2 "to"))
+            (gen-neighbours-condition '= quantity property value remainder =
+                                      dist)
+            (and (= comp1 "more") (= comp2 "than"))
+            (gen-neighbours-condition '= quantity property value remainder >
+                                      dist)
+            (and (= comp1 "less") (= comp2 "than"))
+            (gen-neighbours-condition '= quantity property value remainder <
+                                      dist)))))))

Parse conditions referring to neighbours

+
(defn parse-neighbours-condition
+  [tokens]
+  (or
+    (parse-simple-neighbours-condition tokens)
+    (parse-comparator-neighbours-condition tokens)
+    (parse-some-neighbours-condition tokens)))

Parse conditions of the form '[property] [comparison] [value]'.

+
(defn parse-simple-condition
+  [tokens]
+  (or
+    (parse-neighbours-condition tokens)
+    (parse-member-condition tokens)
+    (parse-not-condition tokens)
+    (parse-less-condition tokens)
+    (parse-more-condition tokens)
+    (parse-between-condition tokens)
+    (parse-is-condition tokens)))

Parse '... or [condition]' from tokens, where left is the already parsed first disjunct.

+
(defn- parse-disjunction-condition
+  [left tokens]
+  (let [partial (parse-conditions tokens)]
+    (if partial
+      (let [[right remainder] partial]
+        [(list 'or left right) remainder]))))

Parse '... and [condition]' from tokens, where left is the already parsed first conjunct.

+
(defn- parse-conjunction-condition
+  [left tokens]
+  (let [partial (parse-conditions tokens)]
+    (if partial
+      (let [[right remainder] partial]
+        [(list 'and left right) remainder]))))

Parse conditions from tokens, where conditions may be linked by either 'and' or 'or'.

+
(defn- parse-conditions
+  [tokens]
+  (let [partial (parse-simple-condition tokens)]
+    (if partial
+      (let [[left [next & remainder]] partial]
+        (cond
+          (= next "and") (parse-conjunction-condition left remainder)
+          (= next "or") (parse-disjunction-condition left remainder)
+          true partial)))))

Parse the left hand side ('if...') of a production rule.

+
(defn- parse-left-hand-side
+ [[IF & tokens]]
+ (if
+   (= IF "if")
+   (parse-conditions tokens)))

Parse actions of the form '[property] should be [property] [arithmetic-operator] [value]', + e.g. 'fertility should be fertility + 1', or 'deer should be deer - wolves'.

+
(defn- parse-arithmetic-action
+  [previous [prop1 SHOULD BE prop2 operator value & rest]]
+  (cond
+    (member? prop1 '("x" "y"))
+    (throw
+      (Exception. reserved-properties-error))
+    (and (= SHOULD "should")
+           (= BE "be")
+           (member? operator '("+" "-" "*" "/")))
+    [(list 'merge (or previous 'cell)
+           {(keyword prop1) (list 'int
+                                  (list (symbol operator) (list 'get-int 'cell (keyword prop2))
+                                        (cond
+                                          (re-matches re-number value) (read-string value)
+                                          true (list 'get-int 'cell (keyword value)))))}) rest]))

Parse actions of the form '[property] should be [value].'

+
(defn- parse-set-action
+  [previous [property SHOULD BE value & rest]]
+  (cond
+    (member? property '("x" "y"))
+    (throw
+      (Exception. reserved-properties-error))
+    (and (= SHOULD "should") (= BE "be"))
+    [(list 'merge (or previous 'cell)
+           {(keyword property) (cond (re-matches re-number value) (read-string value) true (keyword value))}) rest]))
+
(defn- parse-simple-action [previous tokens]
+  (or (parse-arithmetic-action previous tokens)
+      (parse-set-action previous tokens)))

Parse actions from tokens.

+
(defn- parse-actions
+  [previous tokens]
+  (let [[left remainder] (parse-simple-action previous tokens)]
+    (cond left
+          (cond (= (first remainder) "and")
+                (parse-actions left (rest remainder))
+                true (list left)))))

Parse a probability of an action from this collection of tokens

+
(defn- parse-probability
+  [previous [n CHANCE IN m & tokens]]
+  (cond
+    (and (= CHANCE "chance")(= IN "in"))
+    (let [[action remainder] (parse-actions previous tokens)]
+      (cond action
+        [(list 'cond
+              (list '<
+                    (list 'rand
+                          (first (parse-simple-value (list m) true)))
+                    (first (parse-simple-value (list n) true)))
+              action) remainder]))))

Parse the right hand side ('then...') of a production rule.

+
(defn- parse-right-hand-side
+  [[THEN & tokens]]
+  (if (= THEN "then")
+    (or
+      (parse-probability nil tokens)
+      (parse-actions nil tokens))))

Parse a complete rule from this line, expected to be either a string or a + sequence of string tokens. Return the rule in the form of an S-expression.

+ +

Throws an exception if parsing fails.

+
(defn parse-rule
+  [line]
+  (cond
+   (string? line)
+   (let [rule (parse-rule (split (triml line) #"\s+"))]
+     (cond rule rule
+       true (throw (Exception. (format bad-parse-error line)))))
+   true
+   (let [[left remainder] (parse-left-hand-side line)
+              [right junk] (parse-right-hand-side remainder)]
+     (cond
+       ;; there should be a valide left hand side and a valid right hand side
+       ;; there shouldn't be anything left over (junk should be empty)
+       (and left right (empty? junk))
+       (list 'fn ['cell 'world] (list 'if left right))))))

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 + the compiling environment. If return-tuple? is present and true, return + a list comprising the anonymous function compiled, and the function from + which it was compiled.

+ +

Throws an exception if parsing fails.

+
(defn compile-rule
+  ([rule-text return-tuple?]
+    (do
+      (use 'mw-engine.utils)
+      (let [afn (eval (parse-rule rule-text))]
+        (cond
+          (and afn return-tuple?)(list afn (trim rule-text))
+          true afn))))
+  ([rule-text]
+    (compile-rule rule-text false)))
 

mw-parser.bulk

toc

parse multiple rules from a stream, possibly a file.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-parser.bulk
+  (:use mw-parser.core
+        mw-engine.utils
+        clojure.java.io
+        [clojure.string :only [split trim]])
+  (:import (java.io BufferedReader StringReader)))

mw-parser: a rule parser for MicroWorld.

+ +

This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version.

+ +

This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details.

+ +

You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +USA.

+ +

Copyright (C) 2014 Simon Brooke

+

Is this line a comment?

+
(defn comment?
+  [line]
+  (or (empty? (trim line)) (member? (first line) '(nil \# \;))))

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.

+
(defn parse-string
+  [string]
+        ;; TODO: tried to do this using with-open, but couldn't make it work.
+  (map #(parse-rule (trim %)) (remove comment? (split string #"\n"))))

Parse rules from successive lines in the file loaded from this filename. + Return a list of S-expressions.

+
(defn parse-file
+  [filename]
+  (parse-string (slurp filename)))

Compile each non-comment line of this string into an executable anonymous + function, and return the sequence of such functions.

+
(defn compile-string
+  [string]
+  (map #(compile-rule % true) (remove comment? (split string #"\n"))))

Compile each non-comment line of the file indicated by this filename into + an executable anonymous function, and return the sequence of such functions.

+
(defn compile-file
+  [filename]
+  (compile-string (slurp filename)))
 

mw-parser.simplify

toc

Simplify a parse tree.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-parser.simplify
+  (:require [mw-engine.utils :refer [member?]]))

mw-parser: a rule parser for MicroWorld.

+ +

This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version.

+ +

This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details.

+ +

You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +USA.

+ +

Copyright (C) 2014 Simon Brooke

+
+
(declare simplify)

Given that this tree fragment represents a qualifier, what + qualifier is that?

+
(defn simplify-qualifier
+  [tree]
+  (cond
+    (empty? tree) nil
+    (and (coll? tree)
+         (member? (first tree) '(:EQUIVALENCE :COMPARATIVE))) tree
+    (coll? (first tree)) (or (simplify-qualifier (first tree))
+                             (simplify-qualifier (rest tree)))
+    (coll? tree) (simplify-qualifier (rest tree))
+    true tree))

There are a number of possible simplifications such that if the tree has + only two elements, the second is semantically sufficient.

+
(defn simplify-second-of-two
+  [tree]
+  (if (= (count tree) 2) (simplify (nth tree 1)) tree))

If this quantifier is a number, 'simplifiy' it into a comparative whose operator is '=' + and whose quantity is that number. This is actually more complicated but makes generation easier.

+
(defn simplify-quantifier
+  [tree]
+  (if (number? (second tree)) [:COMPARATIVE '= (second tree)] (simplify (second tree))))

Simplify/canonicalise this tree. Opportunistically replace complex fragments with + semantically identical simpler fragments

+
(defn simplify
+  [tree]
+  (if
+    (coll? tree)
+    (case (first tree)
+      :ACTION (simplify-second-of-two tree)
+      :ACTIONS (cons (first tree) (simplify (rest tree)))
+      :CHANCE-IN nil
+      :COMPARATIVE (simplify-second-of-two tree)
+      :CONDITION (simplify-second-of-two tree)
+      :CONDITIONS (simplify-second-of-two tree)
+      :EXPRESSION (simplify-second-of-two tree)
+      :PROPERTY (simplify-second-of-two tree)
+      :PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree)
+      :SPACE nil
+      :THEN nil
+      :AND nil
+      :VALUE (simplify-second-of-two tree)
+      (remove nil? (map simplify tree)))
+    tree))
 

mw-parser.utils

toc

Utilities used in more than one namespace within the parser.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-parser.utils)

mw-parser: a rule parser for MicroWorld.

+ +

This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version.

+ +

This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details.

+ +

You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +USA.

+ +

Copyright (C) 2014 Simon Brooke

+

Return true if the argument appears to be a parsed rule tree, else false.

+
(defn rule?
+  [maybe-rule]
+  (and (coll? maybe-rule) (= (first maybe-rule) :RULE)))

Marker to indicate I'm not yet finished!

+
(defn TODO
+  [message]
+  message)

Return true if tree-fragment appears to be a tree fragment of the expected type.

+
(defn suitable-fragment?
+  [tree-fragment type]
+  (and (coll? tree-fragment)
+       (= (first tree-fragment) type)))

If tree-fragment is not a tree fragment of the expected type, throw an exception.

+
(defn assert-type
+  [tree-fragment type]
+  (assert (suitable-fragment? tree-fragment type)
+          (throw (Exception. (format "Expected a %s fragment" type)))))

Return the first element of this tree which has this tag in a depth-first, left-to-right search

+
(defn search-tree
+  [tree tag]
+  (cond
+    (= (first tree) tag) tree
+    :else (first
+            (remove nil?
+                    (map
+                      #(search-tree % tag)
+                      (rest tree))))))
 
Generated by Marginalia.  Syntax highlighting provided by Alex Gorbatchev's SyntaxHighlighter
  • mw-parser.declarative
  • mw-parser.generate
  • mw-parser.errors
  • mw-parser.core
  • mw-parser.bulk
  • mw-parser.simplify
  • mw-parser.utils
\ No newline at end of file diff --git a/project.clj b/project.clj index 930784f..e8360f9 100644 --- a/project.clj +++ b/project.clj @@ -11,8 +11,8 @@ :license {:name "GNU General Public License v2" :url "http://www.gnu.org/licenses/gpl-2.0.html"} :plugins [[lein-marginalia "0.7.1"]] - :dependencies [[org.clojure/clojure "1.6.0"] - [org.clojure/tools.trace "0.7.9"] - [instaparse "1.4.1"] + :dependencies [[org.clojure/clojure "1.11.1"] + [org.clojure/tools.trace "0.7.11"] + [instaparse "1.4.12"] [mw-engine "0.1.6-SNAPSHOT"] ]) diff --git a/src/mw_parser/declarative.clj b/src/mw_parser/declarative.clj index 62e1b03..bcade62 100644 --- a/src/mw_parser/declarative.clj +++ b/src/mw_parser/declarative.clj @@ -1,3 +1,6 @@ +(ns mw-parser.declarative + (:require [mw-engine.utils :refer [member?]]) + (:require [instaparse.core :as insta])) (ns ^{:doc "A very simple parser which parses production rules." :author "Simon Brooke"} mw-parser.declarative From bbaca4710b1a0158e5f32cc8b899f0d88ab3890b Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 9 Jul 2023 22:25:50 +0100 Subject: [PATCH 14/26] Work on flows, but also preparing for i18n. --- .gitignore | 2 +- src/mw_parser/declarative.clj | 120 +++++++++++++++++++--------------- src/mw_parser/flow.clj | 26 ++++++++ src/mw_parser/simplify.clj | 33 +++++++--- 4 files changed, 116 insertions(+), 65 deletions(-) diff --git a/.gitignore b/.gitignore index ab6836c..88fb07f 100644 --- a/.gitignore +++ b/.gitignore @@ -3,6 +3,6 @@ buildall.tmp.* .lein-repl-history target/ pom.xml - +.calva/ .nrepl-port diff --git a/src/mw_parser/declarative.clj b/src/mw_parser/declarative.clj index 15e88b3..3239c62 100644 --- a/src/mw_parser/declarative.clj +++ b/src/mw_parser/declarative.clj @@ -5,7 +5,7 @@ [clojure.string :refer [join trim]] [mw-parser.errors :refer [throw-parse-exception]] [mw-parser.generate :refer [generate]] - [mw-parser.simplify :refer [simplify]] + [mw-parser.simplify :refer [simplify-rule]] [mw-parser.utils :refer [rule?]] [trptr.java-wrapper.locale :refer [get-default]]) (:import [java.util Locale])) @@ -33,85 +33,97 @@ ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(def grammar +(def rule-grammar "Basic rule language grammar. in order to simplify translation into other natural languages, all TOKENS within the parser should be unambiguou." (join "\n" ["RULE := IF SPACE CONDITIONS SPACE THEN SPACE ACTIONS;" - "CONDITIONS := DISJUNCT-CONDITION | CONJUNCT-CONDITION | CONDITION ;" - "DISJUNCT-CONDITION := CONDITION SPACE OR SPACE CONDITIONS;" - "CONJUNCT-CONDITION := CONDITION SPACE AND SPACE CONDITIONS;" - "CONDITION := WITHIN-CONDITION | NEIGHBOURS-CONDITION | PROPERTY-CONDITION;" - "WITHIN-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE WITHIN SPACE NUMBER SPACE IS SPACE PROPERTY-CONDITION-OR-EXPRESSION;" - "NEIGHBOURS-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE IS SPACE PROPERTY-CONDITION | QUALIFIER SPACE NEIGHBOURS-CONDITION;" - "PROPERTY-CONDITION-OR-EXPRESSION := PROPERTY-CONDITION | EXPRESSION;" - "PROPERTY-CONDITION := PROPERTY SPACE QUALIFIER SPACE EXPRESSION | VALUE;" - "EXPRESSION := SIMPLE-EXPRESSION | RANGE-EXPRESSION | NUMERIC-EXPRESSION | DISJUNCT-EXPRESSION | VALUE;" - "SIMPLE-EXPRESSION := QUALIFIER SPACE EXPRESSION | VALUE;" - "DISJUNCT-EXPRESSION := IN SPACE DISJUNCT-VALUE;" - "RANGE-EXPRESSION := BETWEEN SPACE NUMERIC-EXPRESSION SPACE AND SPACE NUMERIC-EXPRESSION;" - "NUMERIC-EXPRESSION := VALUE | VALUE SPACE OPERATOR SPACE NUMERIC-EXPRESSION;" - "NEGATED-QUALIFIER := QUALIFIER SPACE NOT | NOT SPACE QUALIFIER;" - "COMPARATIVE-QUALIFIER := IS SPACE COMPARATIVE SPACE THAN | COMPARATIVE SPACE THAN;" - "QUALIFIER := COMPARATIVE-QUALIFIER | NEGATED-QUALIFIER | EQUIVALENCE | IS SPACE QUALIFIER;" - "QUANTIFIER := NUMBER | SOME | NONE | ALL | COMPARATIVE SPACE THAN SPACE NUMBER;" - "EQUIVALENCE := IS SPACE EQUAL | EQUAL | IS ;" - "COMPARATIVE := MORE | LESS;" - "DISJUNCT-VALUE := VALUE | VALUE SPACE OR SPACE DISJUNCT-VALUE;" - "PROPERTY := SYMBOL;" - "VALUE := SYMBOL | NUMBER;" - "OPERATOR := '+' | '-' | '*' | '/';" - "NUMBER := #'[0-9]+' | #'[0-9]+.[0-9]+';" "ACTIONS := ACTION | ACTION SPACE AND SPACE ACTIONS" "ACTION := SIMPLE-ACTION | PROBABLE-ACTION;" "PROBABLE-ACTION := VALUE SPACE CHANCE-IN SPACE VALUE SPACE SIMPLE-ACTION;" - "SIMPLE-ACTION := SYMBOL SPACE BECOMES SPACE EXPRESSION;" - "SPACE := #'\\s+';"])) + "SIMPLE-ACTION := SYMBOL SPACE BECOMES SPACE EXPRESSION;"])) + +(def common-grammar + "Grammar rules used both in the rule grammar and in the flow grammar" + (join "\n" ["COMPARATIVE := MORE | LESS;" + "COMPARATIVE-QUALIFIER := IS SPACE COMPARATIVE SPACE THAN | COMPARATIVE SPACE THAN;" + "CONDITION := WITHIN-CONDITION | NEIGHBOURS-CONDITION | PROPERTY-CONDITION;" + "CONDITIONS := DISJUNCT-CONDITION | CONJUNCT-CONDITION | CONDITION ;" + "CONJUNCT-CONDITION := CONDITION SPACE AND SPACE CONDITIONS;" + "DISJUNCT-CONDITION := CONDITION SPACE OR SPACE CONDITIONS;" + "DISJUNCT-EXPRESSION := IN SPACE DISJUNCT-VALUE;" + "DISJUNCT-VALUE := VALUE | VALUE SPACE OR SPACE DISJUNCT-VALUE;" + "EQUIVALENCE := IS SPACE EQUAL | EQUAL | IS ;" + "EXPRESSION := SIMPLE-EXPRESSION | RANGE-EXPRESSION | NUMERIC-EXPRESSION | DISJUNCT-EXPRESSION | VALUE;" + "NEGATED-QUALIFIER := QUALIFIER SPACE NOT | NOT SPACE QUALIFIER;" + "NEIGHBOURS-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE IS SPACE PROPERTY-CONDITION | QUALIFIER SPACE NEIGHBOURS-CONDITION;" + "NUMBER := #'[0-9]+' | #'[0-9]+.[0-9]+';" + "NUMERIC-EXPRESSION := VALUE | VALUE SPACE OPERATOR SPACE NUMERIC-EXPRESSION;" + "OPERATOR := '+' | '-' | '*' | '/';" + "PROPERTY := SYMBOL;" + "PROPERTY-CONDITION := PROPERTY SPACE QUALIFIER SPACE EXPRESSION | VALUE;" + "PROPERTY-CONDITION-OR-EXPRESSION := PROPERTY-CONDITION | EXPRESSION;" + "QUALIFIER := COMPARATIVE-QUALIFIER | NEGATED-QUALIFIER | EQUIVALENCE | IS SPACE QUALIFIER;" + "QUANTIFIER := NUMBER | SOME | NONE | ALL | COMPARATIVE SPACE THAN SPACE NUMBER;" + "RANGE-EXPRESSION := BETWEEN SPACE NUMERIC-EXPRESSION SPACE AND SPACE NUMERIC-EXPRESSION;" + "SIMPLE-EXPRESSION := QUALIFIER SPACE EXPRESSION | VALUE;" + "SPACE := #'\\s+';" + "VALUE := SYMBOL | NUMBER;" + "VALUE := SYMBOL | NUMBER;" + "WITHIN-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE WITHIN SPACE NUMBER SPACE IS SPACE PROPERTY-CONDITION-OR-EXPRESSION;" + ])) (def keywords-en - "English language keyword literals used in rules. + "English language keyword literals used in rules - both in production + rules (this namespace) and in flow rules (see mw-parser.flow). It's a long term aim that the rule language should be easy to internationalise; this isn't a full solution but it's a step towards a solution." - (join "\n" ["IF := 'if';" - "THEN := 'then';" - "THAN := 'than';" - "OR := 'or';" - "NOT := 'not';" - "AND := 'and';" - "SOME := 'some';" - "NONE := 'no';" - "ALL := 'all'" - "BETWEEN := 'between';" - "WITHIN := 'within';" - "IN := 'in';" - "MORE := 'more' | 'greater';" - "LESS := 'less' | 'fewer';" - "NEIGHBOURS := 'neighbour' | 'neighbor' | 'neighbours' | 'neighbors';" - "EQUAL := 'equal to';" - "IS := 'is' | 'are' | 'have' | 'has';" - "CHANCE-IN := 'chance in';" - "BECOMES := 'should be' | 'becomes';" + (join "\n" ["ALL := 'all'" + "AND := 'and';" + "BECOMES := 'should be' | 'becomes';" + "BETWEEN := 'between';" + "CHANCE-IN := 'chance in';" + "EACH := 'each' | 'every' | 'all';" + "EQUAL := 'equal to';" + "FLOW := 'flow' | 'move';" + "FROM := 'from';" + "IF := 'if';" + "IN := 'in';" + "IS := 'is' | 'are' | 'have' | 'has';" + "LEAST := 'least';" + "LESS := 'less' | 'fewer';" + "MORE := 'more' | 'greater';" + "MOST := 'most';" + "NEIGHBOURS := 'neighbour' | 'neighbor' | 'neighbours' | 'neighbors';" + "NONE := 'no';" + "NOT := 'not';" + "OR := 'or';" + "SOME := 'some';" ;; SYMBOL is in the per-language file so that languages that use ;; (e.g.) Cyrillic characters can change the definition. - "SYMBOL := #'[a-z]+';" - ])) + "SYMBOL := #'[a-z]+';" + "THAN := 'than';" + "THEN := 'then';" + "TO := 'to';" + "WITH := 'with' | 'where' | 'having';" + "WITHIN := 'within';"])) -(defn select-keywords-for-locale +(defn keywords-for-locale "For now, just return `keywords-en`; plan is to have resource files of keywords for different languages in a resource directory, but that isn't done yet. It's probably not going to work easily for languages that use non-latin alphabets, anyway." ([] - (select-keywords-for-locale (get-default))) + (keywords-for-locale (get-default))) ([^Locale locale] keywords-en)) (def parse-rule "Parse the argument, assumed to be a string in the correct syntax, and return a parse tree." - (insta/parser (join "\n" [grammar (select-keywords-for-locale)]))) + (insta/parser (join "\n" [rule-grammar common-grammar (keywords-for-locale)]))) (defn compile-rule "Parse this `rule-text`, a string conforming to the grammar of MicroWorld rules, @@ -125,7 +137,7 @@ ([rule-text return-tuple?] (assert (string? rule-text)) (let [rule (trim rule-text) - tree (simplify (parse-rule rule)) + tree (simplify-rule (parse-rule rule)) afn (if (rule? tree) (eval (generate tree)) ;; else (throw-parse-exception tree))] diff --git a/src/mw_parser/flow.clj b/src/mw_parser/flow.clj index e69de29..80f8b50 100644 --- a/src/mw_parser/flow.clj +++ b/src/mw_parser/flow.clj @@ -0,0 +1,26 @@ +(ns ^{:doc "A very simple parser which parses flow rules." + :author "Simon Brooke"} + mw-parser.flow + (:require [clojure.string :refer [join]] + [instaparse.core :as insta] + [mw-parser.declarative :refer [common-grammar keywords-for-locale]])) + +(def flow-grammar + "Grammar for flow rules" + (join "\n" ["FLOW-RULE := FLOW SPACE QUANTITY SPACE PROPERTY SPACE FROM SPACE SOURCE SPACE TO-HOW SPACE DESTINATION;" + "PERCENTAGE := NUMBER #'%';" + "QUANTITY := PERCENTAGE | NUMBER;" + "SOURCE := STATE | STATE SPACE WITH SPACE CONDITIONS;" + "DESTINATION := STATE | STATE SPACE WITH SPACE FLOW-CONDITIONS;" + "DETERMINER := MOST | LEAST;" + "DETERMINER-CONDITION := DETERMINER SPACE PROPERTY | DETERMINER SPACE PROPERTY SPACE WITHIN SPACE NUMBER;" + "FLOW-CONDITIONS := DETERMINER-CONDITION | CONDITIONS" + "STATE := SYMBOL;" + "TO-HOW := TO | TO-EACH | TO-FIRST;" + "TO-EACH := TO SPACE EACH | TO SPACE ALL;" + "TO-FIRST := TO SPACE EACH" + ])) + +(def parse-flow + "Parse the argument, assumed to be a string in the correct syntax, and return a parse tree." + (insta/parser (join "\n" [flow-grammar common-grammar (keywords-for-locale)]))) diff --git a/src/mw_parser/simplify.clj b/src/mw_parser/simplify.clj index 00529a8..e203b0c 100644 --- a/src/mw_parser/simplify.clj +++ b/src/mw_parser/simplify.clj @@ -26,8 +26,7 @@ ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(declare simplify) +(declare simplify-rule) (defn simplify-qualifier "Given that this `tree` fragment represents a qualifier, what @@ -40,23 +39,21 @@ (coll? (first tree)) (or (simplify-qualifier (first tree)) (simplify-qualifier (rest tree))) (coll? tree) (simplify-qualifier (rest tree)) - true tree)) + :else tree)) (defn simplify-second-of-two "There are a number of possible simplifications such that if the `tree` has only two elements, the second is semantically sufficient." [tree] - (if (= (count tree) 2) (simplify (nth tree 1)) tree)) - + (if (= (count tree) 2) (simplify-rule (nth tree 1)) tree)) (defn simplify-quantifier "If this quantifier is a number, 'simplifiy' it into a comparative whose operator is '=' and whose quantity is that number. This is actually more complicated but makes generation easier." [tree] - (if (number? (second tree)) [:COMPARATIVE '= (second tree)] (simplify (second tree)))) + (if (number? (second tree)) [:COMPARATIVE '= (second tree)] (simplify-rule (second tree)))) - -(defn simplify +(defn simplify-rule "Simplify/canonicalise this `tree`. Opportunistically replace complex fragments with semantically identical simpler fragments" [tree] @@ -64,7 +61,7 @@ (coll? tree) (case (first tree) :ACTION (simplify-second-of-two tree) - :ACTIONS (cons (first tree) (simplify (rest tree))) + :ACTIONS (cons (first tree) (simplify-rule (rest tree))) :CHANCE-IN nil :COMPARATIVE (simplify-second-of-two tree) :CONDITION (simplify-second-of-two tree) @@ -76,6 +73,22 @@ :THEN nil :AND nil :VALUE (simplify-second-of-two tree) - (remove nil? (map simplify tree))) + (remove nil? (map simplify-rule tree))) tree)) +(defn simplify-flow + [tree] + (if (coll? tree) + (case (first tree) + :DETERMINER (simplify-second-of-two tree) + :SPACE nil + :STATE [:PROPERTY-CONDITION + [:SYMBOL "state"] + [:QUALIFIER + [:EQUIVALENCE + [:IS "is"]]] + [:EXPRESSION + [:VALUE + (second tree)]]] + (remove nil? (map simplify-flow tree))) + tree)) \ No newline at end of file From ca3861b50518334898095a80566325f5d799b7e0 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Mon, 10 Jul 2023 13:44:47 +0100 Subject: [PATCH 15/26] Upversioning whole system to 0.2.0, for flow feature This is definitely a point version change! --- project.clj | 4 ++-- src/mw_parser/declarative.clj | 1 + src/mw_parser/flow.clj | 4 ++-- src/mw_parser/generate.clj | 12 ++++++++-- src/mw_parser/simplify.clj | 45 ++++++++++++++++++++--------------- 5 files changed, 41 insertions(+), 25 deletions(-) diff --git a/project.clj b/project.clj index 5afc9a1..77f0874 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject mw-parser "0.1.6-SNAPSHOT" +(defproject mw-parser "0.2.0-SNAPSHOT" :description "Parser for production rules for MicroWorld engine" :url "http://www.journeyman.cc/microworld" :manifest { @@ -14,5 +14,5 @@ :dependencies [[org.clojure/clojure "1.11.1"] [org.clojure/tools.trace "0.7.11"] [instaparse "1.4.12"] - [mw-engine "0.1.6-SNAPSHOT"] + [mw-engine "0.2.0-SNAPSHOT"] [trptr/java-wrapper "0.2.3"]]) diff --git a/src/mw_parser/declarative.clj b/src/mw_parser/declarative.clj index 3239c62..a0f6b39 100644 --- a/src/mw_parser/declarative.clj +++ b/src/mw_parser/declarative.clj @@ -88,6 +88,7 @@ "CHANCE-IN := 'chance in';" "EACH := 'each' | 'every' | 'all';" "EQUAL := 'equal to';" + "FIRST := 'first';" "FLOW := 'flow' | 'move';" "FROM := 'from';" "IF := 'if';" diff --git a/src/mw_parser/flow.clj b/src/mw_parser/flow.clj index 80f8b50..adaacf4 100644 --- a/src/mw_parser/flow.clj +++ b/src/mw_parser/flow.clj @@ -9,7 +9,7 @@ "Grammar for flow rules" (join "\n" ["FLOW-RULE := FLOW SPACE QUANTITY SPACE PROPERTY SPACE FROM SPACE SOURCE SPACE TO-HOW SPACE DESTINATION;" "PERCENTAGE := NUMBER #'%';" - "QUANTITY := PERCENTAGE | NUMBER;" + "QUANTITY := PERCENTAGE | NUMBER | SOME;" "SOURCE := STATE | STATE SPACE WITH SPACE CONDITIONS;" "DESTINATION := STATE | STATE SPACE WITH SPACE FLOW-CONDITIONS;" "DETERMINER := MOST | LEAST;" @@ -18,7 +18,7 @@ "STATE := SYMBOL;" "TO-HOW := TO | TO-EACH | TO-FIRST;" "TO-EACH := TO SPACE EACH | TO SPACE ALL;" - "TO-FIRST := TO SPACE EACH" + "TO-FIRST := TO SPACE FIRST" ])) (def parse-flow diff --git a/src/mw_parser/generate.clj b/src/mw_parser/generate.clj index 3c86b02..6a1d318 100644 --- a/src/mw_parser/generate.clj +++ b/src/mw_parser/generate.clj @@ -53,9 +53,9 @@ (defn generate-conjunct-condition - [tree] "From this `tree`, assumed to be a syntactically conjunct correct condition clause, generate and return the appropriate clojure fragment." + [tree] (assert-type tree :CONJUNCT-CONDITION) (cons 'and (map generate (rest tree)))) @@ -93,7 +93,7 @@ qualifier (generate (nth tree 2)) expression (generate (nth tree 3))] (generate-disjunct-property-condition tree property qualifier expression))) - ([tree property qualifier expression] + ([_tree property qualifier expression] (let [e (list 'some (list 'fn ['i] '(= i value)) (list 'quote expression))] (list 'let ['value (list property 'cell)] (if (= qualifier '=) e @@ -314,3 +314,11 @@ :WITHIN-CONDITION (generate-within-condition tree) (map generate tree)) tree)) + +;;; Flow rules. A flow rule DOES NOT return a modified world; instead, it +;;; returns a PLAN to modify the world, in the form of a sequence of `flows`. +;;; It is only when the plan is executed that the world is modified. +;;; +;;; so we're looking at something like +;;; (fn [cell world]) +;;; (if (= (:state cell) (or (:house cell) :house)) \ No newline at end of file diff --git a/src/mw_parser/simplify.clj b/src/mw_parser/simplify.clj index e203b0c..44d81bb 100644 --- a/src/mw_parser/simplify.clj +++ b/src/mw_parser/simplify.clj @@ -1,7 +1,8 @@ (ns ^{:doc "Simplify a parse tree." :author "Simon Brooke"} mw-parser.simplify - (:require [mw-engine.utils :refer [member?]])) + (:require [clojure.pprint :refer [pprint]] + [mw-engine.utils :refer [member?]])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; @@ -26,20 +27,20 @@ ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(declare simplify-rule) +(declare simplify-flow simplify-rule) -(defn simplify-qualifier - "Given that this `tree` fragment represents a qualifier, what - qualifier is that?" - [tree] - (cond - (empty? tree) nil - (and (coll? tree) - (member? (first tree) '(:EQUIVALENCE :COMPARATIVE))) tree - (coll? (first tree)) (or (simplify-qualifier (first tree)) - (simplify-qualifier (rest tree))) - (coll? tree) (simplify-qualifier (rest tree)) - :else tree)) +;; (defn simplify-qualifier +;; "Given that this `tree` fragment represents a qualifier, what +;; qualifier is that?" +;; [tree] +;; (cond +;; (empty? tree) nil +;; (and (coll? tree) +;; (#{:EQUIVALENCE :COMPARATIVE} (first tree))) tree +;; (coll? (first tree)) (or (simplify-qualifier (first tree)) +;; (simplify-qualifier (rest tree))) +;; (coll? tree) (simplify-qualifier (rest tree)) +;; :else tree)) (defn simplify-second-of-two "There are a number of possible simplifications such that if the `tree` has @@ -47,11 +48,11 @@ [tree] (if (= (count tree) 2) (simplify-rule (nth tree 1)) tree)) -(defn simplify-quantifier - "If this quantifier is a number, 'simplifiy' it into a comparative whose operator is '=' - and whose quantity is that number. This is actually more complicated but makes generation easier." - [tree] - (if (number? (second tree)) [:COMPARATIVE '= (second tree)] (simplify-rule (second tree)))) +;; (defn simplify-quantifier +;; "If this quantifier is a number, 'simplifiy' it into a comparative whose operator is '=' +;; and whose quantity is that number. This is actually more complicated but makes generation easier." +;; [tree] +;; (if (number? (second tree)) [:COMPARATIVE '= (second tree)] (simplify-rule (second tree)))) (defn simplify-rule "Simplify/canonicalise this `tree`. Opportunistically replace complex fragments with @@ -76,12 +77,18 @@ (remove nil? (map simplify-rule tree))) tree)) +(defn simplify-determiner-condition + [tree]) + (defn simplify-flow [tree] (if (coll? tree) (case (first tree) + :FLOW nil :DETERMINER (simplify-second-of-two tree) + :DETERMINER-CONDITION (simplify-determiner-condition tree) :SPACE nil + :QUANTITY (simplify-second-of-two tree) :STATE [:PROPERTY-CONDITION [:SYMBOL "state"] [:QUALIFIER From fb39f1ee9c0d25f61a3dd8b96ff9f0adb9dc3f97 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Tue, 11 Jul 2023 09:15:56 +0100 Subject: [PATCH 16/26] Some work on flow, mainly code tidy-up --- .gitignore | 3 +- docs/cloverage/coverage.css | 40 + docs/cloverage/index.html | 149 + docs/cloverage/mw_parser/bulk.clj.html | 194 + docs/cloverage/mw_parser/core.clj.html | 1361 ++++++ docs/cloverage/mw_parser/declarative.clj.html | 479 ++ docs/cloverage/mw_parser/errors.clj.html | 212 + docs/cloverage/mw_parser/flow.clj.html | 209 + docs/cloverage/mw_parser/generate.clj.html | 962 ++++ docs/cloverage/mw_parser/simplify.clj.html | 260 ++ docs/cloverage/mw_parser/utils.clj.html | 200 + docs/codox/css/default.css | 551 +++ docs/codox/css/highlight.css | 97 + docs/codox/index.html | 11 + docs/codox/intro.html | 5 + docs/codox/js/highlight.min.js | 2 + docs/codox/js/jquery.min.js | 4 + docs/codox/js/page_effects.js | 112 + docs/codox/mw-parser.bulk.html | 9 + docs/codox/mw-parser.core.html | 25 + docs/codox/mw-parser.declarative.html | 14 + docs/codox/mw-parser.errors.html | 7 + docs/codox/mw-parser.flow.html | 11 + docs/codox/mw-parser.generate.html | 23 + docs/codox/mw-parser.simplify.html | 8 + docs/codox/mw-parser.utils.html | 9 + docs/uberdoc.html | 3882 ----------------- project.clj | 31 +- src/mw_parser/declarative.clj | 12 +- src/mw_parser/flow.clj | 59 +- src/mw_parser/generate.clj | 82 +- src/mw_parser/simplify.clj | 31 +- src/mw_parser/utils.clj | 20 +- test/mw_parser/declarative_test.clj | 16 +- test/mw_parser/flow_test.clj | 66 + test/mw_parser/utils_test.clj | 30 + 36 files changed, 5191 insertions(+), 3995 deletions(-) create mode 100644 docs/cloverage/coverage.css create mode 100644 docs/cloverage/index.html create mode 100644 docs/cloverage/mw_parser/bulk.clj.html create mode 100644 docs/cloverage/mw_parser/core.clj.html create mode 100644 docs/cloverage/mw_parser/declarative.clj.html create mode 100644 docs/cloverage/mw_parser/errors.clj.html create mode 100644 docs/cloverage/mw_parser/flow.clj.html create mode 100644 docs/cloverage/mw_parser/generate.clj.html create mode 100644 docs/cloverage/mw_parser/simplify.clj.html create mode 100644 docs/cloverage/mw_parser/utils.clj.html create mode 100644 docs/codox/css/default.css create mode 100644 docs/codox/css/highlight.css create mode 100644 docs/codox/index.html create mode 100644 docs/codox/intro.html create mode 100644 docs/codox/js/highlight.min.js create mode 100644 docs/codox/js/jquery.min.js create mode 100644 docs/codox/js/page_effects.js create mode 100644 docs/codox/mw-parser.bulk.html create mode 100644 docs/codox/mw-parser.core.html create mode 100644 docs/codox/mw-parser.declarative.html create mode 100644 docs/codox/mw-parser.errors.html create mode 100644 docs/codox/mw-parser.flow.html create mode 100644 docs/codox/mw-parser.generate.html create mode 100644 docs/codox/mw-parser.simplify.html create mode 100644 docs/codox/mw-parser.utils.html delete mode 100644 docs/uberdoc.html create mode 100644 test/mw_parser/flow_test.clj create mode 100644 test/mw_parser/utils_test.clj diff --git a/.gitignore b/.gitignore index 88fb07f..e050faa 100644 --- a/.gitignore +++ b/.gitignore @@ -4,5 +4,6 @@ buildall.tmp.* target/ pom.xml .calva/ - +.clj-kondo/ +.lsp/ .nrepl-port diff --git a/docs/cloverage/coverage.css b/docs/cloverage/coverage.css new file mode 100644 index 0000000..2be4e57 --- /dev/null +++ b/docs/cloverage/coverage.css @@ -0,0 +1,40 @@ +.covered { + font-family: 'Bitstream Vera Sans Mono', 'Courier', monospace; + background-color: #558B55; +} + +.not-covered { + font-family: 'Bitstream Vera Sans Mono', 'Courier', monospace; + background-color: red; +} + +.partial { + font-family: 'Bitstream Vera Sans Mono', 'Courier', monospace; + background-color: orange; +} + +.not-tracked { + font-family: 'Bitstream Vera Sans Mono', 'Courier', monospace; +} + +.blank { + font-family: 'Bitstream Vera Sans Mono', 'Courier', monospace; +} + +td { + padding-right: 10px; +} + +td.with-bar { + width: 250px; + text-align: center; +} + +td.with-number { + text-align: right; +} + +td.ns-name { + min-width: 150px; + padding-right: 25px; +} diff --git a/docs/cloverage/index.html b/docs/cloverage/index.html new file mode 100644 index 0000000..90cbc82 --- /dev/null +++ b/docs/cloverage/index.html @@ -0,0 +1,149 @@ + + + + + Coverage Summary + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Namespace Forms Forms % Lines Lines %TotalBlankInstrumented
mw-parser.bulk
60
100.00 %
11
100.00 %62711
mw-parser.core
1193
49
96.05 %
207
35
3
98.78 %45141245
mw-parser.declarative
181
13
93.30 %
22
1
1
95.83 %1571024
mw-parser.errors
113
12
90.40 %
19
2
100.00 %68921
mw-parser.flow
74
9
89.16 %
18
3
85.71 %67521
mw-parser.generate
732
187
79.65 %
139
6
30
82.86 %31832175
mw-parser.simplify
72
19
79.12 %
19
1
5
80.00 %84725
mw-parser.utils
73
5
93.59 %
18
2
100.00 %641020
Totals:89.47 %92.25 %
+ + diff --git a/docs/cloverage/mw_parser/bulk.clj.html b/docs/cloverage/mw_parser/bulk.clj.html new file mode 100644 index 0000000..f3b31f2 --- /dev/null +++ b/docs/cloverage/mw_parser/bulk.clj.html @@ -0,0 +1,194 @@ + + + + mw_parser/bulk.clj + + + + 001  (ns ^{:doc "parse multiple rules from a stream, possibly a file." +
+ + 002        :author "Simon Brooke"} +
+ + 003    mw-parser.bulk +
+ + 004    (:use mw-parser.core +
+ + 005          mw-engine.utils +
+ + 006          clojure.java.io +
+ + 007          [clojure.string :only [split trim]]) +
+ + 008    (:import (java.io BufferedReader StringReader))) +
+ + 009   +
+ + 010  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 011  ;;;; +
+ + 012  ;;;; mw-parser: a rule parser for MicroWorld. +
+ + 013  ;;;; +
+ + 014  ;;;; This program is free software; you can redistribute it and/or +
+ + 015  ;;;; modify it under the terms of the GNU General Public License +
+ + 016  ;;;; as published by the Free Software Foundation; either version 2 +
+ + 017  ;;;; of the License, or (at your option) any later version. +
+ + 018  ;;;; +
+ + 019  ;;;; This program is distributed in the hope that it will be useful, +
+ + 020  ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +
+ + 021  ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the +
+ + 022  ;;;; GNU General Public License for more details. +
+ + 023  ;;;; +
+ + 024  ;;;; You should have received a copy of the GNU General Public License +
+ + 025  ;;;; along with this program; if not, write to the Free Software +
+ + 026  ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, +
+ + 027  ;;;; USA. +
+ + 028  ;;;; +
+ + 029  ;;;; Copyright (C) 2014 Simon Brooke +
+ + 030  ;;;; +
+ + 031  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 032   +
+ + 033   +
+ + 034  (defn comment? +
+ + 035    "Is this `line` a comment?" +
+ + 036    [line] +
+ + 037    (or (empty? (trim line)) (member? (first line) '(nil \# \;)))) +
+ + 038   +
+ + 039  (defn parse-string +
+ + 040    "Parse rules from successive lines in this `string`, assumed to have multiple +
+ + 041     lines delimited by the new-line character. Return a list of S-expressions." +
+ + 042    [string] +
+ + 043          ;; TODO: tried to do this using with-open, but couldn't make it work. +
+ + 044    (map #(parse-rule (trim %)) (remove comment? (split string #"\n")))) +
+ + 045   +
+ + 046  (defn parse-file +
+ + 047    "Parse rules from successive lines in the file loaded from this `filename`. +
+ + 048     Return a list of S-expressions." +
+ + 049    [filename] +
+ + 050    (parse-string (slurp filename))) +
+ + 051   +
+ + 052  (defn compile-string +
+ + 053    "Compile each non-comment line of this `string` into an executable anonymous +
+ + 054     function, and return the sequence of such functions." +
+ + 055    [string] +
+ + 056    (map #(compile-rule % true) (remove comment? (split string #"\n")))) +
+ + 057   +
+ + 058  (defn compile-file +
+ + 059    "Compile each non-comment line of the file indicated by this `filename` into +
+ + 060     an executable anonymous function, and return the sequence of such functions." +
+ + 061    [filename] +
+ + 062    (compile-string (slurp filename))) +
+ + diff --git a/docs/cloverage/mw_parser/core.clj.html b/docs/cloverage/mw_parser/core.clj.html new file mode 100644 index 0000000..c7f4a54 --- /dev/null +++ b/docs/cloverage/mw_parser/core.clj.html @@ -0,0 +1,1361 @@ + + + + mw_parser/core.clj + + + + 001  (ns ^{:doc "A very simple parser which parses production rules." +
+ + 002        :author "Simon Brooke"} +
+ + 003    mw-parser.core +
+ + 004    (:use mw-engine.utils +
+ + 005          [clojure.string :only [split trim triml]]) +
+ + 006    (:gen-class) +
+ + 007  ) +
+ + 008   +
+ + 009  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 010  ;;;; +
+ + 011  ;;;; mw-parser: a rule parser for MicroWorld. +
+ + 012  ;;;; +
+ + 013  ;;;; This program is free software; you can redistribute it and/or +
+ + 014  ;;;; modify it under the terms of the GNU General Public License +
+ + 015  ;;;; as published by the Free Software Foundation; either version 2 +
+ + 016  ;;;; of the License, or (at your option) any later version. +
+ + 017  ;;;; +
+ + 018  ;;;; This program is distributed in the hope that it will be useful, +
+ + 019  ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +
+ + 020  ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the +
+ + 021  ;;;; GNU General Public License for more details. +
+ + 022  ;;;; +
+ + 023  ;;;; You should have received a copy of the GNU General Public License +
+ + 024  ;;;; along with this program; if not, write to the Free Software +
+ + 025  ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, +
+ + 026  ;;;; USA. +
+ + 027  ;;;; +
+ + 028  ;;;; Copyright (C) 2014 Simon Brooke +
+ + 029  ;;;; +
+ + 030  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 031  ;;;; +
+ + 032  ;;;; A very simple parser which parses production rules of the following forms: +
+ + 033  ;;;; +
+ + 034  ;;;; * "if altitude is less than 100 and state is forest then state should be climax and deer should be 3" +
+ + 035  ;;;; * "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3" +
+ + 036  ;;;; * "if altitude is 100 or fertility is 25 then state should be heath" +
+ + 037  ;;;; * "if deer is more than 2 and wolves is 0 and fertility is more than 20 then deer should be deer + 2" +
+ + 038  ;;;; * "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves" +
+ + 039  ;;;; * "if state is grassland and 4 neighbours have state equal to water then state should be village" +
+ + 040  ;;;; * "if state is forest and fertility is between 55 and 75 then state should be climax" +
+ + 041  ;;;; * "if 6 neighbours have state equal to water then state should be village" +
+ + 042  ;;;; * "if state is in grassland or pasture or heath and 4 neighbours are water then state should be village" +
+ + 043  ;;;; * "if state is forest or state is climax and some neighbours have state equal to fire then 3 in 5 chance that state should be fire" +
+ + 044  ;;;; * "if state is pasture and more than 3 neighbours have state equal to scrub then state should be scrub" +
+ + 045  ;;;; * +
+ + 046  ;;;; +
+ + 047  ;;;; it generates rules in the form expected by `mw-engine.core`, q.v. +
+ + 048  ;;;; +
+ + 049  ;;;; It is, as I say, very simple; it generates a complete rule, or it fails completely, returning nil. +
+ + 050  ;;;; Very occasionally it generates a wrong rule - one which is not a correct translation of the rule +
+ + 051  ;;;; semantics - but that is buggy behaviour, which I'll try to fix over the next few weeks, not a +
+ + 052  ;;;; design fault. +
+ + 053  ;;;; +
+ + 054  ;;;; More significantly it does not generate useful error messages on failure. +
+ + 055  ;;;; +
+ + 056  ;;;; This parser is now obsolete, but is retained in the codebase for now in +
+ + 057  ;;;; case it is of use to anyone. Prefer the declarative.clj parser. +
+ + 058  ;;;; +
+ + 059  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 060   +
+ + 061  (declare parse-conditions) +
+ + 062  (declare parse-not-condition) +
+ + 063  (declare parse-simple-condition) +
+ + 064   +
+ + 065  ;; a regular expression which matches string representation of positive numbers +
+ + 066  (def re-number #"^[0-9.]*$") +
+ + 067   +
+ + 068  ;; error thrown when an attempt is made to set a reserved property +
+ + 069  (def reserved-properties-error +
+ + 070    "The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions") +
+ + 071  ;; error thrown when a rule cannot be parsed +
+ + 072  (def bad-parse-error "I did not understand '%s'") +
+ + 073   +
+ + 074  (defn- keyword-or-numeric +
+ + 075    "If this token appears to represent an explicit number, return that number; +
+ + 076     otherwise, make a keyword of it and return that." +
+ + 077    [token] +
+ + 078    (cond +
+ + 079      (re-matches re-number token) (read-string token) +
+ + 080      (keyword? token) token +
+ + 081      true (keyword token))) +
+ + 082   +
+ + 083  ;; Generally all functions in this file with names beginning 'parse-' take a +
+ + 084  ;; sequence of tokens (and in some cases other optional arguments) and return a +
+ + 085  ;; vector comprising +
+ + 086  ;; +
+ + 087  ;; 1. A code fragment parsed from the front of the sequence of tokens, and +
+ + 088  ;; 2. the remaining tokens which were not consumed in constructing that fragment. +
+ + 089  ;; +
+ + 090  ;; In every case if the function cannot parse the desired construct from the +
+ + 091  ;; front of the sequence of tokens it returns nil. +
+ + 092   +
+ + 093   +
+ + 094  (defn parse-numeric-value +
+ + 095    "Parse a number." +
+ + 096    [[value & remainder]] +
+ + 097    (if (and value (re-matches re-number value)) [(read-string value) remainder])) +
+ + 098   +
+ + 099  (defn parse-property-int +
+ + 100    "Parse a token assumed to be the name of a property of the current cell, +
+ + 101    whose value is assumed to be an integer." +
+ + 102    [[value & remainder]] +
+ + 103    (if value [(list 'get-int 'cell (keyword value)) remainder])) +
+ + 104   +
+ + 105  (defn parse-property-value +
+ + 106    "Parse a token assumed to be the name of a property of the current cell." +
+ + 107    [[value & remainder]] +
+ + 108    (if value [(list (keyword value) 'cell) remainder])) +
+ + 109   +
+ + 110  (defn parse-token-value +
+ + 111    "Parse a token assumed to be a simple token value." +
+ + 112    [[value & remainder]] +
+ + 113    (if value [(keyword value) remainder])) +
+ + 114   +
+ + 115  (defn parse-simple-value +
+ + 116    "Parse a value from the first of these `tokens`. If `expect-int` is true, return +
+ + 117     an integer or something which will evaluate to an integer." +
+ + 118    ([tokens expect-int] +
+ + 119      (or +
+ + 120          (parse-numeric-value tokens) +
+ + 121          (cond expect-int +
+ + 122            (parse-property-int tokens) +
+ + 123            true (parse-token-value tokens)))) +
+ + 124    ([tokens] +
+ + 125      (parse-simple-value tokens false))) +
+ + 126   +
+ + 127  (defn gen-token-value +
+ + 128    "Parse a single value from this single token and return just the generated +
+ + 129     code, not a pair." +
+ + 130    [token expect-int] +
+ + 131    (first (parse-simple-value (list token) expect-int))) +
+ + 132   +
+ + 133  (defn parse-disjunct-value +
+ + 134    "Parse a list of values from among these `tokens`. If `expect-int` is true, return +
+ + 135     integers or things which will evaluate to integers." +
+ + 136    [[OR token & tokens] expect-int] +
+ + 137    (cond (member? OR '("or" "in")) +
+ + 138      (let [value (first (parse-simple-value (list token) expect-int)) +
+ + 139            seek-others (= (first tokens) "or")] +
+ + 140        (cond seek-others +
+ + 141          (let [[others remainder] (parse-disjunct-value tokens expect-int)] +
+ + 142            [(cons value others) remainder]) +
+ + 143          true +
+ + 144          [(list value) tokens])))) +
+ + 145   +
+ + 146  (defn parse-value +
+ + 147    "Parse a value from among these `tokens`. If `expect-int` is true, return +
+ + 148     an integer or something which will evaluate to an integer." +
+ + 149    ([tokens expect-int] +
+ + 150      (or +
+ + 151        (parse-disjunct-value tokens expect-int) +
+ + 152        (parse-simple-value tokens expect-int))) +
+ + 153    ([tokens] +
+ + 154      (parse-value tokens false))) +
+ + 155   +
+ + 156  (defn parse-member-condition +
+ + 157    "Parses a condition of the form '[property] in [value] or [value]...'" +
+ + 158    [[property IS IN & rest]] +
+ + 159    (if (and (member? IS '("is" "are")) (= IN "in")) +
+ + 160      (let [[l remainder] (parse-disjunct-value (cons "in" rest) false)] +
+ + 161        [(list 'member? (list (keyword property) 'cell) (list 'quote l)) remainder]))) +
+ + 162   +
+ + 163  (defn- parse-less-condition +
+ + 164    "Parse '[property] less than [value]'." +
+ + 165    [[property IS LESS THAN & rest]] +
+ + 166    (cond (and (member? IS '("is" "are")) (member? LESS '("less" "fewer")) (= THAN "than")) +
+ + 167      (let [[value remainder] (parse-value rest true)] +
+ + 168          [(list '< (list 'get-int 'cell (keyword property)) value) remainder]))) +
+ + 169   +
+ + 170  (defn- parse-more-condition +
+ + 171    "Parse '[property] more than [value]'." +
+ + 172    [[property IS MORE THAN & rest]] +
+ + 173    (cond (and (member? IS '("is" "are")) (member? MORE '("more" "greater")) (= THAN "than")) +
+ + 174      (let [[value remainder] (parse-value rest true)] +
+ + 175          [(list '> (list 'get-int 'cell (keyword property)) value) remainder]))) +
+ + 176   +
+ + 177  (defn- parse-between-condition +
+ + 178    [[p IS BETWEEN v1 AND v2 & rest]] +
+ + 179    (cond (and (member? IS '("is" "are")) (= BETWEEN "between") (= AND "and") (not (nil? v2))) +
+ + 180      (let [property (first (parse-simple-value (list p) true)) +
+ + 181            value1 (first (parse-simple-value (list v1) true)) +
+ + 182            value2 (first (parse-simple-value (list v2) true))] +
+ + 183        [(list 'or +
+ + 184              (list '< value1 property value2) +
+ + 185              (list '> value1 property value2)) rest]))) +
+ + 186   +
+ + 187  (defn- parse-is-condition +
+ + 188    "Parse clauses of the form 'x is y', 'x is in y or z...', +
+ + 189     'x is between y and z', 'x is more than y' or 'x is less than y'. +
+ + 190     It is necessary to disambiguate whether value is a numeric or keyword." +
+ + 191    [[property IS value & rest]] +
+ + 192    (cond +
+ + 193      (member? IS '("is" "are")) +
+ + 194      (let [tokens (cons property (cons value rest))] +
+ + 195        (cond +
+ + 196          (re-matches re-number value) [(list '= (list 'get-int 'cell (keyword property)) (read-string value)) rest] +
+ + 197          value [(list '= (list (keyword property) 'cell) (keyword value)) rest])))) +
+ + 198   +
+ + 199  (defn- parse-not-condition +
+ + 200    "Parse the negation of a simple condition." +
+ + 201    [[property IS NOT & rest]] +
+ + 202    (cond (and (member? IS '("is" "are")) (= NOT "not")) +
+ + 203      (let [partial (parse-simple-condition (cons property (cons "is" rest)))] +
+ + 204        (cond partial +
+ + 205          (let [[condition remainder] partial] +
+ + 206            [(list 'not condition) remainder]))))) +
+ + 207   +
+ + 208  (defn- gen-neighbours-condition +
+ + 209    ([comp1 quantity property value remainder comp2 distance] +
+ + 210      [(list comp1 +
+ + 211           (list 'count +
+ + 212                 (list 'get-neighbours-with-property-value 'world +
+ + 213                       '(cell :x) '(cell :y) distance +
+ + 214                       (keyword property) (keyword-or-numeric value) comp2)) +
+ + 215           quantity) +
+ + 216             remainder]) +
+ + 217    ([comp1 quantity property value remainder comp2] +
+ + 218      (gen-neighbours-condition comp1 quantity property value remainder comp2 1))) +
+ + 219   +
+ + 220  (defn parse-comparator-neighbours-condition +
+ + 221    "Parse conditions of the form '...more than 6 neighbours are [condition]'" +
+ + 222    [[MORE THAN n NEIGHBOURS WITHIN distance have-or-are & rest]] +
+ + 223    (let [quantity (first (parse-numeric-value (list n))) +
+ + 224          comparator (cond (= MORE "more") '> +
+ + 225                       (member? MORE '("fewer" "less")) '<)] +
+ + 226      (cond +
+ + 227        (not= WITHIN "within") +
+ + 228        (parse-comparator-neighbours-condition +
+ + 229          (flatten +
+ + 230            ;; two tokens were mis-parsed as 'within distance' that weren't +
+ + 231            ;; actually 'within' and a distance. Splice in 'within 1' and try +
+ + 232            ;; again. +
+ + 233            (list MORE THAN n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest))) +
+ + 234        (and quantity +
+ + 235             comparator +
+ + 236             (= THAN "than") +
+ + 237             (= NEIGHBOURS "neighbours")) +
+ + 238        (cond +
+ + 239          (= have-or-are "are") +
+ + 240          (let [[value & remainder] rest +
+ + 241                dist (gen-token-value distance true)] +
+ + 242            (gen-neighbours-condition comparator quantity :state value remainder = dist)) +
+ + 243          (= have-or-are "have") +
+ + 244          (let [[property comp1 comp2 value & remainder] rest +
+ + 245                dist (gen-token-value distance true)] +
+ + 246            (cond (and (= comp1 "equal") (= comp2 "to")) +
+ + 247              (gen-neighbours-condition comparator quantity property +
+ + 248                                        value remainder = dist) +
+ + 249              (and (= comp1 "more") (= comp2 "than")) +
+ + 250              (gen-neighbours-condition comparator quantity property +
+ + 251                                        value remainder > dist) +
+ + 252              (and (= comp1 "less") (= comp2 "than")) +
+ + 253              (gen-neighbours-condition comparator quantity property +
+ + 254                                        value remainder < dist) +
+ + 255              )))))) +
+ + 256   +
+ + 257  (defn parse-some-neighbours-condition +
+ + 258    [[SOME NEIGHBOURS & rest]] +
+ + 259    (cond +
+ + 260      (and (= SOME "some") (= NEIGHBOURS "neighbours")) +
+ + 261      (parse-comparator-neighbours-condition (concat '("more" "than" "0" "neighbours") rest)))) +
+ + 262   +
+ + 263  (defn parse-simple-neighbours-condition +
+ + 264    "Parse conditions of the form '...6 neighbours are [condition]'" +
+ + 265    [[n NEIGHBOURS WITHIN distance have-or-are & rest]] +
+ + 266    (let [quantity (first (parse-numeric-value (list n)))] +
+ + 267      (cond +
+ + 268        (and quantity (= NEIGHBOURS "neighbours")) +
+ + 269        (cond +
+ + 270          (not= WITHIN "within") +
+ + 271          (parse-simple-neighbours-condition +
+ + 272            (flatten +
+ + 273              ;; two tokens were mis-parsed as 'within distance' that weren't +
+ + 274              ;; actually 'within' and a distance. Splice in 'within 1' and try +
+ + 275              ;; again. +
+ + 276              (list n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest))) +
+ + 277          (= have-or-are "are") +
+ + 278          (let [[value & remainder] rest +
+ + 279                dist (gen-token-value distance true)] +
+ + 280            (gen-neighbours-condition '= quantity :state value remainder = dist)) +
+ + 281          (= have-or-are "have") +
+ + 282          (let [[property comp1 comp2 value & remainder] rest +
+ + 283                dist (gen-token-value distance true)] +
+ + 284            (cond (and (= comp1 "equal") (= comp2 "to")) +
+ + 285              (gen-neighbours-condition '= quantity property value remainder = +
+ + 286                                        dist) +
+ + 287              (and (= comp1 "more") (= comp2 "than")) +
+ + 288              (gen-neighbours-condition '= quantity property value remainder > +
+ + 289                                        dist) +
+ + 290              (and (= comp1 "less") (= comp2 "than")) +
+ + 291              (gen-neighbours-condition '= quantity property value remainder < +
+ + 292                                        dist) +
+ + 293              )))))) +
+ + 294   +
+ + 295  (defn parse-neighbours-condition +
+ + 296    "Parse conditions referring to neighbours" +
+ + 297    [tokens] +
+ + 298    (or +
+ + 299      (parse-simple-neighbours-condition tokens) +
+ + 300      (parse-comparator-neighbours-condition tokens) +
+ + 301      (parse-some-neighbours-condition tokens) +
+ + 302      )) +
+ + 303   +
+ + 304  (defn parse-simple-condition +
+ + 305    "Parse conditions of the form '[property] [comparison] [value]'." +
+ + 306    [tokens] +
+ + 307    (or +
+ + 308      (parse-neighbours-condition tokens) +
+ + 309      (parse-member-condition tokens) +
+ + 310      (parse-not-condition tokens) +
+ + 311      (parse-less-condition tokens) +
+ + 312      (parse-more-condition tokens) +
+ + 313      (parse-between-condition tokens) +
+ + 314      (parse-is-condition tokens))) +
+ + 315   +
+ + 316  (defn- parse-disjunction-condition +
+ + 317    "Parse '... or [condition]' from `tokens`, where `left` is the already parsed first disjunct." +
+ + 318    [left tokens] +
+ + 319    (let [partial (parse-conditions tokens)] +
+ + 320      (if partial +
+ + 321        (let [[right remainder] partial] +
+ + 322          [(list 'or left right) remainder])))) +
+ + 323   +
+ + 324  (defn- parse-conjunction-condition +
+ + 325    "Parse '... and [condition]' from `tokens`, where `left` is the already parsed first conjunct." +
+ + 326    [left tokens] +
+ + 327    (let [partial (parse-conditions tokens)] +
+ + 328      (if partial +
+ + 329        (let [[right remainder] partial] +
+ + 330          [(list 'and left right) remainder])))) +
+ + 331   +
+ + 332  (defn- parse-conditions +
+ + 333    "Parse conditions from `tokens`, where conditions may be linked by either 'and' or 'or'." +
+ + 334    [tokens] +
+ + 335    (let [partial (parse-simple-condition tokens)] +
+ + 336      (if partial +
+ + 337        (let [[left [next & remainder]] partial] +
+ + 338          (cond +
+ + 339            (= next "and") (parse-conjunction-condition left remainder) +
+ + 340            (= next "or") (parse-disjunction-condition left remainder) +
+ + 341            true partial))))) +
+ + 342   +
+ + 343  (defn- parse-left-hand-side +
+ + 344   "Parse the left hand side ('if...') of a production rule." +
+ + 345   [[IF & tokens]] +
+ + 346   (if +
+ + 347     (= IF "if") +
+ + 348     (parse-conditions tokens))) +
+ + 349   +
+ + 350  (defn- parse-arithmetic-action +
+ + 351    "Parse actions of the form '[property] should be [property] [arithmetic-operator] [value]', +
+ + 352     e.g. 'fertility should be fertility + 1', or 'deer should be deer - wolves'." +
+ + 353    [previous [prop1 SHOULD BE prop2 operator value & rest]] +
+ + 354    (cond +
+ + 355      (member? prop1 '("x" "y")) +
+ + 356      (throw +
+ + 357        (Exception. reserved-properties-error)) +
+ + 358      (and (= SHOULD "should") +
+ + 359             (= BE "be") +
+ + 360             (member? operator '("+" "-" "*" "/"))) +
+ + 361      [(list 'merge (or previous 'cell) +
+ + 362             {(keyword prop1) (list 'int +
+ + 363                                    (list (symbol operator) (list 'get-int 'cell (keyword prop2)) +
+ + 364                                          (cond +
+ + 365                                            (re-matches re-number value) (read-string value) +
+ + 366                                            true (list 'get-int 'cell (keyword value)))))}) rest])) +
+ + 367   +
+ + 368  (defn- parse-set-action +
+ + 369    "Parse actions of the form '[property] should be [value].'" +
+ + 370    [previous [property SHOULD BE value & rest]] +
+ + 371    (cond +
+ + 372      (member? property '("x" "y")) +
+ + 373      (throw +
+ + 374        (Exception. reserved-properties-error)) +
+ + 375      (and (= SHOULD "should") (= BE "be")) +
+ + 376      [(list 'merge (or previous 'cell) +
+ + 377             {(keyword property) (cond (re-matches re-number value) (read-string value) true (keyword value))}) rest])) +
+ + 378   +
+ + 379  (defn- parse-simple-action [previous tokens] +
+ + 380    (or (parse-arithmetic-action previous tokens) +
+ + 381        (parse-set-action previous tokens))) +
+ + 382   +
+ + 383  (defn- parse-actions +
+ + 384    "Parse actions from tokens." +
+ + 385    [previous tokens] +
+ + 386    (let [[left remainder] (parse-simple-action previous tokens)] +
+ + 387      (cond left +
+ + 388            (cond (= (first remainder) "and") +
+ + 389                  (parse-actions left (rest remainder)) +
+ + 390                  true (list left))))) +
+ + 391   +
+ + 392  (defn- parse-probability +
+ + 393    "Parse a probability of an action from this collection of tokens" +
+ + 394    [previous [n CHANCE IN m & tokens]] +
+ + 395    (cond +
+ + 396      (and (= CHANCE "chance")(= IN "in")) +
+ + 397      (let [[action remainder] (parse-actions previous tokens)] +
+ + 398        (cond action +
+ + 399          [(list 'cond +
+ + 400                (list '< +
+ + 401                      (list 'rand +
+ + 402                            (first (parse-simple-value (list m) true))) +
+ + 403                      (first (parse-simple-value (list n) true))) +
+ + 404                action) remainder])))) +
+ + 405   +
+ + 406  (defn- parse-right-hand-side +
+ + 407    "Parse the right hand side ('then...') of a production rule." +
+ + 408    [[THEN & tokens]] +
+ + 409    (if (= THEN "then") +
+ + 410      (or +
+ + 411        (parse-probability nil tokens) +
+ + 412        (parse-actions nil tokens)))) +
+ + 413   +
+ + 414  (defn parse-rule +
+ + 415    "Parse a complete rule from this `line`, expected to be either a string or a +
+ + 416     sequence of string tokens. Return the rule in the form of an S-expression. +
+ + 417   +
+ + 418     Throws an exception if parsing fails." +
+ + 419    [line] +
+ + 420    (cond +
+ + 421     (string? line) +
+ + 422     (let [rule (parse-rule (split (triml line) #"\s+"))] +
+ + 423       (cond rule rule +
+ + 424         true (throw (Exception. (format bad-parse-error line))))) +
+ + 425     true +
+ + 426     (let [[left remainder] (parse-left-hand-side line) +
+ + 427                [right junk] (parse-right-hand-side remainder)] +
+ + 428       (cond +
+ + 429         ;; there should be a valide left hand side and a valid right hand side +
+ + 430         ;; there shouldn't be anything left over (junk should be empty) +
+ + 431         (and left right (empty? junk)) +
+ + 432         (list 'fn ['cell 'world] (list 'if left right)))))) +
+ + 433   +
+ + 434  (defn compile-rule +
+ + 435    "Parse this `rule-text`, a string conforming to the grammar of MicroWorld rules, +
+ + 436     into Clojure source, and then compile it into an anonymous +
+ + 437     function object, getting round the problem of binding mw-engine.utils in +
+ + 438     the compiling environment. If `return-tuple?` is present and true, return +
+ + 439     a list comprising the anonymous function compiled, and the function from +
+ + 440     which it was compiled. +
+ + 441   +
+ + 442     Throws an exception if parsing fails." +
+ + 443    ([rule-text return-tuple?] +
+ + 444      (do +
+ + 445        (use 'mw-engine.utils) +
+ + 446        (let [afn (eval (parse-rule rule-text))] +
+ + 447          (cond +
+ + 448            (and afn return-tuple?)(list afn (trim rule-text)) +
+ + 449            true afn)))) +
+ + 450    ([rule-text] +
+ + 451      (compile-rule rule-text false))) +
+ + diff --git a/docs/cloverage/mw_parser/declarative.clj.html b/docs/cloverage/mw_parser/declarative.clj.html new file mode 100644 index 0000000..939e864 --- /dev/null +++ b/docs/cloverage/mw_parser/declarative.clj.html @@ -0,0 +1,479 @@ + + + + mw_parser/declarative.clj + + + + 001  (ns ^{:doc "A very simple parser which parses production rules." +
+ + 002        :author "Simon Brooke"} +
+ + 003   mw-parser.declarative +
+ + 004    (:require [instaparse.core :refer [parser]] +
+ + 005              [clojure.string :refer [join trim]] +
+ + 006              [mw-parser.errors :refer [throw-parse-exception]] +
+ + 007              [mw-parser.generate :refer [generate]] +
+ + 008              [mw-parser.simplify :refer [simplify-rule]] +
+ + 009              [mw-parser.utils :refer [rule?]] +
+ + 010              [trptr.java-wrapper.locale :refer [get-default]]) +
+ + 011    (:import [java.util Locale])) +
+ + 012   +
+ + 013  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 014  ;;;; +
+ + 015  ;;;; mw-parser: a rule parser for MicroWorld. +
+ + 016  ;;;; +
+ + 017  ;;;; This program is free software; you can redistribute it and/or +
+ + 018  ;;;; modify it under the terms of the GNU General Public License +
+ + 019  ;;;; as published by the Free Software Foundation; either version 2 +
+ + 020  ;;;; of the License, or (at your option) any later version. +
+ + 021  ;;;; +
+ + 022  ;;;; This program is distributed in the hope that it will be useful, +
+ + 023  ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +
+ + 024  ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the +
+ + 025  ;;;; GNU General Public License for more details. +
+ + 026  ;;;; +
+ + 027  ;;;; You should have received a copy of the GNU General Public License +
+ + 028  ;;;; along with this program; if not, write to the Free Software +
+ + 029  ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, +
+ + 030  ;;;; USA. +
+ + 031  ;;;; +
+ + 032  ;;;; Copyright (C) 2014 Simon Brooke +
+ + 033  ;;;; +
+ + 034  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 035   +
+ + 036  (def rule-grammar +
+ + 037    "Basic rule language grammar. +
+ + 038      +
+ + 039    in order to simplify translation into other natural languages, all +
+ + 040    TOKENS within the parser should be unambiguou." +
+ + 041    (join "\n" ["RULE := IF SPACE CONDITIONS SPACE THEN SPACE ACTIONS;" +
+ + 042                "ACTIONS := ACTION | ACTION SPACE AND SPACE ACTIONS" +
+ + 043                "ACTION := SIMPLE-ACTION | PROBABLE-ACTION;" +
+ + 044                "PROBABLE-ACTION := VALUE SPACE CHANCE-IN SPACE VALUE SPACE SIMPLE-ACTION;" +
+ + 045                "SIMPLE-ACTION := SYMBOL SPACE BECOMES SPACE EXPRESSION;"])) +
+ + 046   +
+ + 047  (def common-grammar +
+ + 048    "Grammar rules used both in the rule grammar and in the flow grammar" +
+ + 049    (join "\n" ["COMPARATIVE := MORE | LESS;" +
+ + 050                "COMPARATIVE-QUALIFIER := IS SPACE COMPARATIVE SPACE THAN | COMPARATIVE SPACE THAN;" +
+ + 051                "CONDITION := WITHIN-CONDITION | NEIGHBOURS-CONDITION | PROPERTY-CONDITION;" +
+ + 052                "CONDITIONS := DISJUNCT-CONDITION | CONJUNCT-CONDITION | CONDITION ;" +
+ + 053                "CONJUNCT-CONDITION := CONDITION SPACE AND SPACE CONDITIONS;" +
+ + 054                "DISJUNCT-CONDITION := CONDITION SPACE OR SPACE CONDITIONS;" +
+ + 055                "DISJUNCT-EXPRESSION := IN SPACE DISJUNCT-VALUE;" +
+ + 056                "DISJUNCT-VALUE := VALUE | VALUE SPACE OR SPACE DISJUNCT-VALUE;" +
+ + 057                "EQUIVALENCE := IS SPACE EQUAL | EQUAL | IS ;" +
+ + 058                "EXPRESSION := SIMPLE-EXPRESSION | RANGE-EXPRESSION | NUMERIC-EXPRESSION | DISJUNCT-EXPRESSION | VALUE;" +
+ + 059                "NEGATED-QUALIFIER := QUALIFIER SPACE NOT | NOT SPACE QUALIFIER;" +
+ + 060                "NEIGHBOURS-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE IS SPACE PROPERTY-CONDITION | QUALIFIER SPACE NEIGHBOURS-CONDITION;" +
+ + 061                "NUMBER := #'[0-9]+' | #'[0-9]+.[0-9]+';" +
+ + 062                "NUMERIC-EXPRESSION := VALUE | VALUE SPACE OPERATOR SPACE NUMERIC-EXPRESSION;" +
+ + 063                "OPERATOR := '+' | '-' | '*' | '/';" +
+ + 064                "PROPERTY := SYMBOL;" +
+ + 065                "PROPERTY-CONDITION := PROPERTY SPACE QUALIFIER SPACE EXPRESSION | VALUE;" +
+ + 066                "PROPERTY-CONDITION-OR-EXPRESSION := PROPERTY-CONDITION | EXPRESSION;" +
+ + 067                "QUALIFIER := COMPARATIVE-QUALIFIER | NEGATED-QUALIFIER | EQUIVALENCE | IS SPACE QUALIFIER;" +
+ + 068                "QUANTIFIER := NUMBER | SOME | NONE | ALL | COMPARATIVE SPACE THAN SPACE NUMBER;" +
+ + 069                "RANGE-EXPRESSION := BETWEEN SPACE NUMERIC-EXPRESSION SPACE AND SPACE NUMERIC-EXPRESSION;" +
+ + 070                "SIMPLE-EXPRESSION := QUALIFIER SPACE EXPRESSION | VALUE;" +
+ + 071                "SPACE := #'\\s+';" +
+ + 072                "VALUE := SYMBOL | NUMBER;" +
+ + 073                "VALUE := SYMBOL | NUMBER;" +
+ + 074                "WITHIN-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE WITHIN SPACE NUMBER SPACE IS SPACE PROPERTY-CONDITION-OR-EXPRESSION;" +
+ + 075                ])) +
+ + 076   +
+ + 077  (def keywords-en +
+ + 078    "English language keyword literals used in rules - both in production +
+ + 079     rules (this namespace) and in flow rules (see mw-parser.flow). +
+ + 080         +
+ + 081        It's a long term aim that the rule language should be easy to  +
+ + 082        internationalise; this isn't a full solution but it's a step towards +
+ + 083        a solution." +
+ + 084    (join "\n" ["ALL := 'all'"  +
+ + 085                "AND := 'and';"  +
+ + 086                "BECOMES := 'should be' | 'becomes';"  +
+ + 087                "BETWEEN := 'between';"  +
+ + 088                "CHANCE-IN := 'chance in';"  +
+ + 089                "EACH := 'each' | 'every' | 'all';" +
+ + 090                "EQUAL := 'equal to';"  +
+ + 091                "FIRST := 'first';" +
+ + 092                "FLOW := 'flow' | 'move';"  +
+ + 093                "FROM := 'from';" +
+ + 094                "IF := 'if';"  +
+ + 095                "IN := 'in';"  +
+ + 096                "IS := 'is' | 'are' | 'have' | 'has';"  +
+ + 097                "LEAST := 'least';" +
+ + 098                "LESS := 'less' | 'fewer';"  +
+ + 099                "MORE := 'more' | 'greater';"  +
+ + 100                "MOST := 'most';" +
+ + 101                "NEIGHBOURS := 'neighbour' | 'neighbor' | 'neighbours' | 'neighbors';"  +
+ + 102                "NONE := 'no';"  +
+ + 103                "NOT := 'not';"  +
+ + 104                "OR := 'or';"  +
+ + 105                "SOME := 'some';"  +
+ + 106                ;; SYMBOL is in the per-language file so that languages that use +
+ + 107                ;; (e.g.) Cyrillic characters can change the definition. +
+ + 108                "SYMBOL := #'[a-z]+';"  +
+ + 109                "THAN := 'than';"  +
+ + 110                "THEN := 'then';"  +
+ + 111                "TO := 'to';" +
+ + 112                "WITH := 'with' | 'where' | 'having';" +
+ + 113                "WITHIN := 'within';"])) +
+ + 114   +
+ + 115  (defn keywords-for-locale +
+ + 116    "For now, just return `keywords-en`; plan is to have resource files of  +
+ + 117     keywords for different languages in a resource directory, but that isn't +
+ + 118     done yet. It's probably not going to work easily for languages that use +
+ + 119     non-latin alphabets, anyway." +
+ + 120    ([] +
+ + 121     (keywords-for-locale (get-default))) +
+ + 122    ([^Locale _locale] +
+ + 123     keywords-en)) +
+ + 124   +
+ + 125  (defmacro build-parser  +
+ + 126    "Compose this grammar fragment `g` with the common grammar fragments to  +
+ + 127     make a complete grammar, and return a parser for that complete grammar." +
+ + 128    [g] +
+ + 129    `(parser (join "\n" [~g common-grammar (keywords-for-locale)]))) +
+ + 130   +
+ + 131  (def parse-rule +
+ + 132    "Parse the argument, assumed to be a string in the correct syntax, and return a parse tree." +
+ + 133    (build-parser rule-grammar)) +
+ + 134   +
+ + 135  (defn compile-rule +
+ + 136    "Parse this `rule-text`, a string conforming to the grammar of MicroWorld rules, +
+ + 137    into Clojure source, and then compile it into an anonymous +
+ + 138    function object, getting round the problem of binding mw-engine.utils in +
+ + 139    the compiling environment. If `return-tuple?` is present and true, return +
+ + 140    a list comprising the anonymous function compiled, and the function from +
+ + 141    which it was compiled. +
+ + 142   +
+ + 143    Throws an exception if parsing fails." +
+ + 144    ([rule-text return-tuple?] +
+ + 145     (assert (string? rule-text)) +
+ + 146     (let [rule (trim rule-text) +
+ + 147           tree (simplify-rule (parse-rule rule)) +
+ + 148           afn (if (rule? tree) (eval (generate tree)) +
+ + 149                 ;; else +
+ + 150                   (throw-parse-exception tree))] +
+ + 151       (if return-tuple? +
+ + 152         (list afn rule) +
+ + 153         ;; else +
+ + 154         afn))) +
+ + 155    ([rule-text] +
+ + 156     (compile-rule rule-text false))) +
+ + 157   +
+ + diff --git a/docs/cloverage/mw_parser/errors.clj.html b/docs/cloverage/mw_parser/errors.clj.html new file mode 100644 index 0000000..1a0877a --- /dev/null +++ b/docs/cloverage/mw_parser/errors.clj.html @@ -0,0 +1,212 @@ + + + + mw_parser/errors.clj + + + + 001  (ns ^{:doc "Display parse errors in a format which makes it easy for the user +
+ + 002        to see where the error occurred." +
+ + 003        :author "Simon Brooke"} +
+ + 004    mw-parser.errors) +
+ + 005   +
+ + 006  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 007  ;; +
+ + 008  ;; This program is free software; you can redistribute it and/or +
+ + 009  ;; modify it under the terms of the GNU General Public License +
+ + 010  ;; as published by the Free Software Foundation; either version 2 +
+ + 011  ;; of the License, or (at your option) any later version. +
+ + 012  ;; +
+ + 013  ;; This program is distributed in the hope that it will be useful, +
+ + 014  ;; but WITHOUT ANY WARRANTY; without even the implied warranty of +
+ + 015  ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the +
+ + 016  ;; GNU General Public License for more details. +
+ + 017  ;; +
+ + 018  ;; You should have received a copy of the GNU General Public License +
+ + 019  ;; along with this program; if not, write to the Free Software +
+ + 020  ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, +
+ + 021  ;; USA. +
+ + 022  ;; +
+ + 023  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 024   +
+ + 025   +
+ + 026  ;; error thrown when an attempt is made to set a reserved property +
+ + 027  (def reserved-properties-error +
+ + 028    "The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions") +
+ + 029  ;; error thrown when a rule cannot be parsed. Slots are for +
+ + 030  ;; (1) rule text +
+ + 031  ;; (2) cursor showing where in the rule text the error occurred +
+ + 032  ;; (3) the reason for the error +
+ + 033  (def bad-parse-error "I did not understand:\n  '%s'\n  %s\n  %s") +
+ + 034   +
+ + 035   +
+ + 036  (defn- explain-parse-error-reason +
+ + 037    "Attempt to explain the reason for the parse error." +
+ + 038    [reason] +
+ + 039    (str "Expecting one of (" (apply str (map #(str (:expecting %) " ") reason)) ")")) +
+ + 040   +
+ + 041   +
+ + 042  (defn- parser-error-to-map +
+ + 043    [parser-error] +
+ + 044    (let [m (reduce (fn [map item](merge map {(first item)(second item)})) {} parser-error) +
+ + 045          reason (map +
+ + 046                   #(reduce (fn [map item] (merge {(first item) (second item)} map)) {} %) +
+ + 047                   (:reason m))] +
+ + 048      (merge m {:reason reason}))) +
+ + 049   +
+ + 050   +
+ + 051  (defn throw-parse-exception +
+ + 052    "Construct a helpful error message from this `parser-error`, and throw an exception with that message." +
+ + 053    [parser-error] +
+ + 054    (assert (coll? parser-error) "Expected a paser error structure?") +
+ + 055    (let +
+ + 056      [ +
+ + 057        ;; the error structure is a list, such that each element is a list of two items, and +
+ + 058        ;; the first element in each sublist is a keyword. Easier to work with it as a map +
+ + 059       error-map (parser-error-to-map parser-error) +
+ + 060       text (:text error-map) +
+ + 061       reason (explain-parse-error-reason (:reason error-map)) +
+ + 062        ;; rules have only one line, by definition; we're interested in the column +
+ + 063       column (if (:column error-map)(:column error-map) 0) +
+ + 064        ;; create a cursor to point to that column +
+ + 065       cursor (apply str (reverse (conj (repeat column " ") "^"))) +
+ + 066       message (format bad-parse-error text cursor reason) +
+ + 067       ] +
+ + 068    (throw (Exception. message)))) +
+ + diff --git a/docs/cloverage/mw_parser/flow.clj.html b/docs/cloverage/mw_parser/flow.clj.html new file mode 100644 index 0000000..eafe82b --- /dev/null +++ b/docs/cloverage/mw_parser/flow.clj.html @@ -0,0 +1,209 @@ + + + + mw_parser/flow.clj + + + + 001  (ns ^{:doc "A very simple parser which parses flow rules." +
+ + 002        :author "Simon Brooke"} +
+ + 003   mw-parser.flow +
+ + 004    (:require [clojure.string :refer [join]] +
+ + 005              [mw-parser.declarative :refer [build-parser]] +
+ + 006              [mw-parser.simplify :refer [simplify-second-of-two]])) +
+ + 007   +
+ + 008  (def flow-grammar +
+ + 009    "Grammar for flow rules. +
+ + 010               +
+ + 011     My initial conception of this would be that production rules  +
+ + 012     (if-then rules) and flow rules (flow-from-to rules) would be  +
+ + 013     entirely separate, presented to the parser as separate text  +
+ + 014     files, and parsed and compiled by different chains of functions. +
+ + 015               +
+ + 016     This appears not to be necessary. Flow rules are easy to parse +
+ + 017     with the same parser as production rules -- a lot of the grammar  +
+ + 018     is intentionally common -- and the rules are easily discriminated +
+ + 019     at the compilation ('generate') stage. +
+ + 020      +
+ + 021     The basic rule I want to be able to compile at this stage is the 'mutual +
+ + 022     aid' rule: +
+ + 023   +
+ + 024     `flow 1 food from house having food > 1 to house with least food within 2` +
+ + 025     " +
+ + 026    (join "\n" ["FLOW-RULE := FLOW SPACE QUANTITY SPACE PROPERTY SPACE FROM SPACE SOURCE SPACE TO-HOW SPACE DESTINATION;" +
+ + 027                "PERCENTAGE := NUMBER #'%';" +
+ + 028                "QUANTITY := PERCENTAGE | NUMBER | EXPRESSION | SOME;" +
+ + 029                "SOURCE := STATE | STATE SPACE WITH SPACE CONDITIONS;" +
+ + 030                "DESTINATION := STATE | STATE SPACE WITH SPACE FLOW-CONDITIONS | STATE SPACE WITHIN SPACE VALUE SPACE WITH SPACE FLOW-CONDITIONS;" +
+ + 031                "DETERMINER := MOST | LEAST;" +
+ + 032                "DETERMINER-CONDITION := DETERMINER SPACE PROPERTY | DETERMINER SPACE PROPERTY;" +
+ + 033                "FLOW-CONDITIONS := DETERMINER-CONDITION | CONDITIONS" +
+ + 034                "STATE := SYMBOL;" +
+ + 035                "TO-HOW := TO | TO-EACH | TO-FIRST;" +
+ + 036                "TO-EACH := TO SPACE EACH | TO SPACE ALL;" +
+ + 037                "TO-FIRST := TO SPACE FIRST"])) +
+ + 038   +
+ + 039  (def parse-flow +
+ + 040    "Parse the argument, assumed to be a string in the correct syntax, and return a parse tree." +
+ + 041    (build-parser flow-grammar)) +
+ + 042   +
+ + 043  (defn simplify-flow +
+ + 044    [tree] +
+ + 045    (if (coll? tree) +
+ + 046      (case (first tree) +
+ + 047        :CONDITION (simplify-second-of-two tree) +
+ + 048        :CONDITIONS (simplify-second-of-two tree) +
+ + 049        :DETERMINER (simplify-second-of-two tree) +
+ + 050  ;;      :DETERMINER-CONDITION (simplify-determiner-condition tree) +
+ + 051        :EXPRESSION (simplify-second-of-two tree) +
+ + 052        :FLOW nil +
+ + 053  ;;      :FLOW-CONDITIONS (simplify-second-of-two tree) +
+ + 054        :PROPERTY (simplify-second-of-two tree) +
+ + 055        :PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree) +
+ + 056        :SPACE nil +
+ + 057        :QUANTITY (simplify-second-of-two tree) +
+ + 058        :STATE (list :PROPERTY-CONDITION +
+ + 059                     (list :SYMBOL "state") +
+ + 060                     '(:QUALIFIER +
+ + 061                       (:EQUIVALENCE +
+ + 062                        (:IS "is"))) +
+ + 063                     (list :EXPRESSION +
+ + 064                           (list :VALUE (second tree)))) +
+ + 065        (remove nil? (map simplify-flow tree))) +
+ + 066      tree)) +
+ + 067   +
+ + diff --git a/docs/cloverage/mw_parser/generate.clj.html b/docs/cloverage/mw_parser/generate.clj.html new file mode 100644 index 0000000..f901a2f --- /dev/null +++ b/docs/cloverage/mw_parser/generate.clj.html @@ -0,0 +1,962 @@ + + + + mw_parser/generate.clj + + + + 001  (ns ^{:doc "Generate Clojure source from simplified parse trees." +
+ + 002        :author "Simon Brooke"} +
+ + 003   mw-parser.generate +
+ + 004    (:require [mw-parser.utils :refer [assert-type TODO]] +
+ + 005              [mw-parser.errors :as pe])) +
+ + 006   +
+ + 007  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 008  ;; +
+ + 009  ;; This program is free software; you can redistribute it and/or +
+ + 010  ;; modify it under the terms of the GNU General Public License +
+ + 011  ;; as published by the Free Software Foundation; either version 2 +
+ + 012  ;; of the License, or (at your option) any later version. +
+ + 013  ;; +
+ + 014  ;; This program is distributed in the hope that it will be useful, +
+ + 015  ;; but WITHOUT ANY WARRANTY; without even the implied warranty of +
+ + 016  ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the +
+ + 017  ;; GNU General Public License for more details. +
+ + 018  ;; +
+ + 019  ;; You should have received a copy of the GNU General Public License +
+ + 020  ;; along with this program; if not, write to the Free Software +
+ + 021  ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, +
+ + 022  ;; USA. +
+ + 023  ;; +
+ + 024  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 025   +
+ + 026   +
+ + 027  (declare generate generate-action) +
+ + 028   +
+ + 029   +
+ + 030  (defn generate-rule +
+ + 031    "From this `tree`, assumed to be a syntactically correct rule specification, +
+ + 032    generate and return the appropriate rule as a function of two arguments." +
+ + 033    [tree] +
+ + 034    (assert-type tree :RULE) +
+ + 035    (list 'fn ['cell 'world] (list 'if (generate (nth tree 2)) (generate (nth tree 3))))) +
+ + 036   +
+ + 037   +
+ + 038  (defn generate-conditions +
+ + 039    "From this `tree`, assumed to be a syntactically correct conditions clause, +
+ + 040    generate and return the appropriate clojure fragment." +
+ + 041    [tree] +
+ + 042    (assert-type tree :CONDITIONS) +
+ + 043    (generate (second tree))) +
+ + 044   +
+ + 045   +
+ + 046  (defn generate-condition +
+ + 047    "From this `tree`, assumed to be a syntactically correct condition clause, +
+ + 048    generate and return the appropriate clojure fragment." +
+ + 049    [tree] +
+ + 050    (assert-type tree :CONDITION) +
+ + 051    (generate (second tree))) +
+ + 052   +
+ + 053   +
+ + 054  (defn generate-conjunct-condition +
+ + 055    "From this `tree`, assumed to be a syntactically conjunct correct condition clause, +
+ + 056    generate and return the appropriate clojure fragment." +
+ + 057    [tree] +
+ + 058    (assert-type tree :CONJUNCT-CONDITION) +
+ + 059    (cons 'and (map generate (rest tree)))) +
+ + 060   +
+ + 061   +
+ + 062  (defn generate-disjunct-condition +
+ + 063    "From this `tree`, assumed to be a syntactically correct disjunct condition clause, +
+ + 064    generate and return the appropriate clojure fragment." +
+ + 065    [tree] +
+ + 066    (assert-type tree :DISJUNCT-CONDITION) +
+ + 067    (cons 'or (map generate (rest tree)))) +
+ + 068   +
+ + 069   +
+ + 070  (defn generate-ranged-property-condition +
+ + 071    "From this `tree`, assumed to be a syntactically property condition clause for +
+ + 072    this `property` where the `expression` is a numeric range, generate and return +
+ + 073    the appropriate clojure fragment." +
+ + 074    [tree property expression] +
+ + 075    (assert-type tree :PROPERTY-CONDITION) +
+ + 076    (assert-type (nth tree 3) :RANGE-EXPRESSION) +
+ + 077    (let [l1 (generate (nth expression 2)) +
+ + 078          l2 (generate (nth expression 4)) +
+ + 079          pv (list property 'cell)] +
+ + 080      (list 'let ['lower (list 'min l1 l2) +
+ + 081                  'upper (list 'max l1 l2)] +
+ + 082            (list 'and (list '>= pv 'lower) (list '<= pv 'upper))))) +
+ + 083   +
+ + 084   +
+ + 085  (defn generate-disjunct-property-condition +
+ + 086    "From this `tree`, assumed to be a syntactically property condition clause +
+ + 087    where the expression is a a disjunction, generate and return +
+ + 088    the appropriate clojure fragment. +
+ + 089    TODO: this is definitely still wrong!" +
+ + 090    ([tree] +
+ + 091     (let [property (generate (second tree)) +
+ + 092           qualifier (generate (nth tree 2)) +
+ + 093           expression (generate (nth tree 3))] +
+ + 094       (generate-disjunct-property-condition tree property qualifier expression))) +
+ + 095    ([_tree property qualifier expression] +
+ + 096     (let [e (list 'some (list 'fn ['i] '(= i value)) (list 'quote expression))] +
+ + 097       (list 'let ['value (list property 'cell)] +
+ + 098             (if (= qualifier '=) e +
+ + 099                 (list 'not e)))))) +
+ + 100   +
+ + 101   +
+ + 102  (defn generate-property-condition +
+ + 103    "From this `tree`, assumed to be a syntactically property condition clause, +
+ + 104    generate and return the appropriate clojure fragment." +
+ + 105    ([tree] +
+ + 106     (assert-type tree :PROPERTY-CONDITION) +
+ + 107     (if +
+ + 108      (and (= (count tree) 2) (= (first (second tree)) :SYMBOL)) +
+ + 109       ;; it's a shorthand for 'state equal to symbol'. This should probably have +
+ + 110       ;; been handled in simplify... +
+ + 111       (generate-property-condition +
+ + 112        (list +
+ + 113         :PROPERTY-CONDITION +
+ + 114         '(:SYMBOL "state") +
+ + 115         '(:QUALIFIER (:EQUIVALENCE (:EQUAL "equal to"))) +
+ + 116         (second tree))) +
+ + 117       ;; otherwise... +
+ + 118       (generate-property-condition tree (first (nth tree 3))))) +
+ + 119    ([tree expression-type] +
+ + 120     (assert-type tree :PROPERTY-CONDITION) +
+ + 121     (let [property (generate (second tree)) +
+ + 122           qualifier (generate (nth tree 2)) +
+ + 123           e (generate (nth tree 3)) +
+ + 124           expression (cond +
+ + 125                        (and (not (= qualifier '=)) (keyword? e)) (list 'or (list e 'cell) e) +
+ + 126                        (and (not (= qualifier 'not=)) (keyword? e)) (list 'or (list e 'cell) e) +
+ + 127                        :else e)] +
+ + 128       (case expression-type +
+ + 129         :DISJUNCT-EXPRESSION (generate-disjunct-property-condition tree property qualifier expression) +
+ + 130         :RANGE-EXPRESSION (generate-ranged-property-condition tree property expression) +
+ + 131         (list qualifier (list property 'cell) expression))))) +
+ + 132   +
+ + 133  (defn generate-qualifier +
+ + 134    "From this `tree`, assumed to be a syntactically correct qualifier, +
+ + 135    generate and return the appropriate clojure fragment." +
+ + 136    [tree] +
+ + 137    (if +
+ + 138     (= (count tree) 2) +
+ + 139      (generate (second tree)) +
+ + 140      ;; else +
+ + 141      (generate (nth tree 2)))) +
+ + 142   +
+ + 143  (defn generate-simple-action +
+ + 144    "From this `tree`, assumed to be a syntactically correct simple action, +
+ + 145    generate and return the appropriate clojure fragment." +
+ + 146    ([tree] +
+ + 147     (assert-type tree :SIMPLE-ACTION) +
+ + 148     (generate-simple-action tree [])) +
+ + 149    ([tree others] +
+ + 150     (assert-type tree :SIMPLE-ACTION) +
+ + 151     (let [property (generate (second tree)) +
+ + 152           expression (generate (nth tree 3))] +
+ + 153       (if (or (= property :x) (= property :y)) +
+ + 154         (throw (Exception. pe/reserved-properties-error)) +
+ + 155         (list 'merge +
+ + 156               (if (empty? others) 'cell +
+ + 157                 ;; else +
+ + 158                   (generate others)) +
+ + 159               {property expression}))))) +
+ + 160   +
+ + 161  (defn generate-probable-action +
+ + 162    "From this `tree`, assumed to be a syntactically correct probable action, +
+ + 163    generate and return the appropriate clojure fragment." +
+ + 164    ([tree] +
+ + 165     (assert-type tree :PROBABLE-ACTION) +
+ + 166     (generate-probable-action tree [])) +
+ + 167    ([tree others] +
+ + 168     (assert-type tree :PROBABLE-ACTION) +
+ + 169     (let +
+ + 170      [chances (generate (nth tree 1)) +
+ + 171       total (generate (nth tree 2)) +
+ + 172       action (generate-action (nth tree 3) others)] +
+ + 173      ;; TODO: could almost certainly be done better with macro syntax +
+ + 174       (list 'if +
+ + 175             (list '< (list 'rand total) chances) +
+ + 176             action)))) +
+ + 177   +
+ + 178  (defn generate-action +
+ + 179    "From this `tree`, assumed to be a syntactically correct action, +
+ + 180    generate and return the appropriate clojure fragment." +
+ + 181    [tree others] +
+ + 182    (case (first tree) +
+ + 183      :ACTIONS (generate-action (first tree) others) +
+ + 184      :SIMPLE-ACTION (generate-simple-action tree others) +
+ + 185      :PROBABLE-ACTION (generate-probable-action tree others) +
+ + 186      (throw (Exception. (str "Not a known action type: " (first tree)))))) +
+ + 187   +
+ + 188  (defn generate-multiple-actions +
+ + 189    "From this `tree`, assumed to be one or more syntactically correct actions, +
+ + 190    generate and return the appropriate clojure fragment." +
+ + 191    [tree] +
+ + 192    (assert-type tree :ACTIONS) +
+ + 193    (generate-action (first (rest tree)) (second (rest tree)))) +
+ + 194   +
+ + 195  (defn generate-disjunct-value +
+ + 196    "Generate a disjunct value. Essentially what we need here is to generate a +
+ + 197    flat list of values, since the `member` has already been taken care of." +
+ + 198    [tree] +
+ + 199    (assert-type tree :DISJUNCT-VALUE) +
+ + 200    (if (= (count tree) 4) +
+ + 201      (cons (generate (second tree)) (generate (nth tree 3))) +
+ + 202      (list (generate (second tree))))) +
+ + 203   +
+ + 204  (defn generate-numeric-expression +
+ + 205    "From this `tree`, assumed to be a syntactically correct numeric expression, +
+ + 206    generate and return the appropriate clojure fragment." +
+ + 207    [tree] +
+ + 208    (assert-type tree :NUMERIC-EXPRESSION) +
+ + 209    (case (count tree) +
+ + 210      4 (let [[p operator expression] (rest tree) +
+ + 211              property (if (number? p) p (list p 'cell))] +
+ + 212          (list (generate operator) (generate property) (generate expression))) +
+ + 213      (case (first (second tree)) +
+ + 214        :SYMBOL (list (keyword (second (second tree))) 'cell) +
+ + 215        (generate (second tree))))) +
+ + 216   +
+ + 217  (defn generate-neighbours-condition +
+ + 218    "Generate code for a condition which refers to neighbours." +
+ + 219    ([tree] +
+ + 220     (assert-type tree :NEIGHBOURS-CONDITION) +
+ + 221     (case (first (second tree)) +
+ + 222       :NUMBER (read-string (second (second tree))) +
+ + 223       :QUANTIFIER (generate-neighbours-condition tree (first (second (second tree)))) +
+ + 224       :QUALIFIER (cons (generate (second tree)) (rest (generate (nth tree 2)))))) +
+ + 225    ([tree quantifier-type] +
+ + 226     (let [quantifier (second tree) +
+ + 227           pc (generate (nth tree 4))] +
+ + 228       (case quantifier-type +
+ + 229         :NUMBER (generate-neighbours-condition '= (read-string (second (second quantifier))) pc 1) +
+ + 230         :SOME (generate-neighbours-condition '> 0 pc 1) +
+ + 231         :MORE (let [value (generate (nth quantifier 3))] +
+ + 232                 (generate-neighbours-condition '> value pc 1)) +
+ + 233         :LESS (let [value (generate (nth quantifier 3))] +
+ + 234                 (generate-neighbours-condition '< value pc 1))))) +
+ + 235    ([comp1 quantity property-condition distance] +
+ + 236     (list comp1 +
+ + 237           (list 'count +
+ + 238                 (list 'remove 'false? +
+ + 239                       (list 'map (list 'fn ['cell] property-condition) +
+ + 240                             (list 'mw-engine.utils/get-neighbours 'world 'cell distance)))) quantity)) +
+ + 241    ([comp1 quantity property-condition] +
+ + 242     (generate-neighbours-condition comp1 quantity property-condition 1))) +
+ + 243   +
+ + 244   +
+ + 245  (defn generate-within-condition +
+ + 246    "Generate code for a condition which refers to neighbours within a specified distance. +
+ + 247    NOTE THAT there's clearly masses of commonality between this and +
+ + 248    `generate-neighbours-condition`, and that some refactoring is almost certainly +
+ + 249    desirable. It may be that it's better to simplify a `NEIGHBOURS-CONDITION` +
+ + 250    into a `WITHIN-CONDITION` in the simplification stage." +
+ + 251    ([tree] +
+ + 252     (assert-type tree :WITHIN-CONDITION) +
+ + 253     (case (first (second tree)) +
+ + 254       :QUANTIFIER (generate-within-condition tree (first (second (second tree)))) +
+ + 255       :QUALIFIER (TODO "qualified within... help!"))) +
+ + 256    ([tree quantifier-type] +
+ + 257     (let [quantifier (second tree) +
+ + 258           distance (generate (nth tree 4)) +
+ + 259           pc (generate (nth tree 6))] +
+ + 260       (case quantifier-type +
+ + 261         :NUMBER (generate-neighbours-condition '= (read-string (second (second quantifier))) pc distance) +
+ + 262         :SOME (generate-neighbours-condition '> 0 pc distance) +
+ + 263         :MORE (let [value (generate (nth quantifier 3))] +
+ + 264                 (generate-neighbours-condition '> value pc distance)) +
+ + 265         :LESS (let [value (generate (nth quantifier 3))] +
+ + 266                 (generate-neighbours-condition '< value pc distance)))))) +
+ + 267   +
+ + 268  (defn generate-flow +
+ + 269    [tree] +
+ + 270    (assert-type tree :WITHIN-CONDITION)) +
+ + 271   +
+ + 272  (defn generate +
+ + 273    "Generate code for this (fragment of a) parse tree" +
+ + 274    [tree] +
+ + 275    (if +
+ + 276     (coll? tree) +
+ + 277      (case (first tree) +
+ + 278        :ACTIONS (generate-multiple-actions tree) +
+ + 279        :COMPARATIVE (generate (second tree)) +
+ + 280        :COMPARATIVE-QUALIFIER (generate (second tree)) +
+ + 281        :CONDITION (generate-condition tree) +
+ + 282        :CONDITIONS (generate-conditions tree) +
+ + 283        :CONJUNCT-CONDITION (generate-conjunct-condition tree) +
+ + 284        :DISJUNCT-CONDITION (generate-disjunct-condition tree) +
+ + 285        :DISJUNCT-EXPRESSION (generate (nth tree 2)) +
+ + 286        :DISJUNCT-VALUE (generate-disjunct-value tree) +
+ + 287        :EQUIVALENCE '= +
+ + 288        :EXPRESSION (generate (second tree)) +
+ + 289        :FLOW-RULE (generate-flow tree) +
+ + 290        :LESS '< +
+ + 291        :MORE '> +
+ + 292        :NEGATED-QUALIFIER (case (generate (second tree)) +
+ + 293                             = 'not= +
+ + 294                             > '< +
+ + 295                             < '>) +
+ + 296        :NEIGHBOURS-CONDITION (generate-neighbours-condition tree) +
+ + 297        :NUMERIC-EXPRESSION (generate-numeric-expression tree) +
+ + 298        :NUMBER (read-string (second tree)) +
+ + 299        :OPERATOR (symbol (second tree)) +
+ + 300        :PROBABLE-ACTION (generate-probable-action tree) +
+ + 301        :PROPERTY (list (generate (second tree)) 'cell) ;; dubious - may not be right +
+ + 302        :PROPERTY-CONDITION (generate-property-condition tree) +
+ + 303        :QUALIFIER (generate-qualifier tree) +
+ + 304        :RULE (generate-rule tree) +
+ + 305        :SIMPLE-ACTION (generate-simple-action tree) +
+ + 306        :SYMBOL (keyword (second tree)) +
+ + 307        :VALUE (generate (second tree)) +
+ + 308        :WITHIN-CONDITION (generate-within-condition tree) +
+ + 309        (map generate tree)) +
+ + 310      tree)) +
+ + 311   +
+ + 312  ;;; Flow rules. A flow rule DOES NOT return a modified world; instead, it  +
+ + 313  ;;; returns a PLAN to modify the world, in the form of a sequence of `flows`. +
+ + 314  ;;; It is only when the plan is executed that the world is modified. +
+ + 315  ;;; +
+ + 316  ;;; so we're looking at something like +
+ + 317  ;;; (fn [cell world]) +
+ + 318  ;;;    (if (= (:state cell) (or (:house cell) :house)) +
+ + diff --git a/docs/cloverage/mw_parser/simplify.clj.html b/docs/cloverage/mw_parser/simplify.clj.html new file mode 100644 index 0000000..30b49a9 --- /dev/null +++ b/docs/cloverage/mw_parser/simplify.clj.html @@ -0,0 +1,260 @@ + + + + mw_parser/simplify.clj + + + + 001  (ns ^{:doc "Simplify a parse tree." +
+ + 002        :author "Simon Brooke"} +
+ + 003   mw-parser.simplify) +
+ + 004   +
+ + 005  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 006  ;;;; +
+ + 007  ;;;; mw-parser: a rule parser for MicroWorld. +
+ + 008  ;;;; +
+ + 009  ;;;; This program is free software; you can redistribute it and/or +
+ + 010  ;;;; modify it under the terms of the GNU General Public License +
+ + 011  ;;;; as published by the Free Software Foundation; either version 2 +
+ + 012  ;;;; of the License, or (at your option) any later version. +
+ + 013  ;;;; +
+ + 014  ;;;; This program is distributed in the hope that it will be useful, +
+ + 015  ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +
+ + 016  ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the +
+ + 017  ;;;; GNU General Public License for more details. +
+ + 018  ;;;; +
+ + 019  ;;;; You should have received a copy of the GNU General Public License +
+ + 020  ;;;; along with this program; if not, write to the Free Software +
+ + 021  ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, +
+ + 022  ;;;; USA. +
+ + 023  ;;;; +
+ + 024  ;;;; Copyright (C) 2014 Simon Brooke +
+ + 025  ;;;; +
+ + 026  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 027   +
+ + 028  (declare simplify-flow simplify-rule) +
+ + 029   +
+ + 030  ;; (defn simplify-qualifier +
+ + 031  ;;   "Given that this `tree` fragment represents a qualifier, what +
+ + 032  ;;   qualifier is that?" +
+ + 033  ;;   [tree] +
+ + 034  ;;   (cond +
+ + 035  ;;     (empty? tree) nil +
+ + 036  ;;     (and (coll? tree) +
+ + 037  ;;          (#{:EQUIVALENCE :COMPARATIVE} (first tree))) tree +
+ + 038  ;;     (coll? (first tree)) (or (simplify-qualifier (first tree)) +
+ + 039  ;;                              (simplify-qualifier (rest tree))) +
+ + 040  ;;     (coll? tree) (simplify-qualifier (rest tree)) +
+ + 041  ;;     :else tree)) +
+ + 042   +
+ + 043  (defn simplify-second-of-two +
+ + 044    "There are a number of possible simplifications such that if the `tree` has +
+ + 045    only two elements, the second is semantically sufficient." +
+ + 046    [tree] +
+ + 047    (if (= (count tree) 2) (simplify-rule (nth tree 1)) tree)) +
+ + 048   +
+ + 049  ;; (defn simplify-quantifier +
+ + 050  ;;   "If this quantifier is a number, 'simplifiy' it into a comparative whose operator is '=' +
+ + 051  ;;   and whose quantity is that number. This is actually more complicated but makes generation easier." +
+ + 052  ;;   [tree] +
+ + 053  ;;   (if (number? (second tree)) [:COMPARATIVE '= (second tree)] (simplify-rule (second tree)))) +
+ + 054   +
+ + 055  (defn simplify-rule +
+ + 056    "Simplify/canonicalise this `tree`. Opportunistically replace complex fragments with +
+ + 057    semantically identical simpler fragments" +
+ + 058    [tree] +
+ + 059    (if +
+ + 060     (coll? tree) +
+ + 061      (case (first tree) +
+ + 062        :ACTION (simplify-second-of-two tree) +
+ + 063        :ACTIONS (cons (first tree) (simplify-rule (rest tree))) +
+ + 064        :CHANCE-IN nil +
+ + 065        :COMPARATIVE (simplify-second-of-two tree) +
+ + 066        :CONDITION (simplify-second-of-two tree) +
+ + 067        :CONDITIONS (simplify-second-of-two tree) +
+ + 068        :EXPRESSION (simplify-second-of-two tree) +
+ + 069        :PROPERTY (simplify-second-of-two tree) +
+ + 070        :PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree) +
+ + 071        :SPACE nil +
+ + 072        :THEN nil +
+ + 073        :AND nil +
+ + 074        :VALUE (simplify-second-of-two tree) +
+ + 075        (remove nil? (map simplify-rule tree))) +
+ + 076      tree)) +
+ + 077   +
+ + 078  (defn simplify-determiner-condition +
+ + 079    [tree] +
+ + 080    (apply vector +
+ + 081           (cons :DETERMINER-CONDITION +
+ + 082                 (cons +
+ + 083                  (simplify-second-of-two (second tree)) +
+ + 084                  (rest (rest tree)))))) +
+ + diff --git a/docs/cloverage/mw_parser/utils.clj.html b/docs/cloverage/mw_parser/utils.clj.html new file mode 100644 index 0000000..93367ea --- /dev/null +++ b/docs/cloverage/mw_parser/utils.clj.html @@ -0,0 +1,200 @@ + + + + mw_parser/utils.clj + + + + 001  (ns ^{:doc "Utilities used in more than one namespace within the parser." +
+ + 002        :author "Simon Brooke"} +
+ + 003    mw-parser.utils) +
+ + 004   +
+ + 005  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 006  ;;;; +
+ + 007  ;;;; mw-parser: a rule parser for MicroWorld. +
+ + 008  ;;;; +
+ + 009  ;;;; This program is free software; you can redistribute it and/or +
+ + 010  ;;;; modify it under the terms of the GNU General Public License +
+ + 011  ;;;; as published by the Free Software Foundation; either version 2 +
+ + 012  ;;;; of the License, or (at your option) any later version. +
+ + 013  ;;;; +
+ + 014  ;;;; This program is distributed in the hope that it will be useful, +
+ + 015  ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +
+ + 016  ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the +
+ + 017  ;;;; GNU General Public License for more details. +
+ + 018  ;;;; +
+ + 019  ;;;; You should have received a copy of the GNU General Public License +
+ + 020  ;;;; along with this program; if not, write to the Free Software +
+ + 021  ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, +
+ + 022  ;;;; USA. +
+ + 023  ;;;; +
+ + 024  ;;;; Copyright (C) 2014 Simon Brooke +
+ + 025  ;;;; +
+ + 026  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 027   +
+ + 028   +
+ + 029  (defn suitable-fragment? +
+ + 030    "Return `true` if `tree-fragment` appears to be a tree fragment of the expected `type`." +
+ + 031    [tree-fragment type] +
+ + 032    (and (coll? tree-fragment) +
+ + 033         (keyword? type) +
+ + 034         (= (first tree-fragment) type))) +
+ + 035   +
+ + 036  (defn rule? +
+ + 037    "Return true if the argument appears to be a parsed rule tree, else false." +
+ + 038    [maybe-rule] +
+ + 039    (suitable-fragment? maybe-rule :RULE)) +
+ + 040   +
+ + 041  (defn TODO +
+ + 042    "Marker to indicate I'm not yet finished!" +
+ + 043    [message] +
+ + 044    message) +
+ + 045   +
+ + 046   +
+ + 047   +
+ + 048  (defn assert-type +
+ + 049    "If `tree-fragment` is not a tree fragment of the expected `type`, throw an exception." +
+ + 050    [tree-fragment type] +
+ + 051    (assert (suitable-fragment? tree-fragment type) +
+ + 052            (throw (Exception. (format "Expected a %s fragment" type))))) +
+ + 053   +
+ + 054   +
+ + 055  (defn search-tree +
+ + 056    "Return the first element of this tree which has this tag in a depth-first, left-to-right search" +
+ + 057    [tree tag] +
+ + 058    (cond  +
+ + 059      (= (first tree) tag) tree +
+ + 060      :else (first +
+ + 061              (remove nil? +
+ + 062                      (map +
+ + 063                        #(search-tree % tag) +
+ + 064                        (filter coll? (rest tree))))))) +
+ + diff --git a/docs/codox/css/default.css b/docs/codox/css/default.css new file mode 100644 index 0000000..33f78fe --- /dev/null +++ b/docs/codox/css/default.css @@ -0,0 +1,551 @@ +body { + font-family: Helvetica, Arial, sans-serif; + font-size: 15px; +} + +pre, code { + font-family: Monaco, DejaVu Sans Mono, Consolas, monospace; + font-size: 9pt; + margin: 15px 0; +} + +h1 { + font-weight: normal; + font-size: 29px; + margin: 10px 0 2px 0; + padding: 0; +} + +h2 { + font-weight: normal; + font-size: 25px; +} + +h5.license { + margin: 9px 0 22px 0; + color: #555; + font-weight: normal; + font-size: 12px; + font-style: italic; +} + +.document h1, .namespace-index h1 { + font-size: 32px; + margin-top: 12px; +} + +#header, #content, .sidebar { + position: fixed; +} + +#header { + top: 0; + left: 0; + right: 0; + height: 22px; + color: #f5f5f5; + padding: 5px 7px; +} + +#content { + top: 32px; + right: 0; + bottom: 0; + overflow: auto; + background: #fff; + color: #333; + padding: 0 18px; +} + +.sidebar { + position: fixed; + top: 32px; + bottom: 0; + overflow: auto; +} + +.sidebar.primary { + background: #e2e2e2; + border-right: solid 1px #cccccc; + left: 0; + width: 250px; +} + +.sidebar.secondary { + background: #f2f2f2; + border-right: solid 1px #d7d7d7; + left: 251px; + width: 200px; +} + +#content.namespace-index, #content.document { + left: 251px; +} + +#content.namespace-docs { + left: 452px; +} + +#content.document { + padding-bottom: 10%; +} + +#header { + background: #3f3f3f; + box-shadow: 0 0 8px rgba(0, 0, 0, 0.4); + z-index: 100; +} + +#header h1 { + margin: 0; + padding: 0; + font-size: 18px; + font-weight: lighter; + text-shadow: -1px -1px 0px #333; +} + +#header h1 .project-version { + font-weight: normal; +} + +.project-version { + padding-left: 0.15em; +} + +#header a, .sidebar a { + display: block; + text-decoration: none; +} + +#header a { + color: #f5f5f5; +} + +.sidebar a { + color: #333; +} + +#header h2 { + float: right; + font-size: 9pt; + font-weight: normal; + margin: 4px 3px; + padding: 0; + color: #bbb; +} + +#header h2 a { + display: inline; +} + +.sidebar h3 { + margin: 0; + padding: 10px 13px 0 13px; + font-size: 19px; + font-weight: lighter; +} + +.sidebar h3 a { + color: #444; +} + +.sidebar h3.no-link { + color: #636363; +} + +.sidebar ul { + padding: 7px 0 6px 0; + margin: 0; +} + +.sidebar ul.index-link { + padding-bottom: 4px; +} + +.sidebar li { + display: block; + vertical-align: middle; +} + +.sidebar li a, .sidebar li .no-link { + border-left: 3px solid transparent; + padding: 0 10px; + white-space: nowrap; +} + +.sidebar li .no-link { + display: block; + color: #777; + font-style: italic; +} + +.sidebar li .inner { + display: inline-block; + padding-top: 7px; + height: 24px; +} + +.sidebar li a, .sidebar li .tree { + height: 31px; +} + +.depth-1 .inner { padding-left: 2px; } +.depth-2 .inner { padding-left: 6px; } +.depth-3 .inner { padding-left: 20px; } +.depth-4 .inner { padding-left: 34px; } +.depth-5 .inner { padding-left: 48px; } +.depth-6 .inner { padding-left: 62px; } + +.sidebar li .tree { + display: block; + float: left; + position: relative; + top: -10px; + margin: 0 4px 0 0; + padding: 0; +} + +.sidebar li.depth-1 .tree { + display: none; +} + +.sidebar li .tree .top, .sidebar li .tree .bottom { + display: block; + margin: 0; + padding: 0; + width: 7px; +} + +.sidebar li .tree .top { + border-left: 1px solid #aaa; + border-bottom: 1px solid #aaa; + height: 19px; +} + +.sidebar li .tree .bottom { + height: 22px; +} + +.sidebar li.branch .tree .bottom { + border-left: 1px solid #aaa; +} + +.sidebar.primary li.current a { + border-left: 3px solid #a33; + color: #a33; +} + +.sidebar.secondary li.current a { + border-left: 3px solid #33a; + color: #33a; +} + +.namespace-index h2 { + margin: 30px 0 0 0; +} + +.namespace-index h3 { + font-size: 16px; + font-weight: bold; + margin-bottom: 0; +} + +.namespace-index .topics { + padding-left: 30px; + margin: 11px 0 0 0; +} + +.namespace-index .topics li { + padding: 5px 0; +} + +.namespace-docs h3 { + font-size: 18px; + font-weight: bold; +} + +.public h3 { + margin: 0; + float: left; +} + +.usage { + clear: both; +} + +.public { + margin: 0; + border-top: 1px solid #e0e0e0; + padding-top: 14px; + padding-bottom: 6px; +} + +.public:last-child { + margin-bottom: 20%; +} + +.members .public:last-child { + margin-bottom: 0; +} + +.members { + margin: 15px 0; +} + +.members h4 { + color: #555; + font-weight: normal; + font-variant: small-caps; + margin: 0 0 5px 0; +} + +.members .inner { + padding-top: 5px; + padding-left: 12px; + margin-top: 2px; + margin-left: 7px; + border-left: 1px solid #bbb; +} + +#content .members .inner h3 { + font-size: 12pt; +} + +.members .public { + border-top: none; + margin-top: 0; + padding-top: 6px; + padding-bottom: 0; +} + +.members .public:first-child { + padding-top: 0; +} + +h4.type, +h4.dynamic, +h4.added, +h4.deprecated { + float: left; + margin: 3px 10px 15px 0; + font-size: 15px; + font-weight: bold; + font-variant: small-caps; +} + +.public h4.type, +.public h4.dynamic, +.public h4.added, +.public h4.deprecated { + font-size: 13px; + font-weight: bold; + margin: 3px 0 0 10px; +} + +.members h4.type, +.members h4.added, +.members h4.deprecated { + margin-top: 1px; +} + +h4.type { + color: #717171; +} + +h4.dynamic { + color: #9933aa; +} + +h4.added { + color: #508820; +} + +h4.deprecated { + color: #880000; +} + +.namespace { + margin-bottom: 30px; +} + +.namespace:last-child { + margin-bottom: 10%; +} + +.index { + padding: 0; + font-size: 80%; + margin: 15px 0; + line-height: 16px; +} + +.index * { + display: inline; +} + +.index p { + padding-right: 3px; +} + +.index li { + padding-right: 5px; +} + +.index ul { + padding-left: 0; +} + +.type-sig { + clear: both; + color: #088; +} + +.type-sig pre { + padding-top: 10px; + margin: 0; +} + +.usage code { + display: block; + color: #008; + margin: 2px 0; +} + +.usage code:first-child { + padding-top: 10px; +} + +p { + margin: 15px 0; +} + +.public p:first-child, .public pre.plaintext { + margin-top: 12px; +} + +.doc { + margin: 0 0 26px 0; + clear: both; +} + +.public .doc { + margin: 0; +} + +.namespace-index .doc { + margin-bottom: 20px; +} + +.namespace-index .namespace .doc { + margin-bottom: 10px; +} + +.markdown p, .markdown li, .markdown dt, .markdown dd, .markdown td { + line-height: 22px; +} + +.markdown li { + padding: 2px 0; +} + +.markdown h2 { + font-weight: normal; + font-size: 25px; + margin: 30px 0 10px 0; +} + +.markdown h3 { + font-weight: normal; + font-size: 20px; + margin: 30px 0 0 0; +} + +.markdown h4 { + font-size: 15px; + margin: 22px 0 -4px 0; +} + +.doc, .public, .namespace .index { + max-width: 680px; + overflow-x: visible; +} + +.markdown pre > code { + display: block; + padding: 10px; +} + +.markdown pre > code, .src-link a { + border: 1px solid #e4e4e4; + border-radius: 2px; +} + +.markdown code:not(.hljs), .src-link a { + background: #f6f6f6; +} + +pre.deps { + display: inline-block; + margin: 0 10px; + border: 1px solid #e4e4e4; + border-radius: 2px; + padding: 10px; + background-color: #f6f6f6; +} + +.markdown hr { + border-style: solid; + border-top: none; + color: #ccc; +} + +.doc ul, .doc ol { + padding-left: 30px; +} + +.doc table { + border-collapse: collapse; + margin: 0 10px; +} + +.doc table td, .doc table th { + border: 1px solid #dddddd; + padding: 4px 6px; +} + +.doc table th { + background: #f2f2f2; +} + +.doc dl { + margin: 0 10px 20px 10px; +} + +.doc dl dt { + font-weight: bold; + margin: 0; + padding: 3px 0; + border-bottom: 1px solid #ddd; +} + +.doc dl dd { + padding: 5px 0; + margin: 0 0 5px 10px; +} + +.doc abbr { + border-bottom: 1px dotted #333; + font-variant: none; + cursor: help; +} + +.src-link { + margin-bottom: 15px; +} + +.src-link a { + font-size: 70%; + padding: 1px 4px; + text-decoration: none; + color: #5555bb; +} diff --git a/docs/codox/css/highlight.css b/docs/codox/css/highlight.css new file mode 100644 index 0000000..d0cdaa3 --- /dev/null +++ b/docs/codox/css/highlight.css @@ -0,0 +1,97 @@ +/* +github.com style (c) Vasily Polovnyov +*/ + +.hljs { + display: block; + overflow-x: auto; + padding: 0.5em; + color: #333; + background: #f8f8f8; +} + +.hljs-comment, +.hljs-quote { + color: #998; + font-style: italic; +} + +.hljs-keyword, +.hljs-selector-tag, +.hljs-subst { + color: #333; + font-weight: bold; +} + +.hljs-number, +.hljs-literal, +.hljs-variable, +.hljs-template-variable, +.hljs-tag .hljs-attr { + color: #008080; +} + +.hljs-string, +.hljs-doctag { + color: #d14; +} + +.hljs-title, +.hljs-section, +.hljs-selector-id { + color: #900; + font-weight: bold; +} + +.hljs-subst { + font-weight: normal; +} + +.hljs-type, +.hljs-class .hljs-title { + color: #458; + font-weight: bold; +} + +.hljs-tag, +.hljs-name, +.hljs-attribute { + color: #000080; + font-weight: normal; +} + +.hljs-regexp, +.hljs-link { + color: #009926; +} + +.hljs-symbol, +.hljs-bullet { + color: #990073; +} + +.hljs-built_in, +.hljs-builtin-name { + color: #0086b3; +} + +.hljs-meta { + color: #999; + font-weight: bold; +} + +.hljs-deletion { + background: #fdd; +} + +.hljs-addition { + background: #dfd; +} + +.hljs-emphasis { + font-style: italic; +} + +.hljs-strong { + font-weight: bold; +} diff --git a/docs/codox/index.html b/docs/codox/index.html new file mode 100644 index 0000000..8e7cd0c --- /dev/null +++ b/docs/codox/index.html @@ -0,0 +1,11 @@ + +Mw-parser 0.2.0-SNAPSHOT

Project

Topics

Namespaces

Mw-parser 0.2.0-SNAPSHOT

Released under the GNU General Public License v2

Parser for production rules for MicroWorld engine.

Installation

To install, add the following dependency to your project or build file:

[mw-parser "0.2.0-SNAPSHOT"]

Topics

Namespaces

mw-parser.bulk

parse multiple rules from a stream, possibly a file.

+

Public variables and functions:

mw-parser.core

A very simple parser which parses production rules.

+

Public variables and functions:

mw-parser.declarative

A very simple parser which parses production rules.

+

Public variables and functions:

mw-parser.errors

Display parse errors in a format which makes it easy for the user to see where the error occurred.

+

Public variables and functions:

mw-parser.flow

A very simple parser which parses flow rules.

+

Public variables and functions:

mw-parser.generate

Generate Clojure source from simplified parse trees.

+

Public variables and functions:

mw-parser.simplify

Simplify a parse tree.

+

Public variables and functions:

mw-parser.utils

Utilities used in more than one namespace within the parser.

+

Public variables and functions:

\ No newline at end of file diff --git a/docs/codox/intro.html b/docs/codox/intro.html new file mode 100644 index 0000000..a6a5191 --- /dev/null +++ b/docs/codox/intro.html @@ -0,0 +1,5 @@ + +Introduction to mw-parser

Project

Topics

Namespaces

Introduction to mw-parser

+

TODO: write great documentation

+
\ No newline at end of file diff --git a/docs/codox/js/highlight.min.js b/docs/codox/js/highlight.min.js new file mode 100644 index 0000000..6486ffd --- /dev/null +++ b/docs/codox/js/highlight.min.js @@ -0,0 +1,2 @@ +/*! highlight.js v9.6.0 | BSD3 License | git.io/hljslicense */ +!function(e){var n="object"==typeof window&&window||"object"==typeof self&&self;"undefined"!=typeof exports?e(exports):n&&(n.hljs=e({}),"function"==typeof define&&define.amd&&define([],function(){return n.hljs}))}(function(e){function n(e){return e.replace(/[&<>]/gm,function(e){return I[e]})}function t(e){return e.nodeName.toLowerCase()}function r(e,n){var t=e&&e.exec(n);return t&&0===t.index}function a(e){return k.test(e)}function i(e){var n,t,r,i,o=e.className+" ";if(o+=e.parentNode?e.parentNode.className:"",t=B.exec(o))return R(t[1])?t[1]:"no-highlight";for(o=o.split(/\s+/),n=0,r=o.length;r>n;n++)if(i=o[n],a(i)||R(i))return i}function o(e,n){var t,r={};for(t in e)r[t]=e[t];if(n)for(t in n)r[t]=n[t];return r}function u(e){var n=[];return function r(e,a){for(var i=e.firstChild;i;i=i.nextSibling)3===i.nodeType?a+=i.nodeValue.length:1===i.nodeType&&(n.push({event:"start",offset:a,node:i}),a=r(i,a),t(i).match(/br|hr|img|input/)||n.push({event:"stop",offset:a,node:i}));return a}(e,0),n}function c(e,r,a){function i(){return e.length&&r.length?e[0].offset!==r[0].offset?e[0].offset"}function u(e){l+=""}function c(e){("start"===e.event?o:u)(e.node)}for(var s=0,l="",f=[];e.length||r.length;){var g=i();if(l+=n(a.substr(s,g[0].offset-s)),s=g[0].offset,g===e){f.reverse().forEach(u);do c(g.splice(0,1)[0]),g=i();while(g===e&&g.length&&g[0].offset===s);f.reverse().forEach(o)}else"start"===g[0].event?f.push(g[0].node):f.pop(),c(g.splice(0,1)[0])}return l+n(a.substr(s))}function s(e){function n(e){return e&&e.source||e}function t(t,r){return new RegExp(n(t),"m"+(e.cI?"i":"")+(r?"g":""))}function r(a,i){if(!a.compiled){if(a.compiled=!0,a.k=a.k||a.bK,a.k){var u={},c=function(n,t){e.cI&&(t=t.toLowerCase()),t.split(" ").forEach(function(e){var t=e.split("|");u[t[0]]=[n,t[1]?Number(t[1]):1]})};"string"==typeof a.k?c("keyword",a.k):E(a.k).forEach(function(e){c(e,a.k[e])}),a.k=u}a.lR=t(a.l||/\w+/,!0),i&&(a.bK&&(a.b="\\b("+a.bK.split(" ").join("|")+")\\b"),a.b||(a.b=/\B|\b/),a.bR=t(a.b),a.e||a.eW||(a.e=/\B|\b/),a.e&&(a.eR=t(a.e)),a.tE=n(a.e)||"",a.eW&&i.tE&&(a.tE+=(a.e?"|":"")+i.tE)),a.i&&(a.iR=t(a.i)),null==a.r&&(a.r=1),a.c||(a.c=[]);var s=[];a.c.forEach(function(e){e.v?e.v.forEach(function(n){s.push(o(e,n))}):s.push("self"===e?a:e)}),a.c=s,a.c.forEach(function(e){r(e,a)}),a.starts&&r(a.starts,i);var l=a.c.map(function(e){return e.bK?"\\.?("+e.b+")\\.?":e.b}).concat([a.tE,a.i]).map(n).filter(Boolean);a.t=l.length?t(l.join("|"),!0):{exec:function(){return null}}}}r(e)}function l(e,t,a,i){function o(e,n){var t,a;for(t=0,a=n.c.length;a>t;t++)if(r(n.c[t].bR,e))return n.c[t]}function u(e,n){if(r(e.eR,n)){for(;e.endsParent&&e.parent;)e=e.parent;return e}return e.eW?u(e.parent,n):void 0}function c(e,n){return!a&&r(n.iR,e)}function g(e,n){var t=N.cI?n[0].toLowerCase():n[0];return e.k.hasOwnProperty(t)&&e.k[t]}function h(e,n,t,r){var a=r?"":y.classPrefix,i='',i+n+o}function p(){var e,t,r,a;if(!E.k)return n(B);for(a="",t=0,E.lR.lastIndex=0,r=E.lR.exec(B);r;)a+=n(B.substr(t,r.index-t)),e=g(E,r),e?(M+=e[1],a+=h(e[0],n(r[0]))):a+=n(r[0]),t=E.lR.lastIndex,r=E.lR.exec(B);return a+n(B.substr(t))}function d(){var e="string"==typeof E.sL;if(e&&!x[E.sL])return n(B);var t=e?l(E.sL,B,!0,L[E.sL]):f(B,E.sL.length?E.sL:void 0);return E.r>0&&(M+=t.r),e&&(L[E.sL]=t.top),h(t.language,t.value,!1,!0)}function b(){k+=null!=E.sL?d():p(),B=""}function v(e){k+=e.cN?h(e.cN,"",!0):"",E=Object.create(e,{parent:{value:E}})}function m(e,n){if(B+=e,null==n)return b(),0;var t=o(n,E);if(t)return t.skip?B+=n:(t.eB&&(B+=n),b(),t.rB||t.eB||(B=n)),v(t,n),t.rB?0:n.length;var r=u(E,n);if(r){var a=E;a.skip?B+=n:(a.rE||a.eE||(B+=n),b(),a.eE&&(B=n));do E.cN&&(k+=C),E.skip||(M+=E.r),E=E.parent;while(E!==r.parent);return r.starts&&v(r.starts,""),a.rE?0:n.length}if(c(n,E))throw new Error('Illegal lexeme "'+n+'" for mode "'+(E.cN||"")+'"');return B+=n,n.length||1}var N=R(e);if(!N)throw new Error('Unknown language: "'+e+'"');s(N);var w,E=i||N,L={},k="";for(w=E;w!==N;w=w.parent)w.cN&&(k=h(w.cN,"",!0)+k);var B="",M=0;try{for(var I,j,O=0;;){if(E.t.lastIndex=O,I=E.t.exec(t),!I)break;j=m(t.substr(O,I.index-O),I[0]),O=I.index+j}for(m(t.substr(O)),w=E;w.parent;w=w.parent)w.cN&&(k+=C);return{r:M,value:k,language:e,top:E}}catch(T){if(T.message&&-1!==T.message.indexOf("Illegal"))return{r:0,value:n(t)};throw T}}function f(e,t){t=t||y.languages||E(x);var r={r:0,value:n(e)},a=r;return t.filter(R).forEach(function(n){var t=l(n,e,!1);t.language=n,t.r>a.r&&(a=t),t.r>r.r&&(a=r,r=t)}),a.language&&(r.second_best=a),r}function g(e){return y.tabReplace||y.useBR?e.replace(M,function(e,n){return y.useBR&&"\n"===e?"
":y.tabReplace?n.replace(/\t/g,y.tabReplace):void 0}):e}function h(e,n,t){var r=n?L[n]:t,a=[e.trim()];return e.match(/\bhljs\b/)||a.push("hljs"),-1===e.indexOf(r)&&a.push(r),a.join(" ").trim()}function p(e){var n,t,r,o,s,p=i(e);a(p)||(y.useBR?(n=document.createElementNS("http://www.w3.org/1999/xhtml","div"),n.innerHTML=e.innerHTML.replace(/\n/g,"").replace(//g,"\n")):n=e,s=n.textContent,r=p?l(p,s,!0):f(s),t=u(n),t.length&&(o=document.createElementNS("http://www.w3.org/1999/xhtml","div"),o.innerHTML=r.value,r.value=c(t,u(o),s)),r.value=g(r.value),e.innerHTML=r.value,e.className=h(e.className,p,r.language),e.result={language:r.language,re:r.r},r.second_best&&(e.second_best={language:r.second_best.language,re:r.second_best.r}))}function d(e){y=o(y,e)}function b(){if(!b.called){b.called=!0;var e=document.querySelectorAll("pre code");w.forEach.call(e,p)}}function v(){addEventListener("DOMContentLoaded",b,!1),addEventListener("load",b,!1)}function m(n,t){var r=x[n]=t(e);r.aliases&&r.aliases.forEach(function(e){L[e]=n})}function N(){return E(x)}function R(e){return e=(e||"").toLowerCase(),x[e]||x[L[e]]}var w=[],E=Object.keys,x={},L={},k=/^(no-?highlight|plain|text)$/i,B=/\blang(?:uage)?-([\w-]+)\b/i,M=/((^(<[^>]+>|\t|)+|(?:\n)))/gm,C="",y={classPrefix:"hljs-",tabReplace:null,useBR:!1,languages:void 0},I={"&":"&","<":"<",">":">"};return e.highlight=l,e.highlightAuto=f,e.fixMarkup=g,e.highlightBlock=p,e.configure=d,e.initHighlighting=b,e.initHighlightingOnLoad=v,e.registerLanguage=m,e.listLanguages=N,e.getLanguage=R,e.inherit=o,e.IR="[a-zA-Z]\\w*",e.UIR="[a-zA-Z_]\\w*",e.NR="\\b\\d+(\\.\\d+)?",e.CNR="(-?)(\\b0[xX][a-fA-F0-9]+|(\\b\\d+(\\.\\d*)?|\\.\\d+)([eE][-+]?\\d+)?)",e.BNR="\\b(0b[01]+)",e.RSR="!|!=|!==|%|%=|&|&&|&=|\\*|\\*=|\\+|\\+=|,|-|-=|/=|/|:|;|<<|<<=|<=|<|===|==|=|>>>=|>>=|>=|>>>|>>|>|\\?|\\[|\\{|\\(|\\^|\\^=|\\||\\|=|\\|\\||~",e.BE={b:"\\\\[\\s\\S]",r:0},e.ASM={cN:"string",b:"'",e:"'",i:"\\n",c:[e.BE]},e.QSM={cN:"string",b:'"',e:'"',i:"\\n",c:[e.BE]},e.PWM={b:/\b(a|an|the|are|I'm|isn't|don't|doesn't|won't|but|just|should|pretty|simply|enough|gonna|going|wtf|so|such|will|you|your|like)\b/},e.C=function(n,t,r){var a=e.inherit({cN:"comment",b:n,e:t,c:[]},r||{});return a.c.push(e.PWM),a.c.push({cN:"doctag",b:"(?:TODO|FIXME|NOTE|BUG|XXX):",r:0}),a},e.CLCM=e.C("//","$"),e.CBCM=e.C("/\\*","\\*/"),e.HCM=e.C("#","$"),e.NM={cN:"number",b:e.NR,r:0},e.CNM={cN:"number",b:e.CNR,r:0},e.BNM={cN:"number",b:e.BNR,r:0},e.CSSNM={cN:"number",b:e.NR+"(%|em|ex|ch|rem|vw|vh|vmin|vmax|cm|mm|in|pt|pc|px|deg|grad|rad|turn|s|ms|Hz|kHz|dpi|dpcm|dppx)?",r:0},e.RM={cN:"regexp",b:/\//,e:/\/[gimuy]*/,i:/\n/,c:[e.BE,{b:/\[/,e:/\]/,r:0,c:[e.BE]}]},e.TM={cN:"title",b:e.IR,r:0},e.UTM={cN:"title",b:e.UIR,r:0},e.METHOD_GUARD={b:"\\.\\s*"+e.UIR,r:0},e});hljs.registerLanguage("clojure",function(e){var t={"builtin-name":"def defonce cond apply if-not if-let if not not= = < > <= >= == + / * - rem quot neg? pos? delay? symbol? keyword? true? false? integer? empty? coll? list? set? ifn? fn? associative? sequential? sorted? counted? reversible? number? decimal? class? distinct? isa? float? rational? reduced? ratio? odd? even? char? seq? vector? string? map? nil? contains? zero? instance? not-every? not-any? libspec? -> ->> .. . inc compare do dotimes mapcat take remove take-while drop letfn drop-last take-last drop-while while intern condp case reduced cycle split-at split-with repeat replicate iterate range merge zipmap declare line-seq sort comparator sort-by dorun doall nthnext nthrest partition eval doseq await await-for let agent atom send send-off release-pending-sends add-watch mapv filterv remove-watch agent-error restart-agent set-error-handler error-handler set-error-mode! error-mode shutdown-agents quote var fn loop recur throw try monitor-enter monitor-exit defmacro defn defn- macroexpand macroexpand-1 for dosync and or when when-not when-let comp juxt partial sequence memoize constantly complement identity assert peek pop doto proxy defstruct first rest cons defprotocol cast coll deftype defrecord last butlast sigs reify second ffirst fnext nfirst nnext defmulti defmethod meta with-meta ns in-ns create-ns import refer keys select-keys vals key val rseq name namespace promise into transient persistent! conj! assoc! dissoc! pop! disj! use class type num float double short byte boolean bigint biginteger bigdec print-method print-dup throw-if printf format load compile get-in update-in pr pr-on newline flush read slurp read-line subvec with-open memfn time re-find re-groups rand-int rand mod locking assert-valid-fdecl alias resolve ref deref refset swap! reset! set-validator! compare-and-set! alter-meta! reset-meta! commute get-validator alter ref-set ref-history-count ref-min-history ref-max-history ensure sync io! new next conj set! to-array future future-call into-array aset gen-class reduce map filter find empty hash-map hash-set sorted-map sorted-map-by sorted-set sorted-set-by vec vector seq flatten reverse assoc dissoc list disj get union difference intersection extend extend-type extend-protocol int nth delay count concat chunk chunk-buffer chunk-append chunk-first chunk-rest max min dec unchecked-inc-int unchecked-inc unchecked-dec-inc unchecked-dec unchecked-negate unchecked-add-int unchecked-add unchecked-subtract-int unchecked-subtract chunk-next chunk-cons chunked-seq? prn vary-meta lazy-seq spread list* str find-keyword keyword symbol gensym force rationalize"},r="a-zA-Z_\\-!.?+*=<>&#'",n="["+r+"]["+r+"0-9/;:]*",a="[-+]?\\d+(\\.\\d+)?",o={b:n,r:0},s={cN:"number",b:a,r:0},i=e.inherit(e.QSM,{i:null}),c=e.C(";","$",{r:0}),d={cN:"literal",b:/\b(true|false|nil)\b/},l={b:"[\\[\\{]",e:"[\\]\\}]"},m={cN:"comment",b:"\\^"+n},p=e.C("\\^\\{","\\}"),u={cN:"symbol",b:"[:]{1,2}"+n},f={b:"\\(",e:"\\)"},h={eW:!0,r:0},y={k:t,l:n,cN:"name",b:n,starts:h},b=[f,i,m,p,c,u,l,s,d,o];return f.c=[e.C("comment",""),y,h],h.c=b,l.c=b,{aliases:["clj"],i:/\S/,c:[f,i,m,p,c,u,l,s,d]}});hljs.registerLanguage("clojure-repl",function(e){return{c:[{cN:"meta",b:/^([\w.-]+|\s*#_)=>/,starts:{e:/$/,sL:"clojure"}}]}}); \ No newline at end of file diff --git a/docs/codox/js/jquery.min.js b/docs/codox/js/jquery.min.js new file mode 100644 index 0000000..73f33fb --- /dev/null +++ b/docs/codox/js/jquery.min.js @@ -0,0 +1,4 @@ +/*! jQuery v1.11.0 | (c) 2005, 2014 jQuery Foundation, Inc. | jquery.org/license */ +!function(a,b){"object"==typeof module&&"object"==typeof module.exports?module.exports=a.document?b(a,!0):function(a){if(!a.document)throw new Error("jQuery requires a window with a document");return b(a)}:b(a)}("undefined"!=typeof window?window:this,function(a,b){var c=[],d=c.slice,e=c.concat,f=c.push,g=c.indexOf,h={},i=h.toString,j=h.hasOwnProperty,k="".trim,l={},m="1.11.0",n=function(a,b){return new n.fn.init(a,b)},o=/^[\s\uFEFF\xA0]+|[\s\uFEFF\xA0]+$/g,p=/^-ms-/,q=/-([\da-z])/gi,r=function(a,b){return b.toUpperCase()};n.fn=n.prototype={jquery:m,constructor:n,selector:"",length:0,toArray:function(){return d.call(this)},get:function(a){return null!=a?0>a?this[a+this.length]:this[a]:d.call(this)},pushStack:function(a){var b=n.merge(this.constructor(),a);return b.prevObject=this,b.context=this.context,b},each:function(a,b){return n.each(this,a,b)},map:function(a){return this.pushStack(n.map(this,function(b,c){return a.call(b,c,b)}))},slice:function(){return this.pushStack(d.apply(this,arguments))},first:function(){return this.eq(0)},last:function(){return this.eq(-1)},eq:function(a){var b=this.length,c=+a+(0>a?b:0);return this.pushStack(c>=0&&b>c?[this[c]]:[])},end:function(){return this.prevObject||this.constructor(null)},push:f,sort:c.sort,splice:c.splice},n.extend=n.fn.extend=function(){var a,b,c,d,e,f,g=arguments[0]||{},h=1,i=arguments.length,j=!1;for("boolean"==typeof g&&(j=g,g=arguments[h]||{},h++),"object"==typeof g||n.isFunction(g)||(g={}),h===i&&(g=this,h--);i>h;h++)if(null!=(e=arguments[h]))for(d in e)a=g[d],c=e[d],g!==c&&(j&&c&&(n.isPlainObject(c)||(b=n.isArray(c)))?(b?(b=!1,f=a&&n.isArray(a)?a:[]):f=a&&n.isPlainObject(a)?a:{},g[d]=n.extend(j,f,c)):void 0!==c&&(g[d]=c));return g},n.extend({expando:"jQuery"+(m+Math.random()).replace(/\D/g,""),isReady:!0,error:function(a){throw new Error(a)},noop:function(){},isFunction:function(a){return"function"===n.type(a)},isArray:Array.isArray||function(a){return"array"===n.type(a)},isWindow:function(a){return null!=a&&a==a.window},isNumeric:function(a){return a-parseFloat(a)>=0},isEmptyObject:function(a){var b;for(b in a)return!1;return!0},isPlainObject:function(a){var b;if(!a||"object"!==n.type(a)||a.nodeType||n.isWindow(a))return!1;try{if(a.constructor&&!j.call(a,"constructor")&&!j.call(a.constructor.prototype,"isPrototypeOf"))return!1}catch(c){return!1}if(l.ownLast)for(b in a)return j.call(a,b);for(b in a);return void 0===b||j.call(a,b)},type:function(a){return null==a?a+"":"object"==typeof a||"function"==typeof a?h[i.call(a)]||"object":typeof a},globalEval:function(b){b&&n.trim(b)&&(a.execScript||function(b){a.eval.call(a,b)})(b)},camelCase:function(a){return a.replace(p,"ms-").replace(q,r)},nodeName:function(a,b){return a.nodeName&&a.nodeName.toLowerCase()===b.toLowerCase()},each:function(a,b,c){var d,e=0,f=a.length,g=s(a);if(c){if(g){for(;f>e;e++)if(d=b.apply(a[e],c),d===!1)break}else for(e in a)if(d=b.apply(a[e],c),d===!1)break}else if(g){for(;f>e;e++)if(d=b.call(a[e],e,a[e]),d===!1)break}else for(e in a)if(d=b.call(a[e],e,a[e]),d===!1)break;return a},trim:k&&!k.call("\ufeff\xa0")?function(a){return null==a?"":k.call(a)}:function(a){return null==a?"":(a+"").replace(o,"")},makeArray:function(a,b){var c=b||[];return null!=a&&(s(Object(a))?n.merge(c,"string"==typeof a?[a]:a):f.call(c,a)),c},inArray:function(a,b,c){var d;if(b){if(g)return g.call(b,a,c);for(d=b.length,c=c?0>c?Math.max(0,d+c):c:0;d>c;c++)if(c in b&&b[c]===a)return c}return-1},merge:function(a,b){var c=+b.length,d=0,e=a.length;while(c>d)a[e++]=b[d++];if(c!==c)while(void 0!==b[d])a[e++]=b[d++];return a.length=e,a},grep:function(a,b,c){for(var d,e=[],f=0,g=a.length,h=!c;g>f;f++)d=!b(a[f],f),d!==h&&e.push(a[f]);return e},map:function(a,b,c){var d,f=0,g=a.length,h=s(a),i=[];if(h)for(;g>f;f++)d=b(a[f],f,c),null!=d&&i.push(d);else for(f in a)d=b(a[f],f,c),null!=d&&i.push(d);return e.apply([],i)},guid:1,proxy:function(a,b){var c,e,f;return"string"==typeof b&&(f=a[b],b=a,a=f),n.isFunction(a)?(c=d.call(arguments,2),e=function(){return a.apply(b||this,c.concat(d.call(arguments)))},e.guid=a.guid=a.guid||n.guid++,e):void 0},now:function(){return+new Date},support:l}),n.each("Boolean Number String Function Array Date RegExp Object Error".split(" "),function(a,b){h["[object "+b+"]"]=b.toLowerCase()});function s(a){var b=a.length,c=n.type(a);return"function"===c||n.isWindow(a)?!1:1===a.nodeType&&b?!0:"array"===c||0===b||"number"==typeof b&&b>0&&b-1 in a}var t=function(a){var b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s="sizzle"+-new Date,t=a.document,u=0,v=0,w=eb(),x=eb(),y=eb(),z=function(a,b){return a===b&&(j=!0),0},A="undefined",B=1<<31,C={}.hasOwnProperty,D=[],E=D.pop,F=D.push,G=D.push,H=D.slice,I=D.indexOf||function(a){for(var b=0,c=this.length;c>b;b++)if(this[b]===a)return b;return-1},J="checked|selected|async|autofocus|autoplay|controls|defer|disabled|hidden|ismap|loop|multiple|open|readonly|required|scoped",K="[\\x20\\t\\r\\n\\f]",L="(?:\\\\.|[\\w-]|[^\\x00-\\xa0])+",M=L.replace("w","w#"),N="\\["+K+"*("+L+")"+K+"*(?:([*^$|!~]?=)"+K+"*(?:(['\"])((?:\\\\.|[^\\\\])*?)\\3|("+M+")|)|)"+K+"*\\]",O=":("+L+")(?:\\(((['\"])((?:\\\\.|[^\\\\])*?)\\3|((?:\\\\.|[^\\\\()[\\]]|"+N.replace(3,8)+")*)|.*)\\)|)",P=new RegExp("^"+K+"+|((?:^|[^\\\\])(?:\\\\.)*)"+K+"+$","g"),Q=new RegExp("^"+K+"*,"+K+"*"),R=new RegExp("^"+K+"*([>+~]|"+K+")"+K+"*"),S=new RegExp("="+K+"*([^\\]'\"]*?)"+K+"*\\]","g"),T=new RegExp(O),U=new RegExp("^"+M+"$"),V={ID:new RegExp("^#("+L+")"),CLASS:new RegExp("^\\.("+L+")"),TAG:new RegExp("^("+L.replace("w","w*")+")"),ATTR:new RegExp("^"+N),PSEUDO:new RegExp("^"+O),CHILD:new RegExp("^:(only|first|last|nth|nth-last)-(child|of-type)(?:\\("+K+"*(even|odd|(([+-]|)(\\d*)n|)"+K+"*(?:([+-]|)"+K+"*(\\d+)|))"+K+"*\\)|)","i"),bool:new RegExp("^(?:"+J+")$","i"),needsContext:new RegExp("^"+K+"*[>+~]|:(even|odd|eq|gt|lt|nth|first|last)(?:\\("+K+"*((?:-\\d)?\\d*)"+K+"*\\)|)(?=[^-]|$)","i")},W=/^(?:input|select|textarea|button)$/i,X=/^h\d$/i,Y=/^[^{]+\{\s*\[native \w/,Z=/^(?:#([\w-]+)|(\w+)|\.([\w-]+))$/,$=/[+~]/,_=/'|\\/g,ab=new RegExp("\\\\([\\da-f]{1,6}"+K+"?|("+K+")|.)","ig"),bb=function(a,b,c){var d="0x"+b-65536;return d!==d||c?b:0>d?String.fromCharCode(d+65536):String.fromCharCode(d>>10|55296,1023&d|56320)};try{G.apply(D=H.call(t.childNodes),t.childNodes),D[t.childNodes.length].nodeType}catch(cb){G={apply:D.length?function(a,b){F.apply(a,H.call(b))}:function(a,b){var c=a.length,d=0;while(a[c++]=b[d++]);a.length=c-1}}}function db(a,b,d,e){var f,g,h,i,j,m,p,q,u,v;if((b?b.ownerDocument||b:t)!==l&&k(b),b=b||l,d=d||[],!a||"string"!=typeof a)return d;if(1!==(i=b.nodeType)&&9!==i)return[];if(n&&!e){if(f=Z.exec(a))if(h=f[1]){if(9===i){if(g=b.getElementById(h),!g||!g.parentNode)return d;if(g.id===h)return d.push(g),d}else if(b.ownerDocument&&(g=b.ownerDocument.getElementById(h))&&r(b,g)&&g.id===h)return d.push(g),d}else{if(f[2])return G.apply(d,b.getElementsByTagName(a)),d;if((h=f[3])&&c.getElementsByClassName&&b.getElementsByClassName)return G.apply(d,b.getElementsByClassName(h)),d}if(c.qsa&&(!o||!o.test(a))){if(q=p=s,u=b,v=9===i&&a,1===i&&"object"!==b.nodeName.toLowerCase()){m=ob(a),(p=b.getAttribute("id"))?q=p.replace(_,"\\$&"):b.setAttribute("id",q),q="[id='"+q+"'] ",j=m.length;while(j--)m[j]=q+pb(m[j]);u=$.test(a)&&mb(b.parentNode)||b,v=m.join(",")}if(v)try{return G.apply(d,u.querySelectorAll(v)),d}catch(w){}finally{p||b.removeAttribute("id")}}}return xb(a.replace(P,"$1"),b,d,e)}function eb(){var a=[];function b(c,e){return a.push(c+" ")>d.cacheLength&&delete b[a.shift()],b[c+" "]=e}return b}function fb(a){return a[s]=!0,a}function gb(a){var b=l.createElement("div");try{return!!a(b)}catch(c){return!1}finally{b.parentNode&&b.parentNode.removeChild(b),b=null}}function hb(a,b){var c=a.split("|"),e=a.length;while(e--)d.attrHandle[c[e]]=b}function ib(a,b){var c=b&&a,d=c&&1===a.nodeType&&1===b.nodeType&&(~b.sourceIndex||B)-(~a.sourceIndex||B);if(d)return d;if(c)while(c=c.nextSibling)if(c===b)return-1;return a?1:-1}function jb(a){return function(b){var c=b.nodeName.toLowerCase();return"input"===c&&b.type===a}}function kb(a){return function(b){var c=b.nodeName.toLowerCase();return("input"===c||"button"===c)&&b.type===a}}function lb(a){return fb(function(b){return b=+b,fb(function(c,d){var e,f=a([],c.length,b),g=f.length;while(g--)c[e=f[g]]&&(c[e]=!(d[e]=c[e]))})})}function mb(a){return a&&typeof a.getElementsByTagName!==A&&a}c=db.support={},f=db.isXML=function(a){var b=a&&(a.ownerDocument||a).documentElement;return b?"HTML"!==b.nodeName:!1},k=db.setDocument=function(a){var b,e=a?a.ownerDocument||a:t,g=e.defaultView;return e!==l&&9===e.nodeType&&e.documentElement?(l=e,m=e.documentElement,n=!f(e),g&&g!==g.top&&(g.addEventListener?g.addEventListener("unload",function(){k()},!1):g.attachEvent&&g.attachEvent("onunload",function(){k()})),c.attributes=gb(function(a){return a.className="i",!a.getAttribute("className")}),c.getElementsByTagName=gb(function(a){return a.appendChild(e.createComment("")),!a.getElementsByTagName("*").length}),c.getElementsByClassName=Y.test(e.getElementsByClassName)&&gb(function(a){return a.innerHTML="
",a.firstChild.className="i",2===a.getElementsByClassName("i").length}),c.getById=gb(function(a){return m.appendChild(a).id=s,!e.getElementsByName||!e.getElementsByName(s).length}),c.getById?(d.find.ID=function(a,b){if(typeof b.getElementById!==A&&n){var c=b.getElementById(a);return c&&c.parentNode?[c]:[]}},d.filter.ID=function(a){var b=a.replace(ab,bb);return function(a){return a.getAttribute("id")===b}}):(delete d.find.ID,d.filter.ID=function(a){var b=a.replace(ab,bb);return function(a){var c=typeof a.getAttributeNode!==A&&a.getAttributeNode("id");return c&&c.value===b}}),d.find.TAG=c.getElementsByTagName?function(a,b){return typeof b.getElementsByTagName!==A?b.getElementsByTagName(a):void 0}:function(a,b){var c,d=[],e=0,f=b.getElementsByTagName(a);if("*"===a){while(c=f[e++])1===c.nodeType&&d.push(c);return d}return f},d.find.CLASS=c.getElementsByClassName&&function(a,b){return typeof b.getElementsByClassName!==A&&n?b.getElementsByClassName(a):void 0},p=[],o=[],(c.qsa=Y.test(e.querySelectorAll))&&(gb(function(a){a.innerHTML="",a.querySelectorAll("[t^='']").length&&o.push("[*^$]="+K+"*(?:''|\"\")"),a.querySelectorAll("[selected]").length||o.push("\\["+K+"*(?:value|"+J+")"),a.querySelectorAll(":checked").length||o.push(":checked")}),gb(function(a){var b=e.createElement("input");b.setAttribute("type","hidden"),a.appendChild(b).setAttribute("name","D"),a.querySelectorAll("[name=d]").length&&o.push("name"+K+"*[*^$|!~]?="),a.querySelectorAll(":enabled").length||o.push(":enabled",":disabled"),a.querySelectorAll("*,:x"),o.push(",.*:")})),(c.matchesSelector=Y.test(q=m.webkitMatchesSelector||m.mozMatchesSelector||m.oMatchesSelector||m.msMatchesSelector))&&gb(function(a){c.disconnectedMatch=q.call(a,"div"),q.call(a,"[s!='']:x"),p.push("!=",O)}),o=o.length&&new RegExp(o.join("|")),p=p.length&&new RegExp(p.join("|")),b=Y.test(m.compareDocumentPosition),r=b||Y.test(m.contains)?function(a,b){var c=9===a.nodeType?a.documentElement:a,d=b&&b.parentNode;return a===d||!(!d||1!==d.nodeType||!(c.contains?c.contains(d):a.compareDocumentPosition&&16&a.compareDocumentPosition(d)))}:function(a,b){if(b)while(b=b.parentNode)if(b===a)return!0;return!1},z=b?function(a,b){if(a===b)return j=!0,0;var d=!a.compareDocumentPosition-!b.compareDocumentPosition;return d?d:(d=(a.ownerDocument||a)===(b.ownerDocument||b)?a.compareDocumentPosition(b):1,1&d||!c.sortDetached&&b.compareDocumentPosition(a)===d?a===e||a.ownerDocument===t&&r(t,a)?-1:b===e||b.ownerDocument===t&&r(t,b)?1:i?I.call(i,a)-I.call(i,b):0:4&d?-1:1)}:function(a,b){if(a===b)return j=!0,0;var c,d=0,f=a.parentNode,g=b.parentNode,h=[a],k=[b];if(!f||!g)return a===e?-1:b===e?1:f?-1:g?1:i?I.call(i,a)-I.call(i,b):0;if(f===g)return ib(a,b);c=a;while(c=c.parentNode)h.unshift(c);c=b;while(c=c.parentNode)k.unshift(c);while(h[d]===k[d])d++;return d?ib(h[d],k[d]):h[d]===t?-1:k[d]===t?1:0},e):l},db.matches=function(a,b){return db(a,null,null,b)},db.matchesSelector=function(a,b){if((a.ownerDocument||a)!==l&&k(a),b=b.replace(S,"='$1']"),!(!c.matchesSelector||!n||p&&p.test(b)||o&&o.test(b)))try{var d=q.call(a,b);if(d||c.disconnectedMatch||a.document&&11!==a.document.nodeType)return d}catch(e){}return db(b,l,null,[a]).length>0},db.contains=function(a,b){return(a.ownerDocument||a)!==l&&k(a),r(a,b)},db.attr=function(a,b){(a.ownerDocument||a)!==l&&k(a);var e=d.attrHandle[b.toLowerCase()],f=e&&C.call(d.attrHandle,b.toLowerCase())?e(a,b,!n):void 0;return void 0!==f?f:c.attributes||!n?a.getAttribute(b):(f=a.getAttributeNode(b))&&f.specified?f.value:null},db.error=function(a){throw new Error("Syntax error, unrecognized expression: "+a)},db.uniqueSort=function(a){var b,d=[],e=0,f=0;if(j=!c.detectDuplicates,i=!c.sortStable&&a.slice(0),a.sort(z),j){while(b=a[f++])b===a[f]&&(e=d.push(f));while(e--)a.splice(d[e],1)}return i=null,a},e=db.getText=function(a){var b,c="",d=0,f=a.nodeType;if(f){if(1===f||9===f||11===f){if("string"==typeof a.textContent)return a.textContent;for(a=a.firstChild;a;a=a.nextSibling)c+=e(a)}else if(3===f||4===f)return a.nodeValue}else while(b=a[d++])c+=e(b);return c},d=db.selectors={cacheLength:50,createPseudo:fb,match:V,attrHandle:{},find:{},relative:{">":{dir:"parentNode",first:!0}," ":{dir:"parentNode"},"+":{dir:"previousSibling",first:!0},"~":{dir:"previousSibling"}},preFilter:{ATTR:function(a){return a[1]=a[1].replace(ab,bb),a[3]=(a[4]||a[5]||"").replace(ab,bb),"~="===a[2]&&(a[3]=" "+a[3]+" "),a.slice(0,4)},CHILD:function(a){return a[1]=a[1].toLowerCase(),"nth"===a[1].slice(0,3)?(a[3]||db.error(a[0]),a[4]=+(a[4]?a[5]+(a[6]||1):2*("even"===a[3]||"odd"===a[3])),a[5]=+(a[7]+a[8]||"odd"===a[3])):a[3]&&db.error(a[0]),a},PSEUDO:function(a){var b,c=!a[5]&&a[2];return V.CHILD.test(a[0])?null:(a[3]&&void 0!==a[4]?a[2]=a[4]:c&&T.test(c)&&(b=ob(c,!0))&&(b=c.indexOf(")",c.length-b)-c.length)&&(a[0]=a[0].slice(0,b),a[2]=c.slice(0,b)),a.slice(0,3))}},filter:{TAG:function(a){var b=a.replace(ab,bb).toLowerCase();return"*"===a?function(){return!0}:function(a){return a.nodeName&&a.nodeName.toLowerCase()===b}},CLASS:function(a){var b=w[a+" "];return b||(b=new RegExp("(^|"+K+")"+a+"("+K+"|$)"))&&w(a,function(a){return b.test("string"==typeof a.className&&a.className||typeof a.getAttribute!==A&&a.getAttribute("class")||"")})},ATTR:function(a,b,c){return function(d){var e=db.attr(d,a);return null==e?"!="===b:b?(e+="","="===b?e===c:"!="===b?e!==c:"^="===b?c&&0===e.indexOf(c):"*="===b?c&&e.indexOf(c)>-1:"$="===b?c&&e.slice(-c.length)===c:"~="===b?(" "+e+" ").indexOf(c)>-1:"|="===b?e===c||e.slice(0,c.length+1)===c+"-":!1):!0}},CHILD:function(a,b,c,d,e){var f="nth"!==a.slice(0,3),g="last"!==a.slice(-4),h="of-type"===b;return 1===d&&0===e?function(a){return!!a.parentNode}:function(b,c,i){var j,k,l,m,n,o,p=f!==g?"nextSibling":"previousSibling",q=b.parentNode,r=h&&b.nodeName.toLowerCase(),t=!i&&!h;if(q){if(f){while(p){l=b;while(l=l[p])if(h?l.nodeName.toLowerCase()===r:1===l.nodeType)return!1;o=p="only"===a&&!o&&"nextSibling"}return!0}if(o=[g?q.firstChild:q.lastChild],g&&t){k=q[s]||(q[s]={}),j=k[a]||[],n=j[0]===u&&j[1],m=j[0]===u&&j[2],l=n&&q.childNodes[n];while(l=++n&&l&&l[p]||(m=n=0)||o.pop())if(1===l.nodeType&&++m&&l===b){k[a]=[u,n,m];break}}else if(t&&(j=(b[s]||(b[s]={}))[a])&&j[0]===u)m=j[1];else while(l=++n&&l&&l[p]||(m=n=0)||o.pop())if((h?l.nodeName.toLowerCase()===r:1===l.nodeType)&&++m&&(t&&((l[s]||(l[s]={}))[a]=[u,m]),l===b))break;return m-=e,m===d||m%d===0&&m/d>=0}}},PSEUDO:function(a,b){var c,e=d.pseudos[a]||d.setFilters[a.toLowerCase()]||db.error("unsupported pseudo: "+a);return e[s]?e(b):e.length>1?(c=[a,a,"",b],d.setFilters.hasOwnProperty(a.toLowerCase())?fb(function(a,c){var d,f=e(a,b),g=f.length;while(g--)d=I.call(a,f[g]),a[d]=!(c[d]=f[g])}):function(a){return e(a,0,c)}):e}},pseudos:{not:fb(function(a){var b=[],c=[],d=g(a.replace(P,"$1"));return d[s]?fb(function(a,b,c,e){var f,g=d(a,null,e,[]),h=a.length;while(h--)(f=g[h])&&(a[h]=!(b[h]=f))}):function(a,e,f){return b[0]=a,d(b,null,f,c),!c.pop()}}),has:fb(function(a){return function(b){return db(a,b).length>0}}),contains:fb(function(a){return function(b){return(b.textContent||b.innerText||e(b)).indexOf(a)>-1}}),lang:fb(function(a){return U.test(a||"")||db.error("unsupported lang: "+a),a=a.replace(ab,bb).toLowerCase(),function(b){var c;do if(c=n?b.lang:b.getAttribute("xml:lang")||b.getAttribute("lang"))return c=c.toLowerCase(),c===a||0===c.indexOf(a+"-");while((b=b.parentNode)&&1===b.nodeType);return!1}}),target:function(b){var c=a.location&&a.location.hash;return c&&c.slice(1)===b.id},root:function(a){return a===m},focus:function(a){return a===l.activeElement&&(!l.hasFocus||l.hasFocus())&&!!(a.type||a.href||~a.tabIndex)},enabled:function(a){return a.disabled===!1},disabled:function(a){return a.disabled===!0},checked:function(a){var b=a.nodeName.toLowerCase();return"input"===b&&!!a.checked||"option"===b&&!!a.selected},selected:function(a){return a.parentNode&&a.parentNode.selectedIndex,a.selected===!0},empty:function(a){for(a=a.firstChild;a;a=a.nextSibling)if(a.nodeType<6)return!1;return!0},parent:function(a){return!d.pseudos.empty(a)},header:function(a){return X.test(a.nodeName)},input:function(a){return W.test(a.nodeName)},button:function(a){var b=a.nodeName.toLowerCase();return"input"===b&&"button"===a.type||"button"===b},text:function(a){var b;return"input"===a.nodeName.toLowerCase()&&"text"===a.type&&(null==(b=a.getAttribute("type"))||"text"===b.toLowerCase())},first:lb(function(){return[0]}),last:lb(function(a,b){return[b-1]}),eq:lb(function(a,b,c){return[0>c?c+b:c]}),even:lb(function(a,b){for(var c=0;b>c;c+=2)a.push(c);return a}),odd:lb(function(a,b){for(var c=1;b>c;c+=2)a.push(c);return a}),lt:lb(function(a,b,c){for(var d=0>c?c+b:c;--d>=0;)a.push(d);return a}),gt:lb(function(a,b,c){for(var d=0>c?c+b:c;++db;b++)d+=a[b].value;return d}function qb(a,b,c){var d=b.dir,e=c&&"parentNode"===d,f=v++;return b.first?function(b,c,f){while(b=b[d])if(1===b.nodeType||e)return a(b,c,f)}:function(b,c,g){var h,i,j=[u,f];if(g){while(b=b[d])if((1===b.nodeType||e)&&a(b,c,g))return!0}else while(b=b[d])if(1===b.nodeType||e){if(i=b[s]||(b[s]={}),(h=i[d])&&h[0]===u&&h[1]===f)return j[2]=h[2];if(i[d]=j,j[2]=a(b,c,g))return!0}}}function rb(a){return a.length>1?function(b,c,d){var e=a.length;while(e--)if(!a[e](b,c,d))return!1;return!0}:a[0]}function sb(a,b,c,d,e){for(var f,g=[],h=0,i=a.length,j=null!=b;i>h;h++)(f=a[h])&&(!c||c(f,d,e))&&(g.push(f),j&&b.push(h));return g}function tb(a,b,c,d,e,f){return d&&!d[s]&&(d=tb(d)),e&&!e[s]&&(e=tb(e,f)),fb(function(f,g,h,i){var j,k,l,m=[],n=[],o=g.length,p=f||wb(b||"*",h.nodeType?[h]:h,[]),q=!a||!f&&b?p:sb(p,m,a,h,i),r=c?e||(f?a:o||d)?[]:g:q;if(c&&c(q,r,h,i),d){j=sb(r,n),d(j,[],h,i),k=j.length;while(k--)(l=j[k])&&(r[n[k]]=!(q[n[k]]=l))}if(f){if(e||a){if(e){j=[],k=r.length;while(k--)(l=r[k])&&j.push(q[k]=l);e(null,r=[],j,i)}k=r.length;while(k--)(l=r[k])&&(j=e?I.call(f,l):m[k])>-1&&(f[j]=!(g[j]=l))}}else r=sb(r===g?r.splice(o,r.length):r),e?e(null,g,r,i):G.apply(g,r)})}function ub(a){for(var b,c,e,f=a.length,g=d.relative[a[0].type],i=g||d.relative[" "],j=g?1:0,k=qb(function(a){return a===b},i,!0),l=qb(function(a){return I.call(b,a)>-1},i,!0),m=[function(a,c,d){return!g&&(d||c!==h)||((b=c).nodeType?k(a,c,d):l(a,c,d))}];f>j;j++)if(c=d.relative[a[j].type])m=[qb(rb(m),c)];else{if(c=d.filter[a[j].type].apply(null,a[j].matches),c[s]){for(e=++j;f>e;e++)if(d.relative[a[e].type])break;return tb(j>1&&rb(m),j>1&&pb(a.slice(0,j-1).concat({value:" "===a[j-2].type?"*":""})).replace(P,"$1"),c,e>j&&ub(a.slice(j,e)),f>e&&ub(a=a.slice(e)),f>e&&pb(a))}m.push(c)}return rb(m)}function vb(a,b){var c=b.length>0,e=a.length>0,f=function(f,g,i,j,k){var m,n,o,p=0,q="0",r=f&&[],s=[],t=h,v=f||e&&d.find.TAG("*",k),w=u+=null==t?1:Math.random()||.1,x=v.length;for(k&&(h=g!==l&&g);q!==x&&null!=(m=v[q]);q++){if(e&&m){n=0;while(o=a[n++])if(o(m,g,i)){j.push(m);break}k&&(u=w)}c&&((m=!o&&m)&&p--,f&&r.push(m))}if(p+=q,c&&q!==p){n=0;while(o=b[n++])o(r,s,g,i);if(f){if(p>0)while(q--)r[q]||s[q]||(s[q]=E.call(j));s=sb(s)}G.apply(j,s),k&&!f&&s.length>0&&p+b.length>1&&db.uniqueSort(j)}return k&&(u=w,h=t),r};return c?fb(f):f}g=db.compile=function(a,b){var c,d=[],e=[],f=y[a+" "];if(!f){b||(b=ob(a)),c=b.length;while(c--)f=ub(b[c]),f[s]?d.push(f):e.push(f);f=y(a,vb(e,d))}return f};function wb(a,b,c){for(var d=0,e=b.length;e>d;d++)db(a,b[d],c);return c}function xb(a,b,e,f){var h,i,j,k,l,m=ob(a);if(!f&&1===m.length){if(i=m[0]=m[0].slice(0),i.length>2&&"ID"===(j=i[0]).type&&c.getById&&9===b.nodeType&&n&&d.relative[i[1].type]){if(b=(d.find.ID(j.matches[0].replace(ab,bb),b)||[])[0],!b)return e;a=a.slice(i.shift().value.length)}h=V.needsContext.test(a)?0:i.length;while(h--){if(j=i[h],d.relative[k=j.type])break;if((l=d.find[k])&&(f=l(j.matches[0].replace(ab,bb),$.test(i[0].type)&&mb(b.parentNode)||b))){if(i.splice(h,1),a=f.length&&pb(i),!a)return G.apply(e,f),e;break}}}return g(a,m)(f,b,!n,e,$.test(a)&&mb(b.parentNode)||b),e}return c.sortStable=s.split("").sort(z).join("")===s,c.detectDuplicates=!!j,k(),c.sortDetached=gb(function(a){return 1&a.compareDocumentPosition(l.createElement("div"))}),gb(function(a){return a.innerHTML="","#"===a.firstChild.getAttribute("href")})||hb("type|href|height|width",function(a,b,c){return c?void 0:a.getAttribute(b,"type"===b.toLowerCase()?1:2)}),c.attributes&&gb(function(a){return a.innerHTML="",a.firstChild.setAttribute("value",""),""===a.firstChild.getAttribute("value")})||hb("value",function(a,b,c){return c||"input"!==a.nodeName.toLowerCase()?void 0:a.defaultValue}),gb(function(a){return null==a.getAttribute("disabled")})||hb(J,function(a,b,c){var d;return c?void 0:a[b]===!0?b.toLowerCase():(d=a.getAttributeNode(b))&&d.specified?d.value:null}),db}(a);n.find=t,n.expr=t.selectors,n.expr[":"]=n.expr.pseudos,n.unique=t.uniqueSort,n.text=t.getText,n.isXMLDoc=t.isXML,n.contains=t.contains;var u=n.expr.match.needsContext,v=/^<(\w+)\s*\/?>(?:<\/\1>|)$/,w=/^.[^:#\[\.,]*$/;function x(a,b,c){if(n.isFunction(b))return n.grep(a,function(a,d){return!!b.call(a,d,a)!==c});if(b.nodeType)return n.grep(a,function(a){return a===b!==c});if("string"==typeof b){if(w.test(b))return n.filter(b,a,c);b=n.filter(b,a)}return n.grep(a,function(a){return n.inArray(a,b)>=0!==c})}n.filter=function(a,b,c){var d=b[0];return c&&(a=":not("+a+")"),1===b.length&&1===d.nodeType?n.find.matchesSelector(d,a)?[d]:[]:n.find.matches(a,n.grep(b,function(a){return 1===a.nodeType}))},n.fn.extend({find:function(a){var b,c=[],d=this,e=d.length;if("string"!=typeof a)return this.pushStack(n(a).filter(function(){for(b=0;e>b;b++)if(n.contains(d[b],this))return!0}));for(b=0;e>b;b++)n.find(a,d[b],c);return c=this.pushStack(e>1?n.unique(c):c),c.selector=this.selector?this.selector+" "+a:a,c},filter:function(a){return this.pushStack(x(this,a||[],!1))},not:function(a){return this.pushStack(x(this,a||[],!0))},is:function(a){return!!x(this,"string"==typeof a&&u.test(a)?n(a):a||[],!1).length}});var y,z=a.document,A=/^(?:\s*(<[\w\W]+>)[^>]*|#([\w-]*))$/,B=n.fn.init=function(a,b){var c,d;if(!a)return this;if("string"==typeof a){if(c="<"===a.charAt(0)&&">"===a.charAt(a.length-1)&&a.length>=3?[null,a,null]:A.exec(a),!c||!c[1]&&b)return!b||b.jquery?(b||y).find(a):this.constructor(b).find(a);if(c[1]){if(b=b instanceof n?b[0]:b,n.merge(this,n.parseHTML(c[1],b&&b.nodeType?b.ownerDocument||b:z,!0)),v.test(c[1])&&n.isPlainObject(b))for(c in b)n.isFunction(this[c])?this[c](b[c]):this.attr(c,b[c]);return this}if(d=z.getElementById(c[2]),d&&d.parentNode){if(d.id!==c[2])return y.find(a);this.length=1,this[0]=d}return this.context=z,this.selector=a,this}return a.nodeType?(this.context=this[0]=a,this.length=1,this):n.isFunction(a)?"undefined"!=typeof y.ready?y.ready(a):a(n):(void 0!==a.selector&&(this.selector=a.selector,this.context=a.context),n.makeArray(a,this))};B.prototype=n.fn,y=n(z);var C=/^(?:parents|prev(?:Until|All))/,D={children:!0,contents:!0,next:!0,prev:!0};n.extend({dir:function(a,b,c){var d=[],e=a[b];while(e&&9!==e.nodeType&&(void 0===c||1!==e.nodeType||!n(e).is(c)))1===e.nodeType&&d.push(e),e=e[b];return d},sibling:function(a,b){for(var c=[];a;a=a.nextSibling)1===a.nodeType&&a!==b&&c.push(a);return c}}),n.fn.extend({has:function(a){var b,c=n(a,this),d=c.length;return this.filter(function(){for(b=0;d>b;b++)if(n.contains(this,c[b]))return!0})},closest:function(a,b){for(var c,d=0,e=this.length,f=[],g=u.test(a)||"string"!=typeof a?n(a,b||this.context):0;e>d;d++)for(c=this[d];c&&c!==b;c=c.parentNode)if(c.nodeType<11&&(g?g.index(c)>-1:1===c.nodeType&&n.find.matchesSelector(c,a))){f.push(c);break}return this.pushStack(f.length>1?n.unique(f):f)},index:function(a){return a?"string"==typeof a?n.inArray(this[0],n(a)):n.inArray(a.jquery?a[0]:a,this):this[0]&&this[0].parentNode?this.first().prevAll().length:-1},add:function(a,b){return this.pushStack(n.unique(n.merge(this.get(),n(a,b))))},addBack:function(a){return this.add(null==a?this.prevObject:this.prevObject.filter(a))}});function E(a,b){do a=a[b];while(a&&1!==a.nodeType);return a}n.each({parent:function(a){var b=a.parentNode;return b&&11!==b.nodeType?b:null},parents:function(a){return n.dir(a,"parentNode")},parentsUntil:function(a,b,c){return n.dir(a,"parentNode",c)},next:function(a){return E(a,"nextSibling")},prev:function(a){return E(a,"previousSibling")},nextAll:function(a){return n.dir(a,"nextSibling")},prevAll:function(a){return n.dir(a,"previousSibling")},nextUntil:function(a,b,c){return n.dir(a,"nextSibling",c)},prevUntil:function(a,b,c){return n.dir(a,"previousSibling",c)},siblings:function(a){return n.sibling((a.parentNode||{}).firstChild,a)},children:function(a){return n.sibling(a.firstChild)},contents:function(a){return n.nodeName(a,"iframe")?a.contentDocument||a.contentWindow.document:n.merge([],a.childNodes)}},function(a,b){n.fn[a]=function(c,d){var e=n.map(this,b,c);return"Until"!==a.slice(-5)&&(d=c),d&&"string"==typeof d&&(e=n.filter(d,e)),this.length>1&&(D[a]||(e=n.unique(e)),C.test(a)&&(e=e.reverse())),this.pushStack(e)}});var F=/\S+/g,G={};function H(a){var b=G[a]={};return n.each(a.match(F)||[],function(a,c){b[c]=!0}),b}n.Callbacks=function(a){a="string"==typeof a?G[a]||H(a):n.extend({},a);var b,c,d,e,f,g,h=[],i=!a.once&&[],j=function(l){for(c=a.memory&&l,d=!0,f=g||0,g=0,e=h.length,b=!0;h&&e>f;f++)if(h[f].apply(l[0],l[1])===!1&&a.stopOnFalse){c=!1;break}b=!1,h&&(i?i.length&&j(i.shift()):c?h=[]:k.disable())},k={add:function(){if(h){var d=h.length;!function f(b){n.each(b,function(b,c){var d=n.type(c);"function"===d?a.unique&&k.has(c)||h.push(c):c&&c.length&&"string"!==d&&f(c)})}(arguments),b?e=h.length:c&&(g=d,j(c))}return this},remove:function(){return h&&n.each(arguments,function(a,c){var d;while((d=n.inArray(c,h,d))>-1)h.splice(d,1),b&&(e>=d&&e--,f>=d&&f--)}),this},has:function(a){return a?n.inArray(a,h)>-1:!(!h||!h.length)},empty:function(){return h=[],e=0,this},disable:function(){return h=i=c=void 0,this},disabled:function(){return!h},lock:function(){return i=void 0,c||k.disable(),this},locked:function(){return!i},fireWith:function(a,c){return!h||d&&!i||(c=c||[],c=[a,c.slice?c.slice():c],b?i.push(c):j(c)),this},fire:function(){return k.fireWith(this,arguments),this},fired:function(){return!!d}};return k},n.extend({Deferred:function(a){var b=[["resolve","done",n.Callbacks("once memory"),"resolved"],["reject","fail",n.Callbacks("once memory"),"rejected"],["notify","progress",n.Callbacks("memory")]],c="pending",d={state:function(){return c},always:function(){return e.done(arguments).fail(arguments),this},then:function(){var a=arguments;return n.Deferred(function(c){n.each(b,function(b,f){var g=n.isFunction(a[b])&&a[b];e[f[1]](function(){var a=g&&g.apply(this,arguments);a&&n.isFunction(a.promise)?a.promise().done(c.resolve).fail(c.reject).progress(c.notify):c[f[0]+"With"](this===d?c.promise():this,g?[a]:arguments)})}),a=null}).promise()},promise:function(a){return null!=a?n.extend(a,d):d}},e={};return d.pipe=d.then,n.each(b,function(a,f){var g=f[2],h=f[3];d[f[1]]=g.add,h&&g.add(function(){c=h},b[1^a][2].disable,b[2][2].lock),e[f[0]]=function(){return e[f[0]+"With"](this===e?d:this,arguments),this},e[f[0]+"With"]=g.fireWith}),d.promise(e),a&&a.call(e,e),e},when:function(a){var b=0,c=d.call(arguments),e=c.length,f=1!==e||a&&n.isFunction(a.promise)?e:0,g=1===f?a:n.Deferred(),h=function(a,b,c){return function(e){b[a]=this,c[a]=arguments.length>1?d.call(arguments):e,c===i?g.notifyWith(b,c):--f||g.resolveWith(b,c)}},i,j,k;if(e>1)for(i=new Array(e),j=new Array(e),k=new Array(e);e>b;b++)c[b]&&n.isFunction(c[b].promise)?c[b].promise().done(h(b,k,c)).fail(g.reject).progress(h(b,j,i)):--f;return f||g.resolveWith(k,c),g.promise()}});var I;n.fn.ready=function(a){return n.ready.promise().done(a),this},n.extend({isReady:!1,readyWait:1,holdReady:function(a){a?n.readyWait++:n.ready(!0)},ready:function(a){if(a===!0?!--n.readyWait:!n.isReady){if(!z.body)return setTimeout(n.ready);n.isReady=!0,a!==!0&&--n.readyWait>0||(I.resolveWith(z,[n]),n.fn.trigger&&n(z).trigger("ready").off("ready"))}}});function J(){z.addEventListener?(z.removeEventListener("DOMContentLoaded",K,!1),a.removeEventListener("load",K,!1)):(z.detachEvent("onreadystatechange",K),a.detachEvent("onload",K))}function K(){(z.addEventListener||"load"===event.type||"complete"===z.readyState)&&(J(),n.ready())}n.ready.promise=function(b){if(!I)if(I=n.Deferred(),"complete"===z.readyState)setTimeout(n.ready);else if(z.addEventListener)z.addEventListener("DOMContentLoaded",K,!1),a.addEventListener("load",K,!1);else{z.attachEvent("onreadystatechange",K),a.attachEvent("onload",K);var c=!1;try{c=null==a.frameElement&&z.documentElement}catch(d){}c&&c.doScroll&&!function e(){if(!n.isReady){try{c.doScroll("left")}catch(a){return setTimeout(e,50)}J(),n.ready()}}()}return I.promise(b)};var L="undefined",M;for(M in n(l))break;l.ownLast="0"!==M,l.inlineBlockNeedsLayout=!1,n(function(){var a,b,c=z.getElementsByTagName("body")[0];c&&(a=z.createElement("div"),a.style.cssText="border:0;width:0;height:0;position:absolute;top:0;left:-9999px;margin-top:1px",b=z.createElement("div"),c.appendChild(a).appendChild(b),typeof b.style.zoom!==L&&(b.style.cssText="border:0;margin:0;width:1px;padding:1px;display:inline;zoom:1",(l.inlineBlockNeedsLayout=3===b.offsetWidth)&&(c.style.zoom=1)),c.removeChild(a),a=b=null)}),function(){var a=z.createElement("div");if(null==l.deleteExpando){l.deleteExpando=!0;try{delete a.test}catch(b){l.deleteExpando=!1}}a=null}(),n.acceptData=function(a){var b=n.noData[(a.nodeName+" ").toLowerCase()],c=+a.nodeType||1;return 1!==c&&9!==c?!1:!b||b!==!0&&a.getAttribute("classid")===b};var N=/^(?:\{[\w\W]*\}|\[[\w\W]*\])$/,O=/([A-Z])/g;function P(a,b,c){if(void 0===c&&1===a.nodeType){var d="data-"+b.replace(O,"-$1").toLowerCase();if(c=a.getAttribute(d),"string"==typeof c){try{c="true"===c?!0:"false"===c?!1:"null"===c?null:+c+""===c?+c:N.test(c)?n.parseJSON(c):c}catch(e){}n.data(a,b,c)}else c=void 0}return c}function Q(a){var b;for(b in a)if(("data"!==b||!n.isEmptyObject(a[b]))&&"toJSON"!==b)return!1;return!0}function R(a,b,d,e){if(n.acceptData(a)){var f,g,h=n.expando,i=a.nodeType,j=i?n.cache:a,k=i?a[h]:a[h]&&h;if(k&&j[k]&&(e||j[k].data)||void 0!==d||"string"!=typeof b)return k||(k=i?a[h]=c.pop()||n.guid++:h),j[k]||(j[k]=i?{}:{toJSON:n.noop}),("object"==typeof b||"function"==typeof b)&&(e?j[k]=n.extend(j[k],b):j[k].data=n.extend(j[k].data,b)),g=j[k],e||(g.data||(g.data={}),g=g.data),void 0!==d&&(g[n.camelCase(b)]=d),"string"==typeof b?(f=g[b],null==f&&(f=g[n.camelCase(b)])):f=g,f +}}function S(a,b,c){if(n.acceptData(a)){var d,e,f=a.nodeType,g=f?n.cache:a,h=f?a[n.expando]:n.expando;if(g[h]){if(b&&(d=c?g[h]:g[h].data)){n.isArray(b)?b=b.concat(n.map(b,n.camelCase)):b in d?b=[b]:(b=n.camelCase(b),b=b in d?[b]:b.split(" ")),e=b.length;while(e--)delete d[b[e]];if(c?!Q(d):!n.isEmptyObject(d))return}(c||(delete g[h].data,Q(g[h])))&&(f?n.cleanData([a],!0):l.deleteExpando||g!=g.window?delete g[h]:g[h]=null)}}}n.extend({cache:{},noData:{"applet ":!0,"embed ":!0,"object ":"clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"},hasData:function(a){return a=a.nodeType?n.cache[a[n.expando]]:a[n.expando],!!a&&!Q(a)},data:function(a,b,c){return R(a,b,c)},removeData:function(a,b){return S(a,b)},_data:function(a,b,c){return R(a,b,c,!0)},_removeData:function(a,b){return S(a,b,!0)}}),n.fn.extend({data:function(a,b){var c,d,e,f=this[0],g=f&&f.attributes;if(void 0===a){if(this.length&&(e=n.data(f),1===f.nodeType&&!n._data(f,"parsedAttrs"))){c=g.length;while(c--)d=g[c].name,0===d.indexOf("data-")&&(d=n.camelCase(d.slice(5)),P(f,d,e[d]));n._data(f,"parsedAttrs",!0)}return e}return"object"==typeof a?this.each(function(){n.data(this,a)}):arguments.length>1?this.each(function(){n.data(this,a,b)}):f?P(f,a,n.data(f,a)):void 0},removeData:function(a){return this.each(function(){n.removeData(this,a)})}}),n.extend({queue:function(a,b,c){var d;return a?(b=(b||"fx")+"queue",d=n._data(a,b),c&&(!d||n.isArray(c)?d=n._data(a,b,n.makeArray(c)):d.push(c)),d||[]):void 0},dequeue:function(a,b){b=b||"fx";var c=n.queue(a,b),d=c.length,e=c.shift(),f=n._queueHooks(a,b),g=function(){n.dequeue(a,b)};"inprogress"===e&&(e=c.shift(),d--),e&&("fx"===b&&c.unshift("inprogress"),delete f.stop,e.call(a,g,f)),!d&&f&&f.empty.fire()},_queueHooks:function(a,b){var c=b+"queueHooks";return n._data(a,c)||n._data(a,c,{empty:n.Callbacks("once memory").add(function(){n._removeData(a,b+"queue"),n._removeData(a,c)})})}}),n.fn.extend({queue:function(a,b){var c=2;return"string"!=typeof a&&(b=a,a="fx",c--),arguments.lengthh;h++)b(a[h],c,g?d:d.call(a[h],h,b(a[h],c)));return e?a:j?b.call(a):i?b(a[0],c):f},X=/^(?:checkbox|radio)$/i;!function(){var a=z.createDocumentFragment(),b=z.createElement("div"),c=z.createElement("input");if(b.setAttribute("className","t"),b.innerHTML="
a",l.leadingWhitespace=3===b.firstChild.nodeType,l.tbody=!b.getElementsByTagName("tbody").length,l.htmlSerialize=!!b.getElementsByTagName("link").length,l.html5Clone="<:nav>"!==z.createElement("nav").cloneNode(!0).outerHTML,c.type="checkbox",c.checked=!0,a.appendChild(c),l.appendChecked=c.checked,b.innerHTML="",l.noCloneChecked=!!b.cloneNode(!0).lastChild.defaultValue,a.appendChild(b),b.innerHTML="",l.checkClone=b.cloneNode(!0).cloneNode(!0).lastChild.checked,l.noCloneEvent=!0,b.attachEvent&&(b.attachEvent("onclick",function(){l.noCloneEvent=!1}),b.cloneNode(!0).click()),null==l.deleteExpando){l.deleteExpando=!0;try{delete b.test}catch(d){l.deleteExpando=!1}}a=b=c=null}(),function(){var b,c,d=z.createElement("div");for(b in{submit:!0,change:!0,focusin:!0})c="on"+b,(l[b+"Bubbles"]=c in a)||(d.setAttribute(c,"t"),l[b+"Bubbles"]=d.attributes[c].expando===!1);d=null}();var Y=/^(?:input|select|textarea)$/i,Z=/^key/,$=/^(?:mouse|contextmenu)|click/,_=/^(?:focusinfocus|focusoutblur)$/,ab=/^([^.]*)(?:\.(.+)|)$/;function bb(){return!0}function cb(){return!1}function db(){try{return z.activeElement}catch(a){}}n.event={global:{},add:function(a,b,c,d,e){var f,g,h,i,j,k,l,m,o,p,q,r=n._data(a);if(r){c.handler&&(i=c,c=i.handler,e=i.selector),c.guid||(c.guid=n.guid++),(g=r.events)||(g=r.events={}),(k=r.handle)||(k=r.handle=function(a){return typeof n===L||a&&n.event.triggered===a.type?void 0:n.event.dispatch.apply(k.elem,arguments)},k.elem=a),b=(b||"").match(F)||[""],h=b.length;while(h--)f=ab.exec(b[h])||[],o=q=f[1],p=(f[2]||"").split(".").sort(),o&&(j=n.event.special[o]||{},o=(e?j.delegateType:j.bindType)||o,j=n.event.special[o]||{},l=n.extend({type:o,origType:q,data:d,handler:c,guid:c.guid,selector:e,needsContext:e&&n.expr.match.needsContext.test(e),namespace:p.join(".")},i),(m=g[o])||(m=g[o]=[],m.delegateCount=0,j.setup&&j.setup.call(a,d,p,k)!==!1||(a.addEventListener?a.addEventListener(o,k,!1):a.attachEvent&&a.attachEvent("on"+o,k))),j.add&&(j.add.call(a,l),l.handler.guid||(l.handler.guid=c.guid)),e?m.splice(m.delegateCount++,0,l):m.push(l),n.event.global[o]=!0);a=null}},remove:function(a,b,c,d,e){var f,g,h,i,j,k,l,m,o,p,q,r=n.hasData(a)&&n._data(a);if(r&&(k=r.events)){b=(b||"").match(F)||[""],j=b.length;while(j--)if(h=ab.exec(b[j])||[],o=q=h[1],p=(h[2]||"").split(".").sort(),o){l=n.event.special[o]||{},o=(d?l.delegateType:l.bindType)||o,m=k[o]||[],h=h[2]&&new RegExp("(^|\\.)"+p.join("\\.(?:.*\\.|)")+"(\\.|$)"),i=f=m.length;while(f--)g=m[f],!e&&q!==g.origType||c&&c.guid!==g.guid||h&&!h.test(g.namespace)||d&&d!==g.selector&&("**"!==d||!g.selector)||(m.splice(f,1),g.selector&&m.delegateCount--,l.remove&&l.remove.call(a,g));i&&!m.length&&(l.teardown&&l.teardown.call(a,p,r.handle)!==!1||n.removeEvent(a,o,r.handle),delete k[o])}else for(o in k)n.event.remove(a,o+b[j],c,d,!0);n.isEmptyObject(k)&&(delete r.handle,n._removeData(a,"events"))}},trigger:function(b,c,d,e){var f,g,h,i,k,l,m,o=[d||z],p=j.call(b,"type")?b.type:b,q=j.call(b,"namespace")?b.namespace.split("."):[];if(h=l=d=d||z,3!==d.nodeType&&8!==d.nodeType&&!_.test(p+n.event.triggered)&&(p.indexOf(".")>=0&&(q=p.split("."),p=q.shift(),q.sort()),g=p.indexOf(":")<0&&"on"+p,b=b[n.expando]?b:new n.Event(p,"object"==typeof b&&b),b.isTrigger=e?2:3,b.namespace=q.join("."),b.namespace_re=b.namespace?new RegExp("(^|\\.)"+q.join("\\.(?:.*\\.|)")+"(\\.|$)"):null,b.result=void 0,b.target||(b.target=d),c=null==c?[b]:n.makeArray(c,[b]),k=n.event.special[p]||{},e||!k.trigger||k.trigger.apply(d,c)!==!1)){if(!e&&!k.noBubble&&!n.isWindow(d)){for(i=k.delegateType||p,_.test(i+p)||(h=h.parentNode);h;h=h.parentNode)o.push(h),l=h;l===(d.ownerDocument||z)&&o.push(l.defaultView||l.parentWindow||a)}m=0;while((h=o[m++])&&!b.isPropagationStopped())b.type=m>1?i:k.bindType||p,f=(n._data(h,"events")||{})[b.type]&&n._data(h,"handle"),f&&f.apply(h,c),f=g&&h[g],f&&f.apply&&n.acceptData(h)&&(b.result=f.apply(h,c),b.result===!1&&b.preventDefault());if(b.type=p,!e&&!b.isDefaultPrevented()&&(!k._default||k._default.apply(o.pop(),c)===!1)&&n.acceptData(d)&&g&&d[p]&&!n.isWindow(d)){l=d[g],l&&(d[g]=null),n.event.triggered=p;try{d[p]()}catch(r){}n.event.triggered=void 0,l&&(d[g]=l)}return b.result}},dispatch:function(a){a=n.event.fix(a);var b,c,e,f,g,h=[],i=d.call(arguments),j=(n._data(this,"events")||{})[a.type]||[],k=n.event.special[a.type]||{};if(i[0]=a,a.delegateTarget=this,!k.preDispatch||k.preDispatch.call(this,a)!==!1){h=n.event.handlers.call(this,a,j),b=0;while((f=h[b++])&&!a.isPropagationStopped()){a.currentTarget=f.elem,g=0;while((e=f.handlers[g++])&&!a.isImmediatePropagationStopped())(!a.namespace_re||a.namespace_re.test(e.namespace))&&(a.handleObj=e,a.data=e.data,c=((n.event.special[e.origType]||{}).handle||e.handler).apply(f.elem,i),void 0!==c&&(a.result=c)===!1&&(a.preventDefault(),a.stopPropagation()))}return k.postDispatch&&k.postDispatch.call(this,a),a.result}},handlers:function(a,b){var c,d,e,f,g=[],h=b.delegateCount,i=a.target;if(h&&i.nodeType&&(!a.button||"click"!==a.type))for(;i!=this;i=i.parentNode||this)if(1===i.nodeType&&(i.disabled!==!0||"click"!==a.type)){for(e=[],f=0;h>f;f++)d=b[f],c=d.selector+" ",void 0===e[c]&&(e[c]=d.needsContext?n(c,this).index(i)>=0:n.find(c,this,null,[i]).length),e[c]&&e.push(d);e.length&&g.push({elem:i,handlers:e})}return h]","i"),ib=/^\s+/,jb=/<(?!area|br|col|embed|hr|img|input|link|meta|param)(([\w:]+)[^>]*)\/>/gi,kb=/<([\w:]+)/,lb=/\s*$/g,sb={option:[1,""],legend:[1,"
","
"],area:[1,"",""],param:[1,"",""],thead:[1,"","
"],tr:[2,"","
"],col:[2,"","
"],td:[3,"","
"],_default:l.htmlSerialize?[0,"",""]:[1,"X
","
"]},tb=eb(z),ub=tb.appendChild(z.createElement("div"));sb.optgroup=sb.option,sb.tbody=sb.tfoot=sb.colgroup=sb.caption=sb.thead,sb.th=sb.td;function vb(a,b){var c,d,e=0,f=typeof a.getElementsByTagName!==L?a.getElementsByTagName(b||"*"):typeof a.querySelectorAll!==L?a.querySelectorAll(b||"*"):void 0;if(!f)for(f=[],c=a.childNodes||a;null!=(d=c[e]);e++)!b||n.nodeName(d,b)?f.push(d):n.merge(f,vb(d,b));return void 0===b||b&&n.nodeName(a,b)?n.merge([a],f):f}function wb(a){X.test(a.type)&&(a.defaultChecked=a.checked)}function xb(a,b){return n.nodeName(a,"table")&&n.nodeName(11!==b.nodeType?b:b.firstChild,"tr")?a.getElementsByTagName("tbody")[0]||a.appendChild(a.ownerDocument.createElement("tbody")):a}function yb(a){return a.type=(null!==n.find.attr(a,"type"))+"/"+a.type,a}function zb(a){var b=qb.exec(a.type);return b?a.type=b[1]:a.removeAttribute("type"),a}function Ab(a,b){for(var c,d=0;null!=(c=a[d]);d++)n._data(c,"globalEval",!b||n._data(b[d],"globalEval"))}function Bb(a,b){if(1===b.nodeType&&n.hasData(a)){var c,d,e,f=n._data(a),g=n._data(b,f),h=f.events;if(h){delete g.handle,g.events={};for(c in h)for(d=0,e=h[c].length;e>d;d++)n.event.add(b,c,h[c][d])}g.data&&(g.data=n.extend({},g.data))}}function Cb(a,b){var c,d,e;if(1===b.nodeType){if(c=b.nodeName.toLowerCase(),!l.noCloneEvent&&b[n.expando]){e=n._data(b);for(d in e.events)n.removeEvent(b,d,e.handle);b.removeAttribute(n.expando)}"script"===c&&b.text!==a.text?(yb(b).text=a.text,zb(b)):"object"===c?(b.parentNode&&(b.outerHTML=a.outerHTML),l.html5Clone&&a.innerHTML&&!n.trim(b.innerHTML)&&(b.innerHTML=a.innerHTML)):"input"===c&&X.test(a.type)?(b.defaultChecked=b.checked=a.checked,b.value!==a.value&&(b.value=a.value)):"option"===c?b.defaultSelected=b.selected=a.defaultSelected:("input"===c||"textarea"===c)&&(b.defaultValue=a.defaultValue)}}n.extend({clone:function(a,b,c){var d,e,f,g,h,i=n.contains(a.ownerDocument,a);if(l.html5Clone||n.isXMLDoc(a)||!hb.test("<"+a.nodeName+">")?f=a.cloneNode(!0):(ub.innerHTML=a.outerHTML,ub.removeChild(f=ub.firstChild)),!(l.noCloneEvent&&l.noCloneChecked||1!==a.nodeType&&11!==a.nodeType||n.isXMLDoc(a)))for(d=vb(f),h=vb(a),g=0;null!=(e=h[g]);++g)d[g]&&Cb(e,d[g]);if(b)if(c)for(h=h||vb(a),d=d||vb(f),g=0;null!=(e=h[g]);g++)Bb(e,d[g]);else Bb(a,f);return d=vb(f,"script"),d.length>0&&Ab(d,!i&&vb(a,"script")),d=h=e=null,f},buildFragment:function(a,b,c,d){for(var e,f,g,h,i,j,k,m=a.length,o=eb(b),p=[],q=0;m>q;q++)if(f=a[q],f||0===f)if("object"===n.type(f))n.merge(p,f.nodeType?[f]:f);else if(mb.test(f)){h=h||o.appendChild(b.createElement("div")),i=(kb.exec(f)||["",""])[1].toLowerCase(),k=sb[i]||sb._default,h.innerHTML=k[1]+f.replace(jb,"<$1>")+k[2],e=k[0];while(e--)h=h.lastChild;if(!l.leadingWhitespace&&ib.test(f)&&p.push(b.createTextNode(ib.exec(f)[0])),!l.tbody){f="table"!==i||lb.test(f)?""!==k[1]||lb.test(f)?0:h:h.firstChild,e=f&&f.childNodes.length;while(e--)n.nodeName(j=f.childNodes[e],"tbody")&&!j.childNodes.length&&f.removeChild(j)}n.merge(p,h.childNodes),h.textContent="";while(h.firstChild)h.removeChild(h.firstChild);h=o.lastChild}else p.push(b.createTextNode(f));h&&o.removeChild(h),l.appendChecked||n.grep(vb(p,"input"),wb),q=0;while(f=p[q++])if((!d||-1===n.inArray(f,d))&&(g=n.contains(f.ownerDocument,f),h=vb(o.appendChild(f),"script"),g&&Ab(h),c)){e=0;while(f=h[e++])pb.test(f.type||"")&&c.push(f)}return h=null,o},cleanData:function(a,b){for(var d,e,f,g,h=0,i=n.expando,j=n.cache,k=l.deleteExpando,m=n.event.special;null!=(d=a[h]);h++)if((b||n.acceptData(d))&&(f=d[i],g=f&&j[f])){if(g.events)for(e in g.events)m[e]?n.event.remove(d,e):n.removeEvent(d,e,g.handle);j[f]&&(delete j[f],k?delete d[i]:typeof d.removeAttribute!==L?d.removeAttribute(i):d[i]=null,c.push(f))}}}),n.fn.extend({text:function(a){return W(this,function(a){return void 0===a?n.text(this):this.empty().append((this[0]&&this[0].ownerDocument||z).createTextNode(a))},null,a,arguments.length)},append:function(){return this.domManip(arguments,function(a){if(1===this.nodeType||11===this.nodeType||9===this.nodeType){var b=xb(this,a);b.appendChild(a)}})},prepend:function(){return this.domManip(arguments,function(a){if(1===this.nodeType||11===this.nodeType||9===this.nodeType){var b=xb(this,a);b.insertBefore(a,b.firstChild)}})},before:function(){return this.domManip(arguments,function(a){this.parentNode&&this.parentNode.insertBefore(a,this)})},after:function(){return this.domManip(arguments,function(a){this.parentNode&&this.parentNode.insertBefore(a,this.nextSibling)})},remove:function(a,b){for(var c,d=a?n.filter(a,this):this,e=0;null!=(c=d[e]);e++)b||1!==c.nodeType||n.cleanData(vb(c)),c.parentNode&&(b&&n.contains(c.ownerDocument,c)&&Ab(vb(c,"script")),c.parentNode.removeChild(c));return this},empty:function(){for(var a,b=0;null!=(a=this[b]);b++){1===a.nodeType&&n.cleanData(vb(a,!1));while(a.firstChild)a.removeChild(a.firstChild);a.options&&n.nodeName(a,"select")&&(a.options.length=0)}return this},clone:function(a,b){return a=null==a?!1:a,b=null==b?a:b,this.map(function(){return n.clone(this,a,b)})},html:function(a){return W(this,function(a){var b=this[0]||{},c=0,d=this.length;if(void 0===a)return 1===b.nodeType?b.innerHTML.replace(gb,""):void 0;if(!("string"!=typeof a||nb.test(a)||!l.htmlSerialize&&hb.test(a)||!l.leadingWhitespace&&ib.test(a)||sb[(kb.exec(a)||["",""])[1].toLowerCase()])){a=a.replace(jb,"<$1>");try{for(;d>c;c++)b=this[c]||{},1===b.nodeType&&(n.cleanData(vb(b,!1)),b.innerHTML=a);b=0}catch(e){}}b&&this.empty().append(a)},null,a,arguments.length)},replaceWith:function(){var a=arguments[0];return this.domManip(arguments,function(b){a=this.parentNode,n.cleanData(vb(this)),a&&a.replaceChild(b,this)}),a&&(a.length||a.nodeType)?this:this.remove()},detach:function(a){return this.remove(a,!0)},domManip:function(a,b){a=e.apply([],a);var c,d,f,g,h,i,j=0,k=this.length,m=this,o=k-1,p=a[0],q=n.isFunction(p);if(q||k>1&&"string"==typeof p&&!l.checkClone&&ob.test(p))return this.each(function(c){var d=m.eq(c);q&&(a[0]=p.call(this,c,d.html())),d.domManip(a,b)});if(k&&(i=n.buildFragment(a,this[0].ownerDocument,!1,this),c=i.firstChild,1===i.childNodes.length&&(i=c),c)){for(g=n.map(vb(i,"script"),yb),f=g.length;k>j;j++)d=i,j!==o&&(d=n.clone(d,!0,!0),f&&n.merge(g,vb(d,"script"))),b.call(this[j],d,j);if(f)for(h=g[g.length-1].ownerDocument,n.map(g,zb),j=0;f>j;j++)d=g[j],pb.test(d.type||"")&&!n._data(d,"globalEval")&&n.contains(h,d)&&(d.src?n._evalUrl&&n._evalUrl(d.src):n.globalEval((d.text||d.textContent||d.innerHTML||"").replace(rb,"")));i=c=null}return this}}),n.each({appendTo:"append",prependTo:"prepend",insertBefore:"before",insertAfter:"after",replaceAll:"replaceWith"},function(a,b){n.fn[a]=function(a){for(var c,d=0,e=[],g=n(a),h=g.length-1;h>=d;d++)c=d===h?this:this.clone(!0),n(g[d])[b](c),f.apply(e,c.get());return this.pushStack(e)}});var Db,Eb={};function Fb(b,c){var d=n(c.createElement(b)).appendTo(c.body),e=a.getDefaultComputedStyle?a.getDefaultComputedStyle(d[0]).display:n.css(d[0],"display");return d.detach(),e}function Gb(a){var b=z,c=Eb[a];return c||(c=Fb(a,b),"none"!==c&&c||(Db=(Db||n("