From faba3b4d8fd963a0484aee353ea0b81770c17121 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Wed, 11 Sep 2013 14:23:35 -0400 Subject: [PATCH] Shrink serialized type representations more. * 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 --- .../typed-racket/env/init-envs.rkt | 29 +++++++++++++++---- .../typed-racket/typecheck/tc-toplevel.rkt | 3 +- .../typed-racket/types/abbrev.rkt | 2 +- .../typed-racket/types/base-abbrev.rkt | 6 ++++ 4 files changed, 33 insertions(+), 7 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 da17e83c..e1174661 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 @@ -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)] diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt index b7f4a96d..8dd7303a 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt @@ -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) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/abbrev.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/abbrev.rkt index 1902be29..b2cb27b2 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/abbrev.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/abbrev.rkt @@ -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 diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/base-abbrev.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/base-abbrev.rkt index 4588c465..470625bd 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/base-abbrev.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/base-abbrev.rkt @@ -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)