Commit | Line | Data |
---|---|---|
17e90c5e KN |
1 | ;;; Guile High Intermediate Language |
2 | ||
3 | ;; Copyright (C) 2001 Free Software Foundation, Inc. | |
4 | ||
5 | ;; This program is free software; you can redistribute it and/or modify | |
6 | ;; it under the terms of the GNU General Public License as published by | |
7 | ;; the Free Software Foundation; either version 2, or (at your option) | |
8 | ;; any later version. | |
9 | ;; | |
10 | ;; This program is distributed in the hope that it will be useful, | |
11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
13 | ;; GNU General Public License for more details. | |
14 | ;; | |
15 | ;; You should have received a copy of the GNU General Public License | |
16 | ;; along with this program; see the file COPYING. If not, write to | |
17 | ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
18 | ;; Boston, MA 02111-1307, USA. | |
19 | ||
20 | ;;; Code: | |
21 | ||
22 | (define-module (system il ghil) | |
1a1a10d3 AW |
23 | #:use-syntax (system base syntax) |
24 | #:use-module (ice-9 regex) | |
25 | #:export | |
01967b69 | 26 | (<ghil-void> make-ghil-void ghil-void? |
bdaffda2 | 27 | ghil-void-env ghil-void-loc |
01967b69 AW |
28 | |
29 | <ghil-quote> make-ghil-quote ghil-quote? | |
bdaffda2 | 30 | ghil-quote-env ghil-quote-loc ghil-quote-obj |
01967b69 AW |
31 | |
32 | <ghil-quasiquote> make-ghil-quasiquote ghil-quasiquote? | |
bdaffda2 | 33 | ghil-quasiquote-env ghil-quasiquote-loc ghil-quasiquote-exp |
01967b69 AW |
34 | |
35 | <ghil-unquote> make-ghil-unquote ghil-unquote? | |
bdaffda2 | 36 | ghil-unquote-env ghil-unquote-loc ghil-unquote-exp |
01967b69 AW |
37 | |
38 | <ghil-unquote-splicing> make-ghil-unquote-splicing ghil-unquote-splicing? | |
bdaffda2 | 39 | ghil-unquote-env ghil-unquote-loc ghil-unquote-exp |
cb4cca12 | 40 | |
01967b69 | 41 | <ghil-ref> make-ghil-ref ghil-ref? |
bdaffda2 | 42 | ghil-ref-env ghil-ref-loc ghil-ref-var |
01967b69 AW |
43 | |
44 | <ghil-set> make-ghil-set ghil-set? | |
bdaffda2 | 45 | ghil-set-env ghil-set-loc ghil-set-var ghil-set-val |
01967b69 AW |
46 | |
47 | <ghil-define> make-ghil-define ghil-define? | |
bdaffda2 | 48 | ghil-define-env ghil-define-loc ghil-define-var ghil-define-val |
cb4cca12 | 49 | |
01967b69 | 50 | <ghil-if> make-ghil-if ghil-if? |
bdaffda2 | 51 | ghil-if-env ghil-if-loc ghil-if-test ghil-if-then ghil-if-else |
01967b69 AW |
52 | |
53 | <ghil-and> make-ghil-and ghil-and? | |
bdaffda2 | 54 | ghil-and-env ghil-and-loc ghil-and-exps |
01967b69 AW |
55 | |
56 | <ghil-or> make-ghil-or ghil-or? | |
bdaffda2 | 57 | ghil-or-env ghil-or-loc ghil-or-exps |
01967b69 AW |
58 | |
59 | <ghil-begin> make-ghil-begin ghil-begin? | |
bdaffda2 | 60 | ghil-begin-env ghil-begin-loc ghil-begin-exps |
01967b69 AW |
61 | |
62 | <ghil-bind> make-ghil-bind ghil-bind? | |
bdaffda2 | 63 | ghil-bind-env ghil-bind-loc ghil-bind-vars ghil-bind-vals ghil-bind-body |
01967b69 | 64 | |
d51406fe AW |
65 | <ghil-mv-bind> make-ghil-mv-bind ghil-mv-bind? |
66 | ghil-mv-bind-env ghil-mv-bind-loc ghil-mv-bind-producer ghil-mv-bind-vars ghil-mv-bind-rest ghil-mv-bind-body | |
67 | ||
01967b69 | 68 | <ghil-lambda> make-ghil-lambda ghil-lambda? |
fbde2b91 AW |
69 | ghil-lambda-env ghil-lambda-loc ghil-lambda-vars ghil-lambda-rest |
70 | ghil-lambda-meta ghil-lambda-body | |
01967b69 AW |
71 | |
72 | <ghil-inline> make-ghil-inline ghil-inline? | |
bdaffda2 | 73 | ghil-inline-env ghil-inline-loc ghil-inline-inline ghil-inline-args |
01967b69 AW |
74 | |
75 | <ghil-call> make-ghil-call ghil-call? | |
bdaffda2 | 76 | ghil-call-env ghil-call-loc ghil-call-proc ghil-call-args |
aa0a011b | 77 | |
efbd5892 AW |
78 | <ghil-mv-call> make-ghil-mv-call ghil-mv-call? |
79 | ghil-mv-call-env ghil-mv-call-loc ghil-mv-call-producer ghil-mv-call-consumer | |
80 | ||
a222b0fa AW |
81 | <ghil-values> make-ghil-values ghil-values? |
82 | ghil-values-env ghil-values-loc ghil-values-values | |
83 | ||
ef24c01b AW |
84 | <ghil-values*> make-ghil-values* ghil-values*? |
85 | ghil-values*-env ghil-values*-loc ghil-values*-values | |
86 | ||
01967b69 | 87 | <ghil-var> make-ghil-var ghil-var? |
48d00064 | 88 | ghil-var-env ghil-var-name ghil-var-kind ghil-var-index |
aa0a011b | 89 | |
2e7e6969 AW |
90 | <ghil-toplevel-env> make-ghil-toplevel-env ghil-toplevel-env? |
91 | ghil-toplevel-env-table | |
aa0a011b | 92 | |
01967b69 | 93 | <ghil-env> make-ghil-env ghil-env? |
2e7e6969 | 94 | ghil-env-parent ghil-env-table ghil-env-variables |
77046be3 | 95 | |
20bdc710 AW |
96 | <ghil-reified-env> make-ghil-reified-env ghil-reified-env? |
97 | ghil-reified-env-env ghil-reified-env-loc | |
98 | ||
46d2d6f8 | 99 | ghil-env-add! |
3de80ed5 | 100 | ghil-env-reify ghil-env-dereify |
46d2d6f8 | 101 | ghil-var-is-bound? ghil-var-for-ref! ghil-var-for-set! ghil-var-define! |
fd358575 | 102 | ghil-var-at-module! |
77046be3 | 103 | call-with-ghil-environment call-with-ghil-bindings)) |
17e90c5e KN |
104 | |
105 | \f | |
106 | ;;; | |
107 | ;;; Parse tree | |
108 | ;;; | |
109 | ||
ac99cb0c | 110 | (define-type <ghil> |
1086fabd AW |
111 | ;; Objects |
112 | (<ghil-void> env loc) | |
113 | (<ghil-quote> env loc obj) | |
114 | (<ghil-quasiquote> env loc exp) | |
115 | (<ghil-unquote> env loc exp) | |
116 | (<ghil-unquote-splicing> env loc exp) | |
117 | ;; Variables | |
118 | (<ghil-ref> env loc var) | |
119 | (<ghil-set> env loc var val) | |
120 | (<ghil-define> env loc var val) | |
121 | ;; Controls | |
122 | (<ghil-if> env loc test then else) | |
123 | (<ghil-and> env loc exps) | |
124 | (<ghil-or> env loc exps) | |
125 | (<ghil-begin> env loc exps) | |
126 | (<ghil-bind> env loc vars vals body) | |
127 | (<ghil-mv-bind> env loc producer vars rest body) | |
128 | (<ghil-lambda> env loc vars rest meta body) | |
129 | (<ghil-call> env loc proc args) | |
130 | (<ghil-mv-call> env loc producer consumer) | |
131 | (<ghil-inline> env loc inline args) | |
132 | (<ghil-values> env loc values) | |
20bdc710 AW |
133 | (<ghil-values*> env loc values) |
134 | (<ghil-reified-env> env loc)) | |
1086fabd | 135 | |
ac99cb0c | 136 | |
17e90c5e KN |
137 | \f |
138 | ;;; | |
139 | ;;; Variables | |
140 | ;;; | |
141 | ||
48d00064 | 142 | (define-record (<ghil-var> env name kind (index #f))) |
cb4cca12 | 143 | |
17e90c5e KN |
144 | \f |
145 | ;;; | |
146 | ;;; Modules | |
147 | ;;; | |
148 | ||
17e90c5e KN |
149 | \f |
150 | ;;; | |
151 | ;;; Environments | |
152 | ;;; | |
153 | ||
2e7e6969 AW |
154 | (define-record (<ghil-env> parent (table '()) (variables '()))) |
155 | (define-record (<ghil-toplevel-env> (table '()))) | |
66292535 | 156 | |
ac99cb0c | 157 | (define (ghil-env-ref env sym) |
61dc81d9 AW |
158 | (assq-ref (ghil-env-table env) sym)) |
159 | ||
160 | (define-macro (push! item loc) | |
161 | `(set! ,loc (cons ,item ,loc))) | |
162 | (define-macro (apush! k v loc) | |
163 | `(set! ,loc (acons ,k ,v ,loc))) | |
164 | (define-macro (apopq! k loc) | |
cd702346 | 165 | `(set! ,loc (assq-remove! ,loc ,k))) |
17e90c5e | 166 | |
77046be3 | 167 | (define (ghil-env-add! env var) |
61dc81d9 AW |
168 | (apush! (ghil-var-name var) var (ghil-env-table env)) |
169 | (push! var (ghil-env-variables env))) | |
17e90c5e | 170 | |
ac99cb0c | 171 | (define (ghil-env-remove! env var) |
61dc81d9 | 172 | (apopq! (ghil-var-name var) (ghil-env-table env))) |
17e90c5e | 173 | |
46d2d6f8 AW |
174 | (define (force-heap-allocation! var) |
175 | (set! (ghil-var-kind var) 'external)) | |
176 | ||
177 | ||
ac99cb0c KN |
178 | \f |
179 | ;;; | |
180 | ;;; Public interface | |
181 | ;;; | |
182 | ||
46d2d6f8 AW |
183 | ;; The following four functions used to be one, in ghil-lookup. Now they |
184 | ;; are four, to reflect the different intents. A bit of duplication, but | |
185 | ;; that's OK. The common current is to find out where a variable will be | |
186 | ;; stored at runtime. | |
2e7e6969 | 187 | ;; |
46d2d6f8 AW |
188 | ;; These functions first search the lexical environments. If the |
189 | ;; variable is not in the innermost environment, make sure the variable | |
190 | ;; is marked as being "external" so that it goes on the heap. If the | |
191 | ;; variable is being modified (via a set!), also make sure it's on the | |
192 | ;; heap, so that other continuations see the changes to the var. | |
2e7e6969 AW |
193 | ;; |
194 | ;; If the variable is not found lexically, it is a toplevel variable, | |
8e367074 AW |
195 | ;; which will be looked up at runtime with respect to the module that |
196 | ;; was current when the lambda was bound, at runtime. The variable will | |
197 | ;; be resolved when it is first used. | |
46d2d6f8 AW |
198 | (define (ghil-var-is-bound? env sym) |
199 | (let loop ((e env)) | |
200 | (record-case e | |
201 | ((<ghil-toplevel-env> table) | |
202 | (let ((key (cons (module-name (current-module)) sym))) | |
203 | (assoc-ref table key))) | |
204 | ((<ghil-env> parent table variables) | |
205 | (and (not (assq-ref table sym)) | |
206 | (loop parent)))))) | |
207 | ||
208 | (define (ghil-var-for-ref! env sym) | |
209 | (let loop ((e env)) | |
210 | (record-case e | |
211 | ((<ghil-toplevel-env> table) | |
212 | (let ((key (cons (module-name (current-module)) sym))) | |
213 | (or (assoc-ref table key) | |
a1122f8c | 214 | (let ((var (make-ghil-var (car key) (cdr key) 'toplevel))) |
46d2d6f8 AW |
215 | (apush! key var (ghil-toplevel-env-table e)) |
216 | var)))) | |
217 | ((<ghil-env> parent table variables) | |
218 | (cond | |
219 | ((assq-ref table sym) | |
220 | => (lambda (var) | |
221 | (or (eq? e env) | |
222 | (force-heap-allocation! var)) | |
223 | var)) | |
224 | (else | |
225 | (loop parent))))))) | |
226 | ||
227 | (define (ghil-var-for-set! env sym) | |
2e7e6969 AW |
228 | (let loop ((e env)) |
229 | (record-case e | |
230 | ((<ghil-toplevel-env> table) | |
231 | (let ((key (cons (module-name (current-module)) sym))) | |
232 | (or (assoc-ref table key) | |
a1122f8c | 233 | (let ((var (make-ghil-var (car key) (cdr key) 'toplevel))) |
46d2d6f8 AW |
234 | (apush! key var (ghil-toplevel-env-table e)) |
235 | var)))) | |
2e7e6969 | 236 | ((<ghil-env> parent table variables) |
46d2d6f8 AW |
237 | (cond |
238 | ((assq-ref table sym) | |
239 | => (lambda (var) | |
240 | (force-heap-allocation! var) | |
241 | var)) | |
242 | (else | |
243 | (loop parent))))))) | |
244 | ||
fd358575 AW |
245 | (define (ghil-var-at-module! env modname sym interface?) |
246 | (let loop ((e env)) | |
247 | (record-case e | |
248 | ((<ghil-toplevel-env> table) | |
249 | (let ((key (list modname sym interface?))) | |
250 | (or (assoc-ref table key) | |
251 | (let ((var (make-ghil-var modname sym | |
252 | (if interface? 'public 'private)))) | |
253 | (apush! key var (ghil-toplevel-env-table e)) | |
254 | var)))) | |
255 | ((<ghil-env> parent table variables) | |
256 | (loop parent))))) | |
257 | ||
46d2d6f8 | 258 | (define (ghil-var-define! toplevel sym) |
2e7e6969 AW |
259 | (let ((key (cons (module-name (current-module)) sym))) |
260 | (or (assoc-ref (ghil-toplevel-env-table toplevel) key) | |
a1122f8c | 261 | (let ((var (make-ghil-var (car key) (cdr key) 'toplevel))) |
2e7e6969 AW |
262 | (apush! key var (ghil-toplevel-env-table toplevel)) |
263 | var)))) | |
cd9d95d7 | 264 | |
77046be3 | 265 | (define (call-with-ghil-environment e syms func) |
cb4cca12 | 266 | (let* ((e (make-ghil-env e)) |
2e7e6969 AW |
267 | (vars (map (lambda (s) |
268 | (let ((v (make-ghil-var e s 'argument))) | |
269 | (ghil-env-add! e v) v)) | |
270 | syms))) | |
cb4cca12 KN |
271 | (func e vars))) |
272 | ||
77046be3 | 273 | (define (call-with-ghil-bindings e syms func) |
cb4cca12 KN |
274 | (let* ((vars (map (lambda (s) |
275 | (let ((v (make-ghil-var e s 'local))) | |
276 | (ghil-env-add! e v) v)) | |
277 | syms)) | |
278 | (ret (func vars))) | |
279 | (for-each (lambda (v) (ghil-env-remove! e v)) vars) | |
280 | ret)) | |
281 | ||
20bdc710 AW |
282 | (define (ghil-env-reify env) |
283 | (let loop ((e env) (out '())) | |
284 | (record-case e | |
285 | ((<ghil-toplevel-env> table) | |
286 | (map (lambda (v) | |
287 | (cons (ghil-var-name v) | |
288 | (or (ghil-var-index v) | |
289 | (error "reify called before indices finalized")))) | |
290 | out)) | |
291 | ((<ghil-env> parent table variables) | |
292 | (loop parent | |
293 | (append out | |
294 | (filter (lambda (v) (eq? (ghil-var-kind v) 'external)) | |
295 | variables))))))) | |
296 | ||
3de80ed5 AW |
297 | (define (ghil-env-dereify name-index-alist) |
298 | (let* ((e (make-ghil-env (make-ghil-toplevel-env))) | |
299 | (vars (map (lambda (pair) | |
300 | (make-ghil-var e (car pair) 'external (cdr pair))) | |
301 | name-index-alist))) | |
302 | (set! (ghil-env-table e) | |
303 | (map (lambda (v) (cons (ghil-var-name v) v)) vars)) | |
304 | (set! (ghil-env-variables e) vars) | |
305 | e)) | |
306 | ||
17e90c5e KN |
307 | \f |
308 | ;;; | |
309 | ;;; Parser | |
310 | ;;; | |
311 | ||
ac99cb0c KN |
312 | ;;; (define-public (parse-ghil x e) |
313 | ;;; (parse `(@lambda () ,x) (make-ghil-mod e))) | |
314 | ;;; | |
315 | ;;; (define (parse x e) | |
316 | ;;; (cond ((pair? x) (parse-pair x e)) | |
317 | ;;; ((symbol? x) | |
318 | ;;; (let ((str (symbol->string x))) | |
319 | ;;; (case (string-ref str 0) | |
320 | ;;; ((#\@) (error "Invalid use of IL primitive" x)) | |
321 | ;;; ((#\:) (let ((sym (string->symbol (substring str 1)))) | |
322 | ;;; (<ghil-quote> (symbol->keyword sym)))) | |
323 | ;;; (else (<ghil-ref> e (ghil-lookup e x)))))) | |
324 | ;;; (else (<ghil-quote> x)))) | |
325 | ;;; | |
326 | ;;; (define (map-parse x e) | |
327 | ;;; (map (lambda (x) (parse x e)) x)) | |
328 | ;;; | |
329 | ;;; (define (parse-pair x e) | |
330 | ;;; (let ((head (car x)) (tail (cdr x))) | |
331 | ;;; (if (and (symbol? head) (eq? (string-ref (symbol->string head) 0) #\@)) | |
332 | ;;; (if (ghil-primitive-macro? head) | |
333 | ;;; (parse (apply (ghil-macro-expander head) tail) e) | |
334 | ;;; (parse-primitive head tail e)) | |
335 | ;;; (<ghil-call> e (parse head e) (map-parse tail e))))) | |
336 | ;;; | |
337 | ;;; (define (parse-primitive prim args e) | |
338 | ;;; (case prim | |
339 | ;;; ;; (@ IDENTIFIER) | |
340 | ;;; ((@) | |
341 | ;;; (match args | |
342 | ;;; (() | |
343 | ;;; (<ghil-ref> e (make-ghil-var '@ '@ 'module))) | |
344 | ;;; ((identifier) | |
345 | ;;; (receive (module name) (identifier-split identifier) | |
346 | ;;; (<ghil-ref> e (make-ghil-var module name 'module)))))) | |
347 | ;;; | |
348 | ;;; ;; (@@ OP ARGS...) | |
349 | ;;; ((@@) | |
350 | ;;; (match args | |
351 | ;;; ((op . args) | |
352 | ;;; (<ghil-inline> op (map-parse args e))))) | |
353 | ;;; | |
354 | ;;; ;; (@void) | |
355 | ;;; ((@void) | |
356 | ;;; (match args | |
357 | ;;; (() (<ghil-void>)))) | |
358 | ;;; | |
359 | ;;; ;; (@quote OBJ) | |
360 | ;;; ((@quote) | |
361 | ;;; (match args | |
362 | ;;; ((obj) | |
363 | ;;; (<ghil-quote> obj)))) | |
364 | ;;; | |
365 | ;;; ;; (@define NAME VAL) | |
366 | ;;; ((@define) | |
367 | ;;; (match args | |
368 | ;;; ((name val) | |
369 | ;;; (let ((v (ghil-lookup e name))) | |
370 | ;;; (<ghil-set> e v (parse val e)))))) | |
371 | ;;; | |
372 | ;;; ;; (@set! NAME VAL) | |
373 | ;;; ((@set!) | |
374 | ;;; (match args | |
375 | ;;; ((name val) | |
376 | ;;; (let ((v (ghil-lookup e name))) | |
377 | ;;; (<ghil-set> e v (parse val e)))))) | |
378 | ;;; | |
379 | ;;; ;; (@if TEST THEN [ELSE]) | |
380 | ;;; ((@if) | |
381 | ;;; (match args | |
382 | ;;; ((test then) | |
383 | ;;; (<ghil-if> (parse test e) (parse then e) (<ghil-void>))) | |
384 | ;;; ((test then else) | |
385 | ;;; (<ghil-if> (parse test e) (parse then e) (parse else e))))) | |
386 | ;;; | |
387 | ;;; ;; (@begin BODY...) | |
388 | ;;; ((@begin) | |
389 | ;;; (parse-body args e)) | |
390 | ;;; | |
391 | ;;; ;; (@let ((SYM INIT)...) BODY...) | |
392 | ;;; ((@let) | |
393 | ;;; (match args | |
394 | ;;; ((((sym init) ...) body ...) | |
395 | ;;; (let* ((vals (map-parse init e)) | |
396 | ;;; (vars (map (lambda (s) | |
397 | ;;; (let ((v (make-ghil-var e s 'local))) | |
398 | ;;; (ghil-env-add! e v) v)) | |
399 | ;;; sym)) | |
400 | ;;; (body (parse-body body e))) | |
401 | ;;; (for-each (lambda (v) (ghil-env-remove! e v)) vars) | |
402 | ;;; (<ghil-bind> e vars vals body))))) | |
403 | ;;; | |
404 | ;;; ;; (@letrec ((SYM INIT)...) BODY...) | |
405 | ;;; ((@letrec) | |
406 | ;;; (match args | |
407 | ;;; ((((sym init) ...) body ...) | |
408 | ;;; (let* ((vars (map (lambda (s) | |
409 | ;;; (let ((v (make-ghil-var e s 'local))) | |
410 | ;;; (ghil-env-add! e v) v)) | |
411 | ;;; sym)) | |
412 | ;;; (vals (map-parse init e)) | |
413 | ;;; (body (parse-body body e))) | |
414 | ;;; (for-each (lambda (v) (ghil-env-remove! e v)) vars) | |
415 | ;;; (<ghil-bind> e vars vals body))))) | |
416 | ;;; | |
417 | ;;; ;; (@lambda FORMALS BODY...) | |
418 | ;;; ((@lambda) | |
419 | ;;; (match args | |
420 | ;;; ((formals . body) | |
421 | ;;; (receive (syms rest) (parse-formals formals) | |
422 | ;;; (let* ((e (make-ghil-env e)) | |
423 | ;;; (vars (map (lambda (s) | |
424 | ;;; (let ((v (make-ghil-var e s 'argument))) | |
425 | ;;; (ghil-env-add! e v) v)) | |
426 | ;;; syms))) | |
427 | ;;; (<ghil-lambda> e vars rest (parse-body body e))))))) | |
428 | ;;; | |
429 | ;;; ;; (@eval-case CLAUSE...) | |
430 | ;;; ((@eval-case) | |
431 | ;;; (let loop ((clauses args)) | |
432 | ;;; (cond ((null? clauses) (<ghil-void>)) | |
433 | ;;; ((or (eq? (caar clauses) '@else) | |
434 | ;;; (and (memq 'load-toplevel (caar clauses)) | |
435 | ;;; (ghil-env-toplevel? e))) | |
436 | ;;; (parse-body (cdar clauses) e)) | |
437 | ;;; (else | |
438 | ;;; (loop (cdr clauses)))))) | |
439 | ;;; | |
440 | ;;; (else (error "Unknown primitive:" prim)))) | |
441 | ;;; | |
442 | ;;; (define (parse-body x e) | |
443 | ;;; (<ghil-begin> (map-parse x e))) | |
444 | ;;; | |
445 | ;;; (define (parse-formals formals) | |
446 | ;;; (cond | |
447 | ;;; ;; (@lambda x ...) | |
448 | ;;; ((symbol? formals) (values (list formals) #t)) | |
449 | ;;; ;; (@lambda (x y z) ...) | |
450 | ;;; ((list? formals) (values formals #f)) | |
451 | ;;; ;; (@lambda (x y . z) ...) | |
452 | ;;; ((pair? formals) | |
453 | ;;; (let loop ((l formals) (v '())) | |
454 | ;;; (if (pair? l) | |
455 | ;;; (loop (cdr l) (cons (car l) v)) | |
456 | ;;; (values (reverse! (cons l v)) #t)))) | |
457 | ;;; (else (error "Invalid formals:" formals)))) | |
458 | ;;; | |
459 | ;;; (define (identifier-split identifier) | |
460 | ;;; (let ((m (string-match "::([^:]*)$" (symbol->string identifier)))) | |
461 | ;;; (if m | |
462 | ;;; (values (string->symbol (match:prefix m)) | |
463 | ;;; (string->symbol (match:substring m 1))) | |
464 | ;;; (values #f identifier)))) |