From 3d6418b8be888aeba858ba1835c9dbf7bb5a8d37 Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Wed, 9 Sep 2015 12:50:32 -0400 Subject: [PATCH] Refactor provide handling to reduce code --- .../typed-racket/typecheck/def-export.rkt | 13 ------------- .../typed-racket/typecheck/provide-handling.rkt | 12 ++++++++---- typed-racket-lib/typed-racket/typecheck/renamer.rkt | 13 ++++++++++--- 3 files changed, 18 insertions(+), 20 deletions(-) delete mode 100644 typed-racket-lib/typed-racket/typecheck/def-export.rkt diff --git a/typed-racket-lib/typed-racket/typecheck/def-export.rkt b/typed-racket-lib/typed-racket/typecheck/def-export.rkt deleted file mode 100644 index 02511d58..00000000 --- a/typed-racket-lib/typed-racket/typecheck/def-export.rkt +++ /dev/null @@ -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)))])) diff --git a/typed-racket-lib/typed-racket/typecheck/provide-handling.rkt b/typed-racket-lib/typed-racket/typecheck/provide-handling.rkt index 889cab88..7d9436ff 100644 --- a/typed-racket-lib/typed-racket/typecheck/provide-handling.rkt +++ b/typed-racket-lib/typed-racket/typecheck/provide-handling.rkt @@ -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))) diff --git a/typed-racket-lib/typed-racket/typecheck/renamer.rkt b/typed-racket-lib/typed-racket/typecheck/renamer.rkt index 157620d4..ba479cde 100644 --- a/typed-racket-lib/typed-racket/typecheck/renamer.rkt +++ b/typed-racket-lib/typed-racket/typecheck/renamer.rkt @@ -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