diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..7c53947 --- /dev/null +++ b/.gitignore @@ -0,0 +1,6 @@ +buildall.tmp.* +.lein-failures +.lein-repl-history +target/ +pom.xml + diff --git a/docs/uberdoc.html b/docs/uberdoc.html new file mode 100644 index 0000000..fb3bf73 --- /dev/null +++ b/docs/uberdoc.html @@ -0,0 +1,3882 @@ + +mw-parser -- Marginalia

mw-parser

0.1.6-SNAPSHOT


Parser for production rules for MicroWorld engine

+

dependencies

org.clojure/clojure
1.8.0
org.clojure/tools.trace
0.7.9
instaparse
1.4.1
mw-engine
0.1.6-SNAPSHOT



(this space intentionally left almost blank)

namespaces

 

mw-parser.declarative

toc

A very simple parser which parses production rules.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-parser.declarative
+  (:require [instaparse.core :as insta]
+            [clojure.string :refer [split trim triml]]
+            [mw-parser.errors :as pe]
+            [mw-parser.generate :as pg]
+            [mw-parser.simplify :as ps]
+            [mw-parser.utils :refer [rule?]]))

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

+
+
(def grammar
+  ;; in order to simplify translation into other natural languages, all
+  ;; TOKENS within the parser should be unambiguous
+  "RULE := IF SPACE CONDITIONS SPACE THEN SPACE ACTIONS;
+   CONDITIONS := DISJUNCT-CONDITION | CONJUNCT-CONDITION | CONDITION ;
+   DISJUNCT-CONDITION := CONDITION SPACE OR SPACE CONDITIONS;
+   CONJUNCT-CONDITION := CONDITION SPACE AND SPACE CONDITIONS;
+   CONDITION := WITHIN-CONDITION | NEIGHBOURS-CONDITION | PROPERTY-CONDITION;
+   WITHIN-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE WITHIN SPACE NUMBER SPACE IS SPACE PROPERTY-CONDITION-OR-EXPRESSION;
+   NEIGHBOURS-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE IS SPACE PROPERTY-CONDITION | QUALIFIER SPACE NEIGHBOURS-CONDITION;
+   PROPERTY-CONDITION-OR-EXPRESSION := PROPERTY-CONDITION | EXPRESSION;
+   PROPERTY-CONDITION := PROPERTY SPACE QUALIFIER SPACE EXPRESSION | VALUE;
+   EXPRESSION := SIMPLE-EXPRESSION | RANGE-EXPRESSION | NUMERIC-EXPRESSION | DISJUNCT-EXPRESSION | VALUE;
+   SIMPLE-EXPRESSION := QUALIFIER SPACE EXPRESSION | VALUE;
+   DISJUNCT-EXPRESSION := IN SPACE DISJUNCT-VALUE;
+   RANGE-EXPRESSION := BETWEEN SPACE NUMERIC-EXPRESSION SPACE AND SPACE NUMERIC-EXPRESSION;
+   NUMERIC-EXPRESSION := VALUE | VALUE SPACE OPERATOR SPACE NUMERIC-EXPRESSION;
+   NEGATED-QUALIFIER := QUALIFIER SPACE NOT | NOT SPACE QUALIFIER;
+   COMPARATIVE-QUALIFIER := IS SPACE COMPARATIVE SPACE THAN | COMPARATIVE SPACE THAN;
+   QUALIFIER := COMPARATIVE-QUALIFIER | NEGATED-QUALIFIER | EQUIVALENCE | IS SPACE QUALIFIER;
+   QUANTIFIER := NUMBER | SOME | NONE | ALL | COMPARATIVE SPACE THAN SPACE NUMBER;
+   EQUIVALENCE := IS SPACE EQUAL | EQUAL | IS ;
+   COMPARATIVE := MORE | LESS;
+   DISJUNCT-VALUE := VALUE | VALUE SPACE OR SPACE DISJUNCT-VALUE;
+   IF := 'if';
+   THEN := 'then';
+   THAN := 'than';
+   OR := 'or';
+   NOT := 'not';
+   AND := 'and';
+   SOME := 'some';
+   NONE := 'no';
+   ALL := 'all'
+   BETWEEN := 'between';
+   WITHIN := 'within';
+   IN := 'in';
+   MORE := 'more' | 'greater';
+   LESS := 'less' | 'fewer';
+   OPERATOR := '+' | '-' | '*' | '/';
+   NEIGHBOURS := 'neighbour' | 'neighbor' | 'neighbours' | 'neighbors';
+   PROPERTY := SYMBOL;
+   VALUE := SYMBOL | NUMBER;
+   EQUAL := 'equal to';
+   IS := 'is' | 'are' | 'have' | 'has';
+   NUMBER := #'[0-9]+' | #'[0-9]+.[0-9]+';
+   SYMBOL := #'[a-z]+';
+   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;
+   CHANCE-IN := 'chance in';
+   BECOMES := 'should be' | 'becomes';
+   SPACE := #' *'";)

Parse the argument, assumed to be a string in the correct syntax, and return a parse tree.

+
(def parse-rule
+  (insta/parser 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 (ps/simplify (parse-rule rule))
+         afn (if (rule? tree) (eval (pg/generate tree))
+               ;; else
+               (pe/throw-parse-exception tree))]
+     (if return-tuple?
+       (list afn rule)
+       ;; else
+       afn)))
+  ([rule-text]
+   (compile-rule rule-text false)))
 

