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

Supporting byte-regexps and boxes in tester. Improving speed/allocation of parser and noting places where we could do better. Updating struct contracts in code and docs.

Browse Source 
svn: r18262

original commit: 1eea5163cc
This commit is contained in:
Jay McCarthy 2010-02-22 15:47:57 +00:00
commit e3c66c9d47
3 changed files with 43 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
collects/compiler/zo-parse.ss
View File

@ -72,6 +72,7 @@
(values (cdr v) #t))])
(match v
[`(,i ,tv . ,sv)
; XXX Why not leave them as vectors and change the contract?
(make-prefix i (vector->list tv) (vector->list sv))])))
(define (read-unclosed-procedure v)
@ -150,11 +151,13 @@
(define (read-sequence v)
(make-seq v))
; XXX Allocates unnessary list
(define (read-define-values v)
(make-def-values
(cdr (vector->list v))
(vector-ref v 0)))
; XXX Allocates unnessary list
(define (read-define-syntaxes mk v)
(mk (list-tail (vector->list v) 4)
(vector-ref v 0)
@ -463,7 +466,10 @@
n)))]))
(define (read-compact-svector port n)
(list->vector (reverse (for/list ([i (in-range n)]) (read-compact-number port)))))
(define v (make-vector n))
(for ([i (in-range n)])
(vector-set! v (sub1 (- n i)) (read-compact-number port)))
v)
(define (read-marshalled type port)
(let* ([type (if (number? type) (int->type type) type)]
@ -665,7 +671,7 @@
[nominal-path
(make-simple-nominal-path nominal-path)]))
; XXX Matthew, I'm ashamed
; XXX Weird test copied from C code. Matthew?
(define (nom_mod_p p)
(and (pair? p) (not (pair? (cdr p))) (not (symbol? (cdr p)))))
@ -799,25 +805,34 @@
[(true) #t]
[(null) null]
[(void) (void)]
[(vector) (let* ([n (read-compact-number cp)]
[(vector)
; XXX We should provide build-immutable-vector and write this as:
#;(build-immutable-vector (read-compact-number cp)
(lambda (i) (read-compact cp)))
; XXX Now it allocates an unnessary list AND vector
(let* ([n (read-compact-number cp)]
[lst (for/list ([i (in-range n)])
(read-compact cp))])
(vector->immutable-vector (list->vector lst)))]
[(list) (let* ([n (read-compact-number cp)])
(append
(for/list ([i (in-range n)])
(read-compact cp))
(read-compact cp)))]
[(list)
(let ([len (read-compact-number cp)])
(let loop ([i len])
(if (zero? i)
(read-compact cp)
(list* (read-compact cp)
(loop (sub1 i))))))]
[(prefab)
(let ([v (read-compact cp)])
(apply make-prefab-struct
(vector-ref v 0)
(cdr (vector->list v))))]
; XXX This is faster than apply+->list, but can we avoid allocating the vector?
(call-with-values (lambda () (vector->values v))
make-prefab-struct))]
[(hash-table)
; XXX Allocates an unnessary list (maybe use for/hash(eq))
(let ([eq (read-compact-number cp)]
[len (read-compact-number cp)])
((case eq
[(0) make-hasheq-placeholder]
; XXX One of these should be eqv
[(1) make-hash-placeholder]
[(2) make-hash-placeholder])
(for/list ([i (in-range len)])

2
collects/compiler/zo-structs.ss
View File

@ -166,7 +166,7 @@
(define-form-struct (imported-nominal-path nominal-path) ([value module-path-index?]
[import-phase exact-integer?]))
(define-form-struct (phased-nominal-path nominal-path) ([value module-path-index?]
[import-phase exact-integer?]
[import-phase (or/c false/c exact-integer?)]
[phase exact-integer?]))
(define-form-struct module-binding ())

13
collects/tests/compiler/zo-test.ss
View File

@ -124,6 +124,19 @@
(yield p "Unequal regexp" v1 v2))]
[_
(yield p "Not a regexp on right" v1 v2)])]
[(? byte-regexp?)
(match v2
[(? byte-regexp?)
(unless (bytes=? (object-name v1) (object-name v2))
(yield p "Unequal byte-regexp" v1 v2))]
[_
(yield p "Not a byte-regexp on right" v1 v2)])]
[(? box?)
(match v2
[(? box?)
(inner (list* 'unbox) (unbox v1) (unbox v2))]
[_
(yield p "Not a box on right" v1 v2)])]
[(? symbol?)
(match v2
[(? symbol?)