suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Simplify printing for list type special cases

Browse Source
This commit is contained in:
Asumu Takikawa 2014-02-04 16:26:27 -05:00
parent f801fe0736
commit 755998ba82
2 changed files with 12 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/match-expanders.rkt
View File

@ -19,7 +19,12 @@
(lambda (stx) (lambda (stx)
(syntax-parse stx (syntax-parse stx
[(_ elem-pat (~optional var-pat #:defaults ([var-pat #'var]))) [(_ elem-pat (~optional var-pat #:defaults ([var-pat #'var])))
(syntax/loc stx (Mu: var-pat (Union: (list (Value: '()) (Pair: elem-pat (F: var-pat))))))]))) ;; Note: in practice it's unlikely that the second pattern will ever come up
;; because the sequence number for '() will be low and the union will
;; be sorted by sequence number. As a paranoid precaution, however,
;; we will match against both patterns here.
(syntax/loc stx (or (Mu: var-pat (Union: (list (Value: '()) (Pair: elem-pat (F: var-pat)))))
(Mu: var-pat (Union: (list (Pair: elem-pat (F: var-pat)) (Value: '()))))))])))
(define-match-expander List: (define-match-expander List:
(lambda (stx) (lambda (stx)
@ -40,4 +45,6 @@
(lambda (stx) (lambda (stx)
(syntax-parse stx (syntax-parse stx
[(_ elem-pat) [(_ elem-pat)
#'(Mu: var (Union: (list (Value: '()) (MPair: elem-pat (F: var)))))]))) ;; see note above
#'(or (Mu: var (Union: (list (Value: '()) (MPair: elem-pat (F: var)))))
(Mu: var (Union: (list (MPair: elem-pat (F: var)) (Value: '())))))])))

9
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt
View File

@ -8,6 +8,7 @@
(prefix-in s: srfi/1) (prefix-in s: srfi/1)
(path-up "rep/type-rep.rkt" "rep/filter-rep.rkt" "rep/object-rep.rkt" (path-up "rep/type-rep.rkt" "rep/filter-rep.rkt" "rep/object-rep.rkt"
"rep/rep-utils.rkt" "types/subtype.rkt" "rep/rep-utils.rkt" "types/subtype.rkt"
"types/match-expanders.rkt"
"utils/utils.rkt" "utils/utils.rkt"
"utils/tc-utils.rkt") "utils/tc-utils.rkt")
(for-syntax racket/base syntax/parse)) (for-syntax racket/base syntax/parse))
@ -324,13 +325,9 @@
[(App: rator rands stx) [(App: rator rands stx)
(list* (type->sexp rator) (map type->sexp rands))] (list* (type->sexp rator) (map type->sexp rands))]
;; special cases for lists ;; special cases for lists
[(Mu: var (Union: (list (Value: '()) (Pair: elem-ty (F: var))))) [(Listof: elem-ty)
`(Listof ,(t->s elem-ty))] `(Listof ,(t->s elem-ty))]
[(Mu: var (Union: (list (Pair: elem-ty (F: var)) (Value: '())))) [(MListof: elem-ty)
`(Listof ,(t->s elem-ty))]
[(Mu: var (Union: (list (Value: '()) (MPair: elem-ty (F: var)))))
`(MListof ,(t->s elem-ty))]
[(Mu: var (Union: (list (MPair: elem-ty (F: var)) (Value: '()))))
`(MListof ,(t->s elem-ty))] `(MListof ,(t->s elem-ty))]
;; format as a string to preserve reader abbreviations and primitive ;; format as a string to preserve reader abbreviations and primitive
;; values like characters (when `display`ed) ;; values like characters (when `display`ed)