mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

first-class macro representation (no bits on variables)

Browse source 
* libguile/macros.c (scm_macro_p): Update docs.

* module/ice-9/boot-9.scm (module-define!, module-ref): Define pre-boot
  forms of these functions as well. I suspect module-add! can go soon.
  (module-lookup-keyword, module-define-keyword!)
  (module-undefine-keyword!) Remove these.

* module/ice-9/psyntax-pp.scm: Regenerate. Notice the difference?

* module/ice-9/psyntax.scm (put-global-definition-hook)
  (get-global-definition-hook): Rework to expect first-class macros. Heh
  heh.
  (remove-global-definition-hook): Pleasantly, this hook can go away.
  (chi-install-global): Terrorism to generate the right kind of output --
  will clean up.
  (chi-top): Unify definition handling for all kinds of values.
This commit is contained in:
Andy Wingo 2009-04-29 21:19:23 +02:00
parent 5a0132b337
commit 3d5f3091e1
4 changed files with 63 additions and 54 deletions
Download patch file Download diff file Expand all files Collapse all files

4
libguile/macros.c
View file

@ -224,8 +224,8 @@ SCM_DEFINE (scm_make_extended_syncase_macro, "make-extended-syncase-macro", 3, 0
SCM_DEFINE (scm_macro_p, "macro?", 1, 0, 0,
(SCM obj),
"Return @code{#t} if @var{obj} is a regular macro, a memoizing macro or a\n"
"syntax transformer.")
"Return @code{#t} if @var{obj} is a regular macro, a memoizing macro, a\n"
"syntax transformer, or a syntax-case macro.")
#define FUNC_NAME s_scm_macro_p
{
return scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_macro, obj));

35
module/ice-9/boot-9.scm
View file

@ -140,6 +140,16 @@
'(guile))
(define (module-add! module sym var)
(hashq-set! (%get-pre-modules-obarray) sym var))
(define (module-define! module sym val)
(let ((v (hashq-ref (%get-pre-modules-obarray) sym)))
(if v
(variable-set! v val)
(hashq-set! (%get-pre-modules-obarray) sym
(make-variable val)))))
(define (module-ref module sym)
(let ((v (module-variable module sym)))
(if v (variable-ref v) (error "badness!" (pk module) (pk sym)))))
(define (make-module-ref mod var kind)
(case kind
((public) (if mod `(@ ,mod ,var) var))
@ -156,31 +166,6 @@
(define (resolve-module . args)
#f)
;;; Here we use "keyword" in the sense that R6RS uses it, as in "a
;;; definition may be a keyword definition or a variable definition".
;;; Keywords are syntactic bindings; variables are value bindings.
(define (module-define-keyword! mod sym type val)
(let ((v (or (module-local-variable mod sym)
(let ((v (make-undefined-variable)))
(module-add! mod sym v)
v))))
(variable-set! v
(if (and (variable-bound? v) (macro? (variable-ref v)))
(make-extended-syncase-macro (variable-ref v) type val)
(make-syncase-macro type val)))
(set-object-property! v '*sc-expander* (cons type val))))
(define (module-lookup-keyword mod sym)
(let ((v (module-variable mod sym)))
(and v (object-property v '*sc-expander*))))
(define (module-undefine-keyword! mod sym)
(let ((v (module-local-variable mod sym)))
(if v
(let ((p (assq '*sc-expander* (object-properties v))))
;; probably should unbind the variable too
(set-object-properties! v (delq p (object-properties v)))))))
;;; API provided by psyntax
(define syntax-violation #f)
(define datum->syntax #f)

22
module/ice-9/psyntax-pp.scm
View file

File diff suppressed because one or more lines are too long

56
module/ice-9/psyntax.scm
View file

@ -339,19 +339,31 @@
(define put-global-definition-hook
(lambda (symbol type val)
(module-define-keyword! (current-module) symbol type val)))
(define remove-global-definition-hook
(lambda (symbol)
(module-undefine-keyword! (current-module) symbol)))
(let ((existing (let ((v (module-variable (current-module) symbol)))
(and v (variable-bound? v)
(let ((val (variable-ref v)))
(and (macro? val)
(not (syncase-macro-type val))
val))))))
(module-define! (current-module)
symbol
(if existing
(make-extended-syncase-macro existing type val)
(make-syncase-macro type val))))))
(define get-global-definition-hook
(lambda (symbol module)
(if (and (not module) (current-module))
(warn "module system is booted, we should have a module" symbol))
(module-lookup-keyword (if module (resolve-module (cdr module))
(current-module))
symbol)))
(let ((v (module-variable (if module
(resolve-module (cdr module))
(current-module))
symbol)))
(and v (variable-bound? v)
(let ((val (variable-ref v)))
(and (macro? val) (syncase-macro-type val)
(cons (syncase-macro-type val)
(syncase-macro-binding val))))))))
)
@ -897,8 +909,25 @@
(define chi-install-global
(lambda (name e)
(build-application no-source
(build-primref no-source 'install-global-transformer)
(list (build-data no-source name) e))))
(build-primref no-source 'define)
(list
name
;; FIXME: seems nasty to call current-module here
(if (let ((v (module-variable (current-module) name)))
;; FIXME use primitive-macro?
(and v (variable-bound? v) (macro? (variable-ref v))
(not (eq? (macro-type (variable-ref v)) 'syncase-macro))))
(build-application no-source
(build-primref no-source 'make-extended-syncase-macro)
(list (build-application no-source
(build-primref no-source 'module-ref)
(list (build-application no-source 'current-module '())
(build-data no-source name)))
(build-data no-source 'macro)
e))
(build-application no-source
(build-primref no-source 'make-syncase-macro)
(list (build-data no-source 'macro) e)))))))
(define chi-when-list
(lambda (e when-list w)
@ -1098,18 +1127,13 @@
(let* ((n (id-var-name value w))
(type (binding-type (lookup n r mod))))
(case type
((global)
((global core macro module-ref)
(eval-if-c&e m
(build-global-definition s n (chi e r w mod) mod)
mod))
((displaced-lexical)
(syntax-violation #f "identifier out of context"
e (wrap value w mod)))
((core macro module-ref)
(remove-global-definition-hook n)
(eval-if-c&e m
(build-global-definition s n (chi e r w mod) mod)
mod))
(else
(syntax-violation #f "cannot define keyword at top level"
e (wrap value w mod))))))