add experimental support for "phaseless" modules
The intent is to support phase-crossing data such as the `exn:fail:syntax'
structure type that is instantiaed by macros and recognized by contexts
that use `eval' or `expand'. Phaseless modules are highly constrained,
however, to avoid new cross-phase channels, and a module is inferred to
be phaseless when it fits syntactic constraints.
I've adjusted `racket/kernel' and improved its documentation a little
so that it can be used to implement a phaseless module (which can
import only from other phaseless modules).
This change also adds a `flags' field to the `mod' structure type
from `compiler/zo-structs'.
original commit: 899a3279c2
This commit is contained in:
parent
0deb045dde
commit
e97bb74005
|
@ -185,11 +185,12 @@
|
|||
(define (decompile-module mod-form orig-stack stx-ht mod-name)
|
||||
(match mod-form
|
||||
[(struct mod (name srcname self-modidx prefix provides requires body syntax-bodies unexported
|
||||
max-let-depth dummy lang-info internal-context pre-submodules post-submodules))
|
||||
max-let-depth dummy lang-info internal-context flags pre-submodules post-submodules))
|
||||
(let-values ([(globs defns) (decompile-prefix prefix stx-ht)]
|
||||
[(stack) (append '(#%modvars) orig-stack)]
|
||||
[(closed) (make-hasheq)])
|
||||
`(,mod-name ,(if (symbol? name) name (last name)) ....
|
||||
,@(if (null? flags) '() (list `(quote ,@flags)))
|
||||
,@(let ([l (apply
|
||||
append
|
||||
(for/list ([req (in-list requires)]
|
||||
|
|
|
@ -114,7 +114,7 @@
|
|||
(match mod-form
|
||||
[(struct mod (name srcname self-modidx mod-prefix provides requires body syntax-bodies
|
||||
unexported mod-max-let-depth dummy lang-info internal-context
|
||||
pre-submodules post-submodules))
|
||||
flags pre-submodules post-submodules))
|
||||
(define toplevel-offset (length (prefix-toplevels top-prefix)))
|
||||
(define topsyntax-offset (length (prefix-stxs top-prefix)))
|
||||
(define lift-offset (prefix-num-lifts top-prefix))
|
||||
|
|
|
@ -34,6 +34,7 @@
|
|||
lang-info
|
||||
#t
|
||||
empty
|
||||
empty
|
||||
empty))]))
|
||||
|
||||
(provide/contract
|
||||
|
|
|
@ -137,7 +137,7 @@
|
|||
(match mod-form
|
||||
[(struct mod (name srcname self-modidx prefix provides requires body syntax-bodies
|
||||
unexported max-let-depth dummy lang-info internal-context
|
||||
pre-submodules post-submodules))
|
||||
flags pre-submodules post-submodules))
|
||||
(define new-prefix prefix)
|
||||
; Cache all the mpi paths
|
||||
(for-each (match-lambda
|
||||
|
@ -154,7 +154,7 @@
|
|||
(begin (log-debug (format "[~S] lang-info : ~S" name lang-info)) ; XXX Seems to always be #f now
|
||||
(list (make-mod name srcname self-modidx new-prefix provides requires body empty
|
||||
unexported max-let-depth dummy lang-info internal-context
|
||||
empty empty)))
|
||||
empty empty empty)))
|
||||
(begin (log-debug (format "[~S] Dropping module @ ~S" name phase))
|
||||
empty))))]
|
||||
[else (error 'nodep-module "huh?: ~e" mod-form)]))
|
||||
|
|
|
@ -995,7 +995,7 @@
|
|||
(define (convert-module mod-form)
|
||||
(match mod-form
|
||||
[(struct mod (name srcname self-modidx prefix provides requires body syntax-bodies unexported
|
||||
max-let-depth dummy lang-info internal-context pre-submodules post-submodules))
|
||||
max-let-depth dummy lang-info internal-context flags pre-submodules post-submodules))
|
||||
(let* ([lookup-req (lambda (phase)
|
||||
(let ([a (assq phase requires)])
|
||||
(if a
|
||||
|
@ -1091,6 +1091,7 @@
|
|||
[l (cons lang-info l)] ; lang-info
|
||||
[l (cons (map convert-module post-submodules) l)]
|
||||
[l (cons (map convert-module pre-submodules) l)]
|
||||
[l (cons (if (memq 'phaseless flags) #t #f) l)]
|
||||
[l (cons self-modidx l)]
|
||||
[l (cons srcname l)]
|
||||
[l (cons (if (pair? name) (car name) name) l)]
|
||||
|
|
|
@ -251,7 +251,7 @@
|
|||
(define (read-module v)
|
||||
(match v
|
||||
[`(,submod-path
|
||||
,name ,srcname ,self-modidx
|
||||
,name ,srcname ,self-modidx ,phaseless?
|
||||
,pre-submods ,post-submods
|
||||
,lang-info ,functional? ,et-functional?
|
||||
,rename ,max-let-depth ,dummy
|
||||
|
@ -337,6 +337,7 @@
|
|||
dummy
|
||||
lang-info
|
||||
rename
|
||||
(if phaseless? '(phaseless) '())
|
||||
(map read-module pre-submods)
|
||||
(map read-module post-submods))]))]))
|
||||
(define (read-module-wrap v)
|
||||
|
|
|
@ -139,6 +139,7 @@
|
|||
[dummy toplevel?]
|
||||
[lang-info (or/c #f (vector/c module-path? symbol? any/c))]
|
||||
[internal-context (or/c #f #t stx? (vectorof stx?))]
|
||||
[flags (listof (or/c 'phaseless))]
|
||||
[pre-submodules (listof mod?)]
|
||||
[post-submodules (listof mod?)]))
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user