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

Remove many uses of dict functions for performance

Browse Source
This commit is contained in:
Asumu Takikawa 2015-11-01 13:37:09 -05:00 committed by Andrew Kent
parent 3077af848b
commit e2be0382d1
17 changed files with 63 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
typed-racket-lib/typed-racket/base-env/signature-prims.rkt
View File

@ -14,7 +14,6 @@
"../private/syntax-properties.rkt"
(typecheck internal-forms)
syntax/id-table
racket/dict
racket/unit-exptime
(utils tc-utils))
(only-in racket/unit

1
typed-racket-lib/typed-racket/base-env/unit-prims.rkt
View File

@ -30,7 +30,6 @@
"../private/syntax-properties.rkt"
(typecheck internal-forms)
syntax/id-table
racket/dict
racket/unit-exptime
syntax/strip-context
(utils tc-utils)

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

@ -16,8 +16,9 @@
(for-syntax syntax/parse racket/base)
(types abbrev struct-table utils)
data/queue
racket/dict racket/list racket/set racket/promise
racket/match)
racket/dict racket/list racket/promise
racket/match
syntax/id-table)
(provide ;; convenience form for defining an initial environment
;; used by "base-special-env.rkt" and "base-contracted.rkt"
@ -411,7 +412,7 @@
(define (mvar-env-init-code mvar-env)
(make-init-code
(λ (f) (dict-map mvar-env f))
(λ (f) (free-id-table-map mvar-env f))
(lambda (id v) (and v #`(register-mutated-var #'#,id)))))
;; see 'finalize-signatures!' in 'env/signature-env.rkt',

7
typed-racket-lib/typed-racket/env/scoped-tvar-env.rkt vendored
View File

@ -6,8 +6,7 @@
(private syntax-properties)
syntax/parse
syntax/id-table
racket/match
racket/dict)
racket/match)
(provide register-scoped-tvars lookup-scoped-tvars
add-scoped-tvars lookup-scoped-tvar-layer)
@ -52,10 +51,10 @@
;; lookup-scoped-tvars: identifier -> (or/c #f tvar-annotation?)
;; Lookup an indentifier in the scoped tvar-mapping.
(define (lookup-scoped-tvars id)
(dict-ref tvar-mapping id #f))
(free-id-table-ref tvar-mapping id #f))
;; Register type variables for an indentifier in the scoped tvar-mapping.
;; register-scoped-tvars: identifier? tvar-annotation? -> void?
(define (register-scoped-tvars id tvars)
(dict-set! tvar-mapping id tvars))
(free-id-table-set! tvar-mapping id tvars))

4
typed-racket-lib/typed-racket/env/type-alias-env.rkt vendored
View File

@ -2,7 +2,7 @@
(require "../utils/utils.rkt"
"env-utils.rkt"
syntax/id-table racket/dict
syntax/id-table
(utils tc-utils)
(typecheck renamer)
racket/match)
@ -57,7 +57,7 @@
t]))
(define (resolve-type-aliases parse-type)
(for ([id (in-dict-keys the-mapping)])
(for ([id (in-list (free-id-table-keys the-mapping))])
(resolve-type-alias id parse-type)))
;; map over the-mapping, producing a list

19
typed-racket-lib/typed-racket/env/type-alias-helper.rkt vendored
View File

@ -9,7 +9,6 @@
(private parse-type)
(typecheck internal-forms)
(types resolve base-abbrev)
racket/dict
racket/list
racket/match
syntax/id-table
@ -39,7 +38,8 @@
;; Returns the components in topologically sorted order
(define (find-strongly-connected-type-aliases dep-map)
(define vertex-map (make-free-id-table))
(for ([(id adjacent) (in-dict dep-map)])
(for ([entry (in-list dep-map)])
(match-define (cons id adjacent) entry)
(free-id-table-set! vertex-map id (make-vertex id adjacent)))
(define components (tarjan vertex-map))
;; extract the identifiers out of the results since we
@ -111,7 +111,8 @@
;; recursive type aliases should be initialized.
(define-values (type-alias-dependency-map type-alias-class-map)
(for/lists (_1 _2)
([(name alias-info) (in-dict type-alias-map)])
([entry (in-list type-alias-map)])
(match-define (cons name alias-info) entry)
(define links-box (box null))
(define class-box (box null))
(define type
@ -143,7 +144,7 @@
(define (has-self-cycle? component [map type-alias-dependency-map])
(define id (car component))
(memf (λ (id2) (free-identifier=? id id2))
(dict-ref map id)))
(cdr (assoc id map))))
;; A singleton component can be either a self-cycle or a node that
;; that does not participate in cycles, so we disambiguate
@ -184,8 +185,8 @@
;; Actually register recursive type aliases
(define name-types
(for/list ([id (in-list recursive-aliases)])
(define record (dict-ref type-alias-map id))
(match-define (list _ args) record)
(define record (assoc id type-alias-map))
(match-define (list _ _ args) record)
(define name-type (make-Name id (length args) #f))
(register-resolved-type-alias id name-type)
;; The `(make-placeholder-type id)` expression is used to make sure
@ -207,7 +208,7 @@
;; in topologically sorted order, so we want to go through in the
;; reverse order of that to avoid unbound type aliases.
(for ([id (in-list acyclic-singletons)])
(define type-stx (car (dict-ref type-alias-map id)))
(define type-stx (cadr (assoc id type-alias-map)))
(register-resolved-type-alias id (parse-type type-stx)))
;; Clear the resolver cache of Name types from this block
@ -228,8 +229,8 @@
(define-values (names-to-refine types-to-refine tvarss)
(for/lists (_1 _2 _3)
([id (in-list (append other-recursive-aliases class-aliases))])
(define record (dict-ref type-alias-map id))
(match-define (list type-stx args) record)
(define record (assoc id type-alias-map))
(match-define (list _ type-stx args) record)
(define type
;; make sure to reject the type if it uses polymorphic
;; recursion (see resolve.rkt)

3
typed-racket-lib/typed-racket/infer/constraints.rkt
View File

@ -26,7 +26,8 @@
(define (insert cs var S T)
(match cs
[(struct cset (maps))
(make-cset (for/list ([(map dmap) (in-dict maps)])
(make-cset (for/list ([map-entry (in-list maps)])
(match-define (cons map dmap) map-entry)
(cons (hash-set map var (make-c S T))
dmap)))]))

11
typed-racket-lib/typed-racket/optimizer/float.rkt
View File

@ -1,7 +1,8 @@
#lang racket/base
(require syntax/parse racket/sequence racket/dict racket/flonum racket/promise
(require syntax/parse racket/sequence racket/flonum racket/promise
syntax/parse/experimental/specialize
syntax/id-table
(for-template racket/base racket/flonum racket/unsafe/ops racket/math)
"../utils/utils.rkt"
(utils tc-utils)
@ -17,7 +18,7 @@
(define binary-float-ops
(mk-float-tbl (list #'+ #'- #'* #'/ #'min #'max #'expt)))
(define binary-float-comps
(dict-set*
(free-id-table-set*
(mk-float-tbl (list #'= #'<= #'< #'> #'>=))
;; not a comparison, but takes 2 floats and does not return a float,
;; unlike binary-float-ops
@ -25,7 +26,7 @@
#'make-flrectangular #'unsafe-make-flrectangular))
(define unary-float-ops
(dict-set
(free-id-table-set
(mk-float-tbl (list #'abs #'sin #'cos #'tan #'asin #'acos #'atan #'log #'exp
#'sqrt #'round #'floor #'ceiling #'truncate))
#'magnitude #'unsafe-flabs))
@ -46,9 +47,9 @@
(define-syntax-class (float-op tbl)
#:commit
(pattern i:id
#:when (dict-ref tbl #'i #f)
#:when (free-id-table-ref tbl #'i #f)
#:with unsafe (begin (add-disappeared-use #'i)
(dict-ref tbl #'i))))
(free-id-table-ref tbl #'i))))
(define-syntax-class/specialize float-expr (subtyped-expr -Flonum))
(define-syntax-class/specialize single-float-expr (subtyped-expr -SingleFlonum))

4
typed-racket-lib/typed-racket/optimizer/numeric-utils.rkt
View File

@ -1,6 +1,6 @@
#lang racket/base
(require syntax/parse racket/dict syntax/id-table
(require syntax/parse syntax/id-table
(for-template racket/base racket/flonum racket/fixnum racket/unsafe/ops)
"../utils/utils.rkt"
(types numeric-tower)
@ -31,7 +31,7 @@
(define-syntax-class arith-op
(pattern
op:id
#:when (dict-ref arith-ops #'op (lambda () #f))))
#:when (free-id-table-ref arith-ops #'op (lambda () #f))))
;; limited to operation that actually perform arithmeric
;; so, no comparisons, or coercions, or constructors (make-rectangular), accessors, etc.
(define arith-ops

12
typed-racket-lib/typed-racket/optimizer/unboxed-tables.rkt
View File

@ -1,6 +1,6 @@
#lang racket/base
(require syntax/id-table syntax/parse racket/dict
(require syntax/id-table syntax/parse
"../utils/utils.rkt"
(utils tc-utils))
@ -15,13 +15,13 @@
(define unboxed-vars-table (make-free-id-table))
(define (add-unboxed-var! orig-binding real-binding imag-binding)
(dict-set! unboxed-vars-table orig-binding
(list real-binding imag-binding orig-binding)))
(free-id-table-set! unboxed-vars-table orig-binding
(list real-binding imag-binding orig-binding)))
(define-syntax-class unboxed-var
#:attributes (real-binding imag-binding)
(pattern v:id
#:with unboxed-info (dict-ref unboxed-vars-table #'v #f)
#:with unboxed-info (free-id-table-ref unboxed-vars-table #'v #f)
#:when (syntax->datum #'unboxed-info)
#:with (real-binding imag-binding orig-binding) #'unboxed-info
;; we need to introduce both the binding and the use at the same time
@ -38,12 +38,12 @@
(define unboxed-funs-table (make-free-id-table))
(define (add-unboxed-fun! fun-name unboxed-args)
(dict-set! unboxed-funs-table fun-name unboxed-args))
(free-id-table-set! unboxed-funs-table fun-name unboxed-args))
(define-syntax-class unboxed-fun
#:attributes ((unboxed 1) unboxed-info)
(pattern op:id
#:do [(define unboxed-args (dict-ref unboxed-funs-table #'op #f))]
#:do [(define unboxed-args (free-id-table-ref unboxed-funs-table #'op #f))]
#:when unboxed-args
#:with ((unboxed ...) (boxed ...))
(list

4
typed-racket-lib/typed-racket/optimizer/utils.rkt
View File

@ -1,7 +1,7 @@
#lang racket/base
(require racket/match racket/sequence
racket/dict syntax/id-table racket/syntax syntax/stx
syntax/id-table racket/syntax syntax/stx
syntax/parse
syntax/parse/experimental/specialize
racket/promise
@ -47,7 +47,7 @@
(define (mk-unsafe-tbl generic safe-pattern unsafe-pattern)
(for/fold ([h (make-immutable-free-id-table)]) ([g (in-list generic)])
(let ([f (format-id g safe-pattern g)] [u (format-id g unsafe-pattern g)])
(dict-set (dict-set h g u) f u))))
(free-id-table-set (free-id-table-set h g u) f u))))
;; unlike their safe counterparts, unsafe binary operators can only take 2 arguments
;; this works on operations that are (A A -> A)

3
typed-racket-lib/typed-racket/private/type-contract.rkt
View File

@ -14,7 +14,6 @@
(private parse-type syntax-properties)
racket/match racket/syntax racket/list
racket/format
racket/dict racket/set
syntax/flatten-begin
(only-in (types abbrev) -Bottom -Boolean)
(static-contracts instantiate optimize structures combinators constraints)
@ -620,7 +619,7 @@
(unit/sc imports-specs exports-specs init-depends-ids (map t->sc rngs))])]
[(Struct: nm par (list (fld: flds acc-ids mut?) ...) proc poly? pred?)
(cond
[(dict-ref recursive-values nm #f)]
[(hash-ref recursive-values nm #f)]
[proc (fail #:reason "procedural structs are not supported")]
[poly?
(define nm* (generate-temporary #'n*))

3
typed-racket-lib/typed-racket/static-contracts/constraints.rkt
View File

@ -86,8 +86,7 @@
(display open port)
(fprintf port "kind-max")
(display " " port)
(display (for/list ([(id _) (in-free-id-table variables)]) (syntax-e id))
port)
(display (map syntax-e (free-id-table-keys variables)) port)
(display " " port)
(recur max port)
(display close port))])

10
typed-racket-lib/typed-racket/typecheck/provide-handling.rkt
View File

@ -2,7 +2,7 @@
(require "../utils/utils.rkt"
"renamer.rkt"
racket/sequence syntax/id-table racket/dict racket/syntax
racket/sequence syntax/id-table racket/syntax
racket/struct-info racket/match syntax/parse
(only-in (private type-contract) include-extra-requires?)
(private syntax-properties)
@ -73,11 +73,11 @@
(define new-id (freshen-id internal-id))
(cond
;; if it's already done, do nothing
[(dict-ref mapping internal-id
;; if it wasn't there, put it in, and skip this case
(λ () (dict-set! mapping internal-id new-id) #f))
[(free-id-table-ref mapping internal-id
;; if it wasn't there, put it in, and skip this case
(λ () (free-id-table-set! mapping internal-id new-id) #f))
=> mk-ignored-quad]
[(dict-ref defs internal-id #f)
[(free-id-table-ref defs internal-id #f)
=>
(match-lambda
[(def-binding _ ty)

17
typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt
View File

@ -1,7 +1,7 @@
#lang racket/unit
(require "../utils/utils.rkt"
racket/dict racket/list syntax/parse syntax/stx
racket/list syntax/parse syntax/stx
racket/match syntax/id-table racket/set
racket/sequence
(contract-req)
@ -33,9 +33,9 @@
#:attributes (mapping flag-mapping)
(pattern (#%expression :rebuild-let*))
(pattern (let-values ([(new-id) e:cl-rhs]) body:rebuild-let*)
#:attr mapping (dict-set (attribute body.mapping) #'e.i #'new-id)
#:attr mapping (free-id-table-set (attribute body.mapping) #'e.i #'new-id)
#:attr flag-mapping (if (attribute e.cond)
(dict-set (attribute body.flag-mapping) #'e.i #'e.cond)
(free-id-table-set (attribute body.flag-mapping) #'e.i #'e.cond)
(attribute body.flag-mapping)))
(pattern body:expr
#:attr mapping (make-immutable-free-id-table)
@ -162,17 +162,17 @@
(define arg-types
(for/list ([a (in-list arg-list)])
(get-type a #:default (lambda ()
(define id (dict-ref aux-table a #f))
(define id (free-id-table-ref aux-table a #f))
(if id
(get-type id #:default Univ)
Univ)))))
;; new-arg-types: Listof[Listof[Type?]]
(define new-arg-types
(if (= 0 (dict-count flag-table))
(if (= 0 (free-id-table-count flag-table))
(list arg-types)
(apply append
(for/list ([(k v) (in-dict flag-table)])
(for/list ([(k v) (in-free-id-table flag-table)])
(list
(for/list ([i (in-list arg-list)]
[t (in-list arg-types)])
@ -203,7 +203,8 @@
(define-values (aux-table flag-table)
(syntax-parse body
[(b:rebuild-let*) (values (attribute b.mapping) (attribute b.flag-mapping))]
[_ (values #hash() #hash())]))
[_ (values (make-immutable-free-id-table)
(make-immutable-free-id-table))]))
(define arg-list (formals-positional formals))
(define rest-id (formals-rest formals))
@ -218,7 +219,7 @@
[_ #f]))
(cond
[(and (> (dict-count aux-table) 0) (not rest-id))
[(and (> (free-id-table-count aux-table) 0) (not rest-id))
(tc/opt-lambda-clause arg-list body aux-table flag-table)]
[else
(define arg-types (get-types arg-list #:default (lambda () #f)))

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

@ -2,7 +2,7 @@
(require (rename-in "../utils/utils.rkt" [infer r:infer])
racket/syntax syntax/parse syntax/stx syntax/id-table
racket/list racket/dict racket/match racket/sequence
racket/list racket/match racket/sequence
(prefix-in c: (contract-req))
(rep core-rep type-rep values-rep)
(types utils abbrev type-table struct-table resolve)
@ -150,7 +150,7 @@
[(v:typed-id^ ...)
(define top-level? (eq? (syntax-local-context) 'top-level))
(for ([var (in-list vars)])
(when (dict-has-key? unann-defs var)
(when (free-id-table-ref unann-defs var #f)
(free-id-table-remove! unann-defs var))
(finish-register-type var top-level?))
(stx-map make-def-binding #'(v ...) (attribute v.type))]
@ -398,7 +398,7 @@
[(plain-stx-binding? def) other-def]
[(plain-stx-binding? other-def) def]
[else (int-err "Two conflicting definitions: ~a ~a" def other-def)]))
(dict-update h (binding-name def) merge-def-bindings #f)))
(free-id-table-update h (binding-name def) merge-def-bindings #f)))
(do-time "computed def-tbl")
;; check that all parsed apps are sensible
(check-registered-apps!)
@ -430,10 +430,10 @@
(let loop ([f f])
(syntax-parse f
[i:id
(values (dict-update h #'i (lambda (tail) (cons #'i tail)) '())
(values (free-id-table-update h #'i (lambda (tail) (cons #'i tail)) '())
extra)]
[((~datum rename) in out)
(values (dict-update h #'in (lambda (tail) (cons #'out tail)) '())
(values (free-id-table-update h #'in (lambda (tail) (cons #'out tail)) '())
extra)]
[((~datum for-meta) 0 fm)
(values (loop #'fm) extra)]

9
typed-racket-lib/typed-racket/types/struct-table.rkt
View File

@ -1,6 +1,6 @@
#lang racket/base
(require racket/dict syntax/id-table racket/match
(require syntax/id-table racket/match
racket/syntax
"../utils/utils.rkt"
(prefix-in c: (contract-req))
@ -11,18 +11,19 @@
(define struct-fn-table (make-free-id-table))
(define (add-struct-fn! id pe mut?) (dict-set! struct-fn-table id (list pe mut?)))
(define (add-struct-fn! id pe mut?)
(free-id-table-set! struct-fn-table id (list pe mut?)))
(define-values (struct-accessor? struct-mutator?)
(let ()
(define ((mk mut?) id)
(cond [(dict-ref struct-fn-table id #f)
(cond [(free-id-table-ref struct-fn-table id #f)
=> (match-lambda [(list pe m) (and (eq? m mut?) pe)] [_ #f])]
[else #f]))
(values (mk #f) (mk #t))))
(define (struct-fn-idx id)
(match (dict-ref struct-fn-table id #f)
(match (free-id-table-ref struct-fn-table id #f)
[(list (StructPE: _ idx) _) idx]
[_ (int-err (format "no struct fn table entry for ~a" (syntax->datum id)))]))