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)))))))