suzanne.soy/typed-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Refactor provide handling to reduce code

Browse Source
This commit is contained in:
Asumu Takikawa 2015-09-09 12:50:32 -04:00
parent 2b2e87010a
commit 3d6418b8be
3 changed files with 18 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
typed-racket-lib/typed-racket/typecheck/def-export.rkt
View File

@ -1,13 +0,0 @@
#lang racket/base
(require
(for-syntax syntax/parse racket/base
"renamer.rkt"
"../utils/tc-utils.rkt"))
(provide def-export)
(define-syntax (def-export stx)
(syntax-parse stx
[(def-export export-id:identifier id:identifier cnt-id:identifier)
#'(define-syntax export-id (typed-renaming (syntax-property #'id 'not-free-identifier=? #t)
(syntax-property #'cnt-id 'not-free-identifier=? #t)))]))

12
typed-racket-lib/typed-racket/typecheck/provide-handling.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(require "../utils/utils.rkt"
"renamer.rkt"
racket/sequence syntax/id-table racket/dict racket/syntax
racket/struct-info racket/match syntax/parse
(only-in (private type-contract) include-extra-requires?)
@ -8,7 +9,7 @@
(typecheck renamer def-binding)
(utils tc-utils)
(for-syntax racket/base)
(for-template racket/base "def-export.rkt"))
(for-template racket/base))
(provide remove-provides provide? generate-prov)
@ -136,7 +137,8 @@
#,(if type-is-constructor?
#'(make-struct-info-self-ctor constr* info)
#'info)))
(def-export export-id protected-id protected-id))
(define-syntax export-id
(make-rename-transformer #'protected-id)))
#'export-id
(cons (list #'export-id internal-id)
(apply append constr-aliases aliases)))))
@ -154,7 +156,8 @@
#`(begin
(define-syntax (untyped-id stx)
(tc-error/stx stx "Macro ~a from typed module used in untyped code" 'untyped-id))
(def-export export-id id untyped-id))
(define-syntax export-id
(make-typed-renaming #'id #'untyped-id)))
new-id
(list (list #'export-id #'id)))))
@ -175,7 +178,8 @@
#`(begin definitions (provide untyped-id))
;; For the main module
#`(begin (define-syntax local-untyped-id (#,mk-redirect-id (quote-syntax untyped-id)))
(def-export export-id id local-untyped-id))
(define-syntax export-id
(make-typed-renaming #'id #'local-untyped-id)))
new-id
null)))

13
typed-racket-lib/typed-racket/typecheck/renamer.rkt
View File

@ -1,12 +1,19 @@
#lang racket/base
(require typed-racket/utils/tc-utils)
(require typed-racket/utils/tc-utils
(for-syntax syntax/parse racket/base))
(provide typed-renaming un-rename)
(provide make-typed-renaming un-rename)
;; a constructor for typed renamings that attach the required
;; 'not-free-identifier properties
(define (make-typed-renaming target alternate)
(typed-renaming (syntax-property target 'not-free-identifier=? #t)
(syntax-property alternate 'not-free-identifier=? #t)))
;; target : identifier
;; alternate : identifier
(define-struct typed-renaming (target alternate)
(struct typed-renaming (target alternate)
;; prevent the rename transformer from expanding in
;; module-begin context because the typed context flag
;; will not be set until the module-begin