diff --git a/src/mw_parser/bulk.clj b/src/mw_parser/bulk.clj index 00ecd14..2aba74c 100644 --- a/src/mw_parser/bulk.clj +++ b/src/mw_parser/bulk.clj @@ -1,13 +1,32 @@ -;; parse multiple rules from a stream, possibly a file - although the real -;; objective is to parse rules out of a block of text from a textarea - -(ns mw-parser.bulk +(ns ^{:doc "parse multiple rules from a stream, possibly a file." + :author "Simon Brooke"} + mw-parser.bulk (:use mw-parser.declarative mw-engine.utils clojure.java.io [clojure.string :only [split trim]]) (:import (java.io BufferedReader StringReader))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;; USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (defn comment? "Is this `line` a comment?" [line] diff --git a/src/mw_parser/core.clj b/src/mw_parser/core.clj index aafd595..f130f81 100644 --- a/src/mw_parser/core.clj +++ b/src/mw_parser/core.clj @@ -1,3 +1,30 @@ +(ns ^{:doc "A very simple parser which parses production rules." + :author "Simon Brooke"} + mw-parser.core + (:use mw-engine.utils + [clojure.string :only [split trim triml]]) + (:gen-class) +) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;; USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;; A very simple parser which parses production rules of the following forms: ;; ;; * "if altitude is less than 100 and state is forest then state should be climax and deer should be 3" @@ -11,35 +38,31 @@ ;; * "if state is in grassland or pasture or heath and 4 neighbours are water then state should be village" ;; * "if state is forest or state is climax and some neighbours have state equal to fire then 3 in 5 chance that state should be fire" ;; * "if state is pasture and more than 3 neighbours have state equal to scrub then state should be scrub" -;; * +;; * ;; ;; it generates rules in the form expected by `mw-engine.core`, q.v. ;; -;; It is, as I say, very simple; it generates a complete rule, or it fails completely, returning nil. +;; It is, as I say, very simple; it generates a complete rule, or it fails completely, returning nil. ;; Very occasionally it generates a wrong rule - one which is not a correct translation of the rule ;; semantics - but that is buggy behaviour, which I'll try to fix over the next few weeks, not a ;; design fault. ;; ;; More significantly it does not generate useful error messages on failure. ;; -;; This is the parser that is actually used currently; but see also insta.clj, +;; This is the parser that is actually used currently; but see also insta.clj, ;; which is potentially a much better parser but does not quite work yet. - -(ns mw-parser.core - (:use mw-engine.utils - [clojure.string :only [split trim triml]]) - (:gen-class) -) +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (declare parse-conditions) (declare parse-not-condition) (declare parse-simple-condition) -;; a regular expression which matches string representation of numbers +;; a regular expression which matches string representation of positive numbers (def re-number #"^[0-9.]*$") ;; error thrown when an attempt is made to set a reserved property -(def reserved-properties-error +(def reserved-properties-error "The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions") ;; error thrown when a rule cannot be parsed (def bad-parse-error "I did not understand '%s'") @@ -48,12 +71,12 @@ "If this token appears to represent an explicit number, return that number; otherwise, make a keyword of it and return that." [token] - (cond + (cond (re-matches re-number token) (read-string token) (keyword? token) token true (keyword token))) -;; Generally all functions in this file with names beginning 'parse-' take a +;; Generally all functions in this file with names beginning 'parse-' take a ;; sequence of tokens (and in some cases other optional arguments) and return a ;; vector comprising ;; @@ -70,7 +93,7 @@ (if (and value (re-matches re-number value)) [(read-string value) remainder])) (defn parse-property-int - "Parse a token assumed to be the name of a property of the current cell, + "Parse a token assumed to be the name of a property of the current cell, whose value is assumed to be an integer." [[value & remainder]] (if value [(list 'get-int 'cell (keyword value)) remainder])) @@ -115,12 +138,12 @@ [(cons value others) remainder]) true [(list value) tokens])))) - -(defn parse-value + +(defn parse-value "Parse a value from among these `tokens`. If `expect-int` is true, return an integer or something which will evaluate to an integer." ([tokens expect-int] - (or + (or (parse-disjunct-value tokens expect-int) (parse-simple-value tokens expect-int))) ([tokens] @@ -158,18 +181,18 @@ (list '> value1 property value2)) rest]))) (defn- parse-is-condition - "Parse clauses of the form 'x is y', 'x is in y or z...', + "Parse clauses of the form 'x is y', 'x is in y or z...', 'x is between y and z', 'x is more than y' or 'x is less than y'. It is necessary to disambiguate whether value is a numeric or keyword." [[property IS value & rest]] - (cond + (cond (member? IS '("is" "are")) (let [tokens (cons property (cons value rest))] - (cond + (cond (re-matches re-number value) [(list '= (list 'get-int 'cell (keyword property)) (read-string value)) rest] value [(list '= (list (keyword property) 'cell) (keyword value)) rest])))) -(defn- parse-not-condition +(defn- parse-not-condition "Parse the negation of a simple condition." [[property IS NOT & rest]] (cond (and (member? IS '("is" "are")) (= NOT "not")) @@ -179,11 +202,11 @@ [(list 'not condition) remainder]))))) (defn- gen-neighbours-condition - ([comp1 quantity property value remainder comp2 distance] - [(list comp1 + ([comp1 quantity property value remainder comp2 distance] + [(list comp1 (list 'count - (list 'get-neighbours-with-property-value 'world - '(cell :x) '(cell :y) distance + (list 'get-neighbours-with-property-value 'world + '(cell :x) '(cell :y) distance (keyword property) (keyword-or-numeric value) comp2)) quantity) remainder]) @@ -195,21 +218,21 @@ [[MORE THAN n NEIGHBOURS WITHIN distance have-or-are & rest]] (let [quantity (first (parse-numeric-value (list n))) comparator (cond (= MORE "more") '> - (member? MORE '("fewer" "less")) '<)] + (member? MORE '("fewer" "less")) '<)] (cond (not= WITHIN "within") - (parse-comparator-neighbours-condition - (flatten + (parse-comparator-neighbours-condition + (flatten ;; two tokens were mis-parsed as 'within distance' that weren't ;; actually 'within' and a distance. Splice in 'within 1' and try ;; again. (list MORE THAN n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest))) - (and quantity + (and quantity comparator (= THAN "than") (= NEIGHBOURS "neighbours")) (cond - (= have-or-are "are") + (= have-or-are "are") (let [[value & remainder] rest dist (gen-token-value distance true)] (gen-neighbours-condition comparator quantity :state value remainder = dist)) @@ -217,16 +240,16 @@ (let [[property comp1 comp2 value & remainder] rest dist (gen-token-value distance true)] (cond (and (= comp1 "equal") (= comp2 "to")) - (gen-neighbours-condition comparator quantity property + (gen-neighbours-condition comparator quantity property value remainder = dist) (and (= comp1 "more") (= comp2 "than")) - (gen-neighbours-condition comparator quantity property + (gen-neighbours-condition comparator quantity property value remainder > dist) (and (= comp1 "less") (= comp2 "than")) - (gen-neighbours-condition comparator quantity property + (gen-neighbours-condition comparator quantity property value remainder < dist) )))))) - + (defn parse-some-neighbours-condition [[SOME NEIGHBOURS & rest]] (cond @@ -236,18 +259,18 @@ (defn parse-simple-neighbours-condition "Parse conditions of the form '...6 neighbours are [condition]'" [[n NEIGHBOURS WITHIN distance have-or-are & rest]] - (let [quantity (first (parse-numeric-value (list n)))] + (let [quantity (first (parse-numeric-value (list n)))] (cond (and quantity (= NEIGHBOURS "neighbours")) (cond (not= WITHIN "within") (parse-simple-neighbours-condition - (flatten + (flatten ;; two tokens were mis-parsed as 'within distance' that weren't ;; actually 'within' and a distance. Splice in 'within 1' and try ;; again. (list n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest))) - (= have-or-are "are") + (= have-or-are "are") (let [[value & remainder] rest dist (gen-token-value distance true)] (gen-neighbours-condition '= quantity :state value remainder = dist)) @@ -255,16 +278,16 @@ (let [[property comp1 comp2 value & remainder] rest dist (gen-token-value distance true)] (cond (and (= comp1 "equal") (= comp2 "to")) - (gen-neighbours-condition '= quantity property value remainder = + (gen-neighbours-condition '= quantity property value remainder = dist) (and (= comp1 "more") (= comp2 "than")) - (gen-neighbours-condition '= quantity property value remainder > + (gen-neighbours-condition '= quantity property value remainder > dist) (and (= comp1 "less") (= comp2 "than")) - (gen-neighbours-condition '= quantity property value remainder < + (gen-neighbours-condition '= quantity property value remainder < dist) )))))) - + (defn parse-neighbours-condition "Parse conditions referring to neighbours" [tokens] @@ -320,30 +343,30 @@ (= IF "if") (parse-conditions tokens))) -(defn- parse-arithmetic-action +(defn- parse-arithmetic-action "Parse actions of the form '[property] should be [property] [arithmetic-operator] [value]', e.g. 'fertility should be fertility + 1', or 'deer should be deer - wolves'." [previous [prop1 SHOULD BE prop2 operator value & rest]] (cond (member? prop1 '("x" "y")) - (throw + (throw (Exception. reserved-properties-error)) (and (= SHOULD "should") (= BE "be") (member? operator '("+" "-" "*" "/"))) [(list 'merge (or previous 'cell) - {(keyword prop1) (list 'int + {(keyword prop1) (list 'int (list (symbol operator) (list 'get-int 'cell (keyword prop2)) (cond (re-matches re-number value) (read-string value) true (list 'get-int 'cell (keyword value)))))}) rest])) -(defn- parse-set-action +(defn- parse-set-action "Parse actions of the form '[property] should be [value].'" [previous [property SHOULD BE value & rest]] - (cond + (cond (member? property '("x" "y")) - (throw + (throw (Exception. reserved-properties-error)) (and (= SHOULD "should") (= BE "be")) [(list 'merge (or previous 'cell) @@ -362,19 +385,19 @@ (parse-actions left (rest remainder)) true (list left))))) -(defn- parse-probability +(defn- parse-probability "Parse a probability of an action from this collection of tokens" [previous [n CHANCE IN m & tokens]] - (cond + (cond (and (= CHANCE "chance")(= IN "in")) (let [[action remainder] (parse-actions previous tokens)] (cond action - [(list 'cond - (list '< - (list 'rand + [(list 'cond + (list '< + (list 'rand (first (parse-simple-value (list m) true))) - (first (parse-simple-value (list n) true))) - action) remainder])))) + (first (parse-simple-value (list n) true))) + action) remainder])))) (defn- parse-right-hand-side "Parse the right hand side ('then...') of a production rule." @@ -384,27 +407,27 @@ (parse-probability nil tokens) (parse-actions nil tokens)))) -(defn parse-rule - "Parse a complete rule from this `line`, expected to be either a string or a +(defn parse-rule + "Parse a complete rule from this `line`, expected to be either a string or a sequence of string tokens. Return the rule in the form of an S-expression. Throws an exception if parsing fails." [line] (cond - (string? line) + (string? line) (let [rule (parse-rule (split (triml line) #"\s+"))] (cond rule rule true (throw (Exception. (format bad-parse-error line))))) - true + true (let [[left remainder] (parse-left-hand-side line) [right junk] (parse-right-hand-side remainder)] - (cond + (cond ;; there should be a valide left hand side and a valid right hand side ;; there shouldn't be anything left over (junk should be empty) (and left right (empty? junk)) (list 'fn ['cell 'world] (list 'if left right)))))) -(defn compile-rule +(defn compile-rule "Parse this `rule-text`, a string conforming to the grammar of MicroWorld rules, into Clojure source, and then compile it into an anonymous function object, getting round the problem of binding mw-engine.utils in @@ -417,7 +440,7 @@ (do (use 'mw-engine.utils) (let [afn (eval (parse-rule rule-text))] - (cond + (cond (and afn return-tuple?)(list afn (trim rule-text)) true afn)))) ([rule-text] diff --git a/src/mw_parser/declarative.clj b/src/mw_parser/declarative.clj index 69792a4..410b247 100644 --- a/src/mw_parser/declarative.clj +++ b/src/mw_parser/declarative.clj @@ -1,11 +1,31 @@ -(ns mw-parser.declarative - (:use mw-engine.utils - mw-parser.utils - [mw-parser.errors :as pe] - [mw-parser.generate :as pg] - [mw-parser.simplify :as ps] - [clojure.string :only [split trim triml]]) - (:require [instaparse.core :as insta])) +(ns ^{:doc "A very simple parser which parses production rules." + :author "Simon Brooke"} + mw-parser.declarative + (:require [instaparse.core :as insta] + [clojure.string :refer [split trim triml]] + [mw-parser.errors :as pe] + [mw-parser.generate :as pg] + [mw-parser.simplify :as ps] + [mw-parser.utils :refer [rule?]])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;; USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def grammar @@ -93,3 +113,12 @@ (compile-rule rule-text false))) +(ps/simplify + (parse-rule + "if more than 2 neighbours have altitude equal to 11 then state should be beach")) + +(pg/generate + (ps/simplify + (parse-rule + "if more than 2 neighbours have altitude equal to 11 then state should be beach"))) + diff --git a/src/mw_parser/errors.clj b/src/mw_parser/errors.clj index 8db5f6c..6e5efbe 100644 --- a/src/mw_parser/errors.clj +++ b/src/mw_parser/errors.clj @@ -1,4 +1,27 @@ -(ns mw-parser.errors) +(ns ^{:doc "Display parse errors in a format which makes it easy for the user + to see where the error occurred." + :author "Simon Brooke"} + mw-parser.errors) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;; USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; error thrown when an attempt is made to set a reserved property (def reserved-properties-error diff --git a/src/mw_parser/generate.clj b/src/mw_parser/generate.clj index d27647d..3c86b02 100644 --- a/src/mw_parser/generate.clj +++ b/src/mw_parser/generate.clj @@ -1,8 +1,29 @@ -(ns mw-parser.generate - (:use mw-engine.utils - mw-parser.utils +(ns ^{:doc "Generate Clojure source from simplified parse trees." + :author "Simon Brooke"} + mw-parser.generate + (:require [mw-engine.utils :refer []] + [mw-parser.utils :refer [assert-type TODO]] [mw-parser.errors :as pe])) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;; USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (declare generate generate-action) @@ -24,6 +45,8 @@ (defn generate-condition + "From this `tree`, assumed to be a syntactically correct condition clause, + generate and return the appropriate clojure fragment." [tree] (assert-type tree :CONDITION) (generate (second tree))) @@ -31,18 +54,24 @@ (defn generate-conjunct-condition [tree] + "From this `tree`, assumed to be a syntactically conjunct correct condition clause, + generate and return the appropriate clojure fragment." (assert-type tree :CONJUNCT-CONDITION) (cons 'and (map generate (rest tree)))) (defn generate-disjunct-condition + "From this `tree`, assumed to be a syntactically correct disjunct condition clause, + generate and return the appropriate clojure fragment." [tree] (assert-type tree :DISJUNCT-CONDITION) (cons 'or (map generate (rest tree)))) (defn generate-ranged-property-condition - "Generate a property condition where the expression is a numeric range" + "From this `tree`, assumed to be a syntactically property condition clause for + this `property` where the `expression` is a numeric range, generate and return + the appropriate clojure fragment." [tree property expression] (assert-type tree :PROPERTY-CONDITION) (assert-type (nth tree 3) :RANGE-EXPRESSION) @@ -55,7 +84,9 @@ (defn generate-disjunct-property-condition - "Generate a property condition where the expression is a disjunct expression. + "From this `tree`, assumed to be a syntactically property condition clause + where the expression is a a disjunction, generate and return + the appropriate clojure fragment. TODO: this is definitely still wrong!" ([tree] (let [property (generate (second tree)) @@ -70,6 +101,8 @@ (defn generate-property-condition + "From this `tree`, assumed to be a syntactically property condition clause, + generate and return the appropriate clojure fragment." ([tree] (assert-type tree :PROPERTY-CONDITION) (if @@ -100,6 +133,8 @@ (defn generate-qualifier + "From this `tree`, assumed to be a syntactically correct qualifier, + generate and return the appropriate clojure fragment." [tree] (if (= (count tree) 2) @@ -109,6 +144,8 @@ (defn generate-simple-action + "From this `tree`, assumed to be a syntactically correct simple action, + generate and return the appropriate clojure fragment." ([tree] (assert-type tree :SIMPLE-ACTION) (generate-simple-action tree [])) @@ -126,6 +163,8 @@ (defn generate-probable-action + "From this `tree`, assumed to be a syntactically correct probable action, + generate and return the appropriate clojure fragment." ([tree] (assert-type tree :PROBABLE-ACTION) (generate-probable-action tree [])) @@ -142,6 +181,8 @@ (defn generate-action + "From this `tree`, assumed to be a syntactically correct action, + generate and return the appropriate clojure fragment." [tree others] (case (first tree) :ACTIONS (generate-action (first tree) others) @@ -151,6 +192,8 @@ (defn generate-multiple-actions + "From this `tree`, assumed to be one or more syntactically correct actions, + generate and return the appropriate clojure fragment." [tree] (assert-type tree :ACTIONS) (generate-action (first (rest tree)) (second (rest tree)))) @@ -166,6 +209,8 @@ (defn generate-numeric-expression + "From this `tree`, assumed to be a syntactically correct numeric expression, + generate and return the appropriate clojure fragment." [tree] (assert-type tree :NUMERIC-EXPRESSION) (case (count tree) @@ -182,6 +227,7 @@ ([tree] (assert-type tree :NEIGHBOURS-CONDITION) (case (first (second tree)) + :NUMBER (read-string (second (second tree))) :QUANTIFIER (generate-neighbours-condition tree (first (second (second tree)))) :QUALIFIER (cons (generate (second tree)) (rest (generate (nth tree 2)))))) ([tree quantifier-type] diff --git a/src/mw_parser/simplifier.clj b/src/mw_parser/simplifier.clj deleted file mode 100644 index 9943256..0000000 --- a/src/mw_parser/simplifier.clj +++ /dev/null @@ -1,92 +0,0 @@ -(ns mw-parser.simplifier - (:use mw-engine.utils - mw-parser.parser)) - -(declare simplify) - -(defn simplify-qualifier - "Given that this `tree` fragment represents a qualifier, what - qualifier is that?" - [tree] - (cond - (empty? tree) nil - (and (coll? tree) - (member? (first tree) '(:EQUIVALENCE :COMPARATIVE))) tree - (coll? (first tree)) (or (simplify-qualifier (first tree)) - (simplify-qualifier (rest tree))) - (coll? tree) (simplify-qualifier (rest tree)) - true tree)) - -(defn simplify-second-of-two - "There are a number of possible simplifications such that if the `tree` has - only two elements, the second is semantically sufficient." - [tree] - (if (= (count tree) 2) (simplify (nth tree 1)) tree)) - - -(defn simplify-some - "'some' is the same as 'more than zero'" - [tree] - [:COMPARATIVE '> 0]) - -(defn simplify-none - "'none' is the same as 'zero'" - [tree] - [:COMPARATIVE '= 0]) - -(defn simplify-all - "'all' isn't actually the same as 'eight', because cells at the edges of the world have - fewer than eight neighbours; but it's a simplifying (ha!) assumption for now." - [tree] - [:COMPARATIVE '= 8]) - -(defn simplify-quantifier - "If this quantifier is a number, 'simplifiy' it into a comparative whose operator is '=' - and whose quantity is that number. This is actually more complicated but makes generation easier." - [tree] - (if (number? (second tree)) [:COMPARATIVE '= (second tree)] (simplify (second tree)))) - -(defn simplify - "Simplify/canonicalise this `tree`. Opportunistically replace complex fragments with - semantically identical simpler fragments" - [tree] - (if - (coll? tree) - (case (first tree) - :SPACE nil - :QUALIFIER (simplify-qualifier tree) - :CONDITIONS (simplify-second-of-two tree) - :CONDITION (simplify-second-of-two tree) - :EXPRESSION (simplify-second-of-two tree) - :COMPARATIVE (simplify-second-of-two tree) - :QUANTIFIER (simplify-quantifier tree) - :VALUE (simplify-second-of-two tree) - :PROPERTY (simplify-second-of-two tree) - :ACTIONS (simplify-second-of-two tree) - :ACTION (simplify-second-of-two tree) - :ALL (simplify-all tree) - :SOME (simplify-some tree) - :NONE (simplify-none tree) - (remove nil? (map simplify tree))) - tree)) - -(simplify (parse-rule "if state is climax and 4 neighbours have state equal to fire then 3 chance in 5 state should be fire")) -(simplify (parse-rule "if state is climax and no neighbours have state equal to fire then 3 chance in 5 state should be fire")) - -(simplify (parse-rule "if state is in grassland or pasture or heath and more than 4 neighbours have state equal to water then state should be village")) - -(simplify (parse-rule "if 6 neighbours have state equal to water then state should be village")) - -(simplify (parse-rule "if fertility is between 55 and 75 then state should be climax")) - -(simplify (parse-rule "if state is forest then state should be climax")) - - -(simplify (parse-rule "if state is in grassland or pasture or heath and more than 4 neighbours have state equal to water then state should be village")) -(simplify (parse-rule "if altitude is less than 100 and state is forest then state should be climax and deer should be 3")) -(simplify (parse-rule "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3")) -(simplify (parse-rule "if altitude is 100 or fertility is 25 then state should be heath")) - -(simplify (parse-rule "if deer is more than 2 and wolves is 0 and fertility is more than 20 then deer should be deer + 2")) -(simplify (parse-rule "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves")) -(simplify (parse-rule "if state is grassland and 4 neighbours have state equal to water then state should be village")) diff --git a/src/mw_parser/simplify.clj b/src/mw_parser/simplify.clj index 3ac2c3c..1a5e8c6 100644 --- a/src/mw_parser/simplify.clj +++ b/src/mw_parser/simplify.clj @@ -1,12 +1,33 @@ -(ns mw-parser.simplify - (:use mw-engine.utils - mw-parser.utils)) +(ns ^{:doc "Simplify a parse tree." + :author "Simon Brooke"} + mw-parser.simplify + (:require [mw-engine.utils :refer [member?]])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;; USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (declare simplify) (defn simplify-qualifier "Given that this `tree` fragment represents a qualifier, what - qualifier is that?" + qualifier is that?" [tree] (cond (empty? tree) nil @@ -19,9 +40,16 @@ (defn simplify-second-of-two "There are a number of possible simplifications such that if the `tree` has - only two elements, the second is semantically sufficient." + only two elements, the second is semantically sufficient." [tree] - (if (= (count tree) 2) (simplify (second tree)) tree)) + (if (= (count tree) 2) (simplify (nth tree 1)) tree)) + + +(defn simplify-quantifier + "If this quantifier is a number, 'simplifiy' it into a comparative whose operator is '=' + and whose quantity is that number. This is actually more complicated but makes generation easier." + [tree] + (if (number? (second tree)) [:COMPARATIVE '= (second tree)] (simplify (second tree)))) (defn simplify @@ -31,18 +59,24 @@ (if (coll? tree) (case (first tree) + ;; 'all' isn't actually the same as 'eight', because cells at the edges of the world have + ;; fewer than eight neighbours; but it's a simplifying (ha!) assumption for now." + ;; TODO: fix this so it actually works. + :ALL [:COMPARATIVE '= 8] :ACTION (simplify-second-of-two tree) - :ACTIONS (cons (first tree) (simplify (rest tree))) - :CHANCE-IN nil + :ACTIONS (simplify-second-of-two tree) :COMPARATIVE (simplify-second-of-two tree) :CONDITION (simplify-second-of-two tree) :CONDITIONS (simplify-second-of-two tree) :EXPRESSION (simplify-second-of-two tree) + :NONE [:COMPARATIVE '= 0] + :NUMBER tree :PROPERTY (simplify-second-of-two tree) - :PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree) + :QUALIFIER (simplify-qualifier tree) + :QUANTIFIER (simplify-quantifier tree) + :SOME [:COMPARATIVE '> 0] :SPACE nil - :THEN nil - :AND nil :VALUE (simplify-second-of-two tree) (remove nil? (map simplify tree))) tree)) + diff --git a/src/mw_parser/utils.clj b/src/mw_parser/utils.clj index 14e91c5..42f8995 100644 --- a/src/mw_parser/utils.clj +++ b/src/mw_parser/utils.clj @@ -1,4 +1,25 @@ -(ns mw-parser.utils) +(ns ^{:doc "Utilities used in more than one namespace within the parser." + :author "Simon Brooke"} + mw-parser.utils) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;; USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn rule? diff --git a/test/mw_parser/declarative_test.clj b/test/mw_parser/declarative_test.clj index 93ffdbb..d5c6fd3 100644 --- a/test/mw_parser/declarative_test.clj +++ b/test/mw_parser/declarative_test.clj @@ -472,3 +472,15 @@ (is (nil? (apply afn (list {:x 0 :y 1} world))) "Middle cell of the strip has only two high neighbours, so rule should not fire.")) )) + +(deftest regression-tests + (testing "Rule in default set which failed on switchover to declarative rules" + (let [afn (compile-rule "if state is scrub then 1 chance in 5 state should be forest") + world (transform-world + (make-world 3 3) + (list (compile-rule "if x is 2 then altitude should be 11") + (compile-rule "if x is less than 2 then state should be scrub")))] + (is (= (:state (apply afn (list {:x 1 :y 1} world))) :forest) + "Centre cell is scrub, so rule should fire") + (is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach) + "Middle cell of the strip is not scrub, so rule should not fire."))))