3ba909f3c6
Using a tree representation enables sharing to avoid a quadratic-sized
compiled form and intermediate quadtraic-time/space representations
for a program like this one, where there are N calls each with an
average of N/2 live variables:
(define vars
(let loop ([i 10000])
(cond
[(zero? i) '()]
[else (cons (gensym) (loop (sub1 i)))])))
(time
(begin
(compile
`(lambda ,vars
,@(map (lambda (v) `(,v)) vars)))
(void)))
Keeping the variables in tree form (since they're already collected
that way) and memoizing reduces on the tree allows sharing to be
constructed and preserved. The tree approach persists even to the
runtime mask for live variables.
original commit: 35942accb14d1226189605548a9e05ca95e3f0b6
116 lines
4.3 KiB
Scheme
116 lines
4.3 KiB
Scheme
;;; types.ss
|
|
;;; Copyright 1984-2017 Cisco Systems, Inc.
|
|
;;;
|
|
;;; Licensed under the Apache License, Version 2.0 (the "License");
|
|
;;; you may not use this file except in compliance with the License.
|
|
;;; You may obtain a copy of the License at
|
|
;;;
|
|
;;; http://www.apache.org/licenses/LICENSE-2.0
|
|
;;;
|
|
;;; Unless required by applicable law or agreed to in writing, software
|
|
;;; distributed under the License is distributed on an "AS IS" BASIS,
|
|
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
;;; See the License for the specific language governing permissions and
|
|
;;; limitations under the License.
|
|
|
|
;;; annotation fields are mutable so that the reader can handle
|
|
;;; cycles involving annotated data
|
|
(define-record-type annotation
|
|
(fields (mutable expression) (mutable source) (mutable stripped) (mutable flags))
|
|
(nongenerative #{annotation bc6o9md359cw9ds5-b})
|
|
(sealed #t)
|
|
(protocol
|
|
(lambda (new)
|
|
(case-lambda
|
|
[(expression source stripped) (new expression source stripped (fxlogor (constant annotation-debug) (constant annotation-profile)))]
|
|
[(expression source stripped flags) (new expression source stripped flags)]))))
|
|
|
|
(define-record-type source
|
|
(fields (immutable sfd) (immutable bfp) (immutable efp))
|
|
(nongenerative #{source gbwctw0mahurbuiegp7uq3-0}))
|
|
|
|
(define-record-type source-2d
|
|
(parent source)
|
|
(fields (immutable line) (immutable column))
|
|
(nongenerative #{source-2d gbwctw0mahurbuiegp7uq3-2})
|
|
(sealed #t))
|
|
|
|
(define-record-type source-file-descriptor
|
|
(fields (immutable name) (immutable length) (immutable crc))
|
|
(nongenerative #{source-file-descriptor bdbv4s3hk5ja7rql-a})
|
|
(sealed #t))
|
|
|
|
(define-record-type syntax-object
|
|
(fields (immutable expression) (immutable wrap))
|
|
(nongenerative #{syntax-object bdehkef6almh6ypb-a})
|
|
(sealed #t))
|
|
|
|
(define-syntax syntax-object-rtd
|
|
(identifier-syntax (type-descriptor syntax-object)))
|
|
|
|
(define-record-type code-info
|
|
(fields
|
|
(immutable src)
|
|
(immutable sexpr)
|
|
(immutable free) ; vector of elts, elt = symbols #f
|
|
(immutable live) ; vector of pairs each mapping a symbol or pair of symbols to an index
|
|
(immutable rpis)) ; vector of rp-infos
|
|
(nongenerative #{code-info gr886ae7iuw4wt9ft4vxym-2})
|
|
(sealed #t))
|
|
|
|
(define-record-type rp-info
|
|
(fields
|
|
(immutable offset)
|
|
(immutable src)
|
|
(immutable sexpr)
|
|
(immutable mask)) ; an integer or (cons size tree)
|
|
(nongenerative #{rp-info gr886ae7iuw4wt9ft4vxym-1})
|
|
(sealed #t))
|
|
|
|
(define cpsymbol '#{closure cedozdf6uqtmcjjt-2})
|
|
|
|
; block profiling record
|
|
(define-record-type rblock
|
|
(fields (immutable srecs) (immutable op))
|
|
(nongenerative #{rblock bt50nyec0orotoeb-0})
|
|
(sealed #t))
|
|
|
|
(define-record-type static-closure-info
|
|
(nongenerative #{static-closure-info cv84l52b3ghjjuqa-0})
|
|
(sealed #t)
|
|
(fields
|
|
(mutable raw-closure-count)
|
|
(mutable raw-free-var-count)
|
|
(mutable wk-borrowed-count)
|
|
(mutable wk-empty-count)
|
|
(mutable wk-single-count)
|
|
(mutable wk-pair-count)
|
|
(mutable wk-vector-count)
|
|
(mutable wk-vector-free-var-count)
|
|
(mutable nwk-empty-count)
|
|
(mutable nwk-closure-count)
|
|
(mutable nwk-closure-free-var-count))
|
|
(protocol
|
|
(lambda (new)
|
|
(lambda ()
|
|
(new 0 0 0 0 0 0 0 0 0 0 0)))))
|
|
|
|
#;(define-record-type profile-counter
|
|
(fields (mutable uptr count)) ; sadly, can't specify the type
|
|
(nongenerative #{profile-counter b5vnnom9h4o4uny0-2})
|
|
(sealed #t)
|
|
(protocol (lambda (new) (lambda () (new 0)))))
|
|
(let-syntax ([a (lambda (x)
|
|
(syntax-case x ()
|
|
[(_ profile-counter? make-profile-counter profile-counter-count profile-counter-count-set!)
|
|
(let ([rtd ($make-record-type #!base-rtd #f
|
|
'#{profile-counter b5vnnom9h4o4uny0-2}
|
|
'((mutable uptr count))
|
|
#t #f)])
|
|
#`(begin
|
|
(define make-profile-counter (record-constructor '#,rtd))
|
|
(define profile-counter? (record-predicate '#,rtd))
|
|
(define profile-counter-count (record-accessor '#,rtd 0))
|
|
(define profile-counter-count-set! (record-mutator '#,rtd 0))))]))])
|
|
(a profile-counter? make-profile-counter profile-counter-count profile-counter-count-set!))
|