mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
it is alive!!!!! + concision + fix to compile-ghil
* module/ice-9/boot-9.scm: Remove lots of debugging prints. Remove some already-deprecated attempts to load modules from shared libraries. * module/ice-9/psyntax.scm: If we have to create a variable for a syntactic binding, initialize its contents to a gensym. I'd like something more meaningful, but at least this way we can tell different macros apart. Only warn about missing modules if modules are booted. Chi the value part of a (set! (@ ...) ) expression -- whoops! * module/ice-9/psyntax-pp.scm: Regenerated. * module/language/glil.scm (parse-glil): Fix an unquoting error. * module/language/scheme/compile-ghil.scm: No need to import syncase, we gots it. Rework compiler to expand only once, with syncase, instead of incrementally. Fix define-scheme-transformer to work with syncase, by not referencing bare keywords. It works!
This commit is contained in:
parent
c5ad45c7b3
commit
01c161ca11
5 changed files with 31 additions and 47 deletions
|
@ -187,7 +187,7 @@
|
|||
;; Until the module system is booted, this will be the current expander.
|
||||
(primitive-load-path "ice-9/psyntax-pp")
|
||||
|
||||
(define %pre-modules-transformer (lambda args (pk 'in args 'out (apply sc-expand args))))
|
||||
(define %pre-modules-transformer sc-expand)
|
||||
|
||||
|
||||
|
||||
|
@ -1860,7 +1860,6 @@
|
|||
already)
|
||||
(autoload
|
||||
;; Try to autoload the module, and recurse.
|
||||
(pk name)
|
||||
(try-load-module name)
|
||||
(resolve-module name #f))
|
||||
(else
|
||||
|
@ -1894,9 +1893,7 @@
|
|||
;; (define-special-value '(%app modules new-ws) (lambda () (make-scm-module)))
|
||||
|
||||
(define (try-load-module name)
|
||||
(or (begin-deprecated (try-module-linked name))
|
||||
(try-module-autoload name)
|
||||
(begin-deprecated (try-module-dynamic-link name))))
|
||||
(try-module-autoload name))
|
||||
|
||||
(define (purify-module! module)
|
||||
"Removes bindings in MODULE which are inherited from the (guile) module."
|
||||
|
@ -2182,7 +2179,6 @@ module '(ice-9 q) '(make-q q-length))}."
|
|||
(and (not (autoload-done-or-in-progress? dir-hint name))
|
||||
(let ((didit #f))
|
||||
(define (load-file proc file)
|
||||
(pk 'loading proc file)
|
||||
(save-module-excursion (lambda () (proc file)))
|
||||
(set! didit #t))
|
||||
(dynamic-wind
|
||||
|
|
File diff suppressed because one or more lines are too long
|
@ -342,7 +342,7 @@
|
|||
(resolve-module modname)
|
||||
(current-module)))
|
||||
(v (or (module-variable module symbol)
|
||||
(let ((v (make-variable 'sc-macro)))
|
||||
(let ((v (make-variable (gensym))))
|
||||
(module-add! module symbol v)
|
||||
v))))
|
||||
(if (not (variable-bound? v))
|
||||
|
@ -364,7 +364,9 @@
|
|||
(lambda (symbol module)
|
||||
(let* ((module (if module
|
||||
(resolve-module module)
|
||||
(warn "wha" symbol (current-module))))
|
||||
(let ((mod (current-module)))
|
||||
(if mod (warn "wha" symbol))
|
||||
mod)))
|
||||
(v (module-variable module symbol)))
|
||||
(and v
|
||||
(or (object-property v '*sc-expander*)
|
||||
|
@ -1786,9 +1788,10 @@
|
|||
(lambda (type value ee ww ss modmod)
|
||||
(case type
|
||||
((module-ref)
|
||||
(let ((val (chi (syntax val) r w mod)))
|
||||
(call-with-values (lambda () (value (syntax (head tail ...))))
|
||||
(lambda (id mod)
|
||||
(build-global-assignment s id (syntax val) mod))))
|
||||
(build-global-assignment s id val mod)))))
|
||||
(else
|
||||
(build-application s
|
||||
(chi (syntax (setter head)) r w mod)
|
||||
|
|
|
@ -131,7 +131,7 @@
|
|||
((toplevel ,op ,name) (make-glil-toplevel op name))
|
||||
((module public ,op ,mod ,name) (make-glil-module op mod name #t))
|
||||
((module private ,op ,mod ,name) (make-glil-module op mod name #f))
|
||||
((label ,label) (make-label ,label))
|
||||
((label ,label) (make-label label))
|
||||
((branch ,inst ,label) (make-glil-branch inst label))
|
||||
((call ,inst ,nargs) (make-glil-call inst nargs))
|
||||
((mv-call ,nargs ,ra) (make-glil-mv-call nargs ra))
|
||||
|
|
|
@ -27,12 +27,11 @@
|
|||
#:use-module (system vm objcode)
|
||||
#:use-module (ice-9 receive)
|
||||
#:use-module (ice-9 optargs)
|
||||
#:use-module (ice-9 expand-support)
|
||||
#:use-module ((ice-9 syncase) #:select (sc-macro))
|
||||
#:use-module ((system base compile) #:select (syntax-error))
|
||||
#:export (compile-ghil translate-1
|
||||
*translate-table* define-scheme-translator))
|
||||
|
||||
(module-ref (current-module) 'receive)
|
||||
|
||||
;;; environment := #f
|
||||
;;; | MODULE
|
||||
|
@ -70,12 +69,13 @@
|
|||
(and=> (cenv-module e) set-current-module)
|
||||
(call-with-ghil-environment (cenv-ghil-env e) '()
|
||||
(lambda (env vars)
|
||||
(let ((x (sc-expand3 x 'c '(compile load eval))))
|
||||
(let ((x (make-ghil-lambda env #f vars #f '()
|
||||
(translate-1 env #f x)))
|
||||
(cenv (make-cenv (current-module)
|
||||
(ghil-env-parent env)
|
||||
(if e (cenv-externals e) '()))))
|
||||
(values x cenv cenv)))))))
|
||||
(values x cenv cenv))))))))
|
||||
|
||||
|
||||
;;;
|
||||
|
@ -104,9 +104,6 @@
|
|||
(let* ((mod (current-module))
|
||||
(val (cond
|
||||
((symbol? head) (module-ref/safe mod head))
|
||||
;; allow macros to be unquoted into the output of a macro
|
||||
;; expansion
|
||||
((macro? head) head)
|
||||
((pmatch head
|
||||
((@ ,modname ,sym)
|
||||
(module-ref/safe (resolve-interface modname) sym))
|
||||
|
@ -117,18 +114,6 @@
|
|||
(cond
|
||||
((hashq-ref *translate-table* val))
|
||||
|
||||
((defmacro? val)
|
||||
(lambda (env loc exp)
|
||||
(retrans (apply (defmacro-transformer val) (cdr exp)))))
|
||||
|
||||
((eq? val sc-macro)
|
||||
;; syncase!
|
||||
(let ((sc-expand3 (@@ (ice-9 syncase) sc-expand3)))
|
||||
(lambda (env loc exp)
|
||||
(retrans
|
||||
(strip-expansion-structures
|
||||
(sc-expand3 exp 'c '(compile load eval)))))))
|
||||
|
||||
((primitive-macro? val)
|
||||
(syntax-error #f "unhandled primitive macro" head))
|
||||
|
||||
|
@ -180,7 +165,7 @@
|
|||
|
||||
(define-macro (define-scheme-translator sym . clauses)
|
||||
`(hashq-set! (@ (language scheme compile-ghil) *translate-table*)
|
||||
,sym
|
||||
(module-ref (current-module) ',sym)
|
||||
(lambda (e l exp)
|
||||
(define (retrans x)
|
||||
((@ (language scheme compile-ghil) translate-1)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue