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

Move struct->list to racket/struct.

Browse Source
This commit is contained in:
Vincent St-Amour 2015-08-19 13:46:00 -05:00
parent 13b6a98de6
commit 5ce75816c5
2 changed files with 29 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
racket/collects/racket/struct.rkt
View File

@ -5,4 +5,30 @@
[make-constructor-style-printer
(-> (-> any/c (or/c symbol? string?))
(-> any/c sequence?)
(-> any/c output-port? (or/c #t #f 0 1) void?))]))
(-> any/c output-port? (or/c #t #f 0 1) void?))])
struct->list)
(define dummy-value (box 'dummy))
;; struct->list : struct?
;; #:on-opaque (or/c 'error 'return-false 'skip)
;; -> (listof any/c)
(define (struct->list s
#:on-opaque [on-opaque 'error])
(define error-on-opaque? (eq? on-opaque 'error))
(let ([vec (struct->vector s dummy-value)])
;; go through vector backwards, don't traverse 0 (struct name)
(let loop ([index (sub1 (vector-length vec))]
[elems null]
[any-opaque? #f])
(cond [(positive? index)
(let ([elem (vector-ref vec index)])
(cond [(eq? elem dummy-value)
(when error-on-opaque?
(raise-type-error 'struct->list "non-opaque struct" s))
(loop (sub1 index) elems #t)]
[else (loop (sub1 index) (cons elem elems) any-opaque?)]))]
[else
(cond [(and any-opaque? (eq? on-opaque 'return-false))
#f]
[else elems])]))))

28
racket/collects/unstable/struct.rkt
View File

@ -1,7 +1,8 @@
#lang racket/base
;; owner: ryanc
(require (for-syntax racket/base
racket/struct-info))
racket/struct-info)
racket/struct)
(provide make
struct->list
(for-syntax get-struct-info))
@ -49,28 +50,3 @@
;; use `-W warning'. (And then, if you really want these things to be
;; errors, then perhaps something at the racket level should make it throw
;; errors instead of warnings.)
(define dummy-value (box 'dummy))
;; struct->list : struct?
;; #:on-opaque (or/c 'error 'return-false 'skip)
;; -> (listof any/c)
(define (struct->list s
#:on-opaque [on-opaque 'error])
(define error-on-opaque? (eq? on-opaque 'error))
(let ([vec (struct->vector s dummy-value)])
;; go through vector backwards, don't traverse 0 (struct name)
(let loop ([index (sub1 (vector-length vec))]
[elems null]
[any-opaque? #f])
(cond [(positive? index)
(let ([elem (vector-ref vec index)])
(cond [(eq? elem dummy-value)
(when error-on-opaque?
(raise-type-error 'struct->list "non-opaque struct" s))
(loop (sub1 index) elems #t)]
[else (loop (sub1 index) (cons elem elems) any-opaque?)]))]
[else
(cond [(and any-opaque? (eq? on-opaque 'return-false))
#f]
[else elems])]))))