steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

serialize: some cleanup.

db4
John Benediktsson 2014-05-23 13:27:22 -07:00
parent 848420a377
commit cc8ba65558
1 changed files with 16 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
basis/serialize/serialize.factor
View File

@ -6,13 +6,11 @@
! !
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
! !
USING: namespaces sequences kernel math io math.functions USING: accessors arrays assocs byte-arrays classes classes.tuple
io.binary strings classes words sbufs classes.tuple arrays combinators hashtables hashtables.identity io io.binary
vectors byte-arrays quotations hashtables hashtables.identity io.encodings.binary io.encodings.string io.encodings.utf8
assocs help.syntax help.markup splitting io.streams.byte-array io.streams.byte-array kernel locals math namespaces prettyprint
io.encodings.string io.encodings.utf8 io.encodings.binary quotations sequences sequences.private strings vocabs words ;
combinators accessors locals prettyprint compiler.units
sequences.private classes.tuple.private vocabs ;
IN: serialize IN: serialize
GENERIC: (serialize) ( obj -- ) GENERIC: (serialize) ( obj -- )
@ -194,19 +192,17 @@ SYMBOL: deserialized
(deserialize-string) dup intern-object ; (deserialize-string) dup intern-object ;
: deserialize-word ( -- word ) : deserialize-word ( -- word )
(deserialize) (deserialize) 2dup [ require ] keep lookup-word (deserialize) (deserialize)
dup [ 2nip ] [ 2dup [ require ] keep lookup-word [ 2nip ] [
drop
2array unparse "Unknown word: " prepend throw 2array unparse "Unknown word: " prepend throw
] if ; ] if* ;
: deserialize-gensym ( -- word ) : deserialize-gensym ( -- word )
gensym { gensym
[ intern-object ] [ intern-object ]
[ (deserialize) define ] [ (deserialize) define ]
[ (deserialize) >>props drop ] [ (deserialize) >>props ]
[ ] tri ;
} cleave ;
: deserialize-wrapper ( -- wrapper ) : deserialize-wrapper ( -- wrapper )
(deserialize) <wrapper> ; (deserialize) <wrapper> ;
@ -228,8 +224,8 @@ SYMBOL: deserialized
: deserialize-hashtable ( -- hashtable ) : deserialize-hashtable ( -- hashtable )
H{ } clone H{ } clone
[ intern-object ] [ intern-object ]
[ (deserialize) assoc-union! drop ] [ (deserialize) assoc-union! ]
[ ] tri ; bi ;
: copy-seq-to-tuple ( seq tuple -- ) : copy-seq-to-tuple ( seq tuple -- )
[ set-array-nth ] curry each-index ; [ set-array-nth ] curry each-index ;
@ -277,8 +273,7 @@ SYMBOL: deserialized
PRIVATE> PRIVATE>
: deserialize ( -- obj ) : deserialize ( -- obj )
V{ } clone deserialized V{ } clone deserialized [ (deserialize) ] with-variable ;
[ (deserialize) ] with-variable ;
: serialize ( obj -- ) : serialize ( obj -- )
IH{ } clone serialized [ (serialize) ] with-variable ; IH{ } clone serialized [ (serialize) ] with-variable ;