Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 180 lines (163 sloc) 4.182 kb
6641bb67 »
2009-06-07 Much better error messages and binder parsing.
1 ;; parse-table-binder
2 ;; this code parses a table binder for clojure-like binding
3
4 (require 'cl)
5 (require 'utils)
6
7 (setq currently-defining-defn 'lambda)
8
200246e6 »
2009-06-08 added support for :keys in table binder.
9 (defun key->count-key (it)
409eb8e5 »
2011-05-11 defn-readme, docs
10 "Convert a token to the appropriate key to access its count in a table."
200246e6 »
2009-06-08 added support for :keys in table binder.
11 (case it
12 (:as :n-as)
13 (:or :n-or)
14 (:keys :n-keys)))
15
16 (defun check-keys-form (form)
409eb8e5 »
2011-05-11 defn-readme, docs
17 "Check the :keys form in a TBL expressions."
200246e6 »
2009-06-08 added support for :keys in table binder.
18 (and (vectorp form)
19 (foldl
20 (lambda (it ac)
21 (and (not (keywordp it))
22 (symbolp it)
23 ac))
24 t
25 (vector->list form))))
26
6641bb67 »
2009-06-07 Much better error messages and binder parsing.
27 (defun parse-tbl-special-forms (it ac)
409eb8e5 »
2011-05-11 defn-readme, docs
28 "Ad-hoc parser function which handles special form parsing for
29 TBL binders. Takes a state in AC and the current token (IT) and
30 returns the appropriate modified state."
6641bb67 »
2009-06-07 Much better error messages and binder parsing.
31 (let-tbl
32 ((i :i)
33 (state :state)
34 (n-as :n-as)
35 (n-or :n-or)
36 (as-sym :as-sym)
37 (or-form :or-form)
38 (binders :binders)
39 (prev :prev)
40 (keys :keys)) ac
41 (cond
42 ((oddp i)
43 (if (or
200246e6 »
2009-06-08 added support for :keys in table binder.
44 (eq :keys it)
6641bb67 »
2009-06-07 Much better error messages and binder parsing.
45 (eq :as it)
46 (eq :or it))
200246e6 »
2009-06-08 added support for :keys in table binder.
47 (let* ((count-key (key->count-key it))
6641bb67 »
2009-06-07 Much better error messages and binder parsing.
48 (n-special-form (+ 1 (tbl ac count-key))))
49 (if (> n-special-form 1) (error "More than one %s clause in table binder in %s." it currently-defining-defn))
50 (tbl! ac
51 :prev it
52 :i (+ i 1)
53 count-key n-special-form))
54 (error "Unrecognized special form keyword %s in %s" it currently-defining-defn)))
55 ((evenp i)
200246e6 »
2009-06-08 added support for :keys in table binder.
56 (let ((spec-key (case prev (:as :as-sym) (:or :or-form) (:keys :keys-seq))))
6641bb67 »
2009-06-07 Much better error messages and binder parsing.
57 (case prev
200246e6 »
2009-06-08 added support for :keys in table binder.
58 (:keys
59 (if (check-keys-form it)
60 (tbl! ac
61 :i (+ i 1)
62 :prev it
63 spec-key it)
64 (error ":keys must be followed by a vector of symbols, got %s instead in %s." it currently-defining-defn)))
6641bb67 »
2009-06-07 Much better error messages and binder parsing.
65 (:as
66 (if (symbolp it)
67 (tbl! ac
68 :i (+ i 1)
69 :prev it
70 spec-key it)
71 (error "As forms must be symbols. Got %s instead in %s" it currently-defining-defn)))
72 (:or
73 (tbl! ac
74 :i (+ i 1)
75 :prev it
76 spec-key it))))))))
77
78 (defun parse-tbl-binders (it ac)
409eb8e5 »
2011-05-11 defn-readme, docs
79 "Parse the simple binders in a table binder. Takes a table
80 representing parser state and a token, returning the
81 appropriately modified state."
6641bb67 »
2009-06-07 Much better error messages and binder parsing.
82 (let-tbl
83 ((i :i)
84 (state :state)
85 (n-as :n-as)
86 (n-or :n-or)
87 (as-sym :as-sym)
88 (or-form :or-form)
89 (binders :binders)
200246e6 »
2009-06-08 added support for :keys in table binder.
90 (n-keys :n-keys)
91 (keys-seq :keys-seq)
6641bb67 »
2009-06-07 Much better error messages and binder parsing.
92 (keys :keys)) ac
93 (cond
94 ((oddp i)
95 (if (not (keywordp it))
96 (tbl! ac
97 :i (+ i 1)
98 :prev it
99 :binders (suffix binders it))
100 (parse-tbl-special-forms
101 it
102 (tbl! ac
103 :prev it
104 :state :parsing-special-forms))))
105 ((evenp i)
106 (tbl! ac
107 :i (+ i 1)
108 :prev it
109 :keys (suffix keys it))))))
110
111
112 (defun parse-and-check-tbl-binder (binder)
409eb8e5 »
2011-05-11 defn-readme, docs
113 "Parse and check a BINDER expression which represents table
114 destructuring. Works by conditionally folding over the tokens in
115 BINDER.
116
117 Return a list of the form
118
119 (BINDERS KEYS AS-SYM OR-FORM KEYS-SEQ)
120
121 BINDERS the symbols to bind
122 KEYS the keys to bind them to, same order as BINDERS
123 AS-SYM is the symbol to bind the entire table to, if provided.
124 Otherwise it is NIL.
125 OR-FORM is an expression which produces a table to destructuring when
126 the input form fails to destructure properly.
127 KEYS-SEQ the :keys portion of the binding form.
128
129 "
6641bb67 »
2009-06-07 Much better error messages and binder parsing.
130 (let-tbl
131 ((binders :binders)
132 (keys :keys)
133 (as-sym :as-sym)
200246e6 »
2009-06-08 added support for :keys in table binder.
134 (or-form :or-form)
135 (keys-seq :keys-seq))
6641bb67 »
2009-06-07 Much better error messages and binder parsing.
136 (foldl
137 (lambda (it ac)
138 (let-tbl
139 ((i :i)
140 (state :state)
141 (n-as :n-as)
142 (n-or :n-or)
143 (as-sym :as-sym)
144 (or-form :or-form)
145 (binders :binders)
146 (keys :keys)) ac
147 (case state
148 (:parsing-binders
149 (parse-tbl-binders it ac))
150 (:parsing-special-forms
151 (parse-tbl-special-forms it ac))
152 (:init
153 (if (eq it ::)
154 (tbl! ac
155 :state :parsing-binders
156 :prev it
157 :i (+ i 1))
158 (error "Hash-table binding forms must start with :: (%s)." currently-defining-defn))))))
159 (tbl!
160 :i 0
161 :state :init
162 :n-as 0
163 :n-or 0
200246e6 »
2009-06-08 added support for :keys in table binder.
164 :n-keys 0
6641bb67 »
2009-06-07 Much better error messages and binder parsing.
165 :as-sym nil
166 :or-form nil
200246e6 »
2009-06-08 added support for :keys in table binder.
167 :keys-seq nil
6641bb67 »
2009-06-07 Much better error messages and binder parsing.
168 :prev nil
169 :binders '()
170 :keys '())
171 (vector->list binder))
200246e6 »
2009-06-08 added support for :keys in table binder.
172 (list binders keys as-sym or-form keys-seq)))
6641bb67 »
2009-06-07 Much better error messages and binder parsing.
173
174 (comment
200246e6 »
2009-06-08 added support for :keys in table binder.
175 (parse-and-check-tbl-binder [:: a :a b :b c :c :as all :or something :keys [q r s]]) )
6641bb67 »
2009-06-07 Much better error messages and binder parsing.
176
177 (provide 'parse-table-binder)
178
179
Something went wrong with that request. Please try again.