mw-parser.generate

toc

Generate Clojure source from simplified parse trees.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-parser.generate
+  (:require [mw-engine.utils :refer []]
+        [mw-parser.utils :refer [assert-type TODO]]
+        [mw-parser.errors :as pe]))

This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version.

+ +

This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details.

+ +

You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +USA.

+
+
(declare generate generate-action)

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)
+  (list 'fn ['cell 'world] (list 'if (generate (nth tree 2)) (generate (nth tree 3)))))

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)))
+
(defn generate-conjunct-condition
+  [tree]
+  "From this `tree`, assumed to be a syntactically conjunct correct condition clause,
+  generate and return the appropriate clojure fragment."
+  (assert-type tree :CONJUNCT-CONDITION)
+  (cons 'and (map generate (rest tree))))

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 'some (list 'fn ['i] '(= i value)) (list 'quote expression))]
+     (list 'let ['value (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))))))

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 (nth tree 2))
+      :DISJUNCT-VALUE (generate-disjunct-value tree)
+      :EQUIVALENCE '=
+      :EXPRESSION (generate (second 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))
 

mw-parser.errors

toc

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

mw-parser.core

toc

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

+ +
    +
  1. A code fragment parsed from the front of the sequence of tokens, and
    2. +
  2. the remaining tokens which were not consumed in constructing that fragment.
    3. +
+ +

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

mw-parser.bulk

toc

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

mw-parser.simplify

toc

Simplify a parse tree.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-parser.simplify
+  (:require [mw-engine.utils :refer [member?]]))

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)

Given that this tree fragment represents a qualifier, what + qualifier is that?

+
(defn simplify-qualifier
+  [tree]
+  (cond
+    (empty? tree) nil
+    (and (coll? tree)
+         (member? (first tree) '(:EQUIVALENCE :COMPARATIVE))) tree
+    (coll? (first tree)) (or (simplify-qualifier (first tree))
+                             (simplify-qualifier (rest tree)))
+    (coll? tree) (simplify-qualifier (rest tree))
+    true tree))

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

If this quantifier is a number, 'simplifiy' it into a comparative whose operator is '=' + and whose quantity is that number. This is actually more complicated but makes generation easier.

+
(defn simplify-quantifier
+  [tree]
+  (if (number? (second tree)) [:COMPARATIVE '= (second tree)] (simplify (second tree))))

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)))
+      :CHANCE-IN nil
+      :COMPARATIVE (simplify-second-of-two tree)
+      :CONDITION (simplify-second-of-two tree)
+      :CONDITIONS (simplify-second-of-two tree)
+      :EXPRESSION (simplify-second-of-two tree)
+      :PROPERTY (simplify-second-of-two tree)
+      :PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree)
+      :SPACE nil
+      :THEN nil
+      :AND nil
+      :VALUE (simplify-second-of-two tree)
+      (remove nil? (map simplify tree)))
+    tree))
 

mw-parser.utils

toc

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 the argument appears to be a parsed rule tree, else false.

+
(defn rule?
+  [maybe-rule]
+  (and (coll? maybe-rule) (= (first maybe-rule) :RULE)))

Marker to indicate I'm not yet finished!

+
(defn TODO
+  [message]
+  message)

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)
+       (= (first tree-fragment) type)))

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)
+                      (rest tree))))))
 
Generated by Marginalia.  Syntax highlighting provided by Alex Gorbatchev's SyntaxHighlighter
\ No newline at end of file diff --git a/project.clj b/project.clj index 930784f..577f08b 100644 --- a/project.clj +++ b/project.clj @@ -11,8 +11,8 @@ :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"] + :dependencies [[org.clojure/clojure "1.10.3"] + [org.clojure/tools.trace "0.7.11"] + [instaparse "1.4.10"] [mw-engine "0.1.6-SNAPSHOT"] ])