Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 126 lines (115 sloc) 2.581 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
9 (defun parse-tbl-special-forms (it ac)
10 (let-tbl
11 ((i :i)
12 (state :state)
13 (n-as :n-as)
14 (n-or :n-or)
15 (as-sym :as-sym)
16 (or-form :or-form)
17 (binders :binders)
18 (prev :prev)
19 (keys :keys)) ac
20 (cond
21 ((oddp i)
22 (if (or
23 (eq :as it)
24 (eq :or it))
25 (let* ((count-key (case it (:as :n-as) (:or :n-or)))
26 (n-special-form (+ 1 (tbl ac count-key))))
27 (if (> n-special-form 1) (error "More than one %s clause in table binder in %s." it currently-defining-defn))
28 (tbl! ac
29 :prev it
30 :i (+ i 1)
31 count-key n-special-form))
32 (error "Unrecognized special form keyword %s in %s" it currently-defining-defn)))
33 ((evenp i)
34 (let ((spec-key (case prev (:as :as-sym) (:or :or-form))))
35 (case prev
36 (:as
37 (if (symbolp it)
38 (tbl! ac
39 :i (+ i 1)
40 :prev it
41 spec-key it)
42 (error "As forms must be symbols. Got %s instead in %s" it currently-defining-defn)))
43 (:or
44 (tbl! ac
45 :i (+ i 1)
46 :prev it
47 spec-key it))))))))
48
49 (defun parse-tbl-binders (it ac)
50 (let-tbl
51 ((i :i)
52 (state :state)
53 (n-as :n-as)
54 (n-or :n-or)
55 (as-sym :as-sym)
56 (or-form :or-form)
57 (binders :binders)
58 (keys :keys)) ac
59 (cond
60 ((oddp i)
61 (if (not (keywordp it))
62 (tbl! ac
63 :i (+ i 1)
64 :prev it
65 :binders (suffix binders it))
66 (parse-tbl-special-forms
67 it
68 (tbl! ac
69 :prev it
70 :state :parsing-special-forms))))
71 ((evenp i)
72 (tbl! ac
73 :i (+ i 1)
74 :prev it
75 :keys (suffix keys it))))))
76
77
78 (defun parse-and-check-tbl-binder (binder)
79 (let-tbl
80 ((binders :binders)
81 (keys :keys)
82 (as-sym :as-sym)
83 (or-form :or-form))
84 (foldl
85 (lambda (it ac)
86 (let-tbl
87 ((i :i)
88 (state :state)
89 (n-as :n-as)
90 (n-or :n-or)
91 (as-sym :as-sym)
92 (or-form :or-form)
93 (binders :binders)
94 (keys :keys)) ac
95 (case state
96 (:parsing-binders
97 (parse-tbl-binders it ac))
98 (:parsing-special-forms
99 (parse-tbl-special-forms it ac))
100 (:init
101 (if (eq it ::)
102 (tbl! ac
103 :state :parsing-binders
104 :prev it
105 :i (+ i 1))
106 (error "Hash-table binding forms must start with :: (%s)." currently-defining-defn))))))
107 (tbl!
108 :i 0
109 :state :init
110 :n-as 0
111 :n-or 0
112 :as-sym nil
113 :or-form nil
114 :prev nil
115 :binders '()
116 :keys '())
117 (vector->list binder))
118 (list binders keys as-sym or-form)))
119
120 (comment
121 (parse-and-check-tbl-binder [:: a :a b :b c :c :as all :or something]))
122
123 (provide 'parse-table-binder)
124
125
Something went wrong with that request. Please try again.