Apply All's rules for parentheses omission for :
This commit is contained in:
parent
7bb537fc82
commit
8e8df77fc4
|
@ -1,6 +1,7 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
|
|
||||||
(require (for-syntax racket/base syntax/parse unstable/sequence unstable/syntax
|
(require (for-syntax racket/base syntax/parse unstable/sequence unstable/syntax
|
||||||
|
"../private/parse-classes.rkt"
|
||||||
"../utils/disappeared-use.rkt"
|
"../utils/disappeared-use.rkt"
|
||||||
(only-in "../utils/tc-utils.rkt" tc-error/stx))
|
(only-in "../utils/tc-utils.rkt" tc-error/stx))
|
||||||
"../typecheck/internal-forms.rkt"
|
"../typecheck/internal-forms.rkt"
|
||||||
|
@ -28,14 +29,9 @@
|
||||||
[_
|
[_
|
||||||
#:when (eq? 'expression ctx)
|
#:when (eq? 'expression ctx)
|
||||||
(err stx "must be used in a definition context")]
|
(err stx "must be used in a definition context")]
|
||||||
[(: id (~and kw :) x ...)
|
[(: id (~and kw :) . more:omit-parens)
|
||||||
#:fail-unless (for/first ([i (in-syntax #'(x ...))]
|
|
||||||
#:when (identifier? i)
|
|
||||||
#:when (free-identifier=? i #'t:->))
|
|
||||||
i)
|
|
||||||
#f
|
|
||||||
(add-disappeared-use #'kw)
|
(add-disappeared-use #'kw)
|
||||||
(wrap stx #`(:-helper #,top-level? id (x ...)))]
|
(wrap stx #`(:-helper #,top-level? id more.type))]
|
||||||
[(: id : . more)
|
[(: id : . more)
|
||||||
(wrap stx #`(:-helper #,top-level? id . more))]
|
(wrap stx #`(:-helper #,top-level? id . more))]
|
||||||
[(: e ...) (wrap stx #`(:-helper #,top-level? e ...))]))
|
[(: e ...) (wrap stx #`(:-helper #,top-level? e ...))]))
|
||||||
|
|
|
@ -1,7 +1,11 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
|
|
||||||
(require syntax/parse)
|
(require syntax/parse
|
||||||
(provide star ddd ddd/bound)
|
"../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
|
(define-syntax-class star
|
||||||
#:description "*"
|
#:description "*"
|
||||||
|
@ -24,3 +28,15 @@
|
||||||
#:fail-unless (equal? "..." (substring (attribute s) 0 3)) "missing ..."
|
#:fail-unless (equal? "..." (substring (attribute s) 0 3)) "missing ..."
|
||||||
#:attr bound (datum->syntax #'i (string->symbol (substring (attribute s) 3)) #'i #'i))
|
#:attr bound (datum->syntax #'i (string->symbol (substring (attribute s) 3)) #'i #'i))
|
||||||
(pattern (~seq _:ddd bound:id)))
|
(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)])
|
(let* ([stx* (datum->syntax loc datum loc loc)])
|
||||||
(p stx*)))
|
(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)
|
(define (parse-literal-alls stx)
|
||||||
(syntax-parse 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 ...)))
|
(define vars-list (syntax->list #'(vars ...)))
|
||||||
(cons (if (attribute v)
|
(cons (if (attribute v)
|
||||||
(list vars-list #'v)
|
(list vars-list #'v)
|
||||||
|
@ -88,7 +77,7 @@
|
||||||
(define (parse-all-type stx)
|
(define (parse-all-type stx)
|
||||||
;(printf "parse-all-type: ~a \n" (syntax->datum stx))
|
;(printf "parse-all-type: ~a \n" (syntax->datum stx))
|
||||||
(syntax-parse 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)))
|
(when (check-duplicate-identifier (syntax->list #'(vars ... v)))
|
||||||
(tc-error "All: duplicate type variable or index"))
|
(tc-error "All: duplicate type variable or index"))
|
||||||
(let* ([vars (stx-map syntax-e #'(vars ...))]
|
(let* ([vars (stx-map syntax-e #'(vars ...))]
|
||||||
|
@ -96,7 +85,7 @@
|
||||||
(extend-indexes v
|
(extend-indexes v
|
||||||
(extend-tvars vars
|
(extend-tvars vars
|
||||||
(make-PolyDots (append vars (list v)) (parse-type #'t.type)))))]
|
(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 ...)))
|
(when (check-duplicate-identifier (syntax->list #'(vars ...)))
|
||||||
(tc-error "All: duplicate type variable"))
|
(tc-error "All: duplicate type variable"))
|
||||||
(let* ([vars (stx-map syntax-e #'(vars ...))])
|
(let* ([vars (stx-map syntax-e #'(vars ...))])
|
||||||
|
|
Loading…
Reference in New Issue
Block a user