Major overhaul of the parsing of disjunct expressions
... which it turns out have NEVER worked, and badly written tests were masking the problem. Also tagging rules with metadata as first step towards mixing production and flow rules.
This commit is contained in:
parent
fb39f1ee9c
commit
256f9efd5e
16 changed files with 4997 additions and 778 deletions
|
|
@ -1,4 +1,7 @@
|
|||
(ns ^{:doc "A very simple parser which parses production rules."
|
||||
(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
|
||||
(:use mw-engine.utils
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@
|
|||
[clojure.string :refer [join trim]]
|
||||
[mw-parser.errors :refer [throw-parse-exception]]
|
||||
[mw-parser.generate :refer [generate]]
|
||||
[mw-parser.simplify :refer [simplify-rule]]
|
||||
[mw-parser.simplify :refer [simplify]]
|
||||
[mw-parser.utils :refer [rule?]]
|
||||
[trptr.java-wrapper.locale :refer [get-default]])
|
||||
(:import [java.util Locale]))
|
||||
|
|
@ -144,7 +144,7 @@
|
|||
([rule-text return-tuple?]
|
||||
(assert (string? rule-text))
|
||||
(let [rule (trim rule-text)
|
||||
tree (simplify-rule (parse-rule rule))
|
||||
tree (simplify (parse-rule rule))
|
||||
afn (if (rule? tree) (eval (generate tree))
|
||||
;; else
|
||||
(throw-parse-exception tree))]
|
||||
|
|
|
|||
|
|
@ -1,7 +1,9 @@
|
|||
(ns ^{:doc "Generate Clojure source from simplified parse trees."
|
||||
:author "Simon Brooke"}
|
||||
mw-parser.generate
|
||||
(:require [mw-parser.utils :refer [assert-type TODO]]
|
||||
(:require [clojure.pprint :refer [pprint]]
|
||||
[clojure.tools.trace :refer [deftrace]]
|
||||
[mw-parser.utils :refer [assert-type TODO]]
|
||||
[mw-parser.errors :as pe]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -23,17 +25,18 @@
|
|||
;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
(declare generate generate-action)
|
||||
|
||||
|
||||
(defn generate-rule
|
||||
"From this `tree`, assumed to be a syntactically correct rule specification,
|
||||
generate and return the appropriate rule as a function of two arguments."
|
||||
[tree]
|
||||
(assert-type tree :RULE)
|
||||
(list 'fn ['cell 'world] (list 'if (generate (nth tree 2)) (generate (nth tree 3)))))
|
||||
|
||||
(vary-meta
|
||||
(list 'fn ['cell 'world] (list 'when (generate (nth tree 2)) (generate (nth tree 3))))
|
||||
merge
|
||||
{:rule-type
|
||||
:production}))
|
||||
|
||||
(defn generate-conditions
|
||||
"From this `tree`, assumed to be a syntactically correct conditions clause,
|
||||
|
|
@ -42,7 +45,6 @@
|
|||
(assert-type tree :CONDITIONS)
|
||||
(generate (second tree)))
|
||||
|
||||
|
||||
(defn generate-condition
|
||||
"From this `tree`, assumed to be a syntactically correct condition clause,
|
||||
generate and return the appropriate clojure fragment."
|
||||
|
|
@ -50,7 +52,6 @@
|
|||
(assert-type tree :CONDITION)
|
||||
(generate (second tree)))
|
||||
|
||||
|
||||
(defn generate-conjunct-condition
|
||||
"From this `tree`, assumed to be a syntactically conjunct correct condition clause,
|
||||
generate and return the appropriate clojure fragment."
|
||||
|
|
@ -58,7 +59,6 @@
|
|||
(assert-type tree :CONJUNCT-CONDITION)
|
||||
(cons 'and (map generate (rest tree))))
|
||||
|
||||
|
||||
(defn generate-disjunct-condition
|
||||
"From this `tree`, assumed to be a syntactically correct disjunct condition clause,
|
||||
generate and return the appropriate clojure fragment."
|
||||
|
|
@ -66,7 +66,6 @@
|
|||
(assert-type tree :DISJUNCT-CONDITION)
|
||||
(cons 'or (map generate (rest tree))))
|
||||
|
||||
|
||||
(defn generate-ranged-property-condition
|
||||
"From this `tree`, assumed to be a syntactically property condition clause for
|
||||
this `property` where the `expression` is a numeric range, generate and return
|
||||
|
|
@ -81,7 +80,6 @@
|
|||
'upper (list 'max l1 l2)]
|
||||
(list 'and (list '>= pv 'lower) (list '<= pv 'upper)))))
|
||||
|
||||
|
||||
(defn generate-disjunct-property-condition
|
||||
"From this `tree`, assumed to be a syntactically property condition clause
|
||||
where the expression is a a disjunction, generate and return
|
||||
|
|
@ -93,11 +91,9 @@
|
|||
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))))))
|
||||
|
||||
(let [e (list expression (list property 'cell))]
|
||||
(if (= qualifier '=) e
|
||||
(list 'not e)))))
|
||||
|
||||
(defn generate-property-condition
|
||||
"From this `tree`, assumed to be a syntactically property condition clause,
|
||||
|
|
@ -241,7 +237,6 @@
|
|||
([comp1 quantity property-condition]
|
||||
(generate-neighbours-condition comp1 quantity property-condition 1)))
|
||||
|
||||
|
||||
(defn generate-within-condition
|
||||
"Generate code for a condition which refers to neighbours within a specified distance.
|
||||
NOTE THAT there's clearly masses of commonality between this and
|
||||
|
|
@ -265,9 +260,32 @@
|
|||
:LESS (let [value (generate (nth quantifier 3))]
|
||||
(generate-neighbours-condition '< value pc distance))))))
|
||||
|
||||
(defn- generate-disjunct-expression
|
||||
[tree]
|
||||
(assert-type tree :DISJUNCT-EXPRESSION)
|
||||
(try
|
||||
(set (map generate (rest tree)))
|
||||
(catch Exception x
|
||||
(throw
|
||||
(ex-info
|
||||
"Failed to compile :DISJUNCT-EXPRESSION"
|
||||
{:tree tree}
|
||||
x)))))
|
||||
|
||||
;;; Flow rules. A flow rule DOES NOT return a modified world; instead, it
|
||||
;;; returns a PLAN to modify the world, in the form of a sequence of `flows`.
|
||||
;;; It is only when the plan is executed that the world is modified.
|
||||
;;;
|
||||
;;; so we're looking at something like
|
||||
;;; (fn [cell world])
|
||||
;;; (if (= (:state cell) (or (:house cell) :house))
|
||||
|
||||
(defn generate-flow
|
||||
[tree]
|
||||
(assert-type tree :WITHIN-CONDITION))
|
||||
(assert-type tree :FLOW-RULE))
|
||||
|
||||
;;; Top level; only function anything outside this file (except tests) should
|
||||
;;; really call.
|
||||
|
||||
(defn generate
|
||||
"Generate code for this (fragment of a) parse tree"
|
||||
|
|
@ -282,7 +300,7 @@
|
|||
:CONDITIONS (generate-conditions tree)
|
||||
:CONJUNCT-CONDITION (generate-conjunct-condition tree)
|
||||
:DISJUNCT-CONDITION (generate-disjunct-condition tree)
|
||||
:DISJUNCT-EXPRESSION (generate (nth tree 2))
|
||||
:DISJUNCT-EXPRESSION (generate-disjunct-expression tree)
|
||||
:DISJUNCT-VALUE (generate-disjunct-value tree)
|
||||
:EQUIVALENCE '=
|
||||
:EXPRESSION (generate (second tree))
|
||||
|
|
@ -308,11 +326,3 @@
|
|||
:WITHIN-CONDITION (generate-within-condition tree)
|
||||
(map generate tree))
|
||||
tree))
|
||||
|
||||
;;; Flow rules. A flow rule DOES NOT return a modified world; instead, it
|
||||
;;; returns a PLAN to modify the world, in the form of a sequence of `flows`.
|
||||
;;; It is only when the plan is executed that the world is modified.
|
||||
;;;
|
||||
;;; so we're looking at something like
|
||||
;;; (fn [cell world])
|
||||
;;; (if (= (:state cell) (or (:house cell) :house))
|
||||
|
|
@ -25,34 +25,38 @@
|
|||
;;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(declare simplify-flow simplify-rule)
|
||||
|
||||
;; (defn simplify-qualifier
|
||||
;; "Given that this `tree` fragment represents a qualifier, what
|
||||
;; qualifier is that?"
|
||||
;; [tree]
|
||||
;; (cond
|
||||
;; (empty? tree) nil
|
||||
;; (and (coll? tree)
|
||||
;; (#{:EQUIVALENCE :COMPARATIVE} (first tree))) tree
|
||||
;; (coll? (first tree)) (or (simplify-qualifier (first tree))
|
||||
;; (simplify-qualifier (rest tree)))
|
||||
;; (coll? tree) (simplify-qualifier (rest tree))
|
||||
;; :else tree))
|
||||
(declare simplify)
|
||||
|
||||
(defn simplify-second-of-two
|
||||
"There are a number of possible simplifications such that if the `tree` has
|
||||
only two elements, the second is semantically sufficient."
|
||||
[tree]
|
||||
(if (= (count tree) 2) (simplify-rule (nth tree 1)) tree))
|
||||
(if (= (count tree) 2) (simplify (nth tree 1)) tree))
|
||||
|
||||
;; (defn simplify-quantifier
|
||||
;; "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."
|
||||
;; [tree]
|
||||
;; (if (number? (second tree)) [:COMPARATIVE '= (second tree)] (simplify-rule (second tree))))
|
||||
(defn simplify-chained-list
|
||||
"Some parse trees take the form
|
||||
`[:X [:Y 1] :NOISE :NOISE [:X [:Y 2] :NOISE :NOISE [:X [:Y 3]]]]`
|
||||
where what's wanted is `[:X [:Y 1] [:Y 2] [:Y 2]]` -- :DISJUNCT-VALUE is a case
|
||||
in point. This takes such a parse `tree`, where `branch-tag` is the tag of
|
||||
the enclosing form and `leaf-tag` is the tag of the form to be collected, and
|
||||
returns the desired form."
|
||||
[tree branch-tag leaf-tag]
|
||||
(cons
|
||||
(first tree)
|
||||
(reverse
|
||||
(loop [chain (rest tree) v '()]
|
||||
(let [car (first chain)]
|
||||
(cond (empty? chain) v
|
||||
(coll? car) (let [caar (first car)]
|
||||
(cond
|
||||
(= branch-tag caar) (recur car v)
|
||||
(= leaf-tag caar) (recur
|
||||
(rest chain)
|
||||
(cons (simplify car) v))
|
||||
:else (recur (rest chain) v)))
|
||||
:else (recur (rest chain) v)))))))
|
||||
|
||||
(defn simplify-rule
|
||||
(defn simplify
|
||||
"Simplify/canonicalise this `tree`. Opportunistically replace complex fragments with
|
||||
semantically identical simpler fragments"
|
||||
[tree]
|
||||
|
|
@ -60,19 +64,22 @@
|
|||
(coll? tree)
|
||||
(case (first tree)
|
||||
:ACTION (simplify-second-of-two tree)
|
||||
:ACTIONS (cons (first tree) (simplify-rule (rest tree)))
|
||||
:ACTIONS (cons (first tree) (simplify (rest tree)))
|
||||
:AND nil
|
||||
:CHANCE-IN nil
|
||||
:COMPARATIVE (simplify-second-of-two tree)
|
||||
:CONDITION (simplify-second-of-two tree)
|
||||
:CONDITIONS (simplify-second-of-two tree)
|
||||
:DISJUNCT-EXPRESSION (simplify-chained-list tree :DISJUNCT-VALUE :VALUE)
|
||||
:EXPRESSION (simplify-second-of-two tree)
|
||||
:IN nil
|
||||
:PROPERTY (simplify-second-of-two tree)
|
||||
:PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree)
|
||||
:OR nil
|
||||
:SPACE nil
|
||||
:THEN nil
|
||||
:AND nil
|
||||
:VALUE (simplify-second-of-two tree)
|
||||
(remove nil? (map simplify-rule tree)))
|
||||
(remove nil? (map simplify tree)))
|
||||
tree))
|
||||
|
||||
(defn simplify-determiner-condition
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue