ctx.hl.rkt (4771B)
1 #lang hyper-literate typed/racket/base #:no-require-lang 2 @(require scribble-enhanced/doc 3 racket/require 4 hyper-literate 5 (for-label racket/format 6 racket/list 7 (subtract-in racket/contract typed/racket/base) 8 phc-toolkit 9 phc-toolkit/untyped-only 10 remember 11 (subtract-in typed/racket/base type-expander) 12 type-expander)) 13 @doc-lib-setup 14 15 @title[#:style manual-doc-style 16 #:tag "ctx" 17 #:tag-prefix "phc-adt/ctx" 18 ]{Implementation of ADTs: syntax scopes} 19 20 @(chunks-toc-prefix 21 '("(lib phc-adt/scribblings/phc-adt-implementation.scrbl)" 22 "phc-adt/ctx")) 23 24 25 Due to TR bug #399, structs declared by a macro do not work 26 if the macro itself is declared in a separate module. This 27 seems to be due to the extra scope added as pieces of syntax 28 cross the module boundary. There is unfortunately no 29 equivalent to @racket[syntax-local-introduce] that could be 30 used to flip this module scope. 31 32 We therefore require the user to call 33 @racket[(set-adt-context)] at the beginning of the file. 34 This macro stores the scopes present where it was called in 35 a mutable for-syntax variable: 36 37 @chunk[<adt-context> 38 (define-for-syntax mutable-adt-context (box #f))] 39 40 These scopes are later used as the context for struct 41 identifiers: 42 43 @chunk[<ctx-introduce> 44 (define-for-syntax (ctx-introduce id) 45 (unless (unbox mutable-adt-context) 46 (raise-syntax-error 'adt 47 (~a "(adt-init) must be called in the" 48 " file (or REPL). ") id)) 49 (struct-identifier-fresh-introducer 50 (replace-context (syntax-local-introduce 51 (unbox mutable-adt-context)) 52 id)))] 53 54 The @racket[(set-adt-context)] macro should be called at 55 the beginning of the file or typed in the REPL before using 56 structures. It simply stores the syntax used to call it in 57 @racket[mutable-adt-context]. 58 59 @chunk[<adt-context> 60 (define-for-syntax (set-adt-context ctx) 61 (set-box! mutable-adt-context ctx)) 62 63 (define-syntax (set-adt-context-macro stx) 64 (syntax-case stx () 65 [(_ ctx) 66 (begin (set-box! mutable-adt-context #'ctx) 67 #'(void))]))] 68 69 For debugging purposes, we provide a macro and a for-syntax 70 function which show the current ADT context (i.e. the list of 71 scopes). 72 73 @chunk[<adt-context> 74 (define-for-syntax (debug-show-adt-context) 75 (displayln 76 (hash-ref (syntax-debug-info (unbox mutable-adt-context)) 77 'context))) 78 (define-syntax (debug-show-adt-context-macro stx) 79 (debug-show-adt-context) 80 #'(define dummy (void)))] 81 82 The @tc[struct] identifiers are introduced in a fresh scope 83 @note{Due to TR bug #399, this feature is temporarily 84 disabled, until the bug is fixed.}, so that they do not 85 conflict with any other user value. 86 87 @chunk[<fresh-introducer> 88 (define-for-syntax struct-identifier-fresh-introducer 89 (λ (x) x) #;(make-syntax-introducer))] 90 91 We provide two ways of checking whether @racket[set-adt-context] was called: 92 @racket[(adt-context?)] returns a boolean, while @racket[(check-adt-context)] 93 raises an error when @racket[set-adt-context] has not been called. 94 95 @chunk[<adt-context?> 96 (define-for-syntax (adt-context?) 97 (true? (unbox mutable-adt-context)))] 98 99 @chunk[<check-adt-context> 100 (define-for-syntax (check-adt-context) 101 (unless (adt-context?) 102 (raise-syntax-error 'phc-adt 103 (string-append 104 "adt-init must be called before" 105 " using the features in phc-adt"))))] 106 107 @section{Putting it all together} 108 109 @chunk[<*> 110 (begin 111 (require (for-syntax racket/base 112 racket/syntax 113 racket/set 114 racket/list 115 racket/format 116 phc-toolkit/untyped 117 syntax/strip-context) 118 racket/require-syntax 119 type-expander 120 phc-toolkit 121 remember)) 122 123 (provide (for-syntax set-adt-context) 124 set-adt-context-macro 125 debug-show-adt-context-macro) 126 127 (begin-for-syntax 128 (provide debug-show-adt-context 129 adt-context? 130 check-adt-context 131 ctx-introduce)) 132 133 <adt-context> 134 <fresh-introducer> 135 <ctx-introduce> 136 <adt-context?> 137 <check-adt-context>]