From e97bb74005ba4eece8c4a2f3e4ec3b586a981d0c Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 26 Feb 2013 14:14:52 -0700 Subject: [PATCH] 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: 899a3279c2f37665b623a34414dc9c421e4b531e --- collects/compiler/decompile.rkt | 3 ++- collects/compiler/demodularizer/merge.rkt | 2 +- collects/compiler/demodularizer/module.rkt | 1 + collects/compiler/demodularizer/nodep.rkt | 4 ++-- collects/compiler/zo-marshal.rkt | 3 ++- collects/compiler/zo-parse.rkt | 3 ++- collects/compiler/zo-structs.rkt | 1 + 7 files changed, 11 insertions(+), 6 deletions(-) diff --git a/collects/compiler/decompile.rkt b/collects/compiler/decompile.rkt index 6d5127cd50..33d314ebb1 100644 --- a/collects/compiler/decompile.rkt +++ b/collects/compiler/decompile.rkt @@ -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)] diff --git a/collects/compiler/demodularizer/merge.rkt b/collects/compiler/demodularizer/merge.rkt index f118e6b9e4..4ca7184e59 100644 --- a/collects/compiler/demodularizer/merge.rkt +++ b/collects/compiler/demodularizer/merge.rkt @@ -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)) diff --git a/collects/compiler/demodularizer/module.rkt b/collects/compiler/demodularizer/module.rkt index dca4498fec..1be8d31309 100644 --- a/collects/compiler/demodularizer/module.rkt +++ b/collects/compiler/demodularizer/module.rkt @@ -34,6 +34,7 @@ lang-info #t empty + empty empty))])) (provide/contract diff --git a/collects/compiler/demodularizer/nodep.rkt b/collects/compiler/demodularizer/nodep.rkt index f6c70e2bb1..16d705cfca 100644 --- a/collects/compiler/demodularizer/nodep.rkt +++ b/collects/compiler/demodularizer/nodep.rkt @@ -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)])) diff --git a/collects/compiler/zo-marshal.rkt b/collects/compiler/zo-marshal.rkt index e3333ba4ff..a8b787c08f 100644 --- a/collects/compiler/zo-marshal.rkt +++ b/collects/compiler/zo-marshal.rkt @@ -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)] diff --git a/collects/compiler/zo-parse.rkt b/collects/compiler/zo-parse.rkt index 162391bff4..4aaf58de45 100644 --- a/collects/compiler/zo-parse.rkt +++ b/collects/compiler/zo-parse.rkt @@ -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) diff --git a/collects/compiler/zo-structs.rkt b/collects/compiler/zo-structs.rkt index 4ca4395d18..78fa6e2de9 100644 --- a/collects/compiler/zo-structs.rkt +++ b/collects/compiler/zo-structs.rkt @@ -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?)]))