From 07f57aac9b3f52552397bd53597de192ff62fbbc Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Thu, 1 Jul 2010 20:07:01 -0600 Subject: [PATCH] Added uses of unstable/struct --- collects/compiler/zo-parse.rkt | 5 +++-- collects/racket/private/serialize.rkt | 9 +++++---- collects/syntax/private/stxparse/minimatch.rkt | 2 +- collects/syntax/private/template-runtime.rkt | 5 +++-- collects/syntax/strip-context.rkt | 5 +++-- collects/syntax/template.rkt | 7 ++++--- collects/typed-scheme/rep/rep-utils.rkt | 4 ++-- 7 files changed, 21 insertions(+), 16 deletions(-) diff --git a/collects/compiler/zo-parse.rkt b/collects/compiler/zo-parse.rkt index c7f6670fc3..46ad7d584f 100644 --- a/collects/compiler/zo-parse.rkt +++ b/collects/compiler/zo-parse.rkt @@ -2,6 +2,7 @@ (require mzlib/etc scheme/match scheme/list + unstable/struct compiler/zo-structs) (provide zo-parse) @@ -529,7 +530,7 @@ (apply make-prefab-struct k - (map loop (cdr (vector->list (struct->vector v)))))))] + (map loop (struct->list v)))))] [else (add-wrap v)])) ;; Decode sub-elements that have their own wraps: (let-values ([(v counter) (if (exact-integer? (car v)) @@ -551,7 +552,7 @@ (apply make-prefab-struct k - (map loop (cdr (vector->list (struct->vector v)))))))] + (map loop (struct->list v)))))] [else (add-wrap v)])))))) (define (decode-wraps cp w) diff --git a/collects/racket/private/serialize.rkt b/collects/racket/private/serialize.rkt index 176683d9b4..01f09ada69 100644 --- a/collects/racket/private/serialize.rkt +++ b/collects/racket/private/serialize.rkt @@ -1,5 +1,6 @@ (module serialize racket/base (require syntax/modcollapse + unstable/struct "serialize-structs.rkt") ;; This module implements the core serializer. The syntactic @@ -212,7 +213,7 @@ (for-each loop (vector->list ((serialize-info-vectorizer info) v))))] [(and (struct? v) (prefab-struct-key v)) - (for-each loop (cdr (vector->list (struct->vector v))))] + (for-each loop (struct->list v))] [(or (string? v) (bytes? v) (path-for-some-system? v)) @@ -229,7 +230,7 @@ [(box? v) (loop (unbox v))] [(date? v) - (for-each loop (cdr (vector->list (struct->vector v))))] + (for-each loop (struct->list v))] [(hash? v) (hash-for-each v (lambda (k v) (loop k) @@ -282,7 +283,7 @@ (cons 'f (cons k - (map (serial #t) (cdr (vector->list (struct->vector v)))))))] + (map (serial #t) (struct->list v)))))] [(or (string? v) (bytes? v)) (cons 'u v)] @@ -316,7 +317,7 @@ (loop v))))))] [(date? v) (cons 'date - (map (serial #t) (cdr (vector->list (struct->vector v)))))] + (map (serial #t) (struct->list v)))] [(arity-at-least? v) (cons 'arity-at-least ((serial #t) (arity-at-least-value v)))] diff --git a/collects/syntax/private/stxparse/minimatch.rkt b/collects/syntax/private/stxparse/minimatch.rkt index 9ebfe9165c..91ab958810 100644 --- a/collects/syntax/private/stxparse/minimatch.rkt +++ b/collects/syntax/private/stxparse/minimatch.rkt @@ -73,7 +73,7 @@ [(p ...) (struct->list (syntax-e #'s))]) #'(let ([xkey (prefab-struct-key x)]) (if (equal? xkey 'key) - (let ([xps (cdr (vector->list (struct->vector x)))]) + (let ([xps (struct->list x)]) (match-p xps (list p ...) success failure)) failure)))])) diff --git a/collects/syntax/private/template-runtime.rkt b/collects/syntax/private/template-runtime.rkt index 5270257b45..e300642dc1 100644 --- a/collects/syntax/private/template-runtime.rkt +++ b/collects/syntax/private/template-runtime.rkt @@ -1,5 +1,6 @@ #lang scheme/base -(require "../stx.ss") +(require "../stx.ss" + unstable/struct) (provide template-map-apply) @@ -82,5 +83,5 @@ stx (loop (prefab-fields tmap) (cdr data) - (cdr (vector->list (struct->vector (syntax-e stx))))))] + (struct->list (syntax-e stx))))] [else (error "template-map-apply fallthrough")]))) diff --git a/collects/syntax/strip-context.rkt b/collects/syntax/strip-context.rkt index 20d71747ef..a316cad8b3 100644 --- a/collects/syntax/strip-context.rkt +++ b/collects/syntax/strip-context.rkt @@ -1,4 +1,5 @@ -#lang scheme/base +#lang racket/base +(require unstable/struct) (provide strip-context replace-context) @@ -23,5 +24,5 @@ => (lambda (k) (apply make-prefab-struct k - (replace-context ctx (cdr (vector->list (struct->vector e))))))] + (replace-context ctx (struct->list e))))] [else e])) diff --git a/collects/syntax/template.rkt b/collects/syntax/template.rkt index 43ec7f398b..2cb5eae99b 100644 --- a/collects/syntax/template.rkt +++ b/collects/syntax/template.rkt @@ -1,5 +1,6 @@ #lang scheme/base (require "stx.ss" + unstable/struct (for-template scheme/base "private/template-runtime.ss")) @@ -71,7 +72,7 @@ [_ (let ([k (prefab-struct-key (syntax-e tmpl))]) (and k - (let ([as (loop (cdr (vector->list (struct->vector (syntax-e tmpl))) in-ellipses?))]) + (let ([as (loop (struct->list (syntax-e tmpl)) in-ellipses?)]) (and (or as (not const-leaf?)) (make-prefab k as)) #f)))]))) @@ -115,7 +116,7 @@ [(prefab? tmap) (cons (s->d template) (loop (prefab-fields tmap) - (cdr (vector->list (struct->vector (syntax-e template))))))] + (struct->list (syntax-e template))))] [else (error "template-map-collect fall-through")]))) (define (group-ellipses tmap template) @@ -164,7 +165,7 @@ make-prefab-struct (prefab-key tmap) (loop (prefab-fields tmap) - (cdr (vector->list (struct->vector (syntax-e template)))))))] + (struct->list (syntax-e template)))))] [else (error "group-ellipses fall-through")]))) (define (transform-template template-stx diff --git a/collects/typed-scheme/rep/rep-utils.rkt b/collects/typed-scheme/rep/rep-utils.rkt index 36d5426415..a52d800e6d 100644 --- a/collects/typed-scheme/rep/rep-utils.rkt +++ b/collects/typed-scheme/rep/rep-utils.rkt @@ -6,7 +6,7 @@ syntax/boundmap "free-variance.rkt" "interning.rkt" - unstable/syntax unstable/match + unstable/syntax unstable/match unstable/struct mzlib/etc scheme/contract (for-syntax @@ -255,7 +255,7 @@ (define (replace-field val new-val idx) (define-values (type skipped) (struct-info val)) (define maker (struct-type-make-constructor type)) - (define flds (cdr (vector->list (struct->vector val)))) + (define flds (struct->list val)) (apply maker (list-set flds idx new-val))) (define (replace-syntax rep stx)