2008-04-30 17:11:55 -04:00
|
|
|
! Copyright (c) 2008 Slava Pestov
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2009-05-16 14:03:09 -04:00
|
|
|
USING: accessors io io.backend io.files kernel math math.parser
|
2009-05-16 16:17:20 -04:00
|
|
|
sequences vectors io.encodings.binary quotations ;
|
2008-04-30 17:11:55 -04:00
|
|
|
IN: checksums
|
|
|
|
|
|
|
|
MIXIN: checksum
|
|
|
|
|
2009-05-16 14:03:09 -04:00
|
|
|
TUPLE: checksum-state bytes-read block-size bytes ;
|
|
|
|
|
|
|
|
: new-checksum-state ( block-size class -- checksum-state )
|
|
|
|
new
|
|
|
|
swap >>block-size
|
|
|
|
0 >>bytes-read
|
|
|
|
V{ } clone >>bytes ; inline
|
|
|
|
|
2009-05-16 19:00:56 -04:00
|
|
|
M: checksum-state clone
|
|
|
|
call-next-method
|
|
|
|
[ clone ] change-bytes ;
|
|
|
|
|
2009-05-16 14:03:09 -04:00
|
|
|
GENERIC: checksum-block ( bytes checksum -- )
|
|
|
|
|
|
|
|
GENERIC: get-checksum ( checksum -- value )
|
|
|
|
|
|
|
|
: add-checksum-bytes ( checksum-state data -- checksum-state )
|
|
|
|
over bytes>> [ push-all ] keep
|
|
|
|
[ dup length pick block-size>> >= ]
|
|
|
|
[
|
|
|
|
64 cut-slice [
|
|
|
|
over [ checksum-block ]
|
|
|
|
[ [ 64 + ] change-bytes-read drop ] bi
|
|
|
|
] dip
|
2009-05-16 19:00:56 -04:00
|
|
|
] while >vector [ >>bytes ] [ length [ + ] curry change-bytes-read ] bi ;
|
2009-05-16 14:03:09 -04:00
|
|
|
|
|
|
|
: add-checksum-stream ( checksum-state stream -- checksum-state )
|
|
|
|
[
|
2009-05-16 16:17:20 -04:00
|
|
|
[ [ swap add-checksum-bytes drop ] curry each-block ] keep
|
2009-05-16 14:03:09 -04:00
|
|
|
] with-input-stream ;
|
|
|
|
|
|
|
|
: add-checksum-file ( checksum-state path -- checksum-state )
|
|
|
|
binary <file-reader> add-checksum-stream ;
|
|
|
|
|
2008-04-30 17:11:55 -04:00
|
|
|
GENERIC: checksum-bytes ( bytes checksum -- value )
|
|
|
|
|
|
|
|
GENERIC: checksum-stream ( stream checksum -- value )
|
|
|
|
|
|
|
|
GENERIC: checksum-lines ( lines checksum -- value )
|
|
|
|
|
2008-11-23 03:44:56 -05:00
|
|
|
M: checksum checksum-stream
|
2009-05-01 11:41:27 -04:00
|
|
|
[ stream-contents ] dip checksum-bytes ;
|
2008-04-30 17:11:55 -04:00
|
|
|
|
2008-11-23 03:44:56 -05:00
|
|
|
M: checksum checksum-lines
|
|
|
|
[ B{ CHAR: \n } join ] dip checksum-bytes ;
|
2008-04-30 17:11:55 -04:00
|
|
|
|
2008-05-01 21:02:34 -04:00
|
|
|
: checksum-file ( path checksum -- value )
|
2008-12-14 21:03:00 -05:00
|
|
|
#! normalize-path (file-reader) is equivalen to
|
|
|
|
#! binary <file-reader>. We use the lower-level form
|
|
|
|
#! so that we can move io.encodings.binary to basis/.
|
|
|
|
[ normalize-path (file-reader) ] dip checksum-stream ;
|
2008-04-30 17:11:55 -04:00
|
|
|
|
|
|
|
: hex-string ( seq -- str )
|
2009-01-29 23:19:07 -05:00
|
|
|
[ >hex 2 CHAR: 0 pad-head ] { } map-as concat ;
|