").append(n.parseHTML(a)).find(d):a)}).complete(c&&function(a,b){g.each(c,e||[a.responseText,b,a])}),this},n.expr.filters.animated=function(a){return n.grep(n.timers,function(b){return a===b.elem}).length};var dd=a.document.documentElement;function ed(a){return n.isWindow(a)?a:9===a.nodeType?a.defaultView||a.parentWindow:!1}n.offset={setOffset:function(a,b,c){var d,e,f,g,h,i,j,k=n.css(a,"position"),l=n(a),m={};"static"===k&&(a.style.position="relative"),h=l.offset(),f=n.css(a,"top"),i=n.css(a,"left"),j=("absolute"===k||"fixed"===k)&&n.inArray("auto",[f,i])>-1,j?(d=l.position(),g=d.top,e=d.left):(g=parseFloat(f)||0,e=parseFloat(i)||0),n.isFunction(b)&&(b=b.call(a,c,h)),null!=b.top&&(m.top=b.top-h.top+g),null!=b.left&&(m.left=b.left-h.left+e),"using"in b?b.using.call(a,m):l.css(m)}},n.fn.extend({offset:function(a){if(arguments.length)return void 0===a?this:this.each(function(b){n.offset.setOffset(this,a,b)});var b,c,d={top:0,left:0},e=this[0],f=e&&e.ownerDocument;if(f)return b=f.documentElement,n.contains(b,e)?(typeof e.getBoundingClientRect!==L&&(d=e.getBoundingClientRect()),c=ed(f),{top:d.top+(c.pageYOffset||b.scrollTop)-(b.clientTop||0),left:d.left+(c.pageXOffset||b.scrollLeft)-(b.clientLeft||0)}):d},position:function(){if(this[0]){var a,b,c={top:0,left:0},d=this[0];return"fixed"===n.css(d,"position")?b=d.getBoundingClientRect():(a=this.offsetParent(),b=this.offset(),n.nodeName(a[0],"html")||(c=a.offset()),c.top+=n.css(a[0],"borderTopWidth",!0),c.left+=n.css(a[0],"borderLeftWidth",!0)),{top:b.top-c.top-n.css(d,"marginTop",!0),left:b.left-c.left-n.css(d,"marginLeft",!0)}}},offsetParent:function(){return this.map(function(){var a=this.offsetParent||dd;while(a&&!n.nodeName(a,"html")&&"static"===n.css(a,"position"))a=a.offsetParent;return a||dd})}}),n.each({scrollLeft:"pageXOffset",scrollTop:"pageYOffset"},function(a,b){var c=/Y/.test(b);n.fn[a]=function(d){return W(this,function(a,d,e){var f=ed(a);return void 0===e?f?b in f?f[b]:f.document.documentElement[d]:a[d]:void(f?f.scrollTo(c?n(f).scrollLeft():e,c?e:n(f).scrollTop()):a[d]=e)},a,d,arguments.length,null)}}),n.each(["top","left"],function(a,b){n.cssHooks[b]=Mb(l.pixelPosition,function(a,c){return c?(c=Kb(a,b),Ib.test(c)?n(a).position()[b]+"px":c):void 0})}),n.each({Height:"height",Width:"width"},function(a,b){n.each({padding:"inner"+a,content:b,"":"outer"+a},function(c,d){n.fn[d]=function(d,e){var f=arguments.length&&(c||"boolean"!=typeof d),g=c||(d===!0||e===!0?"margin":"border");return W(this,function(b,c,d){var e;return n.isWindow(b)?b.document.documentElement["client"+a]:9===b.nodeType?(e=b.documentElement,Math.max(b.body["scroll"+a],e["scroll"+a],b.body["offset"+a],e["offset"+a],e["client"+a])):void 0===d?n.css(b,c,g):n.style(b,c,d,g)},b,f?d:void 0,f,null)}})}),n.fn.size=function(){return this.length},n.fn.andSelf=n.fn.addBack,"function"==typeof define&&define.amd&&define("jquery",[],function(){return n});var fd=a.jQuery,gd=a.$;return n.noConflict=function(b){return a.$===n&&(a.$=gd),b&&a.jQuery===n&&(a.jQuery=fd),n},typeof b===L&&(a.jQuery=a.$=n),n});
diff --git a/docs/codox/js/page_effects.js b/docs/codox/js/page_effects.js
deleted file mode 100644
index fdacbf8..0000000
--- a/docs/codox/js/page_effects.js
+++ /dev/null
@@ -1,112 +0,0 @@
-function visibleInParent(element) {
- var position = $(element).position().top
- return position > -50 && position < ($(element).offsetParent().height() - 50)
-}
-
-function hasFragment(link, fragment) {
- return $(link).attr("href").indexOf("#" + fragment) != -1
-}
-
-function findLinkByFragment(elements, fragment) {
- return $(elements).filter(function(i, e) { return hasFragment(e, fragment)}).first()
-}
-
-function scrollToCurrentVarLink(elements) {
- var elements = $(elements);
- var parent = elements.offsetParent();
-
- if (elements.length == 0) return;
-
- var top = elements.first().position().top;
- var bottom = elements.last().position().top + elements.last().height();
-
- if (top >= 0 && bottom <= parent.height()) return;
-
- if (top < 0) {
- parent.scrollTop(parent.scrollTop() + top);
- }
- else if (bottom > parent.height()) {
- parent.scrollTop(parent.scrollTop() + bottom - parent.height());
- }
-}
-
-function setCurrentVarLink() {
- $('.secondary a').parent().removeClass('current')
- $('.anchor').
- filter(function(index) { return visibleInParent(this) }).
- each(function(index, element) {
- findLinkByFragment(".secondary a", element.id).
- parent().
- addClass('current')
- });
- scrollToCurrentVarLink('.secondary .current');
-}
-
-var hasStorage = (function() { try { return localStorage.getItem } catch(e) {} }())
-
-function scrollPositionId(element) {
- var directory = window.location.href.replace(/[^\/]+\.html$/, '')
- return 'scroll::' + $(element).attr('id') + '::' + directory
-}
-
-function storeScrollPosition(element) {
- if (!hasStorage) return;
- localStorage.setItem(scrollPositionId(element) + "::x", $(element).scrollLeft())
- localStorage.setItem(scrollPositionId(element) + "::y", $(element).scrollTop())
-}
-
-function recallScrollPosition(element) {
- if (!hasStorage) return;
- $(element).scrollLeft(localStorage.getItem(scrollPositionId(element) + "::x"))
- $(element).scrollTop(localStorage.getItem(scrollPositionId(element) + "::y"))
-}
-
-function persistScrollPosition(element) {
- recallScrollPosition(element)
- $(element).scroll(function() { storeScrollPosition(element) })
-}
-
-function sidebarContentWidth(element) {
- var widths = $(element).find('.inner').map(function() { return $(this).innerWidth() })
- return Math.max.apply(Math, widths)
-}
-
-function calculateSize(width, snap, margin, minimum) {
- if (width == 0) {
- return 0
- }
- else {
- return Math.max(minimum, (Math.ceil(width / snap) * snap) + (margin * 2))
- }
-}
-
-function resizeSidebars() {
- var primaryWidth = sidebarContentWidth('.primary')
- var secondaryWidth = 0
-
- if ($('.secondary').length != 0) {
- secondaryWidth = sidebarContentWidth('.secondary')
- }
-
- // snap to grid
- primaryWidth = calculateSize(primaryWidth, 32, 13, 160)
- secondaryWidth = calculateSize(secondaryWidth, 32, 13, 160)
-
- $('.primary').css('width', primaryWidth)
- $('.secondary').css('width', secondaryWidth).css('left', primaryWidth + 1)
-
- if (secondaryWidth > 0) {
- $('#content').css('left', primaryWidth + secondaryWidth + 2)
- }
- else {
- $('#content').css('left', primaryWidth + 1)
- }
-}
-
-$(window).ready(resizeSidebars)
-$(window).ready(setCurrentVarLink)
-$(window).ready(function() { persistScrollPosition('.primary')})
-$(window).ready(function() {
- $('#content').scroll(setCurrentVarLink)
- $(window).resize(setCurrentVarLink)
-})
diff --git a/docs/codox/mw-parser.bulk.html b/docs/codox/mw-parser.bulk.html
deleted file mode 100644
index 6cca8f1..0000000
--- a/docs/codox/mw-parser.bulk.html
+++ /dev/null
@@ -1,9 +0,0 @@
-
-
\ No newline at end of file
diff --git a/docs/codox/mw-parser.core.html b/docs/codox/mw-parser.core.html
deleted file mode 100644
index 6b3474a..0000000
--- a/docs/codox/mw-parser.core.html
+++ /dev/null
@@ -1,25 +0,0 @@
-
-
\ No newline at end of file
diff --git a/docs/codox/mw-parser.declarative.html b/docs/codox/mw-parser.declarative.html
deleted file mode 100644
index 8f12634..0000000
--- a/docs/codox/mw-parser.declarative.html
+++ /dev/null
@@ -1,14 +0,0 @@
-
-
\ No newline at end of file
diff --git a/docs/codox/mw-parser.errors.html b/docs/codox/mw-parser.errors.html
deleted file mode 100644
index e7a743e..0000000
--- a/docs/codox/mw-parser.errors.html
+++ /dev/null
@@ -1,7 +0,0 @@
-
-
\ No newline at end of file
diff --git a/docs/codox/mw-parser.flow.html b/docs/codox/mw-parser.flow.html
deleted file mode 100644
index b3c6c6e..0000000
--- a/docs/codox/mw-parser.flow.html
+++ /dev/null
@@ -1,11 +0,0 @@
-
-
\ No newline at end of file
diff --git a/docs/codox/mw-parser.generate.html b/docs/codox/mw-parser.generate.html
deleted file mode 100644
index 2577cc0..0000000
--- a/docs/codox/mw-parser.generate.html
+++ /dev/null
@@ -1,23 +0,0 @@
-
-
\ No newline at end of file
diff --git a/docs/codox/mw-parser.simplify.html b/docs/codox/mw-parser.simplify.html
deleted file mode 100644
index bc5d755..0000000
--- a/docs/codox/mw-parser.simplify.html
+++ /dev/null
@@ -1,8 +0,0 @@
-
-
\ No newline at end of file
diff --git a/docs/codox/mw-parser.utils.html b/docs/codox/mw-parser.utils.html
deleted file mode 100644
index f5bd3e8..0000000
--- a/docs/codox/mw-parser.utils.html
+++ /dev/null
@@ -1,9 +0,0 @@
-
-
\ No newline at end of file
diff --git a/docs/uberdoc.html b/docs/uberdoc.html
deleted file mode 100644
index 697d93a..0000000
--- a/docs/uberdoc.html
+++ /dev/null
@@ -1,4020 +0,0 @@
-
-
dependencies| org.clojure/clojure |
| 1.11.1 | | org.clojure/tools.trace |
| 0.7.11 | | instaparse |
| 1.4.12 | | mw-engine |
| 0.2.0-SNAPSHOT | | trptr/java-wrapper |
| 0.2.3 |
|
(this space intentionally left almost blank) |
| |
| |
Simplify a parse tree.
- | (ns ^{:doc
- :author "Simon Brooke"}
- mw-parser.simplify) |
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
- | |
|
- | (declare simplify) |
There are a number of possible simplifications such that if the tree has
- only two elements, the second is semantically sufficient.
- | (defn simplify-second-of-two
- [tree]
- (if (= (count tree) 2) (simplify (nth tree 1)) tree)) |
Some parse trees take the form
- [:X [:Y 1] :NOISE :NOISE [:X [:Y 2] :NOISE :NOISE [:X [:Y 3]]]]
- where what's wanted is [:X [:Y 1] [:Y 2] [:Y 2]] -- :DISJUNCT-VALUE is a case
- in point. This takes such a parse tree, where branch-tag is the tag of
- the enclosing form and leaf-tag is the tag of the form to be collected, and
- returns the desired form.
- | (defn simplify-chained-list
- [tree branch-tag leaf-tag]
- (cons
- (first tree)
- (reverse
- (loop [chain (rest tree) v '()]
- (let [car (first chain)]
- (cond (empty? chain) v
- (coll? car) (let [caar (first car)]
- (cond
- (= branch-tag caar) (recur car v)
- (= leaf-tag caar) (recur
- (rest chain)
- (cons (simplify car) v))
- :else (recur (rest chain) v)))
- :else (recur (rest chain) v))))))) |
Simplify/canonicalise this tree. Opportunistically replace complex fragments with
- semantically identical simpler fragments
- | (defn simplify
- [tree]
- (if
- (coll? tree)
- (case (first tree)
- :ACTION (simplify-second-of-two tree)
- :ACTIONS (cons (first tree) (simplify (rest tree)))
- :AND nil
- :CHANCE-IN nil
- :COMPARATIVE (simplify-second-of-two tree)
- :CONDITION (simplify-second-of-two tree)
- :CONDITIONS (simplify-second-of-two tree)
- :DISJUNCT-EXPRESSION (simplify-chained-list tree :DISJUNCT-VALUE :VALUE)
- :EXPRESSION (simplify-second-of-two tree)
- :IN nil
- :PROPERTY (simplify-second-of-two tree)
- :PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree)
- :OR nil
- :SPACE nil
- :THEN nil
- :VALUE (simplify-second-of-two tree)
- (remove nil? (map simplify tree)))
- tree)) |
|
- | (defn simplify-determiner-condition
- [tree]
- (apply vector
- (cons :DETERMINER-CONDITION
- (cons
- (simplify-second-of-two (second tree))
- (rest (rest tree)))))) |
| | |
| |
parse multiple rules from a stream, possibly a file.
- | (ns ^{:doc
- :author "Simon Brooke"}
- mw-parser.bulk
- (:use mw-parser.core
- mw-engine.utils
- clojure.java.io
- [clojure.string :only [split trim]])
- (:import (java.io BufferedReader StringReader))) |
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
- | |
Is this line a comment?
- | (defn comment?
- [line]
- (or (empty? (trim line)) (member? (first line) '(nil \# \;)))) |
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.
- | (defn parse-string
- [string]
- ;; TODO: tried to do this using with-open, but couldn't make it work.
- (map #(parse-rule (trim %)) (remove comment? (split string #"\n")))) |
Parse rules from successive lines in the file loaded from this filename.
- Return a list of S-expressions.
- | (defn parse-file
- [filename]
- (parse-string (slurp filename))) |
Compile each non-comment line of this string into an executable anonymous
- function, and return the sequence of such functions.
- | (defn compile-string
- [string]
- (map #(compile-rule % true) (remove comment? (split string #"\n")))) |
Compile each non-comment line of the file indicated by this filename into
- an executable anonymous function, and return the sequence of such functions.
- | (defn compile-file
- [filename]
- (compile-string (slurp filename))) |
| | |
| |
Utilities used in more than one namespace within the parser.
- | (ns ^{:doc
- :author "Simon Brooke"}
- mw-parser.utils) |
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
- | |
Return true if tree-fragment appears to be a tree fragment of the expected type.
- | (defn suitable-fragment?
- [tree-fragment type]
- (and (coll? tree-fragment)
- (keyword? type)
- (= (first tree-fragment) type))) |
Return true if the argument appears to be a parsed rule tree, else false.
- | (defn rule?
- [maybe-rule]
- (suitable-fragment? maybe-rule :RULE)) |
Marker to indicate I'm not yet finished!
- | (defn TODO
- [message]
- message) |
If tree-fragment is not a tree fragment of the expected type, throw an exception.
- | (defn assert-type
- [tree-fragment type]
- (assert (suitable-fragment? tree-fragment type)
- (throw (Exception. (format "Expected a %s fragment" type))))) |
Return the first element of this tree which has this tag in a depth-first, left-to-right search
- | (defn search-tree
- [tree tag]
- (cond
- (= (first tree) tag) tree
- :else (first
- (remove nil?
- (map
- #(search-tree % tag)
- (filter coll? (rest tree))))))) |
| | |
| |
A very simple parser which parses flow rules.
- | (ns ^{:doc
- :author "Simon Brooke"}
- mw-parser.flow
- (:require [clojure.string :refer [join]]
- [mw-parser.declarative :refer [build-parser]]
- [mw-parser.simplify :refer [simplify-second-of-two]])) |
Grammar for flow rules.
-
- My initial conception of this would be that production rules
- (if-then rules) and flow rules (flow-from-to rules) would be
- entirely separate, presented to the parser as separate text
- files, and parsed and compiled by different chains of functions.
-
- This appears not to be necessary. Flow rules are easy to parse
- with the same parser as production rules -- a lot of the grammar
- is intentionally common -- and the rules are easily discriminated
- at the compilation ('generate') stage.
-
- The basic rule I want to be able to compile at this stage is the 'mutual
- aid' rule:
-
- flow 1 food from house having food > 1 to house with least food within 2
- | (def flow-grammar
- (join "\n" ["FLOW-RULE := FLOW SPACE QUANTITY SPACE PROPERTY SPACE FROM SPACE SOURCE SPACE TO-HOW SPACE DESTINATION;"
- "PERCENTAGE := NUMBER #'%';"
- "QUANTITY := PERCENTAGE | NUMBER | EXPRESSION | SOME;"
- "SOURCE := STATE | STATE SPACE WITH SPACE CONDITIONS;"
- "DESTINATION := STATE | STATE SPACE WITH SPACE FLOW-CONDITIONS | STATE SPACE WITHIN SPACE VALUE SPACE WITH SPACE FLOW-CONDITIONS;"
- "DETERMINER := MOST | LEAST;"
- "DETERMINER-CONDITION := DETERMINER SPACE PROPERTY | DETERMINER SPACE PROPERTY;"
- "FLOW-CONDITIONS := DETERMINER-CONDITION | CONDITIONS"
- "STATE := SYMBOL;"
- "TO-HOW := TO | TO-EACH | TO-FIRST;"
- "TO-EACH := TO SPACE EACH | TO SPACE ALL;"
- "TO-FIRST := TO SPACE FIRST"])) |
Parse the argument, assumed to be a string in the correct syntax, and return a parse tree.
- | (def parse-flow
- (build-parser flow-grammar)) |
|
- | (defn simplify-flow
- [tree]
- (if (coll? tree)
- (case (first tree)
- :CONDITION (simplify-second-of-two tree)
- :CONDITIONS (simplify-second-of-two tree)
- :DETERMINER (simplify-second-of-two tree)
-;; :DETERMINER-CONDITION (simplify-determiner-condition tree)
- :EXPRESSION (simplify-second-of-two tree)
- :FLOW nil
-;; :FLOW-CONDITIONS (simplify-second-of-two tree)
- :PROPERTY (simplify-second-of-two tree)
- :PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree)
- :SPACE nil
- :QUANTITY (simplify-second-of-two tree)
- :STATE (list :PROPERTY-CONDITION
- (list :SYMBOL "state")
- '(:QUALIFIER
- (:EQUIVALENCE
- (:IS "is")))
- (list :EXPRESSION
- (list :VALUE (second tree))))
- (remove nil? (map simplify-flow tree)))
- tree)) |
| | |
| |
A very simple parser which parses production rules.
- | (ns ^{:doc
- :author "Simon Brooke"}
- mw-parser.core
- (:use mw-engine.utils
- [clojure.string :only [split trim triml]])
- (: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'") |
If this token appears to represent an explicit number, return that number;
- otherwise, make a keyword of it and return that.
- | (defn- keyword-or-numeric
- [token]
- (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
-sequence of tokens (and in some cases other optional arguments) and return a
-vector comprising
-
-
-- A code fragment parsed from the front of the sequence of tokens, and
-- 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.
- | |
Parse a number.
- | (defn parse-numeric-value
- [[value & remainder]]
- (if (and value (re-matches re-number value)) [(read-string value) remainder])) |
Parse a token assumed to be the name of a property of the current cell,
- whose value is assumed to be an integer.
- | (defn parse-property-int
- [[value & remainder]]
- (if value [(list 'get-int 'cell (keyword value)) remainder])) |
Parse a token assumed to be the name of a property of the current cell.
- | (defn parse-property-value
- [[value & remainder]]
- (if value [(list (keyword value) 'cell) remainder])) |
Parse a token assumed to be a simple token value.
- | (defn parse-token-value
- [[value & remainder]]
- (if value [(keyword value) remainder])) |
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.
- | (defn parse-simple-value
- ([tokens expect-int]
- (or
- (parse-numeric-value tokens)
- (cond expect-int
- (parse-property-int tokens)
- true (parse-token-value tokens))))
- ([tokens]
- (parse-simple-value tokens false))) |
Parse a single value from this single token and return just the generated
- code, not a pair.
- | (defn gen-token-value
- [token expect-int]
- (first (parse-simple-value (list token) expect-int))) |
Parse a list of values from among these tokens. If expect-int is true, return
- integers or things which will evaluate to integers.
- | (defn parse-disjunct-value
- [[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])
- true
- [(list value) tokens])))) |
Parse a value from among these tokens. If expect-int is true, return
- an integer or something which will evaluate to an integer.
- | (defn parse-value
- ([tokens expect-int]
- (or
- (parse-disjunct-value tokens expect-int)
- (parse-simple-value tokens expect-int)))
- ([tokens]
- (parse-value tokens false))) |
Parses a condition of the form '[property] in [value] or [value]...'
- | (defn parse-member-condition
- [[property IS IN & rest]]
- (if (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]))) |
Parse '[property] less than [value]'.
- | (defn- parse-less-condition
- [[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]))) |
Parse '[property] more than [value]'.
- | (defn- parse-more-condition
- [[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]))) |
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.
- | (defn- parse-is-condition
- [[property IS value & rest]]
- (cond
- (member? IS '("is" "are"))
- (let [tokens (cons property (cons value rest))]
- (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])))) |
Parse the negation of a simple condition.
- | (defn- parse-not-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))) |
Parse conditions of the form '...more than 6 neighbours are [condition]'
- | (defn parse-comparator-neighbours-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)))) |
Parse conditions of the form '...6 neighbours are [condition]'
- | (defn parse-simple-neighbours-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))))))) |
Parse conditions referring to neighbours
- | (defn parse-neighbours-condition
- [tokens]
- (or
- (parse-simple-neighbours-condition tokens)
- (parse-comparator-neighbours-condition tokens)
- (parse-some-neighbours-condition tokens))) |
Parse conditions of the form '[property] [comparison] [value]'.
- | (defn parse-simple-condition
- [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))) |
Parse '... or [condition]' from tokens, where left is the already parsed first disjunct.
- | (defn- parse-disjunction-condition
- [left tokens]
- (let [partial (parse-conditions tokens)]
- (if partial
- (let [[right remainder] partial]
- [(list 'or left right) remainder])))) |
Parse '... and [condition]' from tokens, where left is the already parsed first conjunct.
- | (defn- parse-conjunction-condition
- [left tokens]
- (let [partial (parse-conditions tokens)]
- (if partial
- (let [[right remainder] partial]
- [(list 'and left right) remainder])))) |
Parse conditions from tokens, where conditions may be linked by either 'and' or 'or'.
- | (defn- parse-conditions
- [tokens]
- (let [partial (parse-simple-condition tokens)]
- (if partial
- (let [[left [next & remainder]] partial]
- (cond
- (= next "and") (parse-conjunction-condition left remainder)
- (= next "or") (parse-disjunction-condition left remainder)
- true partial))))) |
Parse the left hand side ('if...') of a production rule.
- | (defn- parse-left-hand-side
- [[IF & tokens]]
- (if
- (= IF "if")
- (parse-conditions tokens))) |
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'.
- | (defn- parse-arithmetic-action
- [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))
- (cond
- (re-matches re-number value) (read-string value)
- true (list 'get-int 'cell (keyword value)))))}) rest])) |
Parse actions of the form '[property] should be [value].'
- | (defn- parse-set-action
- [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) (cond (re-matches re-number value) (read-string value) true (keyword value))}) rest])) |
|
- | (defn- parse-simple-action [previous tokens]
- (or (parse-arithmetic-action previous tokens)
- (parse-set-action previous tokens))) |
Parse actions from tokens.
- | (defn- parse-actions
- [previous tokens]
- (let [[left remainder] (parse-simple-action previous tokens)]
- (cond left
- (cond (= (first remainder) "and")
- (parse-actions left (rest remainder))
- true (list left))))) |
Parse a probability of an action from this collection of tokens
- | (defn- parse-probability
- [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])))) |
Parse the right hand side ('then...') of a production rule.
- | (defn- parse-right-hand-side
- [[THEN & tokens]]
- (if (= THEN "then")
- (or
- (parse-probability nil tokens)
- (parse-actions nil tokens)))) |
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.
- | (defn parse-rule
- [line]
- (cond
- (string? line)
- (let [rule (parse-rule (split (triml line) #"\s+"))]
- (cond rule rule
- true (throw (Exception. (format bad-parse-error line)))))
- true
- (let [[left remainder] (parse-left-hand-side line)
- [right junk] (parse-right-hand-side remainder)]
- (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)))))) |
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.
- | (defn compile-rule
- ([rule-text return-tuple?]
- (do
- (use 'mw-engine.utils)
- (let [afn (eval (parse-rule rule-text))]
- (cond
- (and afn return-tuple?)(list afn (trim rule-text))
- true afn))))
- ([rule-text]
- (compile-rule rule-text false))) |
| | |
| |
Display parse errors in a format which makes it easy for the user
- to see where the error occurred.
- | (ns ^{:doc
- :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
- "The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions") |
error thrown when a rule cannot be parsed. Slots are for
-(1) rule text
-(2) cursor showing where in the rule text the error occurred
-(3) the reason for the error
- | (def bad-parse-error "I did not understand:\n '%s'\n %s\n %s") |
Attempt to explain the reason for the parse error.
- | (defn- explain-parse-error-reason
- [reason]
- (str "Expecting one of (" (apply str (map #(str (:expecting %) " ") reason)) ")")) |
|
- | (defn- parser-error-to-map
- [parser-error]
- (let [m (reduce (fn [map item](merge map {(first item)(second item)})) {} parser-error)
- reason (map
- #(reduce (fn [map item] (merge {(first item) (second item)} map)) {} %)
- (:reason m))]
- (merge m {:reason reason}))) |
Construct a helpful error message from this parser-error, and throw an exception with that message.
- | (defn throw-parse-exception
- [parser-error]
- (assert (coll? parser-error) "Expected a paser error structure?")
- (let
- [
- ;; the error structure is a list, such that each element is a list of two items, and
- ;; the first element in each sublist is a keyword. Easier to work with it as a map
- error-map (parser-error-to-map parser-error)
- text (:text error-map)
- reason (explain-parse-error-reason (:reason error-map))
- ;; rules have only one line, by definition; we're interested in the column
- column (if (:column error-map)(:column error-map) 0)
- ;; create a cursor to point to that column
- cursor (apply str (reverse (conj (repeat column " ") "^")))
- message (format bad-parse-error text cursor reason)
- ]
- (throw (Exception. message)))) |
| | |
| |
Generate Clojure source from simplified parse trees.
- | (ns ^{:doc
- :author "Simon Brooke"}
- mw-parser.generate
- (:require [clojure.pprint :refer [pprint]]
- [clojure.tools.trace :refer [deftrace]]
- [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) |
From this tree, assumed to be a syntactically correct rule specification,
- generate and return the appropriate rule as a function of two arguments.
- | (defn generate-rule
- [tree]
- (assert-type tree :RULE)
- (vary-meta
- (list 'fn ['cell 'world] (list 'when (generate (nth tree 2)) (generate (nth tree 3))))
- merge
- {:rule-type
- :production})) |
From this tree, assumed to be a syntactically correct conditions clause,
- generate and return the appropriate clojure fragment.
- | (defn generate-conditions
- [tree]
- (assert-type tree :CONDITIONS)
- (generate (second tree))) |
From this tree, assumed to be a syntactically correct condition clause,
- generate and return the appropriate clojure fragment.
- | (defn generate-condition
- [tree]
- (assert-type tree :CONDITION)
- (generate (second tree))) |
From this tree, assumed to be a syntactically conjunct correct condition clause,
- generate and return the appropriate clojure fragment.
- | (defn generate-conjunct-condition
- [tree]
- (assert-type tree :CONJUNCT-CONDITION)
- (cons 'and (map generate (rest tree)))) |
From this tree, assumed to be a syntactically correct disjunct condition clause,
- generate and return the appropriate clojure fragment.
- | (defn generate-disjunct-condition
- [tree]
- (assert-type tree :DISJUNCT-CONDITION)
- (cons 'or (map generate (rest tree)))) |
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.
- | (defn generate-ranged-property-condition
- [tree property expression]
- (assert-type tree :PROPERTY-CONDITION)
- (assert-type (nth tree 3) :RANGE-EXPRESSION)
- (let [l1 (generate (nth expression 2))
- l2 (generate (nth expression 4))
- pv (list property 'cell)]
- (list 'let ['lower (list 'min l1 l2)
- 'upper (list 'max l1 l2)]
- (list 'and (list '>= pv 'lower) (list '<= pv 'upper))))) |
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!
- | (defn generate-disjunct-property-condition
- ([tree]
- (let [property (generate (second tree))
- qualifier (generate (nth tree 2))
- expression (generate (nth tree 3))]
- (generate-disjunct-property-condition tree property qualifier expression)))
- ([_tree property qualifier expression]
- (let [e (list expression (list property 'cell))]
- (if (= qualifier '=) e
- (list 'not e))))) |
From this tree, assumed to be a syntactically property condition clause,
- generate and return the appropriate clojure fragment.
- | (defn generate-property-condition
- ([tree]
- (assert-type tree :PROPERTY-CONDITION)
- (if
- (and (= (count tree) 2) (= (first (second tree)) :SYMBOL))
- ;; it's a shorthand for 'state equal to symbol'. This should probably have
- ;; been handled in simplify...
- (generate-property-condition
- (list
- :PROPERTY-CONDITION
- '(:SYMBOL "state")
- '(:QUALIFIER (:EQUIVALENCE (:EQUAL "equal to")))
- (second tree)))
- ;; otherwise...
- (generate-property-condition tree (first (nth tree 3)))))
- ([tree expression-type]
- (assert-type tree :PROPERTY-CONDITION)
- (let [property (generate (second tree))
- qualifier (generate (nth tree 2))
- e (generate (nth tree 3))
- expression (cond
- (and (not (= qualifier '=)) (keyword? e)) (list 'or (list e 'cell) e)
- (and (not (= qualifier 'not=)) (keyword? e)) (list 'or (list e 'cell) e)
- :else e)]
- (case expression-type
- :DISJUNCT-EXPRESSION (generate-disjunct-property-condition tree property qualifier expression)
- :RANGE-EXPRESSION (generate-ranged-property-condition tree property expression)
- (list qualifier (list property 'cell) expression))))) |
From this tree, assumed to be a syntactically correct qualifier,
- generate and return the appropriate clojure fragment.
- | (defn generate-qualifier
- [tree]
- (if
- (= (count tree) 2)
- (generate (second tree))
- ;; else
- (generate (nth tree 2)))) |
From this tree, assumed to be a syntactically correct simple action,
- generate and return the appropriate clojure fragment.
- | (defn generate-simple-action
- ([tree]
- (assert-type tree :SIMPLE-ACTION)
- (generate-simple-action tree []))
- ([tree others]
- (assert-type tree :SIMPLE-ACTION)
- (let [property (generate (second tree))
- expression (generate (nth tree 3))]
- (if (or (= property :x) (= property :y))
- (throw (Exception. pe/reserved-properties-error))
- (list 'merge
- (if (empty? others) 'cell
- ;; else
- (generate others))
- {property expression}))))) |
From this tree, assumed to be a syntactically correct probable action,
- generate and return the appropriate clojure fragment.
- | (defn generate-probable-action
- ([tree]
- (assert-type tree :PROBABLE-ACTION)
- (generate-probable-action tree []))
- ([tree others]
- (assert-type tree :PROBABLE-ACTION)
- (let
- [chances (generate (nth tree 1))
- total (generate (nth tree 2))
- action (generate-action (nth tree 3) others)]
- ;; TODO: could almost certainly be done better with macro syntax
- (list 'if
- (list '< (list 'rand total) chances)
- action)))) |
From this tree, assumed to be a syntactically correct action,
- generate and return the appropriate clojure fragment.
- | (defn generate-action
- [tree others]
- (case (first tree)
- :ACTIONS (generate-action (first tree) others)
- :SIMPLE-ACTION (generate-simple-action tree others)
- :PROBABLE-ACTION (generate-probable-action tree others)
- (throw (Exception. (str "Not a known action type: " (first tree)))))) |
From this tree, assumed to be one or more syntactically correct actions,
- generate and return the appropriate clojure fragment.
- | (defn generate-multiple-actions
- [tree]
- (assert-type tree :ACTIONS)
- (generate-action (first (rest tree)) (second (rest tree)))) |
Generate a disjunct value. Essentially what we need here is to generate a
- flat list of values, since the member has already been taken care of.
- | (defn generate-disjunct-value
- [tree]
- (assert-type tree :DISJUNCT-VALUE)
- (if (= (count tree) 4)
- (cons (generate (second tree)) (generate (nth tree 3)))
- (list (generate (second tree))))) |
From this tree, assumed to be a syntactically correct numeric expression,
- generate and return the appropriate clojure fragment.
- | (defn generate-numeric-expression
- [tree]
- (assert-type tree :NUMERIC-EXPRESSION)
- (case (count tree)
- 4 (let [[p operator expression] (rest tree)
- property (if (number? p) p (list p 'cell))]
- (list (generate operator) (generate property) (generate expression)))
- (case (first (second tree))
- :SYMBOL (list (keyword (second (second tree))) 'cell)
- (generate (second tree))))) |
Generate code for a condition which refers to neighbours.
- | (defn generate-neighbours-condition
- ([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]
- (let [quantifier (second tree)
- pc (generate (nth tree 4))]
- (case quantifier-type
- :NUMBER (generate-neighbours-condition '= (read-string (second (second quantifier))) pc 1)
- :SOME (generate-neighbours-condition '> 0 pc 1)
- :MORE (let [value (generate (nth quantifier 3))]
- (generate-neighbours-condition '> value pc 1))
- :LESS (let [value (generate (nth quantifier 3))]
- (generate-neighbours-condition '< value pc 1)))))
- ([comp1 quantity property-condition distance]
- (list comp1
- (list 'count
- (list 'remove 'false?
- (list 'map (list 'fn ['cell] property-condition)
- (list 'mw-engine.utils/get-neighbours 'world 'cell distance)))) quantity))
- ([comp1 quantity property-condition]
- (generate-neighbours-condition comp1 quantity property-condition 1))) |
Generate code for a condition which refers to neighbours within a specified distance.
- NOTE THAT there's clearly masses of commonality between this and
- generate-neighbours-condition, and that some refactoring is almost certainly
- desirable. It may be that it's better to simplify a NEIGHBOURS-CONDITION
- into a WITHIN-CONDITION in the simplification stage.
- | (defn generate-within-condition
- ([tree]
- (assert-type tree :WITHIN-CONDITION)
- (case (first (second tree))
- :QUANTIFIER (generate-within-condition tree (first (second (second tree))))
- :QUALIFIER (TODO "qualified within... help!")))
- ([tree quantifier-type]
- (let [quantifier (second tree)
- distance (generate (nth tree 4))
- pc (generate (nth tree 6))]
- (case quantifier-type
- :NUMBER (generate-neighbours-condition '= (read-string (second (second quantifier))) pc distance)
- :SOME (generate-neighbours-condition '> 0 pc distance)
- :MORE (let [value (generate (nth quantifier 3))]
- (generate-neighbours-condition '> value pc distance))
- :LESS (let [value (generate (nth quantifier 3))]
- (generate-neighbours-condition '< value pc distance)))))) |
|
- | (defn- generate-disjunct-expression
- [tree]
- (assert-type tree :DISJUNCT-EXPRESSION)
- (try
- (set (map generate (rest tree)))
- (catch Exception x
- (throw
- (ex-info
- "Failed to compile :DISJUNCT-EXPRESSION"
- {:tree tree}
- x))))) |
Flow rules. A flow rule DOES NOT return a modified world; instead, it
-returns a PLAN to modify the world, in the form of a sequence of flows.
-It is only when the plan is executed that the world is modified.
-
-so we're looking at something like
-(fn [cell world])
- (if (= (:state cell) (or (:house cell) :house))
- | |
|
- | (defn generate-flow
- [tree]
- (assert-type tree :FLOW-RULE)) |
Top level; only function anything outside this file (except tests) should
-really call.
- | |
Generate code for this (fragment of a) parse tree
- | (defn generate
- [tree]
- (if
- (coll? tree)
- (case (first tree)
- :ACTIONS (generate-multiple-actions tree)
- :COMPARATIVE (generate (second tree))
- :COMPARATIVE-QUALIFIER (generate (second tree))
- :CONDITION (generate-condition tree)
- :CONDITIONS (generate-conditions tree)
- :CONJUNCT-CONDITION (generate-conjunct-condition tree)
- :DISJUNCT-CONDITION (generate-disjunct-condition tree)
- :DISJUNCT-EXPRESSION (generate-disjunct-expression tree)
- :DISJUNCT-VALUE (generate-disjunct-value tree)
- :EQUIVALENCE '=
- :EXPRESSION (generate (second tree))
- :FLOW-RULE (generate-flow tree)
- :LESS '<
- :MORE '>
- :NEGATED-QUALIFIER (case (generate (second tree))
- = 'not=
- > '<
- < '>)
- :NEIGHBOURS-CONDITION (generate-neighbours-condition tree)
- :NUMERIC-EXPRESSION (generate-numeric-expression tree)
- :NUMBER (read-string (second tree))
- :OPERATOR (symbol (second tree))
- :PROBABLE-ACTION (generate-probable-action tree)
- :PROPERTY (list (generate (second tree)) 'cell) ;; dubious - may not be right
- :PROPERTY-CONDITION (generate-property-condition tree)
- :QUALIFIER (generate-qualifier tree)
- :RULE (generate-rule tree)
- :SIMPLE-ACTION (generate-simple-action tree)
- :SYMBOL (keyword (second tree))
- :VALUE (generate (second tree))
- :WITHIN-CONDITION (generate-within-condition tree)
- (map generate tree))
- tree)) |
| | |
| |
A very simple parser which parses production rules.
- | (ns ^{:doc
- :author "Simon Brooke"}
- mw-parser.declarative
- (:require [instaparse.core :refer [parser]]
- [clojure.string :refer [join trim]]
- [mw-parser.errors :refer [throw-parse-exception]]
- [mw-parser.generate :refer [generate]]
- [mw-parser.simplify :refer [simplify]]
- [mw-parser.utils :refer [rule?]]
- [trptr.java-wrapper.locale :refer [get-default]])
- (:import [java.util Locale])) |
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
- | |
Basic rule language grammar.
-
- in order to simplify translation into other natural languages, all
- TOKENS within the parser should be unambiguou.
- | (def rule-grammar
- (join "\n" ["RULE := IF SPACE CONDITIONS SPACE THEN SPACE ACTIONS;"
- "ACTIONS := ACTION | ACTION SPACE AND SPACE ACTIONS"
- "ACTION := SIMPLE-ACTION | PROBABLE-ACTION;"
- "PROBABLE-ACTION := VALUE SPACE CHANCE-IN SPACE VALUE SPACE SIMPLE-ACTION;"
- "SIMPLE-ACTION := SYMBOL SPACE BECOMES SPACE EXPRESSION;"])) |
Grammar rules used both in the rule grammar and in the flow grammar
- | (def common-grammar
- (join "\n" ["COMPARATIVE := MORE | LESS;"
- "COMPARATIVE-QUALIFIER := IS SPACE COMPARATIVE SPACE THAN | COMPARATIVE SPACE THAN;"
- "CONDITION := WITHIN-CONDITION | NEIGHBOURS-CONDITION | PROPERTY-CONDITION;"
- "CONDITIONS := DISJUNCT-CONDITION | CONJUNCT-CONDITION | CONDITION ;"
- "CONJUNCT-CONDITION := CONDITION SPACE AND SPACE CONDITIONS;"
- "DISJUNCT-CONDITION := CONDITION SPACE OR SPACE CONDITIONS;"
- "DISJUNCT-EXPRESSION := IN SPACE DISJUNCT-VALUE;"
- "DISJUNCT-VALUE := VALUE | VALUE SPACE OR SPACE DISJUNCT-VALUE;"
- "EQUIVALENCE := IS SPACE EQUAL | EQUAL | IS ;"
- "EXPRESSION := SIMPLE-EXPRESSION | RANGE-EXPRESSION | NUMERIC-EXPRESSION | DISJUNCT-EXPRESSION | VALUE;"
- "NEGATED-QUALIFIER := QUALIFIER SPACE NOT | NOT SPACE QUALIFIER;"
- "NEIGHBOURS-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE IS SPACE PROPERTY-CONDITION | QUALIFIER SPACE NEIGHBOURS-CONDITION;"
- "NUMBER := #'[0-9]+' | #'[0-9]+.[0-9]+';"
- "NUMERIC-EXPRESSION := VALUE | VALUE SPACE OPERATOR SPACE NUMERIC-EXPRESSION;"
- "OPERATOR := '+' | '-' | '*' | '/';"
- "PROPERTY := SYMBOL;"
- "PROPERTY-CONDITION := PROPERTY SPACE QUALIFIER SPACE EXPRESSION | VALUE;"
- "PROPERTY-CONDITION-OR-EXPRESSION := PROPERTY-CONDITION | EXPRESSION;"
- "QUALIFIER := COMPARATIVE-QUALIFIER | NEGATED-QUALIFIER | EQUIVALENCE | IS SPACE QUALIFIER;"
- "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+';"
- "VALUE := SYMBOL | NUMBER;"
- "VALUE := SYMBOL | NUMBER;"
- "WITHIN-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE WITHIN SPACE NUMBER SPACE IS SPACE PROPERTY-CONDITION-OR-EXPRESSION;"
- ])) |
English language keyword literals used in rules - both in production
- rules (this namespace) and in flow rules (see mw-parser.flow).
-
- It's a long term aim that the rule language should be easy to
- internationalise; this isn't a full solution but it's a step towards
- a solution.
-
- | (def keywords-en
- (join "\n" ["ALL := 'all'"
- "AND := 'and';"
- "BECOMES := 'should be' | 'becomes';"
- "BETWEEN := 'between';"
- "CHANCE-IN := 'chance in';"
- "EACH := 'each' | 'every' | 'all';"
- "EQUAL := 'equal to';"
- "FIRST := 'first';"
- "FLOW := 'flow' | 'move';"
- "FROM := 'from';"
- "IF := 'if';"
- "IN := 'in';"
- "IS := 'is' | 'are' | 'have' | 'has';"
- "LEAST := 'least';"
- "LESS := 'less' | 'fewer';"
- "MORE := 'more' | 'greater';"
- "MOST := 'most';"
- "NEIGHBOURS := 'neighbour' | 'neighbor' | 'neighbours' | 'neighbors';"
- "NONE := 'no';"
- "NOT := 'not';"
- "OR := 'or';"
- "SOME := 'some';"
- ;; SYMBOL is in the per-language file so that languages that use
- ;; (e.g.) Cyrillic characters can change the definition.
- "SYMBOL := #'[a-z]+';"
- "THAN := 'than';"
- "THEN := 'then';"
- "TO := 'to';"
- "WITH := 'with' | 'where' | 'having';"
- "WITHIN := 'within';"])) |
For now, just return keywords-en; plan is to have resource files of
- keywords for different languages in a resource directory, but that isn't
- done yet. It's probably not going to work easily for languages that use
- non-latin alphabets, anyway.
- | (defn keywords-for-locale
- ([]
- (keywords-for-locale (get-default)))
- ([^Locale _locale]
- keywords-en)) |
Compose this grammar fragment g with the common grammar fragments to
- make a complete grammar, and return a parser for that complete grammar.
- | (defmacro build-parser
- [g]
- `(parser (join "\n" [~g common-grammar (keywords-for-locale)]))) |
Parse the argument, assumed to be a string in the correct syntax, and return a parse tree.
- | (def parse-rule
- (build-parser rule-grammar)) |
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.
- | (defn compile-rule
- ([rule-text return-tuple?]
- (assert (string? rule-text))
- (let [rule (trim rule-text)
- tree (simplify (parse-rule rule))
- afn (if (rule? tree) (eval (generate tree))
- ;; else
- (throw-parse-exception tree))]
- (if return-tuple?
- (list afn rule)
- ;; else
- afn)))
- ([rule-text]
- (compile-rule rule-text false))) |
| | |
\ No newline at end of file
diff --git a/project.clj b/project.clj
index 9fb35d7..d48db45 100644
--- a/project.clj
+++ b/project.clj
@@ -1,23 +1,18 @@
-(defproject mw-parser "0.3.0-SNAPSHOT"
- :cloverage {:output "docs/cloverage"}
- :codox {:metadata {:doc "**TODO**: write docs"
- :doc/format :markdown}
- :output-path "docs/codox"
- :source-uri "https://github.com/simon-brooke/mw-parser/blob/master/{filepath}#L{line}"}
- :dependencies [[org.clojure/clojure "1.11.1"]
- [org.clojure/tools.trace "0.7.11"]
- [instaparse "1.4.12"]
- [mw-engine "0.3.0-SNAPSHOT"]
- [trptr/java-wrapper "0.2.3"]]
+(defproject mw-parser "0.1.5-SNAPSHOT"
:description "Parser for production rules for MicroWorld engine"
- :license {:name "GNU General Public License v2"
- :url "http://www.gnu.org/licenses/gpl-2.0.html"}
- :manifest {"build-signature-version" "unset"
+ :url "http://www.journeyman.cc/microworld"
+ :manifest {
+ "build-signature-version" "unset"
"build-signature-user" "unset"
"build-signature-email" "unset"
"build-signature-timestamp" "unset"
- "Implementation-Version" "unset"}
- :plugins [[lein-marginalia "0.7.1"]
- [lein-cloverage "1.2.2"]
- [lein-codox "0.10.8"]]
- :url "http://www.journeyman.cc/microworld")
+ "Implementation-Version" "unset"
+ }
+ :license {:name "GNU General Public License v2"
+ :url "http://www.gnu.org/licenses/gpl-2.0.html"}
+ :plugins [[lein-marginalia "0.7.1"]]
+ :dependencies [[org.clojure/clojure "1.6.0"]
+ [org.clojure/tools.trace "0.7.9"]
+ [instaparse "1.4.1"]
+ [mw-engine "0.1.5-SNAPSHOT"]
+ ])
diff --git a/resources/rules.txt b/resources/rules.txt
index d7f2d5f..0356227 100644
--- a/resources/rules.txt
+++ b/resources/rules.txt
@@ -6,19 +6,19 @@
## Vegetation rules
;; rules which populate the world with plants
-;; Occasionally, passing birds plant tree seeds into grassland
+;; Occasionally, passing birds plant tree seeds into grassland
if state is grassland then 1 chance in 10 state should be heath
;; heath below the treeline grows gradually into forest
-if state is heath and altitude is less than 120 then state should be scrub
+if state is heath and altitude is less than 120 then state should be scrub
if state is scrub then 1 chance in 5 state should be forest
;; Forest on fertile land grows to climax
-if state is forest and fertility is more than 5 and altitude is less than 70 then state should be climax
-
+if state is forest and fertility is more than 5 and altitude is less than 70 then state should be climax
+
;; Climax forest occasionally catches fire (e.g. lightning strikes)
if state is climax then 1 chance in 500 state should be fire
@@ -40,7 +40,7 @@ if state is waste then state should be grassland
## Potential blockers
-;; Forest increases soil fertility.
+;; Forest increases soil fertility.
if state is in forest or climax then fertility should be fertility + 1
diff --git a/src/mw_parser/bulk.clj b/src/mw_parser/bulk.clj
new file mode 100644
index 0000000..b4674ec
--- /dev/null
+++ b/src/mw_parser/bulk.clj
@@ -0,0 +1,39 @@
+;; 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
+ (:use mw-parser.core
+ mw-engine.utils
+ clojure.java.io
+ [clojure.string :only [split trim]])
+ (:import (java.io BufferedReader StringReader)))
+
+(defn comment?
+ "Is this `line` a comment?"
+ [line]
+ (or (empty? (trim line)) (member? (first line) '(nil \# \;))))
+
+(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]
+ ;; TODO: tried to do this using with-open, but couldn't make it work.
+ (map parse-rule (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-string
+ "Compile each non-comment line of this `string` into an executable anonymous
+ function, and return the sequence of such functions."
+ [string]
+ (map #(compile-rule % true) (remove comment? (split string #"\n"))))
+
+(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-string (slurp filename)))
diff --git a/src/mw_parser/core.clj b/src/mw_parser/core.clj
new file mode 100644
index 0000000..aafd595
--- /dev/null
+++ b/src/mw_parser/core.clj
@@ -0,0 +1,424 @@
+;; 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 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
+(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
+ true (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]]
+ (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,
+ whose value is assumed to be an integer."
+ [[value & remainder]]
+ (if value [(list '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]]
+ (if value [(list (keyword value) 'cell) remainder]))
+
+(defn parse-token-value
+ "Parse a token assumed to be a simple token value."
+ [[value & remainder]]
+ (if 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)
+ true (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])
+ true
+ [(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]]
+ (if (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]]
+ (cond
+ (member? IS '("is" "are"))
+ (let [tokens (cons property (cons value rest))]
+ (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)]
+ (if 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)]
+ (if 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)]
+ (if partial
+ (let [[left [next & remainder]] partial]
+ (cond
+ (= next "and") (parse-conjunction-condition left remainder)
+ (= next "or") (parse-disjunction-condition left remainder)
+ true partial)))))
+
+(defn- parse-left-hand-side
+ "Parse the left hand side ('if...') of a production rule."
+ [[IF & tokens]]
+ (if
+ (= 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))
+ (cond
+ (re-matches re-number value) (read-string value)
+ true (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) (cond (re-matches re-number value) (read-string value) true (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))
+ true (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]]
+ (if (= 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]
+ (cond
+ (string? line)
+ (let [rule (parse-rule (split (triml line) #"\s+"))]
+ (cond rule rule
+ true (throw (Exception. (format bad-parse-error line)))))
+ true
+ (let [[left remainder] (parse-left-hand-side line)
+ [right junk] (parse-right-hand-side remainder)]
+ (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
+ "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?]
+ (do
+ (use 'mw-engine.utils)
+ (let [afn (eval (parse-rule rule-text))]
+ (cond
+ (and afn return-tuple?)(list afn (trim rule-text))
+ true afn))))
+ ([rule-text]
+ (compile-rule rule-text false)))
diff --git a/src/mw_parser/declarative.clj b/src/mw_parser/declarative.clj
index fada891..8bea7dd 100644
--- a/src/mw_parser/declarative.clj
+++ b/src/mw_parser/declarative.clj
@@ -1,211 +1,368 @@
-(ns ^{:doc "A very simple parser which parses production rules."
- :author "Simon Brooke"}
- mw-parser.declarative
- (:require [clojure.string :refer [join split-lines]]
- [instaparse.core :refer [failure? get-failure parser]]
- [instaparse.failure :refer [pprint-failure]]
- [mw-parser.flow :refer [flow-grammar]]
- [mw-parser.generate :refer [generate]]
- [mw-parser.simplify :refer [simplify]]
- [taoensso.timbre :as l]
- [trptr.java-wrapper.locale :refer [get-default]])
- (:import [java.util Locale]))
+(ns mw-parser.declarative
+ (:use mw-engine.utils
+ [clojure.string :only [split trim triml]])
+ (:require [instaparse.core :as insta]))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;
-;;;; 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
-;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; TODO: Either, when I first wrote this parser, I didn't adequately read the
-;;; Instaparse documentation, or Instaparse has advanced considerably since
-;;; then. Reading the documentation now, I could probably rewrite this to
-;;; eliminate the simplify step altogether, and that would be well worth doing.
+;; error thrown when an attempt is made to set a reserved property
+(def reserved-properties-error
+ "The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions")
+;; error thrown when a rule cannot be parsed. Slots are for
+;; (1) rule text
+;; (2) cursor showing where in the rule text the error occurred
+;; (3) the reason for the error
+(def bad-parse-error "I did not understand:\n'%s'\n%s\n%s")
-(def ruleset-grammar
- "Experimental: parse a whole file in one go."
- ;; TODO: bug here. We're double-counting (some) blank lines
- (join "\n" ["LINES := (LINE)+;"
- "LINE := RULE