1#lang racket/base 2(require "../compile/serialize-property.rkt" 3 "full-binding.rkt" 4 "../common/phase+space.rkt") 5 6(provide make-module-binding 7 module-binding-update 8 module-binding? 9 10 module-binding-module 11 module-binding-phase 12 module-binding-sym 13 module-binding-nominal-module 14 module-binding-nominal-phase+space 15 module-binding-nominal-sym 16 module-binding-nominal-require-phase+space-shift 17 module-binding-extra-inspector 18 module-binding-extra-nominal-bindings 19 20 deserialize-full-module-binding 21 deserialize-simple-module-binding) 22 23;; ---------------------------------------- 24 25(define (make-module-binding module phase sym 26 #:nominal-module [nominal-module module] 27 #:nominal-phase+space [nominal-phase+space phase] 28 #:nominal-sym [nominal-sym sym] 29 #:nominal-require-phase+space-shift [nominal-require-phase+space-shift 0] 30 #:frame-id [frame-id #f] 31 #:free=id [free=id #f] 32 #:extra-inspector [extra-inspector #f] 33 #:extra-nominal-bindings [extra-nominal-bindings null]) 34 (cond 35 [(or frame-id 36 free=id 37 extra-inspector 38 (not (and (eqv? nominal-phase+space phase) 39 (eq? nominal-sym sym) 40 (eqv? nominal-require-phase+space-shift 0) 41 (null? extra-nominal-bindings)))) 42 (full-module-binding frame-id 43 free=id 44 module phase sym 45 nominal-module nominal-phase+space nominal-sym 46 nominal-require-phase+space-shift 47 extra-inspector 48 extra-nominal-bindings)] 49 [else 50 (simple-module-binding module phase sym nominal-module)])) 51 52(define (module-binding-update b 53 #:module [module (module-binding-module b)] 54 #:phase [phase (module-binding-phase b)] 55 #:sym [sym (module-binding-sym b)] 56 #:nominal-module [nominal-module (module-binding-nominal-module b)] 57 #:nominal-phase+space [nominal-phase+space (module-binding-nominal-phase+space b)] 58 #:nominal-sym [nominal-sym (module-binding-nominal-sym b)] 59 #:nominal-require-phase+space-shift [nominal-require-phase+space-shift (module-binding-nominal-require-phase+space-shift b)] 60 #:frame-id [frame-id (binding-frame-id b)] 61 #:free=id [free=id (binding-free=id b)] 62 #:extra-inspector [extra-inspector (module-binding-extra-inspector b)] 63 #:extra-nominal-bindings [extra-nominal-bindings (module-binding-extra-nominal-bindings b)]) 64 (make-module-binding module phase sym 65 #:nominal-module nominal-module 66 #:nominal-phase+space nominal-phase+space 67 #:nominal-sym nominal-sym 68 #:nominal-require-phase+space-shift nominal-require-phase+space-shift 69 #:frame-id frame-id 70 #:free=id free=id 71 #:extra-inspector extra-inspector 72 #:extra-nominal-bindings extra-nominal-bindings)) 73 74(define (module-binding? b) 75 ;; must not overlap with `local-binding?` 76 (or (simple-module-binding? b) 77 (full-module-binding? b))) 78 79;; See `identifier-binding` docs for information about these fields: 80(struct full-module-binding full-binding (module phase sym 81 nominal-module nominal-phase+space nominal-sym 82 nominal-require-phase+space-shift 83 extra-inspector ; preserves access to protected definitions 84 extra-nominal-bindings) 85 #:authentic 86 #:transparent 87 #:property prop:serialize 88 (lambda (b ser-push! state) 89 ;; Dropping the frame id may simplify the representation: 90 (define simplified-b 91 (if (full-binding-frame-id b) 92 (module-binding-update b #:frame-id #f) 93 b)) 94 (cond 95 [(full-module-binding? simplified-b) 96 (ser-push! 'tag '#:module-binding) 97 (ser-push! (full-module-binding-module b)) 98 (ser-push! (full-module-binding-sym b)) 99 (ser-push! (full-module-binding-phase b)) 100 (ser-push! (full-module-binding-nominal-module b)) 101 (ser-push! (full-module-binding-nominal-phase+space b)) 102 (ser-push! (full-module-binding-nominal-sym b)) 103 (ser-push! (full-module-binding-nominal-require-phase+space-shift b)) 104 (ser-push! (full-binding-free=id b)) 105 (if (full-module-binding-extra-inspector b) 106 (ser-push! 'tag '#:inspector) 107 (ser-push! #f)) 108 (ser-push! (full-module-binding-extra-nominal-bindings b))] 109 [else 110 (ser-push! simplified-b)]))) 111 112(struct simple-module-binding (module phase sym nominal-module) 113 #:authentic 114 #:transparent 115 #:property prop:serialize 116 (lambda (b ser-push! state) 117 (ser-push! 'tag '#:simple-module-binding) 118 (ser-push! (simple-module-binding-module b)) 119 (ser-push! (simple-module-binding-sym b)) 120 (ser-push! (simple-module-binding-phase b)) 121 (ser-push! (simple-module-binding-nominal-module b)))) 122 123(define (deserialize-full-module-binding module sym phase 124 nominal-module 125 nominal-phase+space 126 nominal-sym 127 nominal-require-phase+space-shift 128 free=id 129 extra-inspector 130 extra-nominal-bindings) 131 (make-module-binding module phase sym 132 #:nominal-module nominal-module 133 #:nominal-phase+space (intern-phase+space nominal-phase+space) 134 #:nominal-sym nominal-sym 135 #:nominal-require-phase+space-shift (intern-phase+space-shift nominal-require-phase+space-shift) 136 #:free=id free=id 137 #:extra-inspector extra-inspector 138 #:extra-nominal-bindings extra-nominal-bindings)) 139 140(define (deserialize-simple-module-binding module sym phase nominal-module) 141 (simple-module-binding module phase sym nominal-module)) 142 143;; ---------------------------------------- 144 145(define (module-binding-module b) 146 (if (simple-module-binding? b) 147 (simple-module-binding-module b) 148 (full-module-binding-module b))) 149 150(define (module-binding-phase b) 151 (if (simple-module-binding? b) 152 (simple-module-binding-phase b) 153 (full-module-binding-phase b))) 154 155(define (module-binding-sym b) 156 (if (simple-module-binding? b) 157 (simple-module-binding-sym b) 158 (full-module-binding-sym b))) 159 160(define (module-binding-nominal-module b) 161 (if (simple-module-binding? b) 162 (simple-module-binding-nominal-module b) 163 (full-module-binding-nominal-module b))) 164 165(define (module-binding-nominal-phase+space b) 166 (if (simple-module-binding? b) 167 (simple-module-binding-phase b) 168 (full-module-binding-nominal-phase+space b))) 169 170(define (module-binding-nominal-sym b) 171 (if (simple-module-binding? b) 172 (simple-module-binding-sym b) 173 (full-module-binding-nominal-sym b))) 174 175(define (module-binding-nominal-require-phase+space-shift b) 176 (if (simple-module-binding? b) 177 0 178 (full-module-binding-nominal-require-phase+space-shift b))) 179 180(define (module-binding-extra-inspector b) 181 (if (simple-module-binding? b) 182 #f 183 (full-module-binding-extra-inspector b))) 184 185(define (module-binding-extra-nominal-bindings b) 186 (if (simple-module-binding? b) 187 null 188 (full-module-binding-extra-nominal-bindings b))) 189