Add more abbreviations to init-envs.

Make List: matcher require being a Type.

original commit: e4e0ec483f954612184d83262aeddca7eb2639f0
This commit is contained in:
Eric Dobson 2014-05-31 16:41:18 -07:00
parent c1c7f04f3c
commit 4c6cf07310
3 changed files with 8 additions and 6 deletions

View File

@ -60,9 +60,7 @@
(string->symbol (string-append "make-" (substring (symbol->string sym) 7))))
(match v
[(? Rep? (app (lambda (v) (hash-ref predefined-type-table (Rep-seq v) #f)) (? values id))) id]
[(Mu: var (Union: (list (Value: '()) (Pair: elem-ty (F: var)))))
`(-lst ,(sub elem-ty))]
[(Mu: var (Union: (list (Pair: elem-ty (F: var)) (Value: '()))))
[(Listof: elem-ty)
`(-lst ,(sub elem-ty))]
[(Function: (list (arr: dom (Values: (list (Result: t (FilterSet: (Top:) (Top:)) (Empty:)))) #f #f '())))
`(simple-> (list ,@(map sub dom)) ,(sub t))]
@ -76,6 +74,7 @@
(Path: pth (list 0 0)))))
#f #f '())))
`(->acc (list ,@(map sub dom)) ,(sub t) ,(sub pth))]
[(Result: t (FilterSet: (Top:) (Top:)) (Empty:)) `(-result ,(sub t))]
[(Union: elems) (split-union elems)]
[(Base: n cnt pred _) (int-err "Base type not in predefined-type-table" n)]
[(Name: stx deps args struct?)

View File

@ -3,7 +3,7 @@
(require "../utils/utils.rkt")
(require (rep type-rep)
(require (rep type-rep rep-utils)
racket/match
(types resolve)
(contract-req)
@ -28,9 +28,9 @@
(lambda (stx)
(syntax-parse stx
[(_ elem-pats)
#'(app untuple (? values elem-pats) (Value: '()))]
#'(? Type? (app untuple (? values elem-pats) (Value: '())))]
[(_ elem-pats #:tail tail-pat)
#'(app untuple (? values elem-pats) tail-pat)])))
#'(? Type? (app untuple (? values elem-pats) tail-pat))])))
;; Type/c -> (or/c (values/c #f #f) (values/c (listof Type/c) Type/c)))
;; Returns the prefix of types that are consed on to the last type (a non finite-pair type).

View File

@ -30,5 +30,8 @@
(check-equal?
(convert (->acc (list (-lst -String)) -String (list -car)))
'(->acc (list (-lst -String)) -String `(,-car)))
(check-equal?
(convert (-mu x (-lst* Univ (-box x))))
'(make-Mu 'x (-lst* Univ (make-Box (make-F 'x)))))
)
))