top-subscripts.rkt (2033B)
1 #lang racket/base 2 (require (only-in "template-subscripts.rkt" 3 derive 4 ellipsis-count/c) 5 phc-toolkit/untyped 6 (for-syntax racket/base 7 racket/syntax 8 syntax/stx 9 (only-in racket/base [... …]) 10 "subscripts.rkt")) 11 12 (provide (rename-out [top #%top])) 13 14 (define-syntax (top stx) 15 (define/with-syntax bound (stx-cdr stx)) 16 17 ;; find-subscript-binders detects the xᵢ pattern variables declared outside of 18 ;; the #'bound syntax, for which a corresponding yᵢ occurs within the #'bound 19 ;; syntax. Since #'bound should normally be a single identifier, this will in 20 ;; effect check whether #'bound is of the form yᵢ, and if so whether a 21 ;; corresponding pattern variable xᵢ is within scope. The ᵢ can be any 22 ;; subscript, as long as it is the same for xᵢ and yᵢ. 23 (define binders+info (find-subscript-binders #'bound)) 24 25 (if binders+info 26 (let () 27 (define/with-syntax [_bound 28 (binder …) 29 unique-at-runtime-ids 30 ellipsis-depth] 31 binders+info) 32 33 (define/with-syntax whole-form-id (generate-temporary 'whole-subtemplate)) 34 35 #'(let-values () 36 (define-values (whole-form-id) (quote-syntax #,this-syntax)) 37 (derive bound 38 (binder …) 39 unique-at-runtime-ids 40 ellipsis-depth 41 whole-form-id) 42 (let-values () 43 ;; check that all the binders for a given bound are compatible. 44 ((ellipsis-count/c ellipsis-depth) (list (attribute* binder) …)) 45 ;; actually call template or quasitemplate 46 bound))) 47 ;; If #'bound was not of the form yᵢ, or if we did not find a matching 48 ;; pattern variable xᵢ, we fall back to the original #%top implementation 49 (datum->syntax stx `(,#'#%top . ,#'bound))))