From db21e8ed318da746cd4775697f607c6498e7650b Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 15 Jan 2009 17:55:30 -0600
Subject: [PATCH] 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) ;