diff --git a/basis/pack/pack-tests.factor b/basis/pack/pack-tests.factor index b1a354cd4e..1be37292a0 100755 --- a/basis/pack/pack-tests.factor +++ b/basis/pack/pack-tests.factor @@ -46,3 +46,10 @@ 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 +[ "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 0e5cb7dbbc..136deb9ff5 100755 --- a/basis/pack/pack.factor +++ b/basis/pack/pack.factor @@ -1,7 +1,9 @@ +! 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 -words macros math.functions math.bitwise ; +words macros math.functions math.bitwise fry ; IN: pack SYMBOL: big-endian @@ -9,6 +11,13 @@ SYMBOL: big-endian : big-endian? ( -- ? ) 1 *char zero? ; + + : >endian ( obj n -- str ) big-endian get [ >be ] [ >le ] if ; inline @@ -39,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 @@ -47,6 +58,8 @@ M: string b, ( n string -- ) heap-size b, ; drop ] if ; +PRIVATE> + : >128-ber ( n -- str ) [ [ HEX: 7f bitand , ] keep -7 shift @@ -70,7 +83,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 +94,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 +107,9 @@ M: string b, ( n string -- ) heap-size b, ; : read-128-ber ( -- n ) 0 (read-128-ber) ; -: pack-table ( -- hash ) + + : 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 + : 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 ; + + + +: 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 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 ;