Major overhaul of rule metadata, so upversioned to 0.3.0
Many tests do not pass at this time.
This commit is contained in:
parent
8c2e44b42a
commit
b4f796aca4
15 changed files with 228 additions and 1213 deletions
|
|
@ -1,49 +0,0 @@
|
|||
(ns ^{:doc "parse multiple rules from a stream, possibly a file."
|
||||
:author "Simon Brooke"}
|
||||
mw-parser.bulk
|
||||
(:require [clojure.string :refer [split]]
|
||||
[mw-parser.declarative :refer [compile]]
|
||||
[mw-parser.utils :refer [comment?]]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;
|
||||
;;;; 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
|
||||
;;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
(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]
|
||||
(map compile
|
||||
(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-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 (slurp filename) true))
|
||||
|
|
@ -1,451 +0,0 @@
|
|||
(ns ^{:doc "A very simple parser which parses production rules.
|
||||
|
||||
**NOTE**: This parser is obsolete and is superceded by the
|
||||
declarative parser, q.v."
|
||||
:author "Simon Brooke"}
|
||||
mw-parser.core
|
||||
(:require [clojure.string :refer [split trim triml]]
|
||||
[mw-engine.utils :refer [member?]])
|
||||
(: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'")
|
||||
|
||||
(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
|
||||
:else (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]]
|
||||
(when (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]]
|
||||
(when value [(list 'mw-engine.utils/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]]
|
||||
(when value [(list (keyword value) 'cell) remainder]))
|
||||
|
||||
(defn parse-token-value
|
||||
"Parse a token assumed to be a simple token value."
|
||||
[[value & remainder]]
|
||||
(when 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)
|
||||
:else (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])
|
||||
:else
|
||||
[(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]]
|
||||
(when (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]]
|
||||
(when
|
||||
(member? IS '("is" "are"))
|
||||
(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)]
|
||||
(when 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)]
|
||||
(when 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)]
|
||||
(when partial
|
||||
(let [[left [next & remainder]] partial]
|
||||
(cond
|
||||
(= next "and") (parse-conjunction-condition left remainder)
|
||||
(= next "or") (parse-disjunction-condition left remainder)
|
||||
:else partial)))))
|
||||
|
||||
(defn- parse-left-hand-side
|
||||
"Parse the left hand side ('if...') of a production rule."
|
||||
[[IF & tokens]]
|
||||
(when
|
||||
(= 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))
|
||||
(if
|
||||
(re-matches re-number value)
|
||||
(read-string value)
|
||||
(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) (if
|
||||
(re-matches re-number value)
|
||||
(read-string value)
|
||||
(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))
|
||||
:else (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]]
|
||||
(when (= 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]
|
||||
(if
|
||||
(string? line) (let [rule (parse-rule (split (triml line) #"\s+"))]
|
||||
(if rule rule
|
||||
(throw (Exception. (format bad-parse-error line)))))
|
||||
(let [[left remainder] (parse-left-hand-side line)
|
||||
[right junk] (parse-right-hand-side remainder)]
|
||||
(when
|
||||
;; 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?]
|
||||
(let [afn (eval (parse-rule rule-text))]
|
||||
(if
|
||||
(and afn return-tuple?)
|
||||
(list afn (trim rule-text))
|
||||
afn)))
|
||||
([rule-text]
|
||||
(compile-rule rule-text false)))
|
||||
|
|
@ -1,12 +1,11 @@
|
|||
(ns ^{:doc "A very simple parser which parses production rules."
|
||||
:author "Simon Brooke"}
|
||||
mw-parser.declarative
|
||||
(:require [clojure.string :refer [join split split-lines trim]]
|
||||
(:require [clojure.string :refer [join split-lines]]
|
||||
[instaparse.core :refer [parser]]
|
||||
[mw-parser.flow :refer [flow-grammar]]
|
||||
[mw-parser.generate :refer [generate]]
|
||||
[mw-parser.simplify :refer [simplify]]
|
||||
[mw-parser.utils :refer [comment?]]
|
||||
[trptr.java-wrapper.locale :refer [get-default]])
|
||||
(:import [java.util Locale]))
|
||||
|
||||
|
|
@ -33,11 +32,18 @@
|
|||
;;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(def ruleset-grammar
|
||||
"Experimental: parse a whole file in one go."
|
||||
(join "\n" ["LINES := LINE | LINE CR LINES;"
|
||||
"LINE := RULE | FLOW-RULE | CR | COMMENT | '' ;"
|
||||
"CR := #'[\\r\\n]';"
|
||||
"COMMENT := #'[;#]+[^\\r\\n]*' | #'/\\*.*\\*/'"]))
|
||||
|
||||
(def rule-grammar
|
||||
"Basic rule language grammar.
|
||||
|
||||
in order to simplify translation into other natural languages, all
|
||||
TOKENS within the parser should be unambiguou."
|
||||
TOKENS within the parser should be unambiguous."
|
||||
(join "\n" ["RULE := IF SPACE CONDITIONS SPACE THEN SPACE ACTIONS;"
|
||||
"ACTIONS := ACTION | ACTION SPACE AND SPACE ACTIONS"
|
||||
"ACTION := SIMPLE-ACTION | PROBABLE-ACTION;"
|
||||
|
|
@ -68,7 +74,7 @@
|
|||
"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+';"
|
||||
"SPACE := #'[ \\t]+';"
|
||||
"VALUE := SYMBOL | NUMBER;"
|
||||
"VALUE := SYMBOL | NUMBER;"
|
||||
"WITHIN-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE WITHIN SPACE NUMBER SPACE IS SPACE PROPERTY-CONDITION-OR-EXPRESSION;"]))
|
||||
|
|
@ -121,61 +127,61 @@
|
|||
([^Locale _locale]
|
||||
keywords-en))
|
||||
|
||||
(defmacro build-parser
|
||||
"Compose this grammar fragment `g` with the common grammar fragments to
|
||||
make a complete grammar, and return a parser for that complete grammar."
|
||||
[g]
|
||||
`(parser (join "\n" [~g common-grammar (keywords-for-locale)])))
|
||||
|
||||
(def parse-rule
|
||||
(def parse
|
||||
"Parse the argument, assumed to be a string in the correct syntax, and return a parse tree."
|
||||
(build-parser rule-grammar))
|
||||
(parser (join "\n" [ruleset-grammar rule-grammar flow-grammar common-grammar (keywords-for-locale)])))
|
||||
|
||||
(def parse-flow
|
||||
"Parse the argument, assumed to be a string in the correct syntax, and return a parse tree."
|
||||
(build-parser flow-grammar))
|
||||
|
||||
(defn parse
|
||||
"Top level parser function: parse this `text` as either a production or a flow rule;
|
||||
return a raw parse tree."
|
||||
[^String rule-text]
|
||||
(let [text (trim rule-text)]
|
||||
(when-not (zero? (count text))
|
||||
(case (first (split text #"\s+"))
|
||||
"if" (parse-rule text)
|
||||
"flow" (parse-flow text)
|
||||
";;" nil
|
||||
(throw (ex-info "Rule text was not recognised" {:text text}))))))
|
||||
(defn- compile-rule
|
||||
"Compile a rule function from this `parse-tree` derived from this `source`
|
||||
at the zero-based line number `n` in the source file; return a compiled
|
||||
function, whose metadata has the keys:
|
||||
|
||||
* `:rule-type` : the type of rule the function represents;
|
||||
* `:parse` : this `parse-tree`;
|
||||
* `:lisp` : the lisp source generated from this `parse-tree`;
|
||||
* `:line : the one-based line number of the definition in the source file,
|
||||
i.e. `(inc n)`."
|
||||
[parse-tree source n]
|
||||
(when-not (keyword? parse-tree)
|
||||
(let [lisp (generate parse-tree)
|
||||
line-no (inc n)]
|
||||
(try
|
||||
(if (#{'fn 'fn*} (first lisp))
|
||||
(vary-meta
|
||||
(eval lisp)
|
||||
merge (meta lisp) {:src source :lisp lisp :line line-no})
|
||||
(throw
|
||||
(Exception.
|
||||
(format "Parse of `%s` did not return a function: %s" source lisp))))
|
||||
(catch Exception any (throw (ex-info (.getMessage any)
|
||||
{:source source
|
||||
:parse parse-tree
|
||||
:lisp lisp
|
||||
:line line-no})))))))
|
||||
|
||||
(defn compile
|
||||
"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.
|
||||
the compiling environment.
|
||||
|
||||
Returns a list of anonymous functions each of two arguments, `[cell world]`,
|
||||
as expected for a MicroWorld rule function. Each function is decorated with
|
||||
metadata having the keys:
|
||||
|
||||
* `:rule-type` : the type of rule the function represents;
|
||||
* `:lisp` : the lisp source from which the function was compiled;
|
||||
* `:parse` : the parse-tree from which that lisp source was derived;
|
||||
* `:source` : the rule source from which the parse-tree was derived;
|
||||
* `:line : the one-based line number of the rule source in the source file.
|
||||
|
||||
Throws an exception if parsing fails."
|
||||
([rule-text return-tuple?]
|
||||
(let [lines (map trim (remove comment? (split-lines rule-text)))]
|
||||
(if (> (count lines) 1)
|
||||
(map #(compile % return-tuple?) lines)
|
||||
(let [src (first lines)
|
||||
parse-tree (doall (simplify (parse src)))
|
||||
fn' (doall (generate parse-tree))
|
||||
afn (try
|
||||
(if (#{'fn 'fn*} (first fn'))
|
||||
(vary-meta (eval fn') merge (meta fn'))
|
||||
(throw (Exception.
|
||||
(format "Parse of `%s` did not return a function: %s"
|
||||
src fn'))))
|
||||
(catch Exception any (throw (ex-info (.getMessage any)
|
||||
{:src src
|
||||
:parse parse-tree
|
||||
:fn fn'}))))]
|
||||
(if
|
||||
return-tuple?
|
||||
(vary-meta (list afn src fn') merge (meta afn))
|
||||
afn)))))
|
||||
([rule-text]
|
||||
(compile rule-text false)))
|
||||
[rule-text]
|
||||
(let [lines (split-lines rule-text)]
|
||||
(remove
|
||||
nil?
|
||||
(map
|
||||
compile-rule
|
||||
(simplify (parse rule-text))
|
||||
lines
|
||||
(range (count lines))))))
|
||||
|
|
@ -24,8 +24,6 @@
|
|||
|
||||
|
||||
;; 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
|
||||
|
|
|
|||
|
|
@ -1,8 +1,7 @@
|
|||
(ns ^{:doc "Generate Clojure source from simplified parse trees."
|
||||
:author "Simon Brooke"}
|
||||
mw-parser.generate
|
||||
(:require [mw-parser.errors :as pe]
|
||||
[mw-parser.utils :refer [assert-type search-tree TODO]]))
|
||||
(:require [mw-parser.utils :refer [assert-type search-tree TODO]]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
|
|
@ -25,6 +24,9 @@
|
|||
|
||||
(declare generate generate-action)
|
||||
|
||||
(def reserved-properties-error
|
||||
"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions")
|
||||
|
||||
;;; macros used in generated rules ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;; production (if-then) rules ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -152,7 +154,7 @@
|
|||
(let [property (generate (second tree))
|
||||
expression (generate (nth tree 3))]
|
||||
(if (or (= property :x) (= property :y))
|
||||
(throw (Exception. pe/reserved-properties-error))
|
||||
(throw (Exception. reserved-properties-error))
|
||||
(list 'merge
|
||||
(if (empty? others) 'cell
|
||||
;; else
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
(ns ^{:doc "Simplify a parse tree."
|
||||
:author "Simon Brooke"}
|
||||
mw-parser.simplify
|
||||
mw-parser.simplify
|
||||
(:require [mw-parser.utils :refer [search-tree]]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -68,13 +68,32 @@
|
|||
:ACTIONS (cons (first tree) (simplify (rest tree)))
|
||||
:AND nil
|
||||
:CHANCE-IN nil
|
||||
:COMMENT nil
|
||||
:COMPARATIVE (simplify-second-of-two tree)
|
||||
:CONDITION (simplify-second-of-two tree)
|
||||
:CONDITIONS (simplify-second-of-two tree)
|
||||
:CR nil
|
||||
:DISJUNCT-EXPRESSION (simplify-chained-list tree :DISJUNCT-VALUE :VALUE)
|
||||
:EXPRESSION (simplify-second-of-two tree)
|
||||
:FLOW-CONDITIONS (simplify-second-of-two tree)
|
||||
:IN nil
|
||||
;; this is like simplify-second-of-two except if there isn't
|
||||
;; a second element it returns nil
|
||||
:LINE (when (= (count tree) 2) (simplify (nth tree 1)))
|
||||
:LINES (loop [lines tree result '()]
|
||||
(let [line (simplify (second lines))
|
||||
;; the reason for putting :BLANK in the result in place
|
||||
;; of lines that weren't rules is so that we can keep
|
||||
;; track of the source text of the line we're compiling.
|
||||
result' (concat result (list (or line :BLANK)))]
|
||||
(when-not (= :LINES (first lines))
|
||||
(throw (ex-info "Unexpeced parse tree: LINES"
|
||||
{:lines lines})))
|
||||
(case (count lines)
|
||||
2 result'
|
||||
4 (recur (nth lines 3) result')
|
||||
(throw (ex-info "Unexpeced parse tree: LINES"
|
||||
{:lines lines})))))
|
||||
:PROPERTY (simplify-second-of-two tree)
|
||||
:PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree)
|
||||
:OR nil
|
||||
|
|
|
|||
|
|
@ -1,8 +1,6 @@
|
|||
(ns ^{:doc "Utilities used in more than one namespace within the parser."
|
||||
:author "Simon Brooke"}
|
||||
mw-parser.utils
|
||||
(:require [clojure.string :refer [trim]]
|
||||
[mw-engine.utils :refer [member?]]))
|
||||
mw-parser.utils)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;
|
||||
|
|
@ -27,11 +25,6 @@
|
|||
;;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn comment?
|
||||
"Is this `line` a comment?"
|
||||
[line]
|
||||
(or (empty? (trim line)) (member? (first line) '(nil \# \;))))
|
||||
|
||||
(defn suitable-fragment?
|
||||
"Return `true` if `tree-fragment` appears to be a tree fragment of the expected `type`."
|
||||
[tree-fragment type]
|
||||
|
|
@ -39,18 +32,11 @@
|
|||
(keyword? type)
|
||||
(= (first tree-fragment) type)))
|
||||
|
||||
(defn rule?
|
||||
"Return true if the argument appears to be a parsed rule tree, else false."
|
||||
[maybe-rule]
|
||||
(suitable-fragment? maybe-rule :RULE))
|
||||
|
||||
(defn TODO
|
||||
"Marker to indicate I'm not yet finished!"
|
||||
[message]
|
||||
message)
|
||||
|
||||
|
||||
|
||||
(defn assert-type
|
||||
"If `tree-fragment` is not a tree fragment of the expected `type`, throw an exception."
|
||||
[tree-fragment type]
|
||||
|
|
@ -59,7 +45,6 @@
|
|||
{:actual tree-fragment
|
||||
:expected type}))))
|
||||
|
||||
|
||||
(defn search-tree
|
||||
"Return the first element of this tree which has this tag in a depth-first, left-to-right search"
|
||||
[tree tag]
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue