From b4f796aca4ac17e9572bc6d360cc6b8d42d64d19 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 19 Jul 2023 20:30:58 +0100 Subject: [PATCH] Major overhaul of rule metadata, so upversioned to 0.3.0 Many tests do not pass at this time. --- project.clj | 4 +- src/mw_parser/bulk.clj | 49 --- src/mw_parser/core.clj | 451 -------------------------- src/mw_parser/declarative.clj | 112 +++---- src/mw_parser/errors.clj | 2 - src/mw_parser/generate.clj | 8 +- src/mw_parser/simplify.clj | 21 +- src/mw_parser/utils.clj | 17 +- test/mw_parser/bulk_test.clj | 25 -- test/mw_parser/core_test.clj | 475 ---------------------------- test/mw_parser/declarative_test.clj | 237 ++++++++------ test/mw_parser/flow_test.clj | 2 +- test/mw_parser/generate_test.clj | 2 +- test/mw_parser/simplify_test.clj | 6 +- test/mw_parser/utils_test.clj | 30 -- 15 files changed, 228 insertions(+), 1213 deletions(-) delete mode 100644 src/mw_parser/bulk.clj delete mode 100644 src/mw_parser/core.clj delete mode 100644 test/mw_parser/bulk_test.clj delete mode 100644 test/mw_parser/core_test.clj delete mode 100644 test/mw_parser/utils_test.clj diff --git a/project.clj b/project.clj index 4552bd6..9fb35d7 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject mw-parser "0.2.0-SNAPSHOT" +(defproject mw-parser "0.3.0-SNAPSHOT" :cloverage {:output "docs/cloverage"} :codox {:metadata {:doc "**TODO**: write docs" :doc/format :markdown} @@ -7,7 +7,7 @@ :dependencies [[org.clojure/clojure "1.11.1"] [org.clojure/tools.trace "0.7.11"] [instaparse "1.4.12"] - [mw-engine "0.2.0-SNAPSHOT"] + [mw-engine "0.3.0-SNAPSHOT"] [trptr/java-wrapper "0.2.3"]] :description "Parser for production rules for MicroWorld engine" :license {:name "GNU General Public License v2" diff --git a/src/mw_parser/bulk.clj b/src/mw_parser/bulk.clj deleted file mode 100644 index 53f639a..0000000 --- a/src/mw_parser/bulk.clj +++ /dev/null @@ -1,49 +0,0 @@ -(ns ^{:doc "parse multiple rules from a stream, possibly a file." - :author "Simon Brooke"} - mw-parser.bulk - (:require [clojure.string :refer [split]] - [mw-parser.declarative :refer [compile]] - [mw-parser.utils :refer [comment?]])) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; -;;;; 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 -;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -(defn parse-string - "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." - [string] - (map compile - (remove comment? (split string #"\n")))) - -(defn parse-file - "Parse rules from successive lines in the file loaded from this `filename`. - Return a list of S-expressions." - [filename] - (parse-string (slurp filename))) - -(defn compile-file - "Compile each non-comment line of the file indicated by this `filename` into - an executable anonymous function, and return the sequence of such functions." - [filename] - (compile (slurp filename) true)) diff --git a/src/mw_parser/core.clj b/src/mw_parser/core.clj deleted file mode 100644 index 37150fc..0000000 --- a/src/mw_parser/core.clj +++ /dev/null @@ -1,451 +0,0 @@ -(ns ^{:doc "A very simple parser which parses production rules. - - **NOTE**: This parser is obsolete and is superceded by the - declarative parser, q.v." - :author "Simon Brooke"} - mw-parser.core - (:require [clojure.string :refer [split trim triml]] - [mw-engine.utils :refer [member?]]) - (: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'") - -(defn- keyword-or-numeric - "If this token appears to represent an explicit number, return that number; - otherwise, make a keyword of it and return that." - [token] - (cond - (re-matches re-number token) (read-string token) - (keyword? token) token - :else (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. the remaining tokens which were not consumed in constructing that fragment. -;; -;; In every case if the function cannot parse the desired construct from the -;; front of the sequence of tokens it returns nil. - - -(defn parse-numeric-value - "Parse a number." - [[value & remainder]] - (when (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, - whose value is assumed to be an integer." - [[value & remainder]] - (when value [(list 'mw-engine.utils/get-int 'cell (keyword value)) remainder])) - -(defn parse-property-value - "Parse a token assumed to be the name of a property of the current cell." - [[value & remainder]] - (when value [(list (keyword value) 'cell) remainder])) - -(defn parse-token-value - "Parse a token assumed to be a simple token value." - [[value & remainder]] - (when value [(keyword value) remainder])) - -(defn parse-simple-value - "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." - ([tokens expect-int] - (or - (parse-numeric-value tokens) - (cond expect-int (parse-property-int tokens) - :else (parse-token-value tokens)))) - ([tokens] - (parse-simple-value tokens false))) - -(defn gen-token-value - "Parse a single value from this single token and return just the generated - code, not a pair." - [token expect-int] - (first (parse-simple-value (list token) expect-int))) - -(defn parse-disjunct-value - "Parse a list of values from among these `tokens`. If `expect-int` is true, return - integers or things which will evaluate to integers." - [[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]) - :else - [(list value) tokens])))) - -(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 - (parse-disjunct-value tokens expect-int) - (parse-simple-value tokens expect-int))) - ([tokens] - (parse-value tokens false))) - -(defn parse-member-condition - "Parses a condition of the form '[property] in [value] or [value]...'" - [[property IS IN & rest]] - (when (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]))) - -(defn- parse-less-condition - "Parse '[property] less than [value]'." - [[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]))) - -(defn- parse-more-condition - "Parse '[property] more than [value]'." - [[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]))) - -(defn- parse-is-condition - "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]] - (when - (member? IS '("is" "are")) - (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 - "Parse the negation of a simple 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))) - -(defn parse-comparator-neighbours-condition - "Parse conditions of the form '...more than 6 neighbours are [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)))) - -(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)))] - (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))))))) - -(defn parse-neighbours-condition - "Parse conditions referring to neighbours" - [tokens] - (or - (parse-simple-neighbours-condition tokens) - (parse-comparator-neighbours-condition tokens) - (parse-some-neighbours-condition tokens))) - -(defn parse-simple-condition - "Parse conditions of the form '[property] [comparison] [value]'." - [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))) - -(defn- parse-disjunction-condition - "Parse '... or [condition]' from `tokens`, where `left` is the already parsed first disjunct." - [left tokens] - (let [partial (parse-conditions tokens)] - (when partial - (let [[right remainder] partial] - [(list 'or left right) remainder])))) - -(defn- parse-conjunction-condition - "Parse '... and [condition]' from `tokens`, where `left` is the already parsed first conjunct." - [left tokens] - (let [partial (parse-conditions tokens)] - (when partial - (let [[right remainder] partial] - [(list 'and left right) remainder])))) - -(defn- parse-conditions - "Parse conditions from `tokens`, where conditions may be linked by either 'and' or 'or'." - [tokens] - (let [partial (parse-simple-condition tokens)] - (when partial - (let [[left [next & remainder]] partial] - (cond - (= next "and") (parse-conjunction-condition left remainder) - (= next "or") (parse-disjunction-condition left remainder) - :else partial))))) - -(defn- parse-left-hand-side - "Parse the left hand side ('if...') of a production rule." - [[IF & tokens]] - (when - (= IF "if") - (parse-conditions tokens))) - -(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 - (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)) - (if - (re-matches re-number value) - (read-string value) - (list 'get-int 'cell (keyword value)))))}) - rest])) - -(defn- parse-set-action - "Parse actions of the form '[property] should be [value].'" - [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) (if - (re-matches re-number value) - (read-string value) - (keyword value))}) rest])) - -(defn- parse-simple-action [previous tokens] - (or (parse-arithmetic-action previous tokens) - (parse-set-action previous tokens))) - -(defn- parse-actions - "Parse actions from tokens." - [previous tokens] - (let [[left remainder] (parse-simple-action previous tokens)] - (cond left - (cond (= (first remainder) "and") - (parse-actions left (rest remainder)) - :else (list left))))) - -(defn- parse-probability - "Parse a probability of an action from this collection of tokens" - [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])))) - -(defn- parse-right-hand-side - "Parse the right hand side ('then...') of a production rule." - [[THEN & tokens]] - (when (= THEN "then") - (or - (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 - sequence of string tokens. Return the rule in the form of an S-expression. - - Throws an exception if parsing fails." - [line] - (if - (string? line) (let [rule (parse-rule (split (triml line) #"\s+"))] - (if rule rule - (throw (Exception. (format bad-parse-error line))))) - (let [[left remainder] (parse-left-hand-side line) - [right junk] (parse-right-hand-side remainder)] - (when - ;; 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 - "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?] - (let [afn (eval (parse-rule rule-text))] - (if - (and afn return-tuple?) - (list afn (trim rule-text)) - afn))) - ([rule-text] - (compile-rule rule-text false))) diff --git a/src/mw_parser/declarative.clj b/src/mw_parser/declarative.clj index 910c5e5..5e121db 100644 --- a/src/mw_parser/declarative.clj +++ b/src/mw_parser/declarative.clj @@ -1,12 +1,11 @@ (ns ^{:doc "A very simple parser which parses production rules." :author "Simon Brooke"} mw-parser.declarative - (:require [clojure.string :refer [join split split-lines trim]] + (:require [clojure.string :refer [join split-lines]] [instaparse.core :refer [parser]] [mw-parser.flow :refer [flow-grammar]] [mw-parser.generate :refer [generate]] [mw-parser.simplify :refer [simplify]] - [mw-parser.utils :refer [comment?]] [trptr.java-wrapper.locale :refer [get-default]]) (:import [java.util Locale])) @@ -33,11 +32,18 @@ ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def ruleset-grammar + "Experimental: parse a whole file in one go." + (join "\n" ["LINES := LINE | LINE CR LINES;" + "LINE := RULE | FLOW-RULE | CR | COMMENT | '' ;" + "CR := #'[\\r\\n]';" + "COMMENT := #'[;#]+[^\\r\\n]*' | #'/\\*.*\\*/'"])) + (def rule-grammar "Basic rule language grammar. in order to simplify translation into other natural languages, all - TOKENS within the parser should be unambiguou." + TOKENS within the parser should be unambiguous." (join "\n" ["RULE := IF SPACE CONDITIONS SPACE THEN SPACE ACTIONS;" "ACTIONS := ACTION | ACTION SPACE AND SPACE ACTIONS" "ACTION := SIMPLE-ACTION | PROBABLE-ACTION;" @@ -68,7 +74,7 @@ "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+';" + "SPACE := #'[ \\t]+';" "VALUE := SYMBOL | NUMBER;" "VALUE := SYMBOL | NUMBER;" "WITHIN-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE WITHIN SPACE NUMBER SPACE IS SPACE PROPERTY-CONDITION-OR-EXPRESSION;"])) @@ -121,61 +127,61 @@ ([^Locale _locale] keywords-en)) -(defmacro build-parser - "Compose this grammar fragment `g` with the common grammar fragments to - make a complete grammar, and return a parser for that complete grammar." - [g] - `(parser (join "\n" [~g common-grammar (keywords-for-locale)]))) - -(def parse-rule +(def parse "Parse the argument, assumed to be a string in the correct syntax, and return a parse tree." - (build-parser rule-grammar)) + (parser (join "\n" [ruleset-grammar rule-grammar flow-grammar common-grammar (keywords-for-locale)]))) -(def parse-flow - "Parse the argument, assumed to be a string in the correct syntax, and return a parse tree." - (build-parser flow-grammar)) - -(defn parse - "Top level parser function: parse this `text` as either a production or a flow rule; - return a raw parse tree." - [^String rule-text] - (let [text (trim rule-text)] - (when-not (zero? (count text)) - (case (first (split text #"\s+")) - "if" (parse-rule text) - "flow" (parse-flow text) - ";;" nil - (throw (ex-info "Rule text was not recognised" {:text text})))))) +(defn- compile-rule + "Compile a rule function from this `parse-tree` derived from this `source` + at the zero-based line number `n` in the source file; return a compiled + function, whose metadata has the keys: + + * `:rule-type` : the type of rule the function represents; + * `:parse` : this `parse-tree`; + * `:lisp` : the lisp source generated from this `parse-tree`; + * `:line : the one-based line number of the definition in the source file, + i.e. `(inc n)`." + [parse-tree source n] + (when-not (keyword? parse-tree) + (let [lisp (generate parse-tree) + line-no (inc n)] + (try + (if (#{'fn 'fn*} (first lisp)) + (vary-meta + (eval lisp) + merge (meta lisp) {:src source :lisp lisp :line line-no}) + (throw + (Exception. + (format "Parse of `%s` did not return a function: %s" source lisp)))) + (catch Exception any (throw (ex-info (.getMessage any) + {:source source + :parse parse-tree + :lisp lisp + :line line-no}))))))) (defn compile "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. + the compiling environment. + Returns a list of anonymous functions each of two arguments, `[cell world]`, + as expected for a MicroWorld rule function. Each function is decorated with + metadata having the keys: + + * `:rule-type` : the type of rule the function represents; + * `:lisp` : the lisp source from which the function was compiled; + * `:parse` : the parse-tree from which that lisp source was derived; + * `:source` : the rule source from which the parse-tree was derived; + * `:line : the one-based line number of the rule source in the source file. + Throws an exception if parsing fails." - ([rule-text return-tuple?] - (let [lines (map trim (remove comment? (split-lines rule-text)))] - (if (> (count lines) 1) - (map #(compile % return-tuple?) lines) - (let [src (first lines) - parse-tree (doall (simplify (parse src))) - fn' (doall (generate parse-tree)) - afn (try - (if (#{'fn 'fn*} (first fn')) - (vary-meta (eval fn') merge (meta fn')) - (throw (Exception. - (format "Parse of `%s` did not return a function: %s" - src fn')))) - (catch Exception any (throw (ex-info (.getMessage any) - {:src src - :parse parse-tree - :fn fn'}))))] - (if - return-tuple? - (vary-meta (list afn src fn') merge (meta afn)) - afn))))) - ([rule-text] - (compile rule-text false))) + [rule-text] + (let [lines (split-lines rule-text)] + (remove + nil? + (map + compile-rule + (simplify (parse rule-text)) + lines + (range (count lines)))))) \ No newline at end of file diff --git a/src/mw_parser/errors.clj b/src/mw_parser/errors.clj index ddc599e..462f424 100644 --- a/src/mw_parser/errors.clj +++ b/src/mw_parser/errors.clj @@ -24,8 +24,6 @@ ;; 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 diff --git a/src/mw_parser/generate.clj b/src/mw_parser/generate.clj index c7da5cc..8cc4580 100644 --- a/src/mw_parser/generate.clj +++ b/src/mw_parser/generate.clj @@ -1,8 +1,7 @@ (ns ^{:doc "Generate Clojure source from simplified parse trees." :author "Simon Brooke"} mw-parser.generate - (:require [mw-parser.errors :as pe] - [mw-parser.utils :refer [assert-type search-tree TODO]])) + (:require [mw-parser.utils :refer [assert-type search-tree TODO]])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; @@ -25,6 +24,9 @@ (declare generate generate-action) +(def reserved-properties-error + "The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions") + ;;; macros used in generated rules ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; production (if-then) rules ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -152,7 +154,7 @@ (let [property (generate (second tree)) expression (generate (nth tree 3))] (if (or (= property :x) (= property :y)) - (throw (Exception. pe/reserved-properties-error)) + (throw (Exception. reserved-properties-error)) (list 'merge (if (empty? others) 'cell ;; else diff --git a/src/mw_parser/simplify.clj b/src/mw_parser/simplify.clj index cab1071..d73e729 100644 --- a/src/mw_parser/simplify.clj +++ b/src/mw_parser/simplify.clj @@ -1,6 +1,6 @@ (ns ^{:doc "Simplify a parse tree." :author "Simon Brooke"} - mw-parser.simplify + mw-parser.simplify (:require [mw-parser.utils :refer [search-tree]])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -68,13 +68,32 @@ :ACTIONS (cons (first tree) (simplify (rest tree))) :AND nil :CHANCE-IN nil + :COMMENT nil :COMPARATIVE (simplify-second-of-two tree) :CONDITION (simplify-second-of-two tree) :CONDITIONS (simplify-second-of-two tree) + :CR nil :DISJUNCT-EXPRESSION (simplify-chained-list tree :DISJUNCT-VALUE :VALUE) :EXPRESSION (simplify-second-of-two tree) :FLOW-CONDITIONS (simplify-second-of-two tree) :IN nil + ;; this is like simplify-second-of-two except if there isn't + ;; a second element it returns nil + :LINE (when (= (count tree) 2) (simplify (nth tree 1))) + :LINES (loop [lines tree result '()] + (let [line (simplify (second lines)) + ;; the reason for putting :BLANK in the result in place + ;; of lines that weren't rules is so that we can keep + ;; track of the source text of the line we're compiling. + result' (concat result (list (or line :BLANK)))] + (when-not (= :LINES (first lines)) + (throw (ex-info "Unexpeced parse tree: LINES" + {:lines lines}))) + (case (count lines) + 2 result' + 4 (recur (nth lines 3) result') + (throw (ex-info "Unexpeced parse tree: LINES" + {:lines lines}))))) :PROPERTY (simplify-second-of-two tree) :PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree) :OR nil diff --git a/src/mw_parser/utils.clj b/src/mw_parser/utils.clj index 3cf2bfc..f2f3333 100644 --- a/src/mw_parser/utils.clj +++ b/src/mw_parser/utils.clj @@ -1,8 +1,6 @@ (ns ^{:doc "Utilities used in more than one namespace within the parser." :author "Simon Brooke"} - mw-parser.utils - (:require [clojure.string :refer [trim]] - [mw-engine.utils :refer [member?]])) + mw-parser.utils) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; @@ -27,11 +25,6 @@ ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defn comment? - "Is this `line` a comment?" - [line] - (or (empty? (trim line)) (member? (first line) '(nil \# \;)))) - (defn suitable-fragment? "Return `true` if `tree-fragment` appears to be a tree fragment of the expected `type`." [tree-fragment type] @@ -39,18 +32,11 @@ (keyword? type) (= (first tree-fragment) type))) -(defn rule? - "Return true if the argument appears to be a parsed rule tree, else false." - [maybe-rule] - (suitable-fragment? maybe-rule :RULE)) - (defn TODO "Marker to indicate I'm not yet finished!" [message] message) - - (defn assert-type "If `tree-fragment` is not a tree fragment of the expected `type`, throw an exception." [tree-fragment type] @@ -59,7 +45,6 @@ {:actual tree-fragment :expected 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] diff --git a/test/mw_parser/bulk_test.clj b/test/mw_parser/bulk_test.clj deleted file mode 100644 index 382125a..0000000 --- a/test/mw_parser/bulk_test.clj +++ /dev/null @@ -1,25 +0,0 @@ -(ns mw-parser.bulk-test - (:require [clojure.java.io :refer [as-file]] - [clojure.test :refer [deftest is testing]] - [mw-parser.bulk :refer [compile-file parse-file]])) - -(deftest bulk-parsing-test - (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 - (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 - (as-file "resources/rules.txt"))))) - "all compiled rules should be ifns") - )) - diff --git a/test/mw_parser/core_test.clj b/test/mw_parser/core_test.clj deleted file mode 100644 index a64f52f..0000000 --- a/test/mw_parser/core_test.clj +++ /dev/null @@ -1,475 +0,0 @@ -(ns mw-parser.core-test - (:require [clojure.test :refer [deftest is testing]] - [mw-engine.core :refer [transform-world]] - [mw-engine.world :refer [make-world]] - [mw-parser.core :refer [compile-rule parse-property-value - parse-rule parse-simple-value - parse-value]])) - -(deftest primitives-tests - (testing "Simple functions supporting the parser" - (is (= (parse-simple-value '()) nil) - "if there's nothing to parse, return nil") - (is (= (first (parse-simple-value '("1234" "and" "that"))) 1234) - "a simple value is expected to be just a number.") - (is (= (first (parse-simple-value '("this" "and" "that"))) :this) - "or else just a keyword") - (is (= (first (parse-simple-value '("this" "and" "that") true)) - '(mw-engine.utils/get-int cell :this)) - "...unless an integer is explicitly sought, in which case it should be something which gets an integer from the current cell") - (is (= (parse-value '()) nil) - "if there's nothing to parse, return nil") - (is (= (first (parse-value '("1234" "and" "that"))) 1234) - "a simple value is expected to be just a number.") - (is (= (first (parse-value '("this" "and" "that"))) :this) - "or else just a keyword") - (is (= (first (parse-value '("this" "and" "that") true)) - '(mw-engine.utils/get-int cell :this)) - "...unless an integer is explicitly sought, in which case it should be something which gets an integer from the current cell") - (is (= (parse-property-value '()) nil) - "if there's nothing to parse, return nil") - (is (= (first (parse-property-value '("this" "and" "that"))) '(:this cell)) - "Parsing a property value returns a code function to pull its value off the current cell"))) - - -(deftest rules-tests - (testing "Rule parser - does not test whether generated functions actually work, just that something is generated!" - (is (parse-rule "if altitude is less than 100 and state is forest then state should be climax and deer should be 3")) - (is (parse-rule "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3")) - (is (parse-rule "if altitude is 100 or fertility is 25 then state should be heath")) - (is (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 (parse-rule "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves")) - (is (parse-rule "if state is grassland and 4 neighbours have state equal to water then state should be village")) - (is (parse-rule "if state is forest and fertility is between 55 and 75 then state should be climax")) - (is (parse-rule "if 6 neighbours have state equal to water then state should be village")) - (is (parse-rule "if state is in grassland or pasture or heath and 4 neighbours are water then state should be village")) - (is (parse-rule "if state is climax and some neighbours have state equal to fire then 3 chance in 5 state should be fire")) - (is (parse-rule "if state is pasture and more than 3 neighbours have state equal to scrub then state should be scrub")))) - -(deftest exception-tests - (testing "Constructions which should cause exceptions to be thrown" - (is (thrown-with-msg? Exception #"^I did not understand.*" - (parse-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" - (parse-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" - (parse-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"))) - -(deftest correctness-tests - (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")) - - (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"))) - - (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"))) - - (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"))) - - (testing "Can't set x or y properties" - (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'")) - - (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"))) - - (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"))) - - (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"))) - - (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"))) - - (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"))) - - (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' 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."))) - - (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."))) - - (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."))) - - (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."))) - - (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."))) - - (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."))) - -;; 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."))) - - (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."))) - -;; 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."))) - -;; 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."))) - -;; 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."))) - -;; 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."))) - -;; 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."))) - -;; 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."))) - -;; '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"))) - -;; 'property should be symbolic-value' and 'property should be numeric-value' -;; already tested in tests above - -;; 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"))) - -;; 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"))) - - (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"))) - - (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"))) - - (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"))) - - (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"))) - - (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"))) - - (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"))) - - (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"))) - -;; 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."))) - -;; 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.")))) diff --git a/test/mw_parser/declarative_test.clj b/test/mw_parser/declarative_test.clj index 8d3f8b4..6a0bb67 100644 --- a/test/mw_parser/declarative_test.clj +++ b/test/mw_parser/declarative_test.clj @@ -1,34 +1,43 @@ (ns mw-parser.declarative-test - (:require [clojure.test :refer [deftest is testing]] + (:require [clojure.string :refer [join]] + [clojure.test :refer [deftest is testing]] [mw-engine.core :refer [transform-world]] [mw-engine.utils :refer [get-cell]] [mw-engine.world :refer [make-world]] - [mw-parser.declarative :refer [compile parse parse-rule]] - [mw-parser.utils :refer [rule?]])) + [mw-parser.declarative :refer [compile parse]] + [mw-parser.generate :refer [generate]] + [mw-parser.simplify :refer [simplify]] + [mw-parser.utils :refer [suitable-fragment?]])) + + +(defn rule? + "Return true if the argument appears to be a parsed rule tree, else false." + [maybe-rule] + (suitable-fragment? maybe-rule :RULE)) (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"))))) + (is (rule? (parse "if state is forest then state should be climax"))) + (is (rule? (parse "if state is in grassland or pasture or heath then state should be village"))) + (is (rule? (parse "if altitude is less than 100 and state is forest then state should be climax and deer should be 3"))) + (is (rule? (parse "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3"))) + (is (rule? (parse "if altitude is 100 or fertility is 25 then state should be heath"))) + (is (rule? (parse "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 "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves"))) + (is (rule? (parse "if state is forest and fertility is between 55 and 75 then state should be climax"))) + (is (rule? (parse "if fertility is between 55 and 75 then state should be climax"))) + (is (rule? (parse "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"))))) + (is (rule? (parse "if state is climax and some neighbours have state equal to fire then 3 chance in 5 state should be fire"))) + (is (rule? (parse "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 "if 6 neighbours have state equal to water then state should be village"))) + (is (rule? (parse "if state is grassland and 4 neighbours have state equal to water then state should be village"))) + (is (rule? (parse "if state is pasture and more than 3 neighbours have state equal to scrub then state should be scrub"))) + (is (rule? (parse "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 "if state is grassland and 4 neighbours have state equal to water then state should be village"))) + (is (rule? (parse "if 6 neighbours have state equal to water then state should be village"))))) (deftest exception-tests @@ -39,20 +48,22 @@ (is (thrown-with-msg? Exception #"^I did not understand.*" (parse "if i have a cat on my lap then everything is fine")) "Exception thrown if rule text does not match grammar") + ;; TODO: these two should be moved to generate-test; the exception should be + ;; being thrown (but isn't) in the generate phase. (is (thrown-with-msg? Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions" - (parse "if state is new then x should be 0")) + (generate (simplify (parse "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" - (parse "if state is new then y should be 0")) + (generate (simplify (parse "if state is new then y should be 0")))) "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. (testing "Simplest possible rule" - (let [afn (compile "if state is new then state should be grassland")] + (let [afn (first (compile "if state is new then state should be grassland"))] (is (= (apply afn (list {:state :new} nil)) {:state :grassland}) "Rule fires when condition is met") @@ -60,7 +71,7 @@ "Rule doesn't fire when condition isn't met"))) (testing "Condition conjunction rule" - (let [afn (compile "if state is new and altitude is 0 then state should be water")] + (let [afn (first (compile "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") @@ -70,7 +81,7 @@ "Rule does not fire: first condition not met"))) (testing "Condition disjunction rule" - (let [afn (compile "if state is new or state is waste then state should be grassland")] + (let [afn (first (compile "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") @@ -81,7 +92,7 @@ "Rule does not fire: neither condition met"))) (testing "Simple negation rule" - (let [afn (compile "if state is not new then state should be grassland")] + (let [afn (first (compile "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)) @@ -91,15 +102,15 @@ (testing "Can't set x or y properties" (is (thrown-with-msg? Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions" - (compile "if state is new then x should be 0")) + (first (compile "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 "if state is new then y should be 0")) + (first (compile "if state is new then y should be 0"))) "Exception thrown on attempt to set 'y'")) (testing "Simple list membership rule" - (let [afn (compile "if state is in heath or scrub or forest then state should be climax")] + (let [afn (first (compile "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") @@ -113,7 +124,7 @@ "Rule does not fire when condition is not met"))) (testing "Negated list membership rule" - (let [afn (compile "if state is not in heath or scrub or forest then state should be climax")] + (let [afn (first (compile "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))) @@ -125,7 +136,7 @@ "Rule fires when condition is met"))) (testing "Property is more than numeric-value" - (let [afn (compile "if altitude is more than 200 then state should be snow")] + (let [afn (first (compile "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") @@ -133,7 +144,7 @@ "Rule does not fire when condition is not met"))) (testing "Property is more than property" - (let [afn (compile "if wolves are more than deer then deer should be 0")] + (let [afn (first (compile "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") @@ -141,7 +152,7 @@ "Rule does not fire when condition is not met"))) (testing "Property is less than numeric-value" - (let [afn (compile "if altitude is less than 10 then state should be water")] + (let [afn (first (compile "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") @@ -149,7 +160,7 @@ "Rule does not fire when condition is not met"))) (testing "Property is less than property" - (let [afn (compile "if wolves are less than deer then deer should be deer - wolves")] + (let [afn (first (compile "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") @@ -157,14 +168,14 @@ "Rule does not fire when condition is not met"))) (testing "Number neighbours have property equal to value" - (let [afn (compile "if 3 neighbours have state equal to new then state should be water") + (let [afn (first (compile "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 "if 3 neighbours are new then state should be water") + (let [afn (first (compile "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)) @@ -172,7 +183,7 @@ "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 "if 3 neighbours is new then state should be water") + (let [afn (first (compile "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)) @@ -183,76 +194,80 @@ (testing "Number neighbours have property more than numeric-value" ;; if 3 neighbours have altitude more than 10 then state should be beach - (let [afn (compile "if 3 neighbours have altitude more than 10 then state should be beach") + (let [afn (first (compile "if 3 neighbours have altitude more than 10 then state should be beach")) world (transform-world (make-world 3 3) - (list (compile "if x is 2 then altitude should be 11") - (compile "if x is less than 2 then altitude should be 0")))] + (compile (join "\n" ["if x is 2 then altitude should be 11" + "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 "if 5 neighbours have altitude less than 10 then state should be beach") + (let [afn (first (compile "if 5 neighbours have altitude less than 10 then state should be beach")) world (transform-world (make-world 3 3) - (list (compile "if x is 2 then altitude should be 11") - (compile "if x is less than 2 then altitude should be 0")))] + (compile (join "\n" ["if x is 2 then altitude should be 11" + "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 "if more than 2 neighbours have altitude equal to 11 then state should be beach") + (let [afn (first (compile "if more than 2 neighbours have altitude equal to 11 then state should be beach")) world (transform-world (make-world 3 3) - (list (compile "if x is 2 then altitude should be 11") - (compile "if x is less than 2 then altitude should be 0")))] + (compile (join "\n" ["if x is 2 then altitude should be 11" + "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 "if more than 2 neighbours have state equal to grassland then state should be beach") + (let [afn (first (compile "if more than 2 neighbours have state equal to grassland then state should be beach")) world (transform-world (make-world 3 3) - (list (compile "if x is 2 then altitude should be 11 and state should be grassland") - (compile "if x is less than 2 then altitude should be 0 and state should be water")))] + (compile + (join "\n" + (list "if x is 2 then altitude should be 11 and state should be grassland" + "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 "if more than 2 neighbours are grassland then state should be beach") + (let [afn (first (compile "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 "if x is 2 then altitude should be 11 and state should be grassland") - (compile "if x is less than 2 then altitude should be 0 and state should be water")))] + (compile (join "\n" (list "if x is 2 then altitude should be 11 and state should be grassland" + "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 "if fewer than 3 neighbours have altitude equal to 11 then state should be beach") + (let [afn (first (compile "if fewer than 3 neighbours have altitude equal to 11 then state should be beach")) world (transform-world (make-world 3 3) - (list (compile "if x is 2 then altitude should be 11") - (compile "if x is less than 2 then altitude should be 0")))] + (compile (join "\n" (list "if x is 2 then altitude should be 11" + "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 "if fewer than 3 neighbours have state equal to grassland then state should be beach") + (let [afn (first (compile "if fewer than 3 neighbours have state equal to grassland then state should be beach")) world (transform-world (make-world 3 3) - (list (compile "if x is 2 then altitude should be 11 and state should be grassland") - (compile "if x is less than 2 then altitude should be 0 and state should be water")))] + (compile + (join "\n" + (list "if x is 2 then altitude should be 11 and state should be grassland" + "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))) @@ -260,22 +275,26 @@ ;; some neighbours have property equal to value (testing "Some neighbours have property equal to numeric-value" - (let [afn (compile "if some neighbours have altitude equal to 11 then state should be beach") + (let [afn (first (compile "if some neighbours have altitude equal to 11 then state should be beach")) world (transform-world (make-world 3 3) - (list (compile "if x is 2 then altitude should be 11") - (compile "if x is less than 2 then altitude should be 0")))] + (compile + (join "\n" + (list "if x is 2 then altitude should be 11" + "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 "if some neighbours have state equal to grassland then state should be beach") + (let [afn (first (compile "if some neighbours have state equal to grassland then state should be beach")) world (transform-world (make-world 3 3) - (list (compile "if x is 2 then altitude should be 11 and state should be grassland") - (compile "if x is less than 2 then altitude should be 0 and state should be water")))] + (compile + (join "\n" + (list "if x is 2 then altitude should be 11 and state should be grassland" + "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))) @@ -283,11 +302,13 @@ ;; more than number neighbours have property more than numeric-value (testing "More than number neighbours have property more than symbolic-value" - (let [afn (compile "if more than 2 neighbours have altitude more than 10 then state should be beach") + (let [afn (first (compile "if more than 2 neighbours have altitude more than 10 then state should be beach")) world (transform-world (make-world 3 3) - (list (compile "if x is 2 then altitude should be 11 and state should be grassland") - (compile "if x is less than 2 then altitude should be 0 and state should be water")))] + (compile + (join "\n" + (list "if x is 2 then altitude should be 11 and state should be grassland" + "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))) @@ -295,11 +316,13 @@ ;; fewer than number neighbours have property more than numeric-value (testing "Fewer than number neighbours have property more than numeric-value" - (let [afn (compile "if fewer than 3 neighbours have altitude more than 10 then state should be beach") + (let [afn (first (compile "if fewer than 3 neighbours have altitude more than 10 then state should be beach")) world (transform-world (make-world 3 3) - (list (compile "if x is 2 then altitude should be 11") - (compile "if x is less than 2 then altitude should be 0")))] + (compile + (join "\n" + (list "if x is 2 then altitude should be 11" + "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))) @@ -307,11 +330,13 @@ ;; some neighbours have property more than numeric-value (testing "Some neighbours have property more than numeric-value" - (let [afn (compile "if some neighbours have altitude more than 10 then state should be beach") + (let [afn (first (compile "if some neighbours have altitude more than 10 then state should be beach")) world (transform-world (make-world 3 3) - (list (compile "if x is 2 then altitude should be 11") - (compile "if x is less than 2 then altitude should be 0")))] + (compile + (join "\n" + (list "if x is 2 then altitude should be 11" + "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))) @@ -319,11 +344,13 @@ ;; more than number neighbours have property less than numeric-value (testing "More than number neighbours have property less than numeric-value" - (let [afn (compile "if more than 4 neighbours have altitude less than 10 then state should be beach") + (let [afn (first (compile "if more than 4 neighbours have altitude less than 10 then state should be beach")) world (transform-world (make-world 3 3) - (list (compile "if x is 2 then altitude should be 11") - (compile "if x is less than 2 then altitude should be 0")))] + (compile + (join "\n" + (list "if x is 2 then altitude should be 11" + "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))) @@ -331,11 +358,13 @@ ;; fewer than number neighbours have property less than numeric-value (testing "Fewer than number neighbours have property less than numeric-value" - (let [afn (compile "if fewer than 4 neighbours have altitude less than 10 then state should be beach") + (let [afn (first (compile "if fewer than 4 neighbours have altitude less than 10 then state should be beach")) world (transform-world (make-world 3 3) - (list (compile "if x is 2 then altitude should be 11") - (compile "if x is less than 2 then altitude should be 0")))] + (compile + (join "\n" + (list "if x is 2 then altitude should be 11" + "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) @@ -343,11 +372,13 @@ ;; some neighbours have property less than numeric-value (testing "Some number neighbours have property less than numeric-value" - (let [afn (compile "if some neighbours have altitude less than 10 then state should be beach") + (let [afn (first (compile "if some neighbours have altitude less than 10 then state should be beach")) world (transform-world (make-world 3 3) - (list (compile "if x is less than 2 then altitude should be 11") - (compile "if x is 2 then altitude should be 0")))] + (compile + (join "\n" + (list "if x is less than 2 then altitude should be 11" + "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))) @@ -357,7 +388,7 @@ ;; 'single action' already tested in 'condition' tests above ;; action and actions (testing "Conjunction of actions" - (let [afn (compile "if state is new then state should be grassland and fertility should be 0")] + (let [afn (first (compile "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"))) @@ -367,23 +398,23 @@ ;; number chance in number property should be value (testing "Syntax of probability rule - action of real probability very hard to test" - (let [afn (compile "if state is forest then 5 chance in 5 state should be climax")] + (let [afn (first (compile "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 "if state is forest then 0 chance in 5 state should be climax")] + (let [afn (first (compile "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 (testing "Arithmetic action: addition of number" - (let [afn (compile "if state is climax then fertility should be fertility + 1")] + (let [afn (first (compile "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 "if state is climax then fertility should be fertility + leaffall")] + (let [afn (first (compile "if state is climax then fertility should be fertility + leaffall"))] (is (= (:fertility (apply afn (list {:state :climax @@ -393,14 +424,14 @@ "Addition is executed"))) (testing "Arithmetic action: subtraction of number" - (let [afn (compile "if state is crop then fertility should be fertility - 1")] + (let [afn (first (compile "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 "if wolves are more than 0 then deer should be deer - wolves")] + (let [afn (first (compile "if wolves are more than 0 then deer should be deer - wolves"))] (is (= (:deer (apply afn (list {:deer 3 @@ -409,14 +440,14 @@ "Action is executed"))) (testing "Arithmetic action: multiplication by number" - (let [afn (compile "if deer are more than 1 then deer should be deer * 2")] + (let [afn (first (compile "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 "if state is crop then deer should be deer * deer")] + (let [afn (first (compile "if state is crop then deer should be deer * deer"))] (is (= (:deer (apply afn (list {:state :crop :deer 2} nil))) @@ -424,14 +455,14 @@ "Action is executed"))) (testing "Arithmetic action: division by number" - (let [afn (compile "if wolves are more than 0 then deer should be deer / 2")] + (let [afn (first (compile "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 "if wolves are more than 0 then deer should be deer / wolves")] + (let [afn (first (compile "if wolves are more than 0 then deer should be deer / wolves"))] (is (= (:deer (apply afn (list {:deer 2 :wolves 2} nil))) @@ -440,7 +471,7 @@ ;; simple within distance (testing "Number neighbours within distance have property equal to value" - (let [afn (compile "if 8 neighbours within 2 have state equal to new then state should be water") + (let [afn (first (compile "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}) @@ -450,7 +481,7 @@ ;; comparator within distance (testing "More than number neighbours within distance have property equal to symbolic-value" - (let [afn (compile "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") + (let [afn (first (compile "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 @@ -459,8 +490,10 @@ ;; xxooo world (transform-world (make-world 5 5) - (list (compile "if x is less than 2 then altitude should be 11 and state should be grassland") - (compile "if x is more than 1 then altitude should be 0 and state should be water")))] + (compile + (join "\n" + (list "if x is less than 2 then altitude should be 11 and state should be grassland" + "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))) @@ -468,11 +501,13 @@ (deftest regression-tests (testing "Rule in default set which failed on switchover to declarative rules" - (let [afn (compile "if state is scrub then 1 chance in 1 state should be forest") + (let [afn (first (compile "if state is scrub then 1 chance in 1 state should be forest")) world (transform-world (make-world 3 3) - (list (compile "if x is 2 then altitude should be 11") - (compile "if x is less than 2 then state should be scrub")))] + (compile + (join "\n" + (list "if x is 2 then altitude should be 11" + "if x is less than 2 then state should be scrub"))))] (is (= (:state (apply afn (list (get-cell world 1 1) world))) :forest) "Centre cell is scrub, so rule should fire") (is (= (apply afn (list (get-cell world 2 1) world)) nil) diff --git a/test/mw_parser/flow_test.clj b/test/mw_parser/flow_test.clj index 77dbaea..cf8af5b 100644 --- a/test/mw_parser/flow_test.clj +++ b/test/mw_parser/flow_test.clj @@ -4,7 +4,7 @@ [mw-parser.declarative :refer [parse]] [mw-parser.simplify :refer [simplify]])) -(deftest parse-flow-tests +(deftest parse-tests (testing "flow-grammar" (let [rule "flow 1 food from house having food more than 10 to house within 2 with least food" expected '(:FLOW-RULE diff --git a/test/mw_parser/generate_test.clj b/test/mw_parser/generate_test.clj index a097c6d..1547e85 100644 --- a/test/mw_parser/generate_test.clj +++ b/test/mw_parser/generate_test.clj @@ -112,7 +112,7 @@ world [[{:y 0, :state :new, :x 0} {:y 0, :state :new, :x 1} {:y 0, :state :new, :x 2}] [{:y 1, :state :new, :x 0} cell {:y 1, :state :new, :x 2}] [{:y 2, :state :new, :x 0} {:y 2, :state :new, :x 1} {:y 2, :state :new, :x 2}]] - rule (compile "if state is scrub then 1 chance in 5 state should be forest") + rule (first (compile "if state is scrub then 1 chance in 5 state should be forest")) expected #{:scrub :forest} cell' (reduce (fn [c i] (merge (or (apply-rule world c rule) c) {:i i})) diff --git a/test/mw_parser/simplify_test.clj b/test/mw_parser/simplify_test.clj index a585567..ed32373 100644 --- a/test/mw_parser/simplify_test.clj +++ b/test/mw_parser/simplify_test.clj @@ -1,6 +1,6 @@ (ns mw-parser.simplify-test (:require [clojure.test :refer [deftest is testing]] - [mw-parser.declarative :refer [parse-rule]] + [mw-parser.declarative :refer [parse]] [mw-parser.simplify :refer [simplify]] [mw-parser.utils :refer [search-tree]])) @@ -81,7 +81,7 @@ (:SYMBOL "scrub") (:DISJUNCT-VALUE (:SYMBOL "forest"))))) parse-tree (search-tree - (parse-rule + (parse "if state is not in heath or scrub or forest then state should be climax") :DISJUNCT-EXPRESSION) actual (simplify parse-tree)] @@ -91,7 +91,7 @@ (:SYMBOL "scrub") (:SYMBOL "forest")) parse-tree (search-tree - (parse-rule + (parse "if state is not in heath or scrub or forest then state should be climax") :DISJUNCT-EXPRESSION) actual (simplify parse-tree)] diff --git a/test/mw_parser/utils_test.clj b/test/mw_parser/utils_test.clj deleted file mode 100644 index 653fc92..0000000 --- a/test/mw_parser/utils_test.clj +++ /dev/null @@ -1,30 +0,0 @@ -(ns mw-parser.utils-test - (:require [clojure.test :refer [deftest is testing]] - [mw-parser.utils :refer [assert-type rule? search-tree - suitable-fragment? TODO]])) - -(deftest fragment-tests - (testing "Functions finding and identifying rule fragments" - (let [rule '(:RULE - (:IF "if") - (:PROPERTY-CONDITION - (:SYMBOL "state") - (:QUALIFIER (:EQUIVALENCE (:IS "is"))) - (:SYMBOL "forest")) - (:ACTIONS - (:SIMPLE-ACTION - (:SYMBOL "state") - (:BECOMES "should be") - (:SYMBOL "climax")))) - not-rule [:FROBOZ :foo :bar :ban]] - (is (rule? rule)) - (is (not (rule? not-rule))) - (is (= nil (assert-type rule :RULE))) - (is (thrown-with-msg? - Exception #"Expected a :RULE fragment" (assert-type not-rule :RULE))) - (is (= '(:EQUIVALENCE (:IS "is")) (search-tree rule :EQUIVALENCE))) - (is (= nil (search-tree rule :EQUIVOCATION))) - (is (suitable-fragment? '(:EQUIVALENCE (:IS "is")) :EQUIVALENCE)) - (is (not (suitable-fragment? :EQUIVALENCE :EQUIVALENCE))) - (is (not (suitable-fragment? '(:EQUIVALENCE (:IS "is")) :QUALIFIER))) - (is (= (TODO "Froboz") "Froboz"))))) \ No newline at end of file