/
reduction.cljc
56 lines (43 loc) · 1.93 KB
/
reduction.cljc
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
(ns instaparse.reduction
(:require [instaparse.auto-flatten-seq :as afs]
[instaparse.util :refer [throw-illegal-argument-exception]]))
;; utilities
(defn singleton? [s]
(and (seq s) (not (next s))))
;; red is a reduction combinator for expert use only
;; because it is used internally to control the tree tags that
;; are displayed, so adding a different reduction would change
;; that behavior.
(defn red [parser f] (assoc parser :red f))
;; Flattening and reductions
(def raw-non-terminal-reduction {:reduction-type :raw})
(defn HiccupNonTerminalReduction [key]
{:reduction-type :hiccup :key key})
(defn EnliveNonTerminalReduction [key]
{:reduction-type :enlive, :key key})
(def ^:constant reduction-types
{:hiccup HiccupNonTerminalReduction
:enlive EnliveNonTerminalReduction})
(def ^:constant node-builders
; A map of functions for building a node that only has one item
; These functions are used in total-parse mode to build failure nodes
{:enlive (fn [tag item] {:tag tag :content (list item)})
:hiccup (fn [tag item] [tag item])})
(def standard-non-terminal-reduction :hiccup)
(defn apply-reduction [f result]
(case (:reduction-type f)
:raw (afs/conj-flat afs/EMPTY result)
:hiccup (afs/convert-afs-to-vec (afs/conj-flat (afs/auto-flatten-seq [(:key f)]) result))
:enlive
(let [content (afs/conj-flat afs/EMPTY result)]
{:tag (:key f), :content (if (zero? (count content)) nil content)})
(f result)))
(defn apply-standard-reductions
([grammar] (apply-standard-reductions standard-non-terminal-reduction grammar))
([reduction-type grammar]
(if-let [reduction (reduction-types reduction-type)]
(into {} (for [[k v] grammar]
(if (:red v) [k v]
[k (assoc v :red (reduction k))])))
(throw-illegal-argument-exception
"Invalid output format " reduction-type ". Use :enlive or :hiccup."))))