1#lang racket/base 2(require "../common/promise.rkt" 3 "../common/phase.rkt" 4 "../common/small-hash.rkt" 5 "../syntax/bulk-binding.rkt" 6 "../common/module-path.rkt" 7 "../expand/root-expand-context.rkt" 8 "../host/linklet.rkt" 9 "registry.rkt") 10 11(provide make-namespace 12 new-namespace 13 namespace? 14 current-namespace 15 namespace-module-registry 16 namespace-phase 17 namespace-0-phase 18 namespace-root-namespace 19 namespace-get-root-expand-ctx 20 namespace-set-root-expand-ctx! 21 namespace-self-mpi 22 namespace-self-mpi/no-top-level 23 namespace->namespace-at-phase 24 namespace->module 25 namespace-mpi 26 namespace-source-name 27 namespace-bulk-binding-registry 28 29 namespace-set-variable! 30 namespace-set-consistent! 31 namespace-unset-variable! 32 namespace-set-transformer! 33 namespace-unset-transformer! 34 namespace-get-variable 35 namespace-get-transformer 36 37 namespace-declaration-inspector 38 namespace-inspector 39 set-namespace-inspector! 40 41 namespace->instance 42 namespace-same-instance?) 43 44(module+ for-module 45 (provide (struct-out namespace) 46 (struct-out module-registry) 47 (struct-out definitions) 48 namespace->definitions)) 49 50(struct namespace (mpi ; module path index (that's already resolved); instance-specific for a module 51 source-name ; #f (top-level) or symbol or complete path; user-facing alternative to the mpi 52 root-expand-ctx ; delay of box of context for top-level expansion; set by module instantiation 53 phase ; phase (not phase level!) of this namespace 54 0-phase ; phase of module instance's phase-level 0 55 phase-to-namespace ; phase -> namespace for same module [shared for the same module instance] 56 phase-level-to-definitions ; phase-level -> definitions [shared for the same module instance] 57 module-registry ; module-registry of (resolved-module-path -> module) [shared among modules] 58 bulk-binding-registry ; (resolved-module-path -> bulk-provide) for resolving bulk bindings on unmarshal 59 submodule-declarations ; resolved-module-path -> module [shared during a module compilation] 60 root-namespace ; #f or namespace for #lang, #reader, and persistent instances [shared among modules] 61 declaration-inspector ; declaration-time inspector 62 [inspector #:mutable] ; instantiation-time inspector 63 available-module-instances ; phase -> list of module-instance [shared among modules] 64 module-instances) ; union resolved-module-path -> module-instance [shared among modules] 65 ;; ; 0-phase -> resolved-module-path -> module-instance 66 ;; ; where the first option is for cross phase persistent modules 67 #:authentic 68 #:property prop:custom-write 69 (lambda (ns port mode) 70 (write-string "#<namespace" port) 71 (define n (namespace-source-name ns)) 72 (when n 73 (fprintf port ":~a" (namespace->name ns))) 74 (define 0-phase (namespace-0-phase ns)) 75 (define phase-level (phase- (namespace-phase ns) 76 0-phase)) 77 (unless (zero-phase? phase-level) 78 (fprintf port ":~s" phase-level)) 79 (unless (zero-phase? 0-phase) 80 (fprintf port "~a~s" (if (positive? 0-phase) "+" "") 0-phase)) 81 (write-string ">" port))) 82 83(struct definitions (variables ; linklet instance 84 transformers) ; sym -> val 85 #:authentic) 86 87(define (make-namespace) 88 (new-namespace)) 89 90(define (new-namespace [share-from-ns #f] 91 #:root-expand-ctx [root-expand-ctx (make-root-expand-context 92 #:self-mpi top-level-module-path-index)] 93 #:register? [register? #t]) 94 (define phase (if share-from-ns 95 (namespace-phase share-from-ns) 96 0)) 97 (define ns 98 (namespace top-level-module-path-index 99 #f 100 (box root-expand-ctx) 101 phase 102 phase 103 (make-small-hasheqv) ; phase-to-namespace 104 (make-small-hasheqv) ; phase-level-to-definitions 105 (if share-from-ns 106 (namespace-module-registry share-from-ns) 107 (make-module-registry)) 108 (if share-from-ns 109 (namespace-bulk-binding-registry share-from-ns) 110 (make-bulk-binding-registry)) 111 (make-small-hasheq) ; submodule-declarations 112 (and share-from-ns 113 (or (namespace-root-namespace share-from-ns) 114 share-from-ns)) 115 #f ; no declaration-time inspector for a top-level namespace 116 (make-inspector (current-code-inspector)) 117 (if share-from-ns 118 (namespace-available-module-instances share-from-ns) 119 (make-hasheqv)) 120 (if share-from-ns 121 (namespace-module-instances share-from-ns) 122 (make-hasheqv)))) 123 (when register? 124 (small-hash-set! (namespace-phase-to-namespace ns) phase ns)) 125 ns) 126 127(define current-namespace (make-parameter (make-namespace) 128 (lambda (v) 129 (unless (namespace? v) 130 (raise-argument-error 'current-namespace 131 "namespace?" 132 v)) 133 v) 134 'current-namespace)) 135 136(define (namespace-get-root-expand-ctx ns) 137 (force (unbox (namespace-root-expand-ctx ns)))) 138 139(define (namespace-set-root-expand-ctx! ns root-ctx) 140 (set-box! (namespace-root-expand-ctx ns) root-ctx)) 141 142(define (namespace-self-mpi ns) 143 (root-expand-context-self-mpi (namespace-get-root-expand-ctx ns))) 144 145(define (namespace-self-mpi/no-top-level ns) 146 (define mpi (root-expand-context-self-mpi (namespace-get-root-expand-ctx ns))) 147 (if (and mpi (top-level-module-path-index? mpi)) 148 #f 149 mpi)) 150 151(define (namespace->module ns name) 152 (or (small-hash-ref (namespace-submodule-declarations ns) name #f) 153 (hash-ref (module-registry-declarations (namespace-module-registry ns)) name #f))) 154 155(define (namespace->namespace-at-phase ns phase) 156 (or (small-hash-ref (namespace-phase-to-namespace ns) phase #f) 157 (let ([p-ns (struct-copy namespace ns 158 [phase phase] 159 [root-namespace (or (namespace-root-namespace ns) 160 ns)])]) 161 (small-hash-set! (namespace-phase-to-namespace ns) phase p-ns) 162 p-ns))) 163 164(define (namespace->name ns) 165 (define n (namespace-source-name ns)) 166 (define s 167 (cond 168 [(not n) 'top-level] 169 [(symbol? n) (format "'~s" n)] 170 [else (string-append "\"" (path->string n) "\"")])) 171 (define r (resolved-module-path-name (module-path-index-resolve (namespace-mpi ns)))) 172 (if (pair? r) 173 (string-append "(submod " s " " (substring (format "~s" (cdr r)) 1)) 174 s)) 175 176(define (namespace->definitions ns phase-level) 177 (define d (small-hash-ref (namespace-phase-level-to-definitions ns) phase-level #f)) 178 (or d 179 (let () 180 (define p-ns (namespace->namespace-at-phase ns (phase+ (namespace-0-phase ns) 181 phase-level))) 182 (define d (definitions (make-instance (namespace->name p-ns) p-ns) (make-hasheq))) 183 (small-hash-set! (namespace-phase-level-to-definitions ns) phase-level d) 184 d))) 185 186(define (namespace-set-variable! ns phase-level name val [as-constant? #f]) 187 (define d (namespace->definitions ns phase-level)) 188 (instance-set-variable-value! (definitions-variables d) name val (and as-constant? 'constant))) 189 190(define (namespace-set-consistent! ns phase-level name val) 191 (define d (namespace->definitions ns phase-level)) 192 (instance-set-variable-value! (definitions-variables d) name val 'consistent)) 193 194(define (namespace-unset-variable! ns phase-level name) 195 (define d (namespace->definitions ns phase-level)) 196 (instance-unset-variable! (definitions-variables d) name)) 197 198(define (namespace-set-transformer! ns phase-level name val) 199 (define d (namespace->definitions ns (add1 phase-level))) 200 (hash-set! (definitions-transformers d) name val)) 201 202(define (namespace-unset-transformer! ns phase-level name) 203 (define d (namespace->definitions ns (add1 phase-level))) 204 (hash-remove! (definitions-transformers d) name)) 205 206(define (namespace-get-variable ns phase-level name fail-k) 207 (define d (namespace->definitions ns phase-level)) 208 (instance-variable-value (definitions-variables d) name fail-k)) 209 210(define (namespace-get-transformer ns phase-level name fail-k) 211 (define d (namespace->definitions ns (add1 phase-level))) 212 (hash-ref (definitions-transformers d) name fail-k)) 213 214(define (namespace->instance ns phase-shift) 215 (definitions-variables (namespace->definitions ns phase-shift))) 216 217(define (namespace-same-instance? a-ns b-ns) 218 (eq? (small-hash-ref (namespace-phase-level-to-definitions a-ns) 219 0 220 'no-a) 221 (small-hash-ref (namespace-phase-level-to-definitions b-ns) 222 0 223 'no-b))) 224