Apply All's rules for parentheses omission for :

This commit is contained in:
Asumu Takikawa 2014-02-12 23:56:53 -05:00
parent 7bb537fc82
commit 8e8df77fc4
3 changed files with 24 additions and 23 deletions

View File

@ -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 ...))]))

View File

@ -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)))

View File

@ -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 ...))])