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

fix tl-map parse & marshal

Browse Source 
original commit: 8ad8d5b7f7
This commit is contained in:
Matthew Flatt 2011-05-09 12:24:05 -06:00
parent ee407d6610
commit f17d94056f
2 changed files with 6 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/compiler/zo-marshal.rkt
View File

@ -978,13 +978,14 @@
num-all-params num-all-params
max-let-depth max-let-depth
(and tl-map (and tl-map
(if (tl-map . < . #x7FFFFFFF) (if (tl-map . <= . #xFFFFFFF)
;; Encode as a fixnum:
tl-map tl-map
;; Encode as an even-sized vector of 16-bit integers: ;; Encode as an even-sized vector of 16-bit integers:
(let ([len (* 2 (quotient (+ (integer-length tl-map) 31) 32))]) (let ([len (* 2 (quotient (+ (integer-length tl-map) 31) 32))])
(for/vector ([i (in-range len)]) (for/vector ([i (in-range len)])
(let ([s (* i 16)]) (let ([s (* i 16)])
(bitwise-bit-field tl-map s (+ s 16))))))) (bitwise-bit-field tl-map s (+ s 16)))))))
name name
l) l)
out))])) out))]))

4
collects/compiler/zo-parse.rkt
View File

@ -136,9 +136,9 @@
(and tl-map (and tl-map
(let* ([bits (if (exact-integer? tl-map) (let* ([bits (if (exact-integer? tl-map)
tl-map tl-map
(for/fold ([i 0]) ([v (in-list tl-map)] (for/fold ([i 0]) ([v (in-vector tl-map)]
[s (in-naturals)]) [s (in-naturals)])
(bitwise-ior i (arithmetic-shift v 16))))] (bitwise-ior i (arithmetic-shift v (* s 16)))))]
[len (integer-length bits)]) [len (integer-length bits)])
(list->set (list->set
(let loop ([bit 0]) (let loop ([bit 0])