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>
* nonblocking.scm: Removed. libguile is now inherently

View file

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