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

Added uses of unstable/struct

Browse Source
This commit is contained in:
Ryan Culpepper 2010-07-01 20:07:01 -06:00
parent df4e37fe08
commit 07f57aac9b
7 changed files with 21 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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)

9
collects/racket/private/serialize.rkt
View File

@ -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)))]

2
collects/syntax/private/stxparse/minimatch.rkt
View File

@ -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)))]))

5
collects/syntax/private/template-runtime.rkt
View File

@ -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")])))

5
collects/syntax/strip-context.rkt
View File

@ -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]))

7
collects/syntax/template.rkt
View File

@ -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

4
collects/typed-scheme/rep/rep-utils.rkt
View File

@ -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)