mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 21:40:33 +02:00
Code Activity

fix install-global construction of `define' forms

Browse source 
* module/ice-9/psyntax.scm (build-global-definition): Remove mod
  argument, as it does not seem we could ever define something in another
  module.
  (chi-install-global): Build the define as a definition, not an
  application. Doesn't matter now, but it will later.
  (chi-top): Fix build-global-definition call.

* module/ice-9/psyntax.scm: Regenerated.
This commit is contained in:
Andy Wingo 2009-05-07 10:27:53 +02:00
parent f4a644ee88
commit f27e9e11cd
2 changed files with 35 additions and 34 deletions
Download patch file Download diff file Expand all files Collapse all files

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

File diff suppressed because one or more lines are too long

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

@ -423,7 +423,7 @@
(define-syntax build-global-definition (define-syntax build-global-definition
(syntax-rules () (syntax-rules ()
((_ source var exp mod) ((_ source var exp)
(build-annotated source `(define ,var ,exp))))) (build-annotated source `(define ,var ,exp)))))
(define-syntax build-lambda (define-syntax build-lambda
@ -914,29 +914,30 @@
(let ((first (chi-top (car body) r w m esew mod))) (let ((first (chi-top (car body) r w m esew mod)))
(cons first (dobody (cdr body) r w m esew mod)))))))) (cons first (dobody (cdr body) r w m esew mod))))))))
;; FIXME: module?
(define chi-install-global (define chi-install-global
(lambda (name e) (lambda (name e)
(build-application no-source (build-global-definition
(build-primref no-source 'define) no-source
(list name
name ;; FIXME: seems nasty to call current-module here
;; FIXME: seems nasty to call current-module here (if (let ((v (module-variable (current-module) name)))
(if (let ((v (module-variable (current-module) name))) ;; FIXME use primitive-macro?
;; FIXME use primitive-macro? (and v (variable-bound? v) (macro? (variable-ref v))
(and v (variable-bound? v) (macro? (variable-ref v)) (not (eq? (macro-type (variable-ref v)) 'syncase-macro))))
(not (eq? (macro-type (variable-ref v)) 'syncase-macro)))) (build-application
(build-application no-source no-source
(build-primref no-source 'make-extended-syncase-macro) (build-primref no-source 'make-extended-syncase-macro)
(list (build-application no-source (list (build-application
(build-primref no-source 'module-ref) no-source
(list (build-application no-source 'current-module '()) (build-primref no-source 'module-ref)
(build-data no-source name))) (list (build-application no-source 'current-module '())
(build-data no-source 'macro) (build-data no-source name)))
e)) (build-data no-source 'macro)
(build-application no-source e))
(build-primref no-source 'make-syncase-macro) (build-application
(list (build-data no-source 'macro) e))))))) no-source
(build-primref no-source 'make-syncase-macro)
(list (build-data no-source 'macro) e))))))
(define chi-when-list (define chi-when-list
(lambda (e when-list w) (lambda (e when-list w)
@ -1138,7 +1139,7 @@
(case type (case type
((global core macro module-ref) ((global core macro module-ref)
(eval-if-c&e m (eval-if-c&e m
(build-global-definition s n (chi e r w mod) mod) (build-global-definition s n (chi e r w mod))
mod)) mod))
((displaced-lexical) ((displaced-lexical)
(syntax-violation #f "identifier out of context" (syntax-violation #f "identifier out of context"