Added many more unit tests; parser appears to be working correctly,
generator still needs work. But very promising!
This commit is contained in:
Simon Brooke
parent
1fb23ea9ce
commit
b08881a99e
|
|
@ -1,9 +1,19 @@
|
|||
(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
|
||||
;; TOKENS within the parser should be unambiguous
|
||||
|
|
@ -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))
|
||||
|
|
@ -144,6 +178,11 @@
|
|||
(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"
|
||||
|
|
@ -152,6 +191,7 @@
|
|||
(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 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")
|
||||
83
test/mw_parser/declarative_test.clj
Normal file
83
test/mw_parser/declarative_test.clj
Normal file
|
|
@ -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")
|
||||
))
|
||||
Loading…
Reference in a new issue