www

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README

override.rkt (1366B)

      1 #lang racket
      2 
      3 (require (for-syntax "exptime.rkt"
      4                      debug-scopes/named-scopes-sli-parameter))
      5 
      6 (define-for-syntax (use-site-context?)
      7   (not (bound-identifier=? (syntax-local-introduce #'here)
      8                            (syntax-local-identifier-as-binding
      9                             (syntax-local-introduce #'here)))))
     10 
     11 (provide (rename-out [-define-syntax define-syntax])
     12          (for-syntax
     13           (rename-out [-syntax-local-introduce syntax-local-introduce])))
     14 
     15 (define-syntax (-define-syntax stx)
     16   (syntax-case stx ()
     17     [(_ (name arg) . body) #'(define-syntax name
     18                                (named-transformer (name arg)
     19                                  . body))]
     20     [(_ name value) #'(define-syntax name value)]))
     21 
     22 (define-for-syntax (-syntax-local-introduce stx)
     23   (define /m (if (sli-scopes)
     24                  ((sli-scopes) stx 'flip)
     25                  (syntax-local-introduce stx)))
     26   (if (use-site-context?)
     27       (let* ([zero (datum->syntax #f 'zero)]
     28              [sli (syntax-local-introduce zero)]
     29              [sli-use (syntax-local-identifier-as-binding sli)]
     30              [+sli (make-syntax-delta-introducer sli zero)]
     31              [+sli-use (make-syntax-delta-introducer sli-use zero)]
     32              [use (+sli-use sli 'remove)]
     33              [+use (make-syntax-delta-introducer use zero)])
     34         (+use /m))
     35       /m))