Apply All's rules for parentheses omission for :
This commit is contained in:
parent
7bb537fc82
commit
8e8df77fc4
|
@ -1,6 +1,7 @@
|
|||
#lang racket/base
|
||||
|
||||
(require (for-syntax racket/base syntax/parse unstable/sequence unstable/syntax
|
||||
"../private/parse-classes.rkt"
|
||||
"../utils/disappeared-use.rkt"
|
||||
(only-in "../utils/tc-utils.rkt" tc-error/stx))
|
||||
"../typecheck/internal-forms.rkt"
|
||||
|
@ -28,14 +29,9 @@
|
|||
[_
|
||||
#:when (eq? 'expression ctx)
|
||||
(err stx "must be used in a definition context")]
|
||||
[(: id (~and kw :) x ...)
|
||||
#:fail-unless (for/first ([i (in-syntax #'(x ...))]
|
||||
#:when (identifier? i)
|
||||
#:when (free-identifier=? i #'t:->))
|
||||
i)
|
||||
#f
|
||||
[(: id (~and kw :) . more:omit-parens)
|
||||
(add-disappeared-use #'kw)
|
||||
(wrap stx #`(:-helper #,top-level? id (x ...)))]
|
||||
(wrap stx #`(:-helper #,top-level? id more.type))]
|
||||
[(: id : . more)
|
||||
(wrap stx #`(:-helper #,top-level? id . more))]
|
||||
[(: e ...) (wrap stx #`(:-helper #,top-level? e ...))]))
|
||||
|
|
|
@ -1,7 +1,11 @@
|
|||
#lang racket/base
|
||||
|
||||
(require syntax/parse)
|
||||
(provide star ddd ddd/bound)
|
||||
(require syntax/parse
|
||||
"../utils/literal-syntax-class.rkt"
|
||||
(for-label "../base-env/base-types-extra.rkt"))
|
||||
(provide star ddd ddd/bound omit-parens)
|
||||
|
||||
(define-literal-syntax-class #:for-label ->)
|
||||
|
||||
(define-syntax-class star
|
||||
#:description "*"
|
||||
|
@ -24,3 +28,15 @@
|
|||
#:fail-unless (equal? "..." (substring (attribute s) 0 3)) "missing ..."
|
||||
#:attr bound (datum->syntax #'i (string->symbol (substring (attribute s) 3)) #'i #'i))
|
||||
(pattern (~seq _:ddd bound:id)))
|
||||
|
||||
;; The body of a Forall type or type annotation after the second :
|
||||
;; Allows one level of parentheses to be omitted for infix -> types
|
||||
(define-syntax-class omit-parens
|
||||
#:attributes (type)
|
||||
;; FIXME: the error message when a failure is triggered by this case
|
||||
;; is not very good, but I have been unsuccessful with ~fail
|
||||
;; or with #:fail-when. -- AT
|
||||
(pattern (~and (:->^ x y ~! z ...) (~fail))
|
||||
#:with type 'dummy)
|
||||
(pattern (~and type ((~or (~once :->^) (~not :->^)) ...)))
|
||||
(pattern (type)))
|
||||
|
|
|
@ -61,20 +61,9 @@
|
|||
(let* ([stx* (datum->syntax loc datum loc loc)])
|
||||
(p stx*)))
|
||||
|
||||
;; The body of a Forall type
|
||||
(define-syntax-class all-body
|
||||
#:attributes (type)
|
||||
;; FIXME: the error message when a failure is triggered by this case
|
||||
;; is not very good, but I have been unsuccessful with ~fail
|
||||
;; or with #:fail-when. -- AT
|
||||
(pattern (~and (:->^ x y ~! z ...) (~fail))
|
||||
#:with type 'dummy)
|
||||
(pattern (~and type ((~or (~once :->^) (~not :->^)) ...)))
|
||||
(pattern (type)))
|
||||
|
||||
(define (parse-literal-alls stx)
|
||||
(syntax-parse stx
|
||||
[(:All^ (~or (vars:id ... v:id dd:ddd) (vars:id ...)) . t:all-body)
|
||||
[(:All^ (~or (vars:id ... v:id dd:ddd) (vars:id ...)) . t:omit-parens)
|
||||
(define vars-list (syntax->list #'(vars ...)))
|
||||
(cons (if (attribute v)
|
||||
(list vars-list #'v)
|
||||
|
@ -88,7 +77,7 @@
|
|||
(define (parse-all-type stx)
|
||||
;(printf "parse-all-type: ~a \n" (syntax->datum stx))
|
||||
(syntax-parse stx
|
||||
[(:All^ (vars:id ... v:id dd:ddd) . t:all-body)
|
||||
[(:All^ (vars:id ... v:id dd:ddd) . t:omit-parens)
|
||||
(when (check-duplicate-identifier (syntax->list #'(vars ... v)))
|
||||
(tc-error "All: duplicate type variable or index"))
|
||||
(let* ([vars (stx-map syntax-e #'(vars ...))]
|
||||
|
@ -96,7 +85,7 @@
|
|||
(extend-indexes v
|
||||
(extend-tvars vars
|
||||
(make-PolyDots (append vars (list v)) (parse-type #'t.type)))))]
|
||||
[(:All^ (vars:id ...) . t:all-body)
|
||||
[(:All^ (vars:id ...) . t:omit-parens)
|
||||
(when (check-duplicate-identifier (syntax->list #'(vars ...)))
|
||||
(tc-error "All: duplicate type variable"))
|
||||
(let* ([vars (stx-map syntax-e #'(vars ...))])
|
||||
|
|
Loading…
Reference in New Issue
Block a user