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

Add omit-define-syntaxes to secondary form of define-type-alias.

Browse Source 
Closes PR 14505.
This commit is contained in:
Eric Dobson 2014-07-06 17:06:10 -07:00
parent 4aef86ce4f
commit 64a653696c
2 changed files with 28 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt
View File

@ -519,21 +519,28 @@ This file defines two sorts of primitives. All of them are provided into any mod
(syntax/loc stx
((plambda: (A ...) (bn ...) . body) e ...))]))
;; Syntax classes for `define-type-alias`
(begin-for-syntax
(define-syntax-class type-alias-rest
#:literals (All)
#:attributes (args)
(pattern (All (arg:id ...) rest)
#:with args #'(arg ...))
(pattern type:expr #:with args #'#f)))
(define-syntax (define-type-alias stx)
(define-syntax-class all-vars
#:literals (All)
#:attributes (poly-vars)
(pattern (All (arg:id ...) rest)
#:with poly-vars #'(arg ...))
(pattern type:expr #:with poly-vars #'#f))
(define-splicing-syntax-class omit-define-syntaxes
#:attributes (omit)
(pattern #:omit-define-syntaxes #:attr omit #t)
(pattern (~seq) #:attr omit #f))
(define-splicing-syntax-class type-alias-full
#:attributes (tname type poly-vars omit)
(pattern (~seq tname:id (~and type:expr :all-vars) :omit-define-syntaxes))
(pattern (~seq (tname:id arg:id ...) body:expr :omit-define-syntaxes)
#:with poly-vars #'(arg ...)
#:with type (syntax/loc #'body (All (arg ...) body))))
(syntax-parse stx
[(_ tname:id rest:type-alias-rest
(~optional (~and omit #:omit-define-syntaxes)
#:defaults
([omit #f])))
[(_ :type-alias-full)
(define/with-syntax stx-err-fun
#'(lambda (stx)
(raise-syntax-error
@ -546,10 +553,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
(ignore #'(define-syntax tname stx-err-fun))
#'(begin))
#,(internal (syntax/loc stx
(define-type-alias-internal tname rest
rest.args))))]
[(_ (tname:id args:id ...) rest)
(syntax/loc stx (define-type-alias tname (All (args ...) rest)))]))
(define-type-alias-internal tname type poly-vars))))]))
(define-syntax (with-handlers: stx)
(syntax-parse stx

7
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/type-alias-omit-define-syntaxes.rkt Normal file
View File

@ -0,0 +1,7 @@
#lang typed/racket
(define-type (Type1 t) t #:omit-define-syntaxes)
(define-type (Type1* t) t)
(define-type Type2 (All (t) t) #:omit-define-syntaxes)
(define-type Type2* (All (t) t))
(define-type Type3 Symbol #:omit-define-syntaxes)
(define-type Type3* Symbol)