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

Shrink serialized type representations more.

Browse Source 
* Use helper functions to construct list types and simple function types.
  These are extremely common and their serialization is verbose.

* Split unions into numeric and non-numeric parts for serialization.
  Often numeric types have simple representations, and the union is
  polluted by one extra non-numeric type.

* Use the raw `sort` procedure to avoid keyword expansion
  NB: This doesn't affect zo size, only expanded code size.

Saves 300k on zo files in `math`.

original commit: 2a507c6881151541e367b0b6a159c086a0ecca7e
This commit is contained in:
Sam Tobin-Hochstadt 2013-09-11 14:23:35 -04:00
parent 7660c51532
commit faba3b4d8f
4 changed files with 33 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/env/init-envs.rkt vendored
View File

@ -8,13 +8,15 @@
"type-name-env.rkt"
"type-alias-env.rkt"
"mvar-env.rkt"
(rename-in racket/private/sort [sort raw-sort])
(rep type-rep object-rep filter-rep rep-utils free-variance)
(for-template (rep type-rep object-rep filter-rep)
(types union abbrev)
racket/shared racket/base)
racket/shared (except-in racket/base sort)
(rename-in racket/private/sort [sort raw-sort]))
(for-syntax syntax/parse racket/base)
(types abbrev)
racket/syntax racket/dict
(types abbrev union)
racket/syntax racket/dict racket/list
mzlib/pconvert racket/match)
(provide ;; convenience form for defining an initial environment
@ -28,7 +30,7 @@
tvariance-env-init-code
talias-env-init-code
env-init-code
mvar-env-init-code )
mvar-env-init-code)
(define-syntax (define-initial-env stx)
(syntax-parse stx
@ -45,11 +47,28 @@
(for-each (lambda (nm/ty) (register-type-if-undefined (car nm/ty) (cadr nm/ty))) initial-env))
(define (converter v basic sub)
(define (numeric? t) (match t [(Base: _ _ _ b) b] [(Value: (? number?)) #t] [_ #f]))
(define (split-union ts)
(define-values (nums others) (partition numeric? ts))
(cond [(or (null? nums) (null? others))
;; nothing interesting to do in this case
`(make-Union (,#'raw-sort (list ,@(map sub ts)) < Type-seq #f))]
[else
;; we do a little more work to hopefully save a bunch in serialization space
;; if we get a hit in the predefined-type-table
`(simple-Un ,(sub (apply Un nums)) ,(sub (apply Un others)))]))
(define (gen-constructor sym)
(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]
[(Union: elems) `(make-Union (sort (list ,@(map sub elems)) < #:key Type-seq))]
[(Mu: var (Union: (list (Value: '()) (Pair: elem-ty (F: var)))))
`(-lst ,(sub elem-ty))]
[(Mu: var (Union: (list (Pair: elem-ty (F: var)) (Value: '()))))
`(-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))]
[(Union: elems) (split-union elems)]
[(Base: n cnt pred _) (int-err "Base type not in predefined-type-table" n)]
[(Name: stx) `(make-Name (quote-syntax ,stx))]
[(fld: t acc mut) `(make-fld ,(sub t) (quote-syntax ,acc) ,mut)]

3
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt
View File

@ -383,7 +383,8 @@
(#%plain-module-begin ;; avoid top-level printing and config
(require typed-racket/types/numeric-tower typed-racket/env/type-name-env
typed-racket/env/global-env typed-racket/env/type-alias-env
typed-racket/types/type-table typed-racket/types/abbrev)
typed-racket/types/struct-table typed-racket/types/abbrev
(rename-in racket/private/sort [sort raw-sort]))
#,(env-init-code syntax-provide? provide-tbl def-tbl)
#,(talias-env-init-code)
#,(tname-env-init-code)

2
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/abbrev.rkt
View File

@ -83,7 +83,7 @@
(define -Listof (-poly (list-elem) (make-Listof list-elem)))
(define/decl -Boolean (Un (-val #t) (-val #f)))
(define/decl -Boolean (Un -False -True))
(define/decl -Undefined
(make-Base 'Undefined
#'(lambda (x) (equal? (letrec ([y y]) y) x)) ; initial value of letrec bindings

6
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/base-abbrev.rkt
View File

@ -33,6 +33,9 @@
(define/decl -Bottom (make-Union null))
(define/decl Err (make-Error))
(define/decl -False (make-Value #f))
(define/decl -True (make-Value #t))
;A Type that corresponds to the any contract for the
;return type of functions
(define/decl ManyUniv (make-AnyValues))
@ -191,6 +194,9 @@
[(_ dom (dty dbound) rng : filters)
(make-Function (list (make-arr* dom rng #:drest (cons dty 'dbound) #:filters filters)))]))
(define (simple-> doms rng)
(->* doms rng))
(define (->acc dom rng path)
(make-Function (list (make-arr* dom rng
#:filters (-FS (-not-filter (-val #f) 0 path)