Some work on flow, mainly code tidy-up
This commit is contained in:
parent
ca3861b505
commit
fb39f1ee9c
36 changed files with 5191 additions and 3995 deletions
|
|
@ -1,7 +1,7 @@
|
|||
(ns ^{:doc "A very simple parser which parses production rules."
|
||||
:author "Simon Brooke"}
|
||||
mw-parser.declarative
|
||||
(:require [instaparse.core :as insta]
|
||||
(:require [instaparse.core :refer [parser]]
|
||||
[clojure.string :refer [join trim]]
|
||||
[mw-parser.errors :refer [throw-parse-exception]]
|
||||
[mw-parser.generate :refer [generate]]
|
||||
|
|
@ -119,12 +119,18 @@
|
|||
non-latin alphabets, anyway."
|
||||
([]
|
||||
(keywords-for-locale (get-default)))
|
||||
([^Locale locale]
|
||||
([^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
|
||||
"Parse the argument, assumed to be a string in the correct syntax, and return a parse tree."
|
||||
(insta/parser (join "\n" [rule-grammar common-grammar (keywords-for-locale)])))
|
||||
(build-parser rule-grammar))
|
||||
|
||||
(defn compile-rule
|
||||
"Parse this `rule-text`, a string conforming to the grammar of MicroWorld rules,
|
||||
|
|
|
|||
|
|
@ -2,25 +2,66 @@
|
|||
:author "Simon Brooke"}
|
||||
mw-parser.flow
|
||||
(:require [clojure.string :refer [join]]
|
||||
[instaparse.core :as insta]
|
||||
[mw-parser.declarative :refer [common-grammar keywords-for-locale]]))
|
||||
[mw-parser.declarative :refer [build-parser]]
|
||||
[mw-parser.simplify :refer [simplify-second-of-two]]))
|
||||
|
||||
(def flow-grammar
|
||||
"Grammar for flow rules"
|
||||
"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`
|
||||
"
|
||||
(join "\n" ["FLOW-RULE := FLOW SPACE QUANTITY SPACE PROPERTY SPACE FROM SPACE SOURCE SPACE TO-HOW SPACE DESTINATION;"
|
||||
"PERCENTAGE := NUMBER #'%';"
|
||||
"QUANTITY := PERCENTAGE | NUMBER | SOME;"
|
||||
"QUANTITY := PERCENTAGE | NUMBER | EXPRESSION | SOME;"
|
||||
"SOURCE := STATE | STATE SPACE WITH SPACE CONDITIONS;"
|
||||
"DESTINATION := STATE | STATE SPACE WITH SPACE FLOW-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 SPACE WITHIN SPACE NUMBER;"
|
||||
"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"
|
||||
]))
|
||||
"TO-FIRST := TO SPACE FIRST"]))
|
||||
|
||||
(def parse-flow
|
||||
"Parse the argument, assumed to be a string in the correct syntax, and return a parse tree."
|
||||
(insta/parser (join "\n" [flow-grammar common-grammar (keywords-for-locale)])))
|
||||
(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))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,9 +1,8 @@
|
|||
(ns ^{:doc "Generate Clojure source from simplified parse trees."
|
||||
:author "Simon Brooke"}
|
||||
mw-parser.generate
|
||||
(:require [mw-engine.utils :refer []]
|
||||
[mw-parser.utils :refer [assert-type TODO]]
|
||||
[mw-parser.errors :as pe]))
|
||||
mw-parser.generate
|
||||
(:require [mw-parser.utils :refer [assert-type TODO]]
|
||||
[mw-parser.errors :as pe]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
|
|
@ -73,14 +72,14 @@
|
|||
this `property` where the `expression` is a numeric range, generate and return
|
||||
the appropriate clojure fragment."
|
||||
[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)))))
|
||||
(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)))))
|
||||
|
||||
|
||||
(defn generate-disjunct-property-condition
|
||||
|
|
@ -97,7 +96,7 @@
|
|||
(let [e (list 'some (list 'fn ['i] '(= i value)) (list 'quote expression))]
|
||||
(list 'let ['value (list property 'cell)]
|
||||
(if (= qualifier '=) e
|
||||
(list 'not e))))))
|
||||
(list 'not e))))))
|
||||
|
||||
|
||||
(defn generate-property-condition
|
||||
|
|
@ -106,15 +105,15 @@
|
|||
([tree]
|
||||
(assert-type tree :PROPERTY-CONDITION)
|
||||
(if
|
||||
(and (= (count tree) 2) (= (first (second tree)) :SYMBOL))
|
||||
(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)))
|
||||
(list
|
||||
:PROPERTY-CONDITION
|
||||
'(:SYMBOL "state")
|
||||
'(:QUALIFIER (:EQUIVALENCE (:EQUAL "equal to")))
|
||||
(second tree)))
|
||||
;; otherwise...
|
||||
(generate-property-condition tree (first (nth tree 3)))))
|
||||
([tree expression-type]
|
||||
|
|
@ -131,18 +130,16 @@
|
|||
:RANGE-EXPRESSION (generate-ranged-property-condition tree property expression)
|
||||
(list qualifier (list property 'cell) expression)))))
|
||||
|
||||
|
||||
(defn generate-qualifier
|
||||
"From this `tree`, assumed to be a syntactically correct qualifier,
|
||||
generate and return the appropriate clojure fragment."
|
||||
[tree]
|
||||
(if
|
||||
(= (count tree) 2)
|
||||
(= (count tree) 2)
|
||||
(generate (second tree))
|
||||
;; else
|
||||
(generate (nth tree 2))))
|
||||
|
||||
|
||||
(defn generate-simple-action
|
||||
"From this `tree`, assumed to be a syntactically correct simple action,
|
||||
generate and return the appropriate clojure fragment."
|
||||
|
|
@ -158,10 +155,9 @@
|
|||
(list 'merge
|
||||
(if (empty? others) 'cell
|
||||
;; else
|
||||
(generate others))
|
||||
(generate others))
|
||||
{property expression})))))
|
||||
|
||||
|
||||
(defn generate-probable-action
|
||||
"From this `tree`, assumed to be a syntactically correct probable action,
|
||||
generate and return the appropriate clojure fragment."
|
||||
|
|
@ -170,15 +166,14 @@
|
|||
(generate-probable-action tree []))
|
||||
([tree others]
|
||||
(assert-type tree :PROBABLE-ACTION)
|
||||
(let
|
||||
(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))))
|
||||
|
||||
(list 'if
|
||||
(list '< (list 'rand total) chances)
|
||||
action))))
|
||||
|
||||
(defn generate-action
|
||||
"From this `tree`, assumed to be a syntactically correct action,
|
||||
|
|
@ -190,7 +185,6 @@
|
|||
:PROBABLE-ACTION (generate-probable-action tree others)
|
||||
(throw (Exception. (str "Not a known action type: " (first tree))))))
|
||||
|
||||
|
||||
(defn generate-multiple-actions
|
||||
"From this `tree`, assumed to be one or more syntactically correct actions,
|
||||
generate and return the appropriate clojure fragment."
|
||||
|
|
@ -207,7 +201,6 @@
|
|||
(cons (generate (second tree)) (generate (nth tree 3)))
|
||||
(list (generate (second tree)))))
|
||||
|
||||
|
||||
(defn generate-numeric-expression
|
||||
"From this `tree`, assumed to be a syntactically correct numeric expression,
|
||||
generate and return the appropriate clojure fragment."
|
||||
|
|
@ -221,7 +214,6 @@
|
|||
:SYMBOL (list (keyword (second (second tree))) 'cell)
|
||||
(generate (second tree)))))
|
||||
|
||||
|
||||
(defn generate-neighbours-condition
|
||||
"Generate code for a condition which refers to neighbours."
|
||||
([tree]
|
||||
|
|
@ -239,8 +231,7 @@
|
|||
: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))
|
||||
)))
|
||||
(generate-neighbours-condition '< value pc 1)))))
|
||||
([comp1 quantity property-condition distance]
|
||||
(list comp1
|
||||
(list 'count
|
||||
|
|
@ -258,10 +249,10 @@
|
|||
desirable. It may be that it's better to simplify a `NEIGHBOURS-CONDITION`
|
||||
into a `WITHIN-CONDITION` in the simplification stage."
|
||||
([tree]
|
||||
(assert-type tree :WITHIN-CONDITION)
|
||||
(case (first (second tree))
|
||||
:QUANTIFIER (generate-within-condition tree (first (second (second tree))))
|
||||
:QUALIFIER (TODO "qualified within... help!")))
|
||||
(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))
|
||||
|
|
@ -272,15 +263,17 @@
|
|||
: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-neighbours-condition '< value pc distance))))))
|
||||
|
||||
(defn generate-flow
|
||||
[tree]
|
||||
(assert-type tree :WITHIN-CONDITION))
|
||||
|
||||
(defn generate
|
||||
"Generate code for this (fragment of a) parse tree"
|
||||
[tree]
|
||||
(if
|
||||
(coll? tree)
|
||||
(coll? tree)
|
||||
(case (first tree)
|
||||
:ACTIONS (generate-multiple-actions tree)
|
||||
:COMPARATIVE (generate (second tree))
|
||||
|
|
@ -293,12 +286,13 @@
|
|||
: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=
|
||||
> '<
|
||||
< '>)
|
||||
= 'not=
|
||||
> '<
|
||||
< '>)
|
||||
:NEIGHBOURS-CONDITION (generate-neighbours-condition tree)
|
||||
:NUMERIC-EXPRESSION (generate-numeric-expression tree)
|
||||
:NUMBER (read-string (second tree))
|
||||
|
|
|
|||
|
|
@ -1,8 +1,6 @@
|
|||
(ns ^{:doc "Simplify a parse tree."
|
||||
:author "Simon Brooke"}
|
||||
mw-parser.simplify
|
||||
(:require [clojure.pprint :refer [pprint]]
|
||||
[mw-engine.utils :refer [member?]]))
|
||||
mw-parser.simplify)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;
|
||||
|
|
@ -59,7 +57,7 @@
|
|||
semantically identical simpler fragments"
|
||||
[tree]
|
||||
(if
|
||||
(coll? tree)
|
||||
(coll? tree)
|
||||
(case (first tree)
|
||||
:ACTION (simplify-second-of-two tree)
|
||||
:ACTIONS (cons (first tree) (simplify-rule (rest tree)))
|
||||
|
|
@ -78,24 +76,9 @@
|
|||
tree))
|
||||
|
||||
(defn simplify-determiner-condition
|
||||
[tree])
|
||||
|
||||
(defn simplify-flow
|
||||
[tree]
|
||||
(if (coll? tree)
|
||||
(case (first tree)
|
||||
:FLOW nil
|
||||
:DETERMINER (simplify-second-of-two tree)
|
||||
:DETERMINER-CONDITION (simplify-determiner-condition tree)
|
||||
:SPACE nil
|
||||
:QUANTITY (simplify-second-of-two tree)
|
||||
:STATE [:PROPERTY-CONDITION
|
||||
[:SYMBOL "state"]
|
||||
[:QUALIFIER
|
||||
[:EQUIVALENCE
|
||||
[:IS "is"]]]
|
||||
[:EXPRESSION
|
||||
[:VALUE
|
||||
(second tree)]]]
|
||||
(remove nil? (map simplify-flow tree)))
|
||||
tree))
|
||||
(apply vector
|
||||
(cons :DETERMINER-CONDITION
|
||||
(cons
|
||||
(simplify-second-of-two (second tree))
|
||||
(rest (rest tree))))))
|
||||
|
|
|
|||
|
|
@ -26,11 +26,17 @@
|
|||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
(defn suitable-fragment?
|
||||
"Return `true` if `tree-fragment` appears to be a tree fragment of the expected `type`."
|
||||
[tree-fragment type]
|
||||
(and (coll? tree-fragment)
|
||||
(keyword? type)
|
||||
(= (first tree-fragment) type)))
|
||||
|
||||
(defn rule?
|
||||
"Return true if the argument appears to be a parsed rule tree, else false."
|
||||
[maybe-rule]
|
||||
(and (coll? maybe-rule) (= (first maybe-rule) :RULE)))
|
||||
|
||||
(suitable-fragment? maybe-rule :RULE))
|
||||
|
||||
(defn TODO
|
||||
"Marker to indicate I'm not yet finished!"
|
||||
|
|
@ -38,12 +44,6 @@
|
|||
message)
|
||||
|
||||
|
||||
(defn suitable-fragment?
|
||||
"Return `true` if `tree-fragment` appears to be a tree fragment of the expected `type`."
|
||||
[tree-fragment type]
|
||||
(and (coll? tree-fragment)
|
||||
(= (first tree-fragment) type)))
|
||||
|
||||
|
||||
(defn assert-type
|
||||
"If `tree-fragment` is not a tree fragment of the expected `type`, throw an exception."
|
||||
|
|
@ -55,10 +55,10 @@
|
|||
(defn search-tree
|
||||
"Return the first element of this tree which has this tag in a depth-first, left-to-right search"
|
||||
[tree tag]
|
||||
(cond
|
||||
(cond
|
||||
(= (first tree) tag) tree
|
||||
:else (first
|
||||
(remove nil?
|
||||
(map
|
||||
#(search-tree % tag)
|
||||
(rest tree))))))
|
||||
(filter coll? (rest tree)))))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue