simon/mw-parser
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Trying to get code quality up, but in the process I've broken something -

Browse source 
I think, the simplifier.
This commit is contained in:
simon 2016-08-13 19:45:43 +01:00
parent d2a73ba408
commit 3168c1b2fb
9 changed files with 298 additions and 183 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
src/mw_parser/bulk.clj
View file

@ -1,13 +1,32 @@
;; parse multiple rules from a stream, possibly a file - although the real (ns ^{:doc "parse multiple rules from a stream, possibly a file."
;; objective is to parse rules out of a block of text from a textarea :author "Simon Brooke"}
mw-parser.bulk
(ns mw-parser.bulk
(:use mw-parser.declarative (:use mw-parser.declarative
mw-engine.utils mw-engine.utils
clojure.java.io clojure.java.io
[clojure.string :only [split trim]]) [clojure.string :only [split trim]])
(:import (java.io BufferedReader StringReader))) (: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? (defn comment?
"Is this `line` a comment?" "Is this `line` a comment?"
[line] [line]

145
src/mw_parser/core.clj
View file

@ -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: ;; 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 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 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 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" ;; * "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 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 ;; 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 ;; semantics - but that is buggy behaviour, which I'll try to fix over the next few weeks, not a
;; design fault. ;; design fault.
;; ;;
;; More significantly it does not generate useful error messages on failure. ;; 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. ;; 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-conditions)
(declare parse-not-condition) (declare parse-not-condition)
(declare parse-simple-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.]*$") (def re-number #"^[0-9.]*$")
;; error thrown when an attempt is made to set a reserved property ;; 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") "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 ;; error thrown when a rule cannot be parsed
(def bad-parse-error "I did not understand '%s'") (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; "If this token appears to represent an explicit number, return that number;
otherwise, make a keyword of it and return that." otherwise, make a keyword of it and return that."
[token] [token]
(cond (cond
(re-matches re-number token) (read-string token) (re-matches re-number token) (read-string token)
(keyword? token) token (keyword? token) token
true (keyword 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 ;; sequence of tokens (and in some cases other optional arguments) and return a
;; vector comprising ;; vector comprising
;; ;;
@ -70,7 +93,7 @@
(if (and value (re-matches re-number value)) [(read-string value) remainder])) (if (and value (re-matches re-number value)) [(read-string value) remainder]))
(defn parse-property-int (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." whose value is assumed to be an integer."
[[value & remainder]] [[value & remainder]]
(if value [(list 'get-int 'cell (keyword value)) remainder])) (if value [(list 'get-int 'cell (keyword value)) remainder]))
@ -115,12 +138,12 @@
[(cons value others) remainder]) [(cons value others) remainder])
true true
[(list value) tokens])))) [(list value) tokens]))))
(defn parse-value (defn parse-value
"Parse a value from among these `tokens`. If `expect-int` is true, return "Parse a value from among these `tokens`. If `expect-int` is true, return
an integer or something which will evaluate to an integer." an integer or something which will evaluate to an integer."
([tokens expect-int] ([tokens expect-int]
(or (or
(parse-disjunct-value tokens expect-int) (parse-disjunct-value tokens expect-int)
(parse-simple-value tokens expect-int))) (parse-simple-value tokens expect-int)))
([tokens] ([tokens]
@ -158,18 +181,18 @@
(list '> value1 property value2)) rest]))) (list '> value1 property value2)) rest])))
(defn- parse-is-condition (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'. '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." It is necessary to disambiguate whether value is a numeric or keyword."
[[property IS value & rest]] [[property IS value & rest]]
(cond (cond
(member? IS '("is" "are")) (member? IS '("is" "are"))
(let [tokens (cons property (cons value rest))] (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] (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])))) value [(list '= (list (keyword property) 'cell) (keyword value)) rest]))))
(defn- parse-not-condition (defn- parse-not-condition
"Parse the negation of a simple condition." "Parse the negation of a simple condition."
[[property IS NOT & rest]] [[property IS NOT & rest]]
(cond (and (member? IS '("is" "are")) (= NOT "not")) (cond (and (member? IS '("is" "are")) (= NOT "not"))
@ -179,11 +202,11 @@
[(list 'not condition) remainder]))))) [(list 'not condition) remainder])))))
(defn- gen-neighbours-condition (defn- gen-neighbours-condition
([comp1 quantity property value remainder comp2 distance] ([comp1 quantity property value remainder comp2 distance]
[(list comp1 [(list comp1
(list 'count (list 'count
(list 'get-neighbours-with-property-value 'world (list 'get-neighbours-with-property-value 'world
'(cell :x) '(cell :y) distance '(cell :x) '(cell :y) distance
(keyword property) (keyword-or-numeric value) comp2)) (keyword property) (keyword-or-numeric value) comp2))
quantity) quantity)
remainder]) remainder])
@ -195,21 +218,21 @@
[[MORE THAN n NEIGHBOURS WITHIN distance have-or-are & rest]] [[MORE THAN n NEIGHBOURS WITHIN distance have-or-are & rest]]
(let [quantity (first (parse-numeric-value (list n))) (let [quantity (first (parse-numeric-value (list n)))
comparator (cond (= MORE "more") '> comparator (cond (= MORE "more") '>
(member? MORE '("fewer" "less")) '<)] (member? MORE '("fewer" "less")) '<)]
(cond (cond
(not= WITHIN "within") (not= WITHIN "within")
(parse-comparator-neighbours-condition (parse-comparator-neighbours-condition
(flatten (flatten
;; two tokens were mis-parsed as 'within distance' that weren't ;; two tokens were mis-parsed as 'within distance' that weren't
;; actually 'within' and a distance. Splice in 'within 1' and try ;; actually 'within' and a distance. Splice in 'within 1' and try
;; again. ;; again.
(list MORE THAN n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest))) (list MORE THAN n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest)))
(and quantity (and quantity
comparator comparator
(= THAN "than") (= THAN "than")
(= NEIGHBOURS "neighbours")) (= NEIGHBOURS "neighbours"))
(cond (cond
(= have-or-are "are") (= have-or-are "are")
(let [[value & remainder] rest (let [[value & remainder] rest
dist (gen-token-value distance true)] dist (gen-token-value distance true)]
(gen-neighbours-condition comparator quantity :state value remainder = dist)) (gen-neighbours-condition comparator quantity :state value remainder = dist))
@ -217,16 +240,16 @@
(let [[property comp1 comp2 value & remainder] rest (let [[property comp1 comp2 value & remainder] rest
dist (gen-token-value distance true)] dist (gen-token-value distance true)]
(cond (and (= comp1 "equal") (= comp2 "to")) (cond (and (= comp1 "equal") (= comp2 "to"))
(gen-neighbours-condition comparator quantity property (gen-neighbours-condition comparator quantity property
value remainder = dist) value remainder = dist)
(and (= comp1 "more") (= comp2 "than")) (and (= comp1 "more") (= comp2 "than"))
(gen-neighbours-condition comparator quantity property (gen-neighbours-condition comparator quantity property
value remainder > dist) value remainder > dist)
(and (= comp1 "less") (= comp2 "than")) (and (= comp1 "less") (= comp2 "than"))
(gen-neighbours-condition comparator quantity property (gen-neighbours-condition comparator quantity property
value remainder < dist) value remainder < dist)
)))))) ))))))
(defn parse-some-neighbours-condition (defn parse-some-neighbours-condition
[[SOME NEIGHBOURS & rest]] [[SOME NEIGHBOURS & rest]]
(cond (cond
@ -236,18 +259,18 @@
(defn parse-simple-neighbours-condition (defn parse-simple-neighbours-condition
"Parse conditions of the form '...6 neighbours are [condition]'" "Parse conditions of the form '...6 neighbours are [condition]'"
[[n NEIGHBOURS WITHIN distance have-or-are & rest]] [[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 (cond
(and quantity (= NEIGHBOURS "neighbours")) (and quantity (= NEIGHBOURS "neighbours"))
(cond (cond
(not= WITHIN "within") (not= WITHIN "within")
(parse-simple-neighbours-condition (parse-simple-neighbours-condition
(flatten (flatten
;; two tokens were mis-parsed as 'within distance' that weren't ;; two tokens were mis-parsed as 'within distance' that weren't
;; actually 'within' and a distance. Splice in 'within 1' and try ;; actually 'within' and a distance. Splice in 'within 1' and try
;; again. ;; again.
(list n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest))) (list n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest)))
(= have-or-are "are") (= have-or-are "are")
(let [[value & remainder] rest (let [[value & remainder] rest
dist (gen-token-value distance true)] dist (gen-token-value distance true)]
(gen-neighbours-condition '= quantity :state value remainder = dist)) (gen-neighbours-condition '= quantity :state value remainder = dist))
@ -255,16 +278,16 @@
(let [[property comp1 comp2 value & remainder] rest (let [[property comp1 comp2 value & remainder] rest
dist (gen-token-value distance true)] dist (gen-token-value distance true)]
(cond (and (= comp1 "equal") (= comp2 "to")) (cond (and (= comp1 "equal") (= comp2 "to"))
(gen-neighbours-condition '= quantity property value remainder = (gen-neighbours-condition '= quantity property value remainder =
dist) dist)
(and (= comp1 "more") (= comp2 "than")) (and (= comp1 "more") (= comp2 "than"))
(gen-neighbours-condition '= quantity property value remainder > (gen-neighbours-condition '= quantity property value remainder >
dist) dist)
(and (= comp1 "less") (= comp2 "than")) (and (= comp1 "less") (= comp2 "than"))
(gen-neighbours-condition '= quantity property value remainder < (gen-neighbours-condition '= quantity property value remainder <
dist) dist)
)))))) ))))))
(defn parse-neighbours-condition (defn parse-neighbours-condition
"Parse conditions referring to neighbours" "Parse conditions referring to neighbours"
[tokens] [tokens]
@ -320,30 +343,30 @@
(= IF "if") (= IF "if")
(parse-conditions tokens))) (parse-conditions tokens)))
(defn- parse-arithmetic-action (defn- parse-arithmetic-action
"Parse actions of the form '[property] should be [property] [arithmetic-operator] [value]', "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'." e.g. 'fertility should be fertility + 1', or 'deer should be deer - wolves'."
[previous [prop1 SHOULD BE prop2 operator value & rest]] [previous [prop1 SHOULD BE prop2 operator value & rest]]
(cond (cond
(member? prop1 '("x" "y")) (member? prop1 '("x" "y"))
(throw (throw
(Exception. reserved-properties-error)) (Exception. reserved-properties-error))
(and (= SHOULD "should") (and (= SHOULD "should")
(= BE "be") (= BE "be")
(member? operator '("+" "-" "*" "/"))) (member? operator '("+" "-" "*" "/")))
[(list 'merge (or previous 'cell) [(list 'merge (or previous 'cell)
{(keyword prop1) (list 'int {(keyword prop1) (list 'int
(list (symbol operator) (list 'get-int 'cell (keyword prop2)) (list (symbol operator) (list 'get-int 'cell (keyword prop2))
(cond (cond
(re-matches re-number value) (read-string value) (re-matches re-number value) (read-string value)
true (list 'get-int 'cell (keyword value)))))}) rest])) 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].'" "Parse actions of the form '[property] should be [value].'"
[previous [property SHOULD BE value & rest]] [previous [property SHOULD BE value & rest]]
(cond (cond
(member? property '("x" "y")) (member? property '("x" "y"))
(throw (throw
(Exception. reserved-properties-error)) (Exception. reserved-properties-error))
(and (= SHOULD "should") (= BE "be")) (and (= SHOULD "should") (= BE "be"))
[(list 'merge (or previous 'cell) [(list 'merge (or previous 'cell)
@ -362,19 +385,19 @@
(parse-actions left (rest remainder)) (parse-actions left (rest remainder))
true (list left))))) true (list left)))))
(defn- parse-probability (defn- parse-probability
"Parse a probability of an action from this collection of tokens" "Parse a probability of an action from this collection of tokens"
[previous [n CHANCE IN m & tokens]] [previous [n CHANCE IN m & tokens]]
(cond (cond
(and (= CHANCE "chance")(= IN "in")) (and (= CHANCE "chance")(= IN "in"))
(let [[action remainder] (parse-actions previous tokens)] (let [[action remainder] (parse-actions previous tokens)]
(cond action (cond action
[(list 'cond [(list 'cond
(list '< (list '<
(list 'rand (list 'rand
(first (parse-simple-value (list m) true))) (first (parse-simple-value (list m) true)))
(first (parse-simple-value (list n) true))) (first (parse-simple-value (list n) true)))
action) remainder])))) action) remainder]))))
(defn- parse-right-hand-side (defn- parse-right-hand-side
"Parse the right hand side ('then...') of a production rule." "Parse the right hand side ('then...') of a production rule."
@ -384,27 +407,27 @@
(parse-probability nil tokens) (parse-probability nil tokens)
(parse-actions nil tokens)))) (parse-actions nil tokens))))
(defn parse-rule (defn parse-rule
"Parse a complete rule from this `line`, expected to be either a string or a "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. sequence of string tokens. Return the rule in the form of an S-expression.
Throws an exception if parsing fails." Throws an exception if parsing fails."
[line] [line]
(cond (cond
(string? line) (string? line)
(let [rule (parse-rule (split (triml line) #"\s+"))] (let [rule (parse-rule (split (triml line) #"\s+"))]
(cond rule rule (cond rule rule
true (throw (Exception. (format bad-parse-error line))))) true (throw (Exception. (format bad-parse-error line)))))
true true
(let [[left remainder] (parse-left-hand-side line) (let [[left remainder] (parse-left-hand-side line)
[right junk] (parse-right-hand-side remainder)] [right junk] (parse-right-hand-side remainder)]
(cond (cond
;; there should be a valide left hand side and a valid right hand side ;; 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) ;; there shouldn't be anything left over (junk should be empty)
(and left right (empty? junk)) (and left right (empty? junk))
(list 'fn ['cell 'world] (list 'if left right)))))) (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, "Parse this `rule-text`, a string conforming to the grammar of MicroWorld rules,
into Clojure source, and then compile it into an anonymous into Clojure source, and then compile it into an anonymous
function object, getting round the problem of binding mw-engine.utils in function object, getting round the problem of binding mw-engine.utils in
@ -417,7 +440,7 @@
(do (do
(use 'mw-engine.utils) (use 'mw-engine.utils)
(let [afn (eval (parse-rule rule-text))] (let [afn (eval (parse-rule rule-text))]
(cond (cond
(and afn return-tuple?)(list afn (trim rule-text)) (and afn return-tuple?)(list afn (trim rule-text))
true afn)))) true afn))))
([rule-text] ([rule-text]

45
src/mw_parser/declarative.clj
View file

@ -1,11 +1,31 @@
(ns mw-parser.declarative (ns ^{:doc "A very simple parser which parses production rules."
(:use mw-engine.utils :author "Simon Brooke"}
mw-parser.utils mw-parser.declarative
[mw-parser.errors :as pe] (:require [instaparse.core :as insta]
[mw-parser.generate :as pg] [clojure.string :refer [split trim triml]]
[mw-parser.simplify :as ps] [mw-parser.errors :as pe]
[clojure.string :only [split trim triml]]) [mw-parser.generate :as pg]
(:require [instaparse.core :as insta])) [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 (def grammar
@ -93,3 +113,12 @@
(compile-rule rule-text false))) (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")))

25
src/mw_parser/errors.clj
View file

@ -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 ;; error thrown when an attempt is made to set a reserved property
(def reserved-properties-error (def reserved-properties-error

56
src/mw_parser/generate.clj
View file

@ -1,8 +1,29 @@
(ns mw-parser.generate (ns ^{:doc "Generate Clojure source from simplified parse trees."
(:use mw-engine.utils :author "Simon Brooke"}
mw-parser.utils mw-parser.generate
(:require [mw-engine.utils :refer []]
[mw-parser.utils :refer [assert-type TODO]]
[mw-parser.errors :as pe])) [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) (declare generate generate-action)
@ -24,6 +45,8 @@
(defn generate-condition (defn generate-condition
"From this `tree`, assumed to be a syntactically correct condition clause,
generate and return the appropriate clojure fragment."
[tree] [tree]
(assert-type tree :CONDITION) (assert-type tree :CONDITION)
(generate (second tree))) (generate (second tree)))
@ -31,18 +54,24 @@
(defn generate-conjunct-condition (defn generate-conjunct-condition
[tree] [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) (assert-type tree :CONJUNCT-CONDITION)
(cons 'and (map generate (rest tree)))) (cons 'and (map generate (rest tree))))
(defn generate-disjunct-condition (defn generate-disjunct-condition
"From this `tree`, assumed to be a syntactically correct disjunct condition clause,
generate and return the appropriate clojure fragment."
[tree] [tree]
(assert-type tree :DISJUNCT-CONDITION) (assert-type tree :DISJUNCT-CONDITION)
(cons 'or (map generate (rest tree)))) (cons 'or (map generate (rest tree))))
(defn generate-ranged-property-condition (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] [tree property expression]
(assert-type tree :PROPERTY-CONDITION) (assert-type tree :PROPERTY-CONDITION)
(assert-type (nth tree 3) :RANGE-EXPRESSION) (assert-type (nth tree 3) :RANGE-EXPRESSION)
@ -55,7 +84,9 @@
(defn generate-disjunct-property-condition (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!" TODO: this is definitely still wrong!"
([tree] ([tree]
(let [property (generate (second tree)) (let [property (generate (second tree))
@ -70,6 +101,8 @@
(defn generate-property-condition (defn generate-property-condition
"From this `tree`, assumed to be a syntactically property condition clause,
generate and return the appropriate clojure fragment."
([tree] ([tree]
(assert-type tree :PROPERTY-CONDITION) (assert-type tree :PROPERTY-CONDITION)
(if (if
@ -100,6 +133,8 @@
(defn generate-qualifier (defn generate-qualifier
"From this `tree`, assumed to be a syntactically correct qualifier,
generate and return the appropriate clojure fragment."
[tree] [tree]
(if (if
(= (count tree) 2) (= (count tree) 2)
@ -109,6 +144,8 @@
(defn generate-simple-action (defn generate-simple-action
"From this `tree`, assumed to be a syntactically correct simple action,
generate and return the appropriate clojure fragment."
([tree] ([tree]
(assert-type tree :SIMPLE-ACTION) (assert-type tree :SIMPLE-ACTION)
(generate-simple-action tree [])) (generate-simple-action tree []))
@ -126,6 +163,8 @@
(defn generate-probable-action (defn generate-probable-action
"From this `tree`, assumed to be a syntactically correct probable action,
generate and return the appropriate clojure fragment."
([tree] ([tree]
(assert-type tree :PROBABLE-ACTION) (assert-type tree :PROBABLE-ACTION)
(generate-probable-action tree [])) (generate-probable-action tree []))
@ -142,6 +181,8 @@
(defn generate-action (defn generate-action
"From this `tree`, assumed to be a syntactically correct action,
generate and return the appropriate clojure fragment."
[tree others] [tree others]
(case (first tree) (case (first tree)
:ACTIONS (generate-action (first tree) others) :ACTIONS (generate-action (first tree) others)
@ -151,6 +192,8 @@
(defn generate-multiple-actions (defn generate-multiple-actions
"From this `tree`, assumed to be one or more syntactically correct actions,
generate and return the appropriate clojure fragment."
[tree] [tree]
(assert-type tree :ACTIONS) (assert-type tree :ACTIONS)
(generate-action (first (rest tree)) (second (rest tree)))) (generate-action (first (rest tree)) (second (rest tree))))
@ -166,6 +209,8 @@
(defn generate-numeric-expression (defn generate-numeric-expression
"From this `tree`, assumed to be a syntactically correct numeric expression,
generate and return the appropriate clojure fragment."
[tree] [tree]
(assert-type tree :NUMERIC-EXPRESSION) (assert-type tree :NUMERIC-EXPRESSION)
(case (count tree) (case (count tree)
@ -182,6 +227,7 @@
([tree] ([tree]
(assert-type tree :NEIGHBOURS-CONDITION) (assert-type tree :NEIGHBOURS-CONDITION)
(case (first (second tree)) (case (first (second tree))
:NUMBER (read-string (second (second tree)))
:QUANTIFIER (generate-neighbours-condition tree (first (second (second tree)))) :QUANTIFIER (generate-neighbours-condition tree (first (second (second tree))))
:QUALIFIER (cons (generate (second tree)) (rest (generate (nth tree 2)))))) :QUALIFIER (cons (generate (second tree)) (rest (generate (nth tree 2))))))
([tree quantifier-type] ([tree quantifier-type]

92
src/mw_parser/simplifier.clj
View file

@ -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"))

56
src/mw_parser/simplify.clj
View file

@ -1,12 +1,33 @@
(ns mw-parser.simplify (ns ^{:doc "Simplify a parse tree."
(:use mw-engine.utils :author "Simon Brooke"}
mw-parser.utils)) 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) (declare simplify)
(defn simplify-qualifier (defn simplify-qualifier
"Given that this `tree` fragment represents a qualifier, what "Given that this `tree` fragment represents a qualifier, what
qualifier is that?" qualifier is that?"
[tree] [tree]
(cond (cond
(empty? tree) nil (empty? tree) nil
@ -19,9 +40,16 @@
(defn simplify-second-of-two (defn simplify-second-of-two
"There are a number of possible simplifications such that if the `tree` has "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] [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 (defn simplify
@ -31,18 +59,24 @@
(if (if
(coll? tree) (coll? tree)
(case (first 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) :ACTION (simplify-second-of-two tree)
:ACTIONS (cons (first tree) (simplify (rest tree))) :ACTIONS (simplify-second-of-two tree)
:CHANCE-IN nil
:COMPARATIVE (simplify-second-of-two tree) :COMPARATIVE (simplify-second-of-two tree)
:CONDITION (simplify-second-of-two tree) :CONDITION (simplify-second-of-two tree)
:CONDITIONS (simplify-second-of-two tree) :CONDITIONS (simplify-second-of-two tree)
:EXPRESSION (simplify-second-of-two tree) :EXPRESSION (simplify-second-of-two tree)
:NONE [:COMPARATIVE '= 0]
:NUMBER tree
:PROPERTY (simplify-second-of-two 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 :SPACE nil
:THEN nil
:AND nil
:VALUE (simplify-second-of-two tree) :VALUE (simplify-second-of-two tree)
(remove nil? (map simplify tree))) (remove nil? (map simplify tree)))
tree)) tree))

23
src/mw_parser/utils.clj
View file

@ -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? (defn rule?

12
test/mw_parser/declarative_test.clj
View file

@ -472,3 +472,15 @@
(is (nil? (apply afn (list {:x 0 :y 1} world))) (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.")) "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."))))