From db21e8ed318da746cd4775697f607c6498e7650b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 15 Jan 2009 17:55:30 -0600 Subject: [PATCH 1/6] add way to get length of packed bytes, add words to read packed bytes directly from streams --- basis/pack/pack-tests.factor | 2 ++ basis/pack/pack.factor | 37 ++++++++++++++++++++++++++++++++++++ 2 files changed, 39 insertions(+) diff --git a/basis/pack/pack-tests.factor b/basis/pack/pack-tests.factor index b1a354cd4e..b813abc834 100755 --- a/basis/pack/pack-tests.factor +++ b/basis/pack/pack-tests.factor @@ -46,3 +46,5 @@ pack strings tools.test ; [ f ] [ "" [ read-c-string ] with-string-reader ] unit-test [ 5 ] [ "FRAM\0\u000005\0\0\0\0\0\0\0" [ read-c-string drop read-u64 ] with-string-reader ] unit-test +[ 9 ] +[ "iic" packed-length ] unit-test diff --git a/basis/pack/pack.factor b/basis/pack/pack.factor index 0e5cb7dbbc..bd4b77c828 100755 --- a/basis/pack/pack.factor +++ b/basis/pack/pack.factor @@ -130,6 +130,24 @@ M: string b, ( n string -- ) heap-size b, ; { CHAR: D read-double } } ; +: packed-length-table ( -- hash ) + H{ + { CHAR: c 1 } + { CHAR: C 1 } + { CHAR: s 2 } + { CHAR: S 2 } + { CHAR: t 3 } + { CHAR: T 3 } + { CHAR: i 4 } + { CHAR: I 4 } + { CHAR: q 8 } + { CHAR: Q 8 } + { CHAR: f 4 } + { CHAR: F 4 } + { CHAR: d 8 } + { CHAR: D 8 } + } ; + MACRO: (pack) ( seq str -- quot ) [ [ @@ -172,3 +190,22 @@ MACRO: (unpack) ( str -- quot ) : unpack-le ( seq str -- seq ) [ big-endian off (unpack) ] with-scope ; + +: packed-length ( str -- n ) + [ packed-length-table at ] sigma ; + +ERROR: packed-read-fail str bytes ; + +: packed-read ( str -- bytes ) + dup packed-length [ read dup length ] keep = [ + nip + ] [ + packed-read-fail + ] if ; + +: (read-packed) ( str quot -- seq ) + [ packed-read ] swap bi ; + +: read-packed-le ( str -- seq ) [ unpack-le ] (read-packed) ; +: read-packed-be ( str -- seq ) [ unpack-be ] (read-packed) ; +: read-packed-native ( str -- seq ) [ unpack-native ] (read-packed) ; From a6e0df75ea489c7fa22dc41d7775d1c39e7aa01c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 15 Jan 2009 17:56:09 -0600 Subject: [PATCH 2/6] use sigma --- basis/roman/roman.factor | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/basis/roman/roman.factor b/basis/roman/roman.factor index 866ac92872..c9394b07ed 100644 --- a/basis/roman/roman.factor +++ b/basis/roman/roman.factor @@ -39,16 +39,14 @@ ERROR: roman-range-error n ; PRIVATE> : >roman ( n -- str ) - dup roman-range-check [ - (>roman) - ] "" make ; + dup roman-range-check + [ (>roman) ] "" make ; : >ROMAN ( n -- str ) >roman >upper ; : roman> ( str -- n ) - >lower [ roman<= ] monotonic-split [ - (roman>) - ] map sum ; + >lower [ roman<= ] monotonic-split + [ (roman>) ] sigma ; Date: Thu, 15 Jan 2009 18:38:58 -0600 Subject: [PATCH 3/6] clean up pack --- basis/pack/pack-tests.factor | 7 +++-- basis/pack/pack.factor | 59 ++++++++++++++++++------------------ 2 files changed, 34 insertions(+), 32 deletions(-) diff --git a/basis/pack/pack-tests.factor b/basis/pack/pack-tests.factor index b813abc834..c32c528299 100755 --- a/basis/pack/pack-tests.factor +++ b/basis/pack/pack-tests.factor @@ -46,5 +46,8 @@ pack strings tools.test ; [ f ] [ "" [ read-c-string ] with-string-reader ] unit-test [ 5 ] [ "FRAM\0\u000005\0\0\0\0\0\0\0" [ read-c-string drop read-u64 ] with-string-reader ] unit-test -[ 9 ] -[ "iic" packed-length ] unit-test +[ 9 ] [ "iic" packed-length ] unit-test +[ "iii" read-packed-le ] must-infer +[ "iii" unpack-le ] must-infer +[ "iii" unpack-be ] must-infer +[ "iii" unpack-native ] must-infer diff --git a/basis/pack/pack.factor b/basis/pack/pack.factor index bd4b77c828..b60b8956b6 100755 --- a/basis/pack/pack.factor +++ b/basis/pack/pack.factor @@ -9,6 +9,9 @@ SYMBOL: big-endian : big-endian? ( -- ? ) 1 *char zero? ; +: set-big-endian ( -- ) + big-endian? big-endian set ; inline + : >endian ( obj n -- str ) big-endian get [ >be ] [ >le ] if ; inline @@ -70,7 +73,7 @@ M: string b, ( n string -- ) heap-size b, ; : read-s32 ( -- n ) 4 read-signed ; : read-u32 ( -- n ) 4 read-unsigned ; : read-s64 ( -- n ) 8 read-signed ; -: read-u64 ( -- n ) 8 read-signed ; +: read-u64 ( -- n ) 8 read-unsigned ; : read-s128 ( -- n ) 16 read-signed ; : read-u128 ( -- n ) 16 read-unsigned ; @@ -81,7 +84,7 @@ M: string b, ( n string -- ) heap-size b, ; 8 read endian> bits>double ; : read-c-string ( -- str/f ) - "\0" read-until [ drop f ] unless ; + "\0" read-until swap and ; : read-c-string* ( n -- str/f ) read [ zero? ] trim-right [ f ] when-empty ; @@ -94,7 +97,7 @@ M: string b, ( n string -- ) heap-size b, ; : read-128-ber ( -- n ) 0 (read-128-ber) ; -: pack-table ( -- hash ) +CONSTANT: pack-table H{ { CHAR: c s8, } { CHAR: C u8, } @@ -110,9 +113,9 @@ M: string b, ( n string -- ) heap-size b, ; { CHAR: F float, } { CHAR: d double, } { CHAR: D double, } - } ; + } -: unpack-table ( -- hash ) +CONSTANT: unpack-table H{ { CHAR: c read-s8 } { CHAR: C read-u8 } @@ -128,9 +131,9 @@ M: string b, ( n string -- ) heap-size b, ; { CHAR: F read-float } { CHAR: d read-double } { CHAR: D read-double } - } ; + } -: packed-length-table ( -- hash ) +CONSTANT: packed-length-table H{ { CHAR: c 1 } { CHAR: C 1 } @@ -146,7 +149,7 @@ M: string b, ( n string -- ) heap-size b, ; { CHAR: F 4 } { CHAR: d 8 } { CHAR: D 8 } - } ; + } MACRO: (pack) ( seq str -- quot ) [ @@ -159,16 +162,13 @@ MACRO: (pack) ( seq str -- quot ) ] [ ] make ; : pack-native ( seq str -- seq ) - [ - big-endian? big-endian set (pack) - ] with-scope ; + [ set-big-endian (pack) ] with-scope ; inline : pack-be ( seq str -- seq ) - [ big-endian on (pack) ] with-scope ; + [ big-endian on (pack) ] with-scope ; inline : pack-le ( seq str -- seq ) - [ big-endian off (pack) ] with-scope ; - + [ big-endian off (pack) ] with-scope ; inline MACRO: (unpack) ( str -- quot ) [ @@ -181,31 +181,30 @@ MACRO: (unpack) ( str -- quot ) ] [ ] make ; : unpack-native ( seq str -- seq ) - [ - big-endian? big-endian set (unpack) - ] with-scope ; + [ set-big-endian (unpack) ] with-scope ; inline : unpack-be ( seq str -- seq ) - [ big-endian on (unpack) ] with-scope ; + [ big-endian on (unpack) ] with-scope ; inline : unpack-le ( seq str -- seq ) - [ big-endian off (unpack) ] with-scope ; + [ big-endian off (unpack) ] with-scope ; inline : packed-length ( str -- n ) [ packed-length-table at ] sigma ; ERROR: packed-read-fail str bytes ; -: packed-read ( str -- bytes ) - dup packed-length [ read dup length ] keep = [ - nip - ] [ - packed-read-fail - ] if ; + + +: read-packed ( str quot -- seq ) + [ read-packed-bytes ] swap bi ; inline + +: read-packed-le ( str -- seq ) [ unpack-le ] read-packed ; inline +: read-packed-be ( str -- seq ) [ unpack-be ] read-packed ; inline +: read-packed-native ( str -- seq ) [ unpack-native ] read-packed ; inline From 681e91cad5824148fb3dd3ca83433065e1cf201e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 15 Jan 2009 19:03:55 -0600 Subject: [PATCH 4/6] clean up pack macros --- basis/pack/pack.factor | 35 ++++++++++++++--------------------- 1 file changed, 14 insertions(+), 21 deletions(-) diff --git a/basis/pack/pack.factor b/basis/pack/pack.factor index b60b8956b6..f98d90325e 100755 --- a/basis/pack/pack.factor +++ b/basis/pack/pack.factor @@ -1,7 +1,7 @@ USING: alien alien.c-types arrays assocs byte-arrays io io.binary io.streams.string kernel math math.parser namespaces make parser prettyprint quotations sequences strings vectors -words macros math.functions math.bitwise ; +words macros math.functions math.bitwise fry ; IN: pack SYMBOL: big-endian @@ -152,15 +152,9 @@ CONSTANT: packed-length-table } MACRO: (pack) ( seq str -- quot ) - [ - [ - [ - swap , pack-table at , - ] 2each - ] [ ] make 1quotation % - [ B{ } make ] % - ] [ ] make ; - + [ pack-table at 1quotation '[ _ @ ] ] [ ] 2map-as concat + '[ _ B{ } make ] ; + : pack-native ( seq str -- seq ) [ set-big-endian (pack) ] with-scope ; inline @@ -171,14 +165,8 @@ MACRO: (pack) ( seq str -- quot ) [ big-endian off (pack) ] with-scope ; inline MACRO: (unpack) ( str -- quot ) - [ - [ - [ unpack-table at , \ , , ] each - ] [ ] make - 1quotation [ { } make ] append - 1quotation % - \ with-string-reader , - ] [ ] make ; + [ unpack-table at 1quotation '[ @ , ] ] { } map-as concat + '[ [ _ { } make ] with-string-reader ] ; : unpack-native ( seq str -- seq ) [ set-big-endian (unpack) ] with-scope ; inline @@ -205,6 +193,11 @@ PRIVATE> : read-packed ( str quot -- seq ) [ read-packed-bytes ] swap bi ; inline -: read-packed-le ( str -- seq ) [ unpack-le ] read-packed ; inline -: read-packed-be ( str -- seq ) [ unpack-be ] read-packed ; inline -: read-packed-native ( str -- seq ) [ unpack-native ] read-packed ; inline +: read-packed-le ( str -- seq ) + [ unpack-le ] read-packed ; inline + +: read-packed-be ( str -- seq ) + [ unpack-be ] read-packed ; inline + +: read-packed-native ( str -- seq ) + [ unpack-native ] read-packed ; inline From 75af02313c8d2cf51347a6e268da3cf9ea4280fd Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 15 Jan 2009 19:08:08 -0600 Subject: [PATCH 5/6] add copyright information to pack --- basis/pack/pack-tests.factor | 2 ++ basis/pack/pack.factor | 2 ++ 2 files changed, 4 insertions(+) diff --git a/basis/pack/pack-tests.factor b/basis/pack/pack-tests.factor index c32c528299..1be37292a0 100755 --- a/basis/pack/pack-tests.factor +++ b/basis/pack/pack-tests.factor @@ -48,6 +48,8 @@ pack strings tools.test ; [ 9 ] [ "iic" packed-length ] unit-test [ "iii" read-packed-le ] must-infer +[ "iii" read-packed-be ] must-infer +[ "iii" read-packed-native ] must-infer [ "iii" unpack-le ] must-infer [ "iii" unpack-be ] must-infer [ "iii" unpack-native ] must-infer diff --git a/basis/pack/pack.factor b/basis/pack/pack.factor index f98d90325e..8f00792c47 100755 --- a/basis/pack/pack.factor +++ b/basis/pack/pack.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types arrays assocs byte-arrays io io.binary io.streams.string kernel math math.parser namespaces make parser prettyprint quotations sequences strings vectors From 0aff3f2452af7b8de4b54b6099532e3f5ca03cf5 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 15 Jan 2009 19:10:40 -0600 Subject: [PATCH 6/6] more cleanups. (pack) -> pack, use PRIVATE --- basis/pack/pack.factor | 32 ++++++++++++++++++++++++-------- 1 file changed, 24 insertions(+), 8 deletions(-) diff --git a/basis/pack/pack.factor b/basis/pack/pack.factor index 8f00792c47..136deb9ff5 100755 --- a/basis/pack/pack.factor +++ b/basis/pack/pack.factor @@ -11,9 +11,13 @@ SYMBOL: big-endian : big-endian? ( -- ? ) 1 *char zero? ; + + : >endian ( obj n -- str ) big-endian get [ >be ] [ >le ] if ; inline @@ -44,6 +48,8 @@ M: string b, ( n string -- ) heap-size b, ; : double, ( n -- ) double>bits 8 b, ; : c-string, ( str -- ) % 0 u8, ; +128-ber) ( n -- ) dup 0 > [ [ HEX: 7f bitand HEX: 80 bitor , ] keep -7 shift @@ -52,6 +58,8 @@ M: string b, ( n string -- ) heap-size b, ; drop ] if ; +PRIVATE> + : >128-ber ( n -- str ) [ [ HEX: 7f bitand , ] keep -7 shift @@ -99,6 +107,8 @@ M: string b, ( n string -- ) heap-size b, ; : read-128-ber ( -- n ) 0 (read-128-ber) ; + : pack-native ( seq str -- seq ) - [ set-big-endian (pack) ] with-scope ; inline + [ set-big-endian pack ] with-scope ; inline : pack-be ( seq str -- seq ) - [ big-endian on (pack) ] with-scope ; inline + [ big-endian on pack ] with-scope ; inline : pack-le ( seq str -- seq ) - [ big-endian off (pack) ] with-scope ; inline + [ big-endian off pack ] with-scope ; inline -MACRO: (unpack) ( str -- quot ) + + : unpack-native ( seq str -- seq ) - [ set-big-endian (unpack) ] with-scope ; inline + [ set-big-endian unpack ] with-scope ; inline : unpack-be ( seq str -- seq ) - [ big-endian on (unpack) ] with-scope ; inline + [ big-endian on unpack ] with-scope ; inline : unpack-le ( seq str -- seq ) - [ big-endian off (unpack) ] with-scope ; inline + [ big-endian off unpack ] with-scope ; inline : packed-length ( str -- n ) [ packed-length-table at ] sigma ;