From 6166dc254c5f316e948c9f574384c8222c944bec Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Fri, 13 Feb 2015 22:25:53 +0000
Subject: [PATCH] Now almost to the point that the new parser can compile
simple rules!
---
src/mw_parser/insta.clj | 166 ++++++++++++++++++++++++++--------------
1 file changed, 108 insertions(+), 58 deletions(-)
diff --git a/src/mw_parser/insta.clj b/src/mw_parser/insta.clj
index 0dccaaf..9d220f9 100644
--- a/src/mw_parser/insta.clj
+++ b/src/mw_parser/insta.clj
@@ -5,28 +5,43 @@
(def grammar
- "RULE := 'if' SPACE CONDITIONS SPACE 'then' SPACE ACTIONS;
+ ;; 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 | PROPERTY-CONDITION | NEIGHBOURS-CONDITION ;
- DISJUNCT-CONDITION := CONDITION SPACE 'or' SPACE CONDITIONS;
- CONJUNCT-CONDITION := CONDITION SPACE 'and' SPACE CONDITIONS;
+ DISJUNCT-CONDITION := CONDITION SPACE OR SPACE CONDITIONS;
+ CONJUNCT-CONDITION := CONDITION SPACE AND SPACE CONDITIONS;
CONDITION := NEIGHBOURS-CONDITION | PROPERTY-CONDITION;
NEIGHBOURS-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE IS SPACE PROPERTY-CONDITION | QUANTIFIER SPACE NEIGHBOURS IS EXPRESSION | QUALIFIER SPACE NEIGHBOURS-CONDITION;
PROPERTY-CONDITION := PROPERTY SPACE QUALIFIER SPACE EXPRESSION;
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;
+ 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;
- QUALIFIER := COMPARATIVE SPACE 'than' | EQUIVALENCE | IS SPACE QUALIFIER;
- NEIGHBOURS := 'neighbour' | 'neighbor' | 'neighbours' | 'neighbors';
- QUANTIFIER := NUMBER | 'some' | 'no' | 'all';
- EQUIVALENCE := IS SPACE 'equal to' | 'equal to' | IS ;
- COMPARATIVE := 'more' | 'less' | 'fewer';
+ QUALIFIER := COMPARATIVE SPACE THAN | EQUIVALENCE | IS SPACE QUALIFIER;
+ QUANTIFIER := NUMBER | SOME | NONE | ALL;
+ 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';
+ AND := 'and';
+ SOME := 'some';
+ NONE := 'no';
+ ALL := 'all'
+ BETWEEN := 'between';
+ IN := 'in';
+ MORE := 'more';
+ LESS := 'less' | 'fewer';
OPERATOR := '+' | '-' | '*' | '/';
+ NEIGHBOURS := 'neighbour' | 'neighbor' | 'neighbours' | 'neighbors';
PROPERTY := SYMBOL;
- DISJUNCT-VALUE := VALUE | VALUE SPACE 'or' SPACE DISJUNCT-VALUE;
VALUE := SYMBOL | NUMBER;
- IS := 'is' | 'are' | 'have';
+ 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
@@ -42,7 +57,7 @@
message)
-(declare generate)
+(declare generate simplify)
(defn generate-rule
"From this `tree`, assumed to be a syntactically correct rule specification,
@@ -70,58 +85,93 @@
[tree]
(list 'or (generate (nth tree 1))(generate (nth tree 3))))
-(defn generate-qualifier
- "Return more than (>), less than (<) or equal to (=) depending on the `qualifier`."
- [qualifier]
- (TODO "not written yet")
- tree)
-
(defn generate-property-condition
[tree]
(let [property (generate (nth tree 1))
qualifier (generate (nth tree 2))
expression (generate (nth tree 3))]
- (list qualifier (list (keyword property) 'cell) expression)))
+ (list qualifier (list property 'cell) expression)))
+(defn generate-simple-action
+ [tree]
+ (let [property (generate (nth tree 1))
+ expression (generate (nth tree 3))]
+ (list 'merge 'cell {property expression})))
(defn generate
"Generate code for this (fragment of a) parse tree"
[tree]
- (case (first tree)
- :RULE (generate-rule tree)
- :CONDITIONS (generate-conditions tree)
- :CONDITION (generate-condition tree)
-;; :NEIGHBOURS-CONDITION (generate-neighbours-condition tree)
- :DISJUNCT-CONDITION (generate-disjunct-condition tree)
- :CONJUNCT-CONDITION (generate-conjunct-condition tree)
- :PROPERTY-CONDITION (generate-property-condition tree)
-;; :EXPRESSION (generate-expression tree)
-;; :SIMPLE-EXPRESSION
+ (if
+ (coll? tree)
+ (case (first tree)
+ :RULE (generate-rule tree)
+ :CONDITIONS (generate-conditions tree)
+ :CONDITION (generate-condition tree)
+ ;; :NEIGHBOURS-CONDITION (generate-neighbours-condition tree)
+ :DISJUNCT-CONDITION (generate-disjunct-condition tree)
+ :CONJUNCT-CONDITION (generate-conjunct-condition tree)
+ :PROPERTY-CONDITION (generate-property-condition tree)
+ :SIMPLE-ACTION (generate-simple-action tree)
+ :SYMBOL (keyword (second tree))
+ :NUMBER (read-string (second tree))
+ :EQUIVALENCE '=
+ :MORE '>
+ :LESS '<
+ ;; :EXPRESSION (generate-expression tree)
+ ;; :SIMPLE-EXPRESSION
+ (map generate tree))
tree))
-(defn prune-tree
- "Simplify/canonicalise the `tree`. Opportunistically replace complex fragments with
+
+(defn simplify-qualifier
+ "Given that this `tree` fragment represents a qualifier, what
+ qualifier is that?"
+ [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))
+
+(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 (nth tree 1)) tree))
+
+
+(defn simplify
+ "Simplify/canonicalise this `tree`. Opportunistically replace complex fragments with
semantically identical simpler fragments"
[tree]
- (TODO "not written yet")
- tree)
+ (if
+ (coll? tree)
+ (case (first tree)
+ :SPACE nil
+ :QUALIFIER (simplify-qualifier tree)
+ :CONDITIONS (simplify-second-of-two tree)
+ :CONDITION (simplify-second-of-two tree)
+ :EXPRESSION (simplify-second-of-two tree)
+ :COMPARATIVE (simplify-second-of-two tree)
+ :QUANTIFIER (simplify-second-of-two tree)
+ :VALUE (simplify-second-of-two tree)
+ :PROPERTY (simplify-second-of-two tree)
+ :ACTIONS (simplify-second-of-two tree)
+ :ACTION (simplify-second-of-two tree)
+ (remove nil? (map simplify tree)))
+ tree))
-(defn clean-tree
- "Returns a structure which is structurally equivalent to `tree` but which has
- the noise tokens (spaces) removed. As a side effect this new structure is a
- list, not a vector, but that is not a desideratum and you should not rely in it."
- [tree]
- (cond
- (and (coll? tree) (= (first tree) :SPACE)) nil
- (coll? tree) (remove nil? (map clean-tree tree))
- true tree))
-
-(def rule-parser
+(def parse-rule
(insta/parser grammar))
-(defn compile-rule [rule]
- (generate (prune-tree (clean-tree (rule-parser rule)))))
+(defn compile-rule
+ [rule]
+ nil)
+;; (generate (prune-tree (parse-rule rule))))
@@ -129,20 +179,20 @@
(compile-rule "if state is climax and some neighbours have state equal to fire then 3 chance in 5 state should be fire")
-(rule-parser "if state is in grassland or pasture or heath and 4 neighbours have state equal to water then state should be village")
+(compile-rule "if state is in grassland or pasture or heath and 4 neighbours have state equal to water then state should be village")
-(rule-parser "if 6 neighbours have state equal to water then state should be village")
+(compile-rule "if 6 neighbours have state equal to water then state should be village")
-(rule-parser "if fertility is between 55 and 75 then state should be climax")
+(compile-rule "if fertility is between 55 and 75 then state should be climax")
-(rule-parser "if state is forest then state should be climax")
+(compile-rule "if state is forest then state should be climax")
-(rule-parser "if state is in grassland or pasture or heath and 4 neighbours have state equal to water then state should be village")
-(rule-parser "if altitude is less than 100 and state is forest then state should be climax and deer should be 3")
-(rule-parser "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3")
-(rule-parser "if altitude is 100 or fertility is 25 then state should be heath")
+(compile-rule "if state is in grassland or pasture or heath and 4 neighbours have state equal to water then state should be village")
+(compile-rule "if altitude is less than 100 and state is forest then state should be climax and deer should be 3")
+(compile-rule "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3")
+(compile-rule "if altitude is 100 or fertility is 25 then state should be heath")
-(rule-parser "if deer is more than 2 and wolves is 0 and fertility is more than 20 then deer should be deer + 2")
-(rule-parser "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves")
-(rule-parser "if state is grassland and 4 neighbours have state equal to water then state should be village")
+(compile-rule "if deer is more than 2 and wolves is 0 and fertility is more than 20 then deer should be deer + 2")
+(compile-rule "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves")
+(compile-rule "if state is grassland and 4 neighbours have state equal to water then state should be village")