From b08881a99ee19da4e5a9cc228d5f705f9d62bf1c Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Mon, 28 Dec 2015 19:46:18 +0000 Subject: [PATCH] Added many more unit tests; parser appears to be working correctly, generator still needs work. But very promising! --- src/mw_parser/{insta.clj => declarative.clj} | 113 +++++++++++++------ test/mw_parser/declarative_test.clj | 83 ++++++++++++++ 2 files changed, 163 insertions(+), 33 deletions(-) rename src/mw_parser/{insta.clj => declarative.clj} (64%) create mode 100644 test/mw_parser/declarative_test.clj diff --git a/src/mw_parser/insta.clj b/src/mw_parser/declarative.clj similarity index 64% rename from src/mw_parser/insta.clj rename to src/mw_parser/declarative.clj index 9d220f9..6d9e1ca 100644 --- a/src/mw_parser/insta.clj +++ b/src/mw_parser/declarative.clj @@ -1,11 +1,21 @@ -(ns mw-parser.insta +(ns mw-parser.declarative (:use mw-engine.utils [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 + ;; 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 ; @@ -47,7 +57,8 @@ 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 'should be' SPACE EXPRESSION + SIMPLE-ACTION := SYMBOL SPACE BECOMES SPACE EXPRESSION + BECOMES := 'should be' SPACE := #' *'" ) @@ -59,6 +70,17 @@ (declare generate 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 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." @@ -79,15 +101,18 @@ (defn generate-conjunct-condition [tree] + (assert-type tree :CONJUNCT-CONDITION) (list 'and (generate (nth tree 1))(generate (nth tree 3)))) (defn generate-disjunct-condition [tree] + (assert-type tree :DISJUNCT-CONDITION) (list 'or (generate (nth tree 1))(generate (nth tree 3)))) (defn generate-property-condition [tree] + (assert-type tree :PROPERTY-CONDITION) (let [property (generate (nth tree 1)) qualifier (generate (nth tree 2)) expression (generate (nth tree 3))] @@ -95,10 +120,17 @@ (defn generate-simple-action [tree] + (assert-type tree :SIMPLE-ACTION) (let [property (generate (nth tree 1)) expression (generate (nth tree 3))] (list 'merge 'cell {property expression}))) +(defn generate-multiple-actions + [tree] + nil) +;; (assert (and (coll? tree)(= (first tree) :ACTIONS)) "Expected an ACTIONS fragment") +;; (conj 'do (map + (defn generate "Generate code for this (fragment of a) parse tree" [tree] @@ -113,11 +145,13 @@ :CONJUNCT-CONDITION (generate-conjunct-condition tree) :PROPERTY-CONDITION (generate-property-condition tree) :SIMPLE-ACTION (generate-simple-action tree) + :ACTIONS (generate-multiple-actions tree) :SYMBOL (keyword (second tree)) :NUMBER (read-string (second tree)) :EQUIVALENCE '= :MORE '> :LESS '< + :COMPARATIVE (generate (second tree)) ;; :EXPRESSION (generate-expression tree) ;; :SIMPLE-EXPRESSION (map generate tree)) @@ -125,12 +159,12 @@ (defn simplify-qualifier - "Given that this `tree` fragment represents a qualifier, what + "Given that this `tree` fragment represents a qualifier, what qualifier is that?" [tree] - (cond + (cond (empty? tree) nil - (and (coll? tree) + (and (coll? tree) (member? (first tree) '(:EQUIVALENCE :COMPARATIVE))) tree (coll? (first tree)) (or (simplify-qualifier (first tree)) (simplify-qualifier (rest tree))) @@ -142,16 +176,22 @@ only two elements, the second is semantically sufficient." [tree] (if (= (count tree) 2) (simplify (nth tree 1)) 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 + (if (coll? tree) (case (first tree) :SPACE nil + :THEN nil :QUALIFIER (simplify-qualifier tree) :CONDITIONS (simplify-second-of-two tree) :CONDITION (simplify-second-of-two tree) @@ -168,31 +208,38 @@ (def parse-rule (insta/parser grammar)) -(defn compile-rule +(defn explain-parse-error-reason + "The parse error `reason` is a complex structure of which I have as yet seen + few examples. This function is a place-holder so that I can later produce + friendlier reason messages." + [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 (reduce (fn [map item](merge map {(first item)(rest item)})) {} parser-error) + text (first (: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)(first (:column error-map)) 0) + ;; create a cursor to point to that column + cursor (apply str (reverse (conj (repeat column " ") "^"))) + ] + (throw (Exception. (format bad-parse-error text cursor reason))))) + +(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] - nil) -;; (generate (prune-tree (parse-rule rule)))) + (assert (string? rule)) + (let [tree (parse-rule rule)] + (if (rule? rule) (generate (simplify tree)) + (throw-parse-exception tree)))) - - -(compile-rule "if state is climax and some neighbours have state equal to fire then 3 chance in 5 state should be fire") - - -(compile-rule "if state is in grassland or pasture or heath and 4 neighbours have state equal to water then state should be village") - -(compile-rule "if 6 neighbours have state equal to water then state should be village") - -(compile-rule "if fertility is between 55 and 75 then state should be climax") - -(compile-rule "if state is forest then state should be climax") - - -(compile-rule "if state is in grassland or pasture or heath and 4 neighbours have state equal to water then state should be village") -(compile-rule "if altitude is less than 100 and state is forest then state should be climax and deer should be 3") -(compile-rule "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3") -(compile-rule "if altitude is 100 or fertility is 25 then state should be heath") - -(compile-rule "if deer is more than 2 and wolves is 0 and fertility is more than 20 then deer should be deer + 2") -(compile-rule "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves") -(compile-rule "if state is grassland and 4 neighbours have state equal to water then state should be village") diff --git a/test/mw_parser/declarative_test.clj b/test/mw_parser/declarative_test.clj new file mode 100644 index 0000000..ab6b04f --- /dev/null +++ b/test/mw_parser/declarative_test.clj @@ -0,0 +1,83 @@ +(ns mw-parser.declarative-test + (:use clojure.pprint + mw-engine.core + mw-engine.world) + (:require [clojure.test :refer :all] + [mw-parser.declarative :refer :all])) + +(deftest rules-tests + (testing "Rule parser - does not test whether generated functions actually work, just that something is generated!" + (is (rule? (parse-rule "if state is forest then state should be climax"))) + (is (rule? (parse-rule "if state is in grassland or pasture or heath then state should be village"))) + (is (rule? (parse-rule "if altitude is less than 100 and state is forest then state should be climax and deer should be 3"))) + (is (rule? (parse-rule "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3"))) + (is (rule? (parse-rule "if altitude is 100 or fertility is 25 then state should be heath"))) + (is (rule? (parse-rule "if deer is more than 2 and wolves is 0 and fertility is more than 20 then deer should be deer + 2"))) + (is (rule? (parse-rule "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves"))) + (is (rule? (parse-rule "if state is forest and fertility is between 55 and 75 then state should be climax"))) + (is (rule? (parse-rule "if fertility is between 55 and 75 then state should be climax"))) + (is (rule? (parse-rule "if altitude is less than 100 and state is forest then state should be climax and deer should be 3"))) + )) + +(deftest neighbours-rules-tests + (testing "Rules which relate to neighbours - hard!" + (is (rule? (parse-rule "if state is climax and some neighbours have state equal to fire then 3 chance in 5 state should be fire"))) + (is (rule? (parse-rule "if state is in grassland or pasture or heath and 4 neighbours have state equal to water then state should be village"))) + (is (rule? (parse-rule "if 6 neighbours have state equal to water then state should be village"))) + (is (rule? (parse-rule "if state is grassland and 4 neighbours have state equal to water then state should be village"))) + (is (rule? (parse-rule "if state is pasture and more than 3 neighbours have state equal to scrub then state should be scrub"))) + (is (rule? (parse-rule "if state is in grassland or pasture or heath and 4 neighbours have state equal to water then state should be village"))) + (is (rule? (parse-rule "if state is grassland and 4 neighbours have state equal to water then state should be village"))) + (is (rule? (parse-rule "if 6 neighbours have state equal to water then state should be village"))) + )) + +(deftest lhs-generators-tests + (testing "Generating left-hand-side fragments of rule functions from appropriate fragments of parse trees" + (is (generate-property-condition + '(:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest"))) + '(= (:state cell) :forest)) + (is (generate-property-condition + '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:EQUIVALENCE [:IS "is"]] (:NUMBER "10"))) + '(= (:fertility cell) 10)) + (is (generate-property-condition '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:COMPARATIVE [:LESS "less"]] (:NUMBER "10"))) + '(< (:fertility cell) 10)) + (is (generate-property-condition '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:COMPARATIVE [:MORE "more"]] (:NUMBER "10"))) + '(> (:fertility cell) 10)) + (is (generate-conjunct-condition '(: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 '(: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))) + )) + +(deftest rhs-generators-tests + (testing "Generating left-hand-side fragments of rule functions from appropriate fragments of parse trees" + (is (generate-simple-action + '(:SIMPLE-ACTION (:SYMBOL "state") (:BECOMES "should be") (:SYMBOL "climax"))) + '(merge cell {:state :climax})) + (is (generate-simple-action + '(:SIMPLE-ACTION (:SYMBOL "fertility") (:BECOMES "should be") (:NUMBER "10"))) + '(merge cell {:fertility 10})) + )) + +(deftest exception-tests + (testing "Constructions which should cause exceptions to be thrown" + (is (thrown-with-msg? Exception #"^I did not understand.*" + (compile-rule "the quick brown fox jumped over the lazy dog")) + "Exception thrown if rule text does not match grammar") +;; (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 #"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'") +;; (is (thrown? Exception (compile-rule "if state is new then x should be 0")) +;; "Can't set x property to number, as this would break the world") +;; (is (thrown? Exception (compile-rule "if state is new then y should be 0")) +;; "Can't set y property to number, as this would break the world") +;; (is (thrown? Exception (compile-rule "if state is new then x should be heath")) +;; "Can't set x property to symbol, as this would break the world") +;; (is (thrown? Exception (compile-rule "if state is new then y should be heath")) +;; "Can't set y property to symbol, as this would break the world") + ))