001  (ns ^{:doc "Simplify a parse tree."
002        :author "Simon Brooke"}
003   mw-parser.simplify)
004  
005  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
006  ;;;;
007  ;;;; mw-parser: a rule parser for MicroWorld.
008  ;;;;
009  ;;;; This program is free software; you can redistribute it and/or
010  ;;;; modify it under the terms of the GNU General Public License
011  ;;;; as published by the Free Software Foundation; either version 2
012  ;;;; of the License, or (at your option) any later version.
013  ;;;;
014  ;;;; This program is distributed in the hope that it will be useful,
015  ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
016  ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
017  ;;;; GNU General Public License for more details.
018  ;;;;
019  ;;;; You should have received a copy of the GNU General Public License
020  ;;;; along with this program; if not, write to the Free Software
021  ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
022  ;;;; USA.
023  ;;;;
024  ;;;; Copyright (C) 2014 Simon Brooke
025  ;;;;
026  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
027  
028  (declare simplify-flow simplify-rule)
029  
030  ;; (defn simplify-qualifier
031  ;;   "Given that this `tree` fragment represents a qualifier, what
032  ;;   qualifier is that?"
033  ;;   [tree]
034  ;;   (cond
035  ;;     (empty? tree) nil
036  ;;     (and (coll? tree)
037  ;;          (#{:EQUIVALENCE :COMPARATIVE} (first tree))) tree
038  ;;     (coll? (first tree)) (or (simplify-qualifier (first tree))
039  ;;                              (simplify-qualifier (rest tree)))
040  ;;     (coll? tree) (simplify-qualifier (rest tree))
041  ;;     :else tree))
042  
043  (defn simplify-second-of-two
044    "There are a number of possible simplifications such that if the `tree` has
045    only two elements, the second is semantically sufficient."
046    [tree]
047    (if (= (count tree) 2) (simplify-rule (nth tree 1)) tree))
048  
049  ;; (defn simplify-quantifier
050  ;;   "If this quantifier is a number, 'simplifiy' it into a comparative whose operator is '='
051  ;;   and whose quantity is that number. This is actually more complicated but makes generation easier."
052  ;;   [tree]
053  ;;   (if (number? (second tree)) [:COMPARATIVE '= (second tree)] (simplify-rule (second tree))))
054  
055  (defn simplify-rule
056    "Simplify/canonicalise this `tree`. Opportunistically replace complex fragments with
057    semantically identical simpler fragments"
058    [tree]
059    (if
060     (coll? tree)
061      (case (first tree)
062        :ACTION (simplify-second-of-two tree)
063        :ACTIONS (cons (first tree) (simplify-rule (rest tree)))
064        :CHANCE-IN nil
065        :COMPARATIVE (simplify-second-of-two tree)
066        :CONDITION (simplify-second-of-two tree)
067        :CONDITIONS (simplify-second-of-two tree)
068        :EXPRESSION (simplify-second-of-two tree)
069        :PROPERTY (simplify-second-of-two tree)
070        :PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree)
071        :SPACE nil
072        :THEN nil
073        :AND nil
074        :VALUE (simplify-second-of-two tree)
075        (remove nil? (map simplify-rule tree)))
076      tree))
077  
078  (defn simplify-determiner-condition
079    [tree]
080    (apply vector
081           (cons :DETERMINER-CONDITION
082                 (cons
083                  (simplify-second-of-two (second tree))
084                  (rest (rest tree))))))