001  (ns ^{:doc "Utilities used in more than one namespace within the parser."
002        :author "Simon Brooke"}
003    mw-parser.utils)
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  
029  (defn suitable-fragment?
030    "Return `true` if `tree-fragment` appears to be a tree fragment of the expected `type`."
031    [tree-fragment type]
032    (and (coll? tree-fragment)
033         (keyword? type)
034         (= (first tree-fragment) type)))
035  
036  (defn rule?
037    "Return true if the argument appears to be a parsed rule tree, else false."
038    [maybe-rule]
039    (suitable-fragment? maybe-rule :RULE))
040  
041  (defn TODO
042    "Marker to indicate I'm not yet finished!"
043    [message]
044    message)
045  
046  
047  
048  (defn assert-type
049    "If `tree-fragment` is not a tree fragment of the expected `type`, throw an exception."
050    [tree-fragment type]
051    (assert (suitable-fragment? tree-fragment type)
052            (throw (Exception. (format "Expected a %s fragment" type)))))
053  
054  
055  (defn search-tree
056    "Return the first element of this tree which has this tag in a depth-first, left-to-right search"
057    [tree tag]
058    (cond 
059      (= (first tree) tag) tree
060      :else (first
061              (remove nil?
062                      (map
063                        #(search-tree % tag)
064                        (filter coll? (rest tree)))))))