").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
new file mode 100644
index 0000000..fdacbf8
--- /dev/null
+++ b/docs/codox/js/page_effects.js
@@ -0,0 +1,112 @@
+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
new file mode 100644
index 0000000..6cca8f1
--- /dev/null
+++ b/docs/codox/mw-parser.bulk.html
@@ -0,0 +1,9 @@
+
+
\ No newline at end of file
diff --git a/docs/codox/mw-parser.core.html b/docs/codox/mw-parser.core.html
new file mode 100644
index 0000000..6b3474a
--- /dev/null
+++ b/docs/codox/mw-parser.core.html
@@ -0,0 +1,25 @@
+
+
\ No newline at end of file
diff --git a/docs/codox/mw-parser.declarative.html b/docs/codox/mw-parser.declarative.html
new file mode 100644
index 0000000..8f12634
--- /dev/null
+++ b/docs/codox/mw-parser.declarative.html
@@ -0,0 +1,14 @@
+
+
\ No newline at end of file
diff --git a/docs/codox/mw-parser.errors.html b/docs/codox/mw-parser.errors.html
new file mode 100644
index 0000000..e7a743e
--- /dev/null
+++ b/docs/codox/mw-parser.errors.html
@@ -0,0 +1,7 @@
+
+
\ No newline at end of file
diff --git a/docs/codox/mw-parser.flow.html b/docs/codox/mw-parser.flow.html
new file mode 100644
index 0000000..b3c6c6e
--- /dev/null
+++ b/docs/codox/mw-parser.flow.html
@@ -0,0 +1,11 @@
+
+
\ No newline at end of file
diff --git a/docs/codox/mw-parser.generate.html b/docs/codox/mw-parser.generate.html
new file mode 100644
index 0000000..2577cc0
--- /dev/null
+++ b/docs/codox/mw-parser.generate.html
@@ -0,0 +1,23 @@
+
+
\ No newline at end of file
diff --git a/docs/codox/mw-parser.simplify.html b/docs/codox/mw-parser.simplify.html
new file mode 100644
index 0000000..bc5d755
--- /dev/null
+++ b/docs/codox/mw-parser.simplify.html
@@ -0,0 +1,8 @@
+
+
\ No newline at end of file
diff --git a/docs/codox/mw-parser.utils.html b/docs/codox/mw-parser.utils.html
new file mode 100644
index 0000000..f5bd3e8
--- /dev/null
+++ b/docs/codox/mw-parser.utils.html
@@ -0,0 +1,9 @@
+
+
\ No newline at end of file
diff --git a/docs/uberdoc.html b/docs/uberdoc.html
new file mode 100644
index 0000000..697d93a
--- /dev/null
+++ b/docs/uberdoc.html
@@ -0,0 +1,4020 @@
+
+
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 d48db45..9fb35d7 100644
--- a/project.clj
+++ b/project.clj
@@ -1,18 +1,23 @@
-(defproject mw-parser "0.1.5-SNAPSHOT"
+(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"]]
:description "Parser for production rules for MicroWorld engine"
- :url "http://www.journeyman.cc/microworld"
- :manifest {
- "build-signature-version" "unset"
+ :license {:name "GNU General Public License v2"
+ :url "http://www.gnu.org/licenses/gpl-2.0.html"}
+ :manifest {"build-signature-version" "unset"
"build-signature-user" "unset"
"build-signature-email" "unset"
"build-signature-timestamp" "unset"
- "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"]
- ])
+ "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")
diff --git a/resources/rules.txt b/resources/rules.txt
index 0356227..d7f2d5f 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
deleted file mode 100644
index b4674ec..0000000
--- a/src/mw_parser/bulk.clj
+++ /dev/null
@@ -1,39 +0,0 @@
-;; 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
deleted file mode 100644
index aafd595..0000000
--- a/src/mw_parser/core.clj
+++ /dev/null
@@ -1,424 +0,0 @@
-;; 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 8bea7dd..fada891 100644
--- a/src/mw_parser/declarative.clj
+++ b/src/mw_parser/declarative.clj
@@ -1,368 +1,211 @@
-(ns mw-parser.declarative
- (:use mw-engine.utils
- [clojure.string :only [split trim triml]])
- (:require [instaparse.core :as insta]))
+(ns ^{:doc "A very simple parser which parses production rules."
+ :author "Simon Brooke"}
+ mw-parser.declarative
+ (:require [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]))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;
+;;;; 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
+;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; 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")
+;;; 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.
+(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