-
Notifications
You must be signed in to change notification settings - Fork 54
/
epsilon.clj
122 lines (112 loc) · 4.7 KB
/
epsilon.clj
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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
(ns meander.rewrite.epsilon
(:require
[meander.match.epsilon :as m.match]
[meander.match.syntax.epsilon :as m.match.syntax]
[meander.match.runtime.epsilon :as m.match.runtime]
[meander.substitute.epsilon :as m.subst]
[meander.substitute.syntax.epsilon :as m.subst.syntax]
[meander.syntax.epsilon :as m.syntax]))
;; rewrite compilation
;; -------------------
(defn analyze-rewrite-args
{:arglists '([[target & rewrite-clauses] env])
:private true}
[rewrite-args env]
(let [find-analysis (m.match/analyze-find-args rewrite-args env)
parse-subst (fn [form]
(m.subst.syntax/parse form env))]
(m.match/match find-analysis
{:errors [?error & _]}
?error
{:cata-symbol ?cata-symbol
:contains-cata? ?match-cata?
:matrix [{:rhs {:value (m.match.syntax/apply parse-subst !subst-asts)}} ...
:as ?matrix]}
(let [subst-cata? (boolean (some m.subst.syntax/contains-cata-node? !subst-asts))
matrix (mapv
(fn [column subst-ast]
(assoc column :rhs subst-ast))
?matrix
!subst-asts)
analysis (merge find-analysis
{:contains-cata? (or ?match-cata? subst-cata?)
:match-cata? ?match-cata?
:matrix matrix
:subst-cata? subst-cata?})]
analysis))))
(defn compile-rewrite-args
{:arglists '([[target & rewrite-clauses] env])}
[rewrite-args env]
(let [rewrite-analysis (analyze-rewrite-args rewrite-args env)]
(m.match/match rewrite-analysis
{:error [?error & _]}
?error
{:cata-symbol ?cata-symbol
:match-cata? ?match-cata?
:matrix ?matrix
:subst-cata? ?subst-cata?}
(let [subst-env (merge env {:cata-symbol ?cata-symbol
:match-cata? ?match-cata?
:subst-cata? ?subst-cata?})
find-matrix (mapv
(fn [column]
(let [subst-ast (get column :rhs)
value (m.subst/compile subst-ast subst-env)
ir {:op :return, :value value}]
(assoc column :rhs ir)))
?matrix)
find-analysis (assoc rewrite-analysis :matrix find-matrix)]
(m.match/compile-find-analysis find-analysis env)))))
;; rewrites compilation
;; --------------------
(defn analyze-rewrites-args
{:arglists '([[target & rewrite-clauses] env])
:private true}
[rewrite-args env]
(let [search-analysis (m.match/analyze-search-args rewrite-args env)
parse-subst (fn [form]
(m.subst.syntax/parse form env))]
(m.match/match search-analysis
{:errors [?error & _]}
?error
{:cata-symbol ?cata-symbol
:contains-cata? ?match-cata?
:matrix [{:rhs {:value (m.match.syntax/apply parse-subst !subst-asts)}} ...
:as ?matrix]}
(let [subst-cata? (boolean (some m.subst.syntax/contains-cata-node? !subst-asts))
matrix (mapv
(fn [column subst-ast]
(assoc column :rhs subst-ast))
?matrix
!subst-asts)
analysis (merge search-analysis
{:contains-cata? (or ?match-cata? subst-cata?)
:match-cata? ?match-cata?
:matrix matrix
:subst-cata? subst-cata?})]
analysis))))
(defn compile-rewrites-args
{:arglists '([[target & rewrite-clauses] env])}
[rewrite-args env]
(let [rewrites-analysis (analyze-rewrites-args rewrite-args env)]
(m.match/match rewrites-analysis
{:error [?error & _]}
?error
{:cata-symbol ?cata-symbol
:match-cata? ?match-cata?
:matrix ?matrix
:subst-cata? ?subst-cata?}
(if ?subst-cata?
::CATA_NOT_IMPLEMENTED
(let [subst-env (merge env {:cata-symbol ?cata-symbol
:match-cata? ?match-cata?
:subst-cata? ?subst-cata?})
search-matrix (mapv
(fn [column]
(let [subst-ast (get column :rhs)
value (m.subst/compile subst-ast subst-env)
ir {:op :return, :value value}]
(assoc column :rhs ir)))
?matrix)
search-analysis (assoc rewrites-analysis :matrix search-matrix)]
(m.match/compile-search-analysis search-analysis env))))))