www

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

identifiers.rkt (1928B)


      1 #lang typed/racket
      2 
      3 (require (for-syntax racket/syntax))
      4 
      5 (define-syntax-rule (provide-id id)
      6   (begin
      7     (define-syntax (id stx)
      8       (raise-syntax-error 'id
      9                           (format "Type expander form “~a” cannot be used as an expression"
     10                                   'id)
     11                           stx))
     12     (provide id)))
     13 
     14 (define-syntax-rule (provide-ids id ...) (begin (provide-id id) ...))
     15 
     16 (provide-ids Let Letrec Λ ...* No-Expand)
     17 
     18 ;; Define a mutable implementation for new-:, circumvent the fact that
     19 ;; typed/racket wraps macros with a contract.
     20 ;;
     21 ;; Technique from:
     22 ;;
     23 ;; https://github.com/racket/typed-racket/issues/329#issuecomment-205060192
     24 
     25 (define-syntax (provide-mutable-id stx)
     26   (syntax-case stx ()
     27     [(_ short-id)
     28      (with-syntax ([id (format-id #'short-id "new-~a" #'short-id)]
     29                    [id-set-impl (format-id #'short-id
     30                                            "set-~a-impl!"
     31                                            #'short-id)])
     32        #'(begin
     33            (provide id id-set-impl)
     34            
     35            (define-for-syntax (id-impl-orig stx)
     36              (raise-syntax-error ':
     37                                  (format "Implementation for ~a was not loaded!"
     38                                          'short-id)
     39                                  stx))
     40            
     41            (define-for-syntax id-impl (box id-impl-orig))
     42 
     43            (define-syntax (id stx)
     44              ((unbox id-impl) stx))
     45            
     46            (define-syntax-rule (id-set-impl impl)
     47              (begin-for-syntax
     48                (when (eq? (unbox id-impl) id-impl-orig)
     49                  (set-box! id-impl impl))))))]))
     50 
     51 (define-syntax-rule (provide-mutable-ids id ...)
     52   (begin (provide-mutable-id id) ...))
     53 
     54 (provide-mutable-ids :
     55                      ;; The class-related IDs need to also work as types.
     56                      ;field
     57                      ;super-new
     58                      )