From 4c6cf0731022f4cdc0931c3838c36932b9de9ff9 Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Sat, 31 May 2014 16:41:18 -0700 Subject: [PATCH] Add more abbreviations to init-envs. Make List: matcher require being a Type. original commit: e4e0ec483f954612184d83262aeddca7eb2639f0 --- .../typed-racket-lib/typed-racket/env/init-envs.rkt | 5 ++--- .../typed-racket-lib/typed-racket/types/match-expanders.rkt | 6 +++--- .../tests/typed-racket/unit-tests/init-env-tests.rkt | 3 +++ 3 files changed, 8 insertions(+), 6 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/env/init-envs.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/env/init-envs.rkt index f402567f..5e85f73f 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/env/init-envs.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/env/init-envs.rkt @@ -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?) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/match-expanders.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/match-expanders.rkt index 3a67d166..72eda3b3 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/match-expanders.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/match-expanders.rkt @@ -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). diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/init-env-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/init-env-tests.rkt index 39ca9b4f..0b78b5e8 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/init-env-tests.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/init-env-tests.rkt @@ -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))))) ) ))