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

struct-copy

Browse Source 
svn: r9456
This commit is contained in:
Matthew Flatt 2008-04-24 13:56:36 +00:00
parent 7be28dfc6d
commit 1ee0298552
4 changed files with 182 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

113
collects/scheme/private/define-struct.ss
View File

@ -12,6 +12,7 @@
(#%provide define-struct*
define-struct/derived
struct-field-index
struct-copy
(for-syntax
(rename checked-struct-info-rec? checked-struct-info?)))
@ -510,5 +511,113 @@
(raise-syntax-error
#f
"bad syntax"
stx)])))
stx)]))
(define-syntax (struct-copy stx)
(if (not (eq? (syntax-local-context) 'expression))
(quasisyntax/loc stx (#%expression #,stx))
(syntax-case stx ()
[(form-name info struct-expr field+val ...)
(let ([ans (syntax->list #'(field+val ...))])
;; Check syntax:
(unless (identifier? #'info)
(raise-syntax-error #f "not an identifier for structure type" stx #'info))
(for-each (lambda (an)
(syntax-case an ()
[(field val)
(unless (identifier? #'field)
(raise-syntax-error #f
"not an identifier for field name"
stx
#'field))]
[_
(raise-syntax-error #f
"expected a field update fo the form (<field-id> <expr>)"
stx
an)]))
ans)
(let ([new-fields
(map (lambda (an)
(syntax-case an ()
[(field expr)
(list (datum->syntax #'field
(string->symbol
(format "~a-~a"
(syntax-e #'info)
(syntax-e #'field)))
#'field)
#'expr
(car (generate-temporaries (list #'field))))]))
ans)])
;; new-binding-for : syntax[field-name] -> (union syntax[expression] #f)
(let ([new-binding-for
(lambda (f)
(ormap (lambda (new-field)
(and (free-identifier=? (car new-field) f)
(caddr new-field)))
new-fields))])
(let-values ([(construct pred accessors)
(let ([v (syntax-local-value #'info (lambda () #f))])
(unless (struct-info? v)
(raise-syntax-error #f "identifier is not bound to a structure type" stx #'info))
(let ([v (extract-struct-info v)])
(values (cadr v)
(caddr v)
(cadddr v))))])
(unless construct
(raise-syntax-error #f
"constructor not statically known for structure type"
stx
#'info))
(unless pred
(raise-syntax-error #f
"predicate not statically known for structure type"
stx
#'info))
(unless (andmap values accessors)
(raise-syntax-error #f
"not all accessors are statically known for structure type"
stx
#'info))
(let ([dests
(map (lambda (new-field)
(or (ormap (lambda (f2)
(and f2
(free-identifier=? (car new-field) f2)
f2))
accessors)
(raise-syntax-error #f
"accessor name not associated with the given structure type"
stx
(car new-field))))
new-fields)])
;; Check for duplicates using dests, not as, because mod=? as might not be id=?
(let ((dupe (check-duplicate-identifier dests)))
(when dupe
(raise-syntax-error #f
"duplicate field assignment"
stx
;; Map back to an original field:
(ormap (lambda (nf)
(and nf
(free-identifier=? dupe (car nf))
(car nf)))
(reverse new-fields)))))
;; the actual result
#`(let ((the-struct struct-expr))
(if (#,pred the-struct)
(let #,(map (lambda (new-field)
#`[#,(caddr new-field) #,(cadr new-field)])
new-fields)
(#,construct
#,@(map
(lambda (field) (or (new-binding-for field)
#`(#,field the-struct)))
(reverse accessors))))
(raise-type-error 'form-name
#,(format "~a" (syntax-e #'info))
the-struct))))))))]))))

3
collects/scheme/private/pre-base.ss
View File

@ -79,4 +79,5 @@
procedure-reduce-keyword-arity
(rename define-struct* define-struct)
define-struct/derived
struct-field-index))
struct-field-index
struct-copy))

34
collects/scribblings/guide/define-struct.scrbl
View File

@ -37,8 +37,8 @@ used directly:
posn
]
We explain one use of the @scheme[_struct-id] binding in the next
section, @secref["struct-subtypes"].
We show two uses of the @scheme[_struct-id] binding below in
@secref["struct-copy"] and @secref["struct-subtypes"].
Meanwhile, in addition to defining @scheme[_struct-id],
@scheme[define-struct] also defines a number of identifiers that are
@ -85,6 +85,36 @@ instance of @scheme[posn], even though @scheme["apple"] and
as requiring them to be numbers, is normally the job of a contract, as
discussed later in @secref["contracts"].
@; ------------------------------------------------------------
@section[#:tag "struct-copy"]{Copying and Update}
The @scheme[struct-copy] form clones a structure and optionally
updates specified fields in the clone. This process is sometimes
called a @deftech{functional update}, because the result is a
structure with updated field values. but the original structure is not
modified.
@specform[
(struct-copy struct-id struct-expr [field-id expr] ...)
]
The @scheme[_struct-id] that appears after @scheme[struct-copy] must
be a structure type name bound by @scheme[define-struct] (i.e., the
name that cannot be used directly as an expression). The
@scheme[_struct-expr] must produce an instance of the structure type.
The result is a new instance of the structure tpe that is like the old
one, except that the field indicated by each @scheme[_field-id] gets
the value of the corresponding @scheme[_expr].
@examples[
#:eval posn-eval
(define p1 (make-posn 1 2))
(define p2 (struct-copy posn p1 [x 3]))
(list (posn-x p2) (posn-y p2))
(list (posn-x p1) (posn-x p2))
]
@; ------------------------------------------------------------
@section[#:tag "struct-subtypes"]{Structure Subtypes}

38
collects/scribblings/reference/struct.scrbl
View File

@ -4,10 +4,12 @@
@(define struct-eval (make-base-eval))
@title[#:tag "structures"]{Structures}
@title[#:tag "structures" #:style 'toc]{Structures}
@guideintro["define-struct"]{structure types via @scheme[define-struct]}
@local-table-of-contents[]
A @deftech{structure type} is a record datatype composing a number of
@idefterm{fields}. A @deftech{structure}, an instance of a structure
type, is a first-class value that contains a value for each field of
@ -340,6 +342,40 @@ descriptor} value, @scheme[#f] otherwise.
}
@;------------------------------------------------------------------------
@section[#:tag "struct-copy"]{Copying and Updating Structures}
@defform[(struct-copy id struct-expr [field-id expr] ...)]{
Creates a new instance of the structure type @scheme[id] with the same
field values as the structure produced by @scheme[struct-expr], except
that the value of each supplied @scheme[field-id] is instead
determined by the corresponding @scheme[expr].
The @scheme[id] must have a @tech{transformer binding} that
encapsulates information about a structure type (i.e., like the
initial identifier bound by @scheme[define-struct]), and the binding
must supply a constructor, a predicate, and all field accessors.
Each @scheme[field-id] is combined with @scheme[id] to form
@scheme[id]@schemeidfont{-}@scheme[field-id] (using the lexical
context of @scheme[field-id]), which must be one of the accessor
bindings in @scheme[id]. The accessor bindings determined by different
@scheme[field-id]s must be distinct. The order of the
@scheme[field-id]s need not match the order of the corresponding
fields in the structure type.
The @scheme[struct-expr] is evaluated first. The result must be an
instance of the @scheme[id] structure type, otherwise the
@exnraise[exn:fail:contract]. Next, the field @scheme[expr]s are
evaluated in order (even if the fields that correspond to the
@scheme[field-id]s are in a different order). Finally, the new
structure instance is created.
The result of @scheme[struct-expr] can be an instance of a sub-type of
@scheme[id], but the resulting copy is an immediate instance of
@scheme[id] (not the sub-type).}
@;------------------------------------------------------------------------
@section[#:tag "structutils"]{Structure Utilities}