1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-04 22:40:25 +02:00

* boot-9.scm (process-define-module): Added keyword use-syntax.

This commit is contained in:
Mikael Djurfeldt 1998-05-04 11:44:13 +00:00
parent 8bb51def7d
commit f714ca8e67
2 changed files with 33 additions and 22 deletions

View file

@ -1,3 +1,7 @@
1998-04-22 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* boot-9.scm (process-define-module): Added keyword use-syntax.
1998-04-19 Mikael Djurfeldt <mdj@mdj.nada.kth.se> 1998-04-19 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* nonblocking.scm: Removed. libguile is now inherently * nonblocking.scm: Removed. libguile is now inherently

View file

@ -1872,28 +1872,35 @@
(for-each (lambda (interface) (for-each (lambda (interface)
(module-use! module interface)) (module-use! module interface))
reversed-interfaces) reversed-interfaces)
(case (cond ((keyword? (car kws)) (let ((keyword (cond ((keyword? (car kws))
(keyword->symbol (car kws))) (keyword->symbol (car kws)))
((and (symbol? (car kws)) ((and (symbol? (car kws))
(eq? (string-ref (car kws) 0) #\:)) (eq? (string-ref (car kws) 0) #\:))
(string->symbol (substring (car kws) 1))) (string->symbol (substring (car kws) 1)))
(else #f)) (else #f))))
((use-module) (case keyword
(if (not (pair? (cdr kws))) ((use-module use-syntax)
(error "unrecognized defmodule argument" kws)) (if (not (pair? (cdr kws)))
(let* ((used-name (cadr kws)) (error "unrecognized defmodule argument" kws))
(used-module (resolve-module used-name))) (let* ((used-name (cadr kws))
(if (not (module-ref used-module '%module-public-interface #f)) (used-module (resolve-module used-name)))
(begin (if (not (module-ref used-module '%module-public-interface #f))
((if %autoloader-developer-mode warn error) (begin
"no code for module" (module-name used-module)) ((if %autoloader-developer-mode warn error)
(beautify-user-module! used-module))) "no code for module" (module-name used-module))
(let ((interface (module-public-interface used-module))) (beautify-user-module! used-module)))
(if (not interface) (let ((interface (module-public-interface used-module)))
(error "missing interface for use-module" used-module)) (if (not interface)
(loop (cddr kws) (cons interface reversed-interfaces))))) (error "missing interface for use-module" used-module))
(else (if (eq? keyword 'use-syntax)
(error "unrecognized defmodule argument" kws))))) (let ((transformer (module-ref interface
(car (last-pair used-name))
#f)))
(set-module-transformer! module transformer)
(set! scm:eval-transformer transformer)))
(loop (cddr kws) (cons interface reversed-interfaces)))))
(else
(error "unrecognized defmodule argument" kws))))))
module)) module))
;;; {Autoloading modules} ;;; {Autoloading modules}