mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-18 01:30:27 +02:00
syncase knows about @ / @@
* module/ice-9/psyntax.scm (syntax-type): Handle a new type, module-ref. Like external-macro, it also has a procedure as a binding. (chi-expr): module-ref forms -- that is to say, (@ (foo ...) bar) -- as expressions they are global references, but with respect to a specific module. (@, @@): Define module-ref syntax handlers. * module/ice-9/psyntax-pp.scm: Regenerated. * module/ice-9/syncase.scm: Mark as primitive syntax so we don't clobber their definitions. The reason I'm doing things like this is so as to support (set! (@@ ...) ...) sensibly, which will be the next patch.
This commit is contained in:
parent
d4876cb413
commit
265e61273d
3 changed files with 37 additions and 13 deletions
File diff suppressed because one or more lines are too long
|
@ -508,6 +508,7 @@
|
|||
;;; <binding> ::= (macro . <procedure>) macros
|
||||
;;; (core . <procedure>) core forms
|
||||
;;; (external-macro . <procedure>) external-macro
|
||||
;;; (module-ref . <procedure>) @ or @@
|
||||
;;; (begin) begin
|
||||
;;; (define) define
|
||||
;;; (define-syntax) define-syntax
|
||||
|
@ -926,6 +927,7 @@
|
|||
;;; -------------------------------------------------------------------
|
||||
;;; core procedure core form (including singleton)
|
||||
;;; external-macro procedure external macro
|
||||
;;; module-ref procedure @ or @@ form
|
||||
;;; lexical name lexical variable reference
|
||||
;;; global name global variable reference
|
||||
;;; begin none begin keyword
|
||||
|
@ -984,7 +986,7 @@
|
|||
((macro)
|
||||
(syntax-type (chi-macro (binding-value b) e r w rib mod)
|
||||
r empty-wrap s rib mod))
|
||||
((core external-macro)
|
||||
((core external-macro module-ref)
|
||||
(values type (binding-value b) e w s mod))
|
||||
((local-syntax)
|
||||
(values 'local-syntax-form (binding-value b) e w s mod))
|
||||
|
@ -1129,6 +1131,10 @@
|
|||
((core external-macro)
|
||||
;; apply transformer
|
||||
(value e r w s mod))
|
||||
((module-ref)
|
||||
(call-with-values (lambda () (value e r w s mod))
|
||||
;; we could add a public? arg here
|
||||
(lambda (id mod) (build-global-reference s id mod))))
|
||||
((lexical-call)
|
||||
(chi-application
|
||||
(build-lexical-reference 'fun (source-annotation (car e)) value)
|
||||
|
@ -1773,6 +1779,24 @@
|
|||
(syntax (arg ... val)))))
|
||||
(_ (syntax-error (source-wrap e w s mod))))))
|
||||
|
||||
(global-extend 'module-ref '@
|
||||
(lambda (e r w s mod)
|
||||
(syntax-case e (%module-public-interface)
|
||||
((_ (mod ...) id)
|
||||
(and (andmap id? (syntax (mod ...))) (id? (syntax id)))
|
||||
(values (syntax-object->datum (syntax id))
|
||||
(syntax-object->datum
|
||||
(syntax (mod ... %module-public-interface))))))))
|
||||
|
||||
(global-extend 'module-ref '@@
|
||||
(lambda (e r w s mod)
|
||||
(syntax-case e ()
|
||||
((_ (mod ...) id)
|
||||
(and (andmap id? (syntax (mod ...))) (id? (syntax id)))
|
||||
(values (syntax-object->datum (syntax id))
|
||||
(syntax-object->datum
|
||||
(syntax (mod ...))))))))
|
||||
|
||||
(global-extend 'begin 'begin '())
|
||||
|
||||
(global-extend 'define 'define '())
|
||||
|
|
|
@ -65,7 +65,7 @@
|
|||
|
||||
(define primitive-syntax '(quote lambda letrec if set! begin define or
|
||||
and let let* cond do quasiquote unquote
|
||||
unquote-splicing case))
|
||||
unquote-splicing case @ @@))
|
||||
|
||||
(for-each (lambda (symbol)
|
||||
(set-symbol-property! symbol 'primitive-syntax #t))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue