/
parse-table-binder.el
125 lines (115 loc) · 2.52 KB
/
parse-table-binder.el
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
123
124
125
;; parse-table-binder
;; this code parses a table binder for clojure-like binding
(require 'cl)
(require 'utils)
(setq currently-defining-defn 'lambda)
(defun parse-tbl-special-forms (it ac)
(let-tbl
((i :i)
(state :state)
(n-as :n-as)
(n-or :n-or)
(as-sym :as-sym)
(or-form :or-form)
(binders :binders)
(prev :prev)
(keys :keys)) ac
(cond
((oddp i)
(if (or
(eq :as it)
(eq :or it))
(let* ((count-key (case it (:as :n-as) (:or :n-or)))
(n-special-form (+ 1 (tbl ac count-key))))
(if (> n-special-form 1) (error "More than one %s clause in table binder in %s." it currently-defining-defn))
(tbl! ac
:prev it
:i (+ i 1)
count-key n-special-form))
(error "Unrecognized special form keyword %s in %s" it currently-defining-defn)))
((evenp i)
(let ((spec-key (case prev (:as :as-sym) (:or :or-form))))
(case prev
(:as
(if (symbolp it)
(tbl! ac
:i (+ i 1)
:prev it
spec-key it)
(error "As forms must be symbols. Got %s instead in %s" it currently-defining-defn)))
(:or
(tbl! ac
:i (+ i 1)
:prev it
spec-key it))))))))
(defun parse-tbl-binders (it ac)
(let-tbl
((i :i)
(state :state)
(n-as :n-as)
(n-or :n-or)
(as-sym :as-sym)
(or-form :or-form)
(binders :binders)
(keys :keys)) ac
(cond
((oddp i)
(if (not (keywordp it))
(tbl! ac
:i (+ i 1)
:prev it
:binders (suffix binders it))
(parse-tbl-special-forms
it
(tbl! ac
:prev it
:state :parsing-special-forms))))
((evenp i)
(tbl! ac
:i (+ i 1)
:prev it
:keys (suffix keys it))))))
(defun parse-and-check-tbl-binder (binder)
(let-tbl
((binders :binders)
(keys :keys)
(as-sym :as-sym)
(or-form :or-form))
(foldl
(lambda (it ac)
(let-tbl
((i :i)
(state :state)
(n-as :n-as)
(n-or :n-or)
(as-sym :as-sym)
(or-form :or-form)
(binders :binders)
(keys :keys)) ac
(case state
(:parsing-binders
(parse-tbl-binders it ac))
(:parsing-special-forms
(parse-tbl-special-forms it ac))
(:init
(if (eq it ::)
(tbl! ac
:state :parsing-binders
:prev it
:i (+ i 1))
(error "Hash-table binding forms must start with :: (%s)." currently-defining-defn))))))
(tbl!
:i 0
:state :init
:n-as 0
:n-or 0
:as-sym nil
:or-form nil
:prev nil
:binders '()
:keys '())
(vector->list binder))
(list binders keys as-sym or-form)))
(comment
(parse-and-check-tbl-binder [:: a :a b :b c :c :as all :or something]))
(provide 'parse-table-binder)