From 033735a8756202bc52eaab6ddca21b57bdde36df Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Sun, 3 Sep 2023 09:41:17 -0700
Subject: [PATCH] leb128: faster default case, some simplification

---
 extra/leb128/leb128-tests.factor |  8 ++++++--
 extra/leb128/leb128.factor       | 26 +++++++++++++-------------
 2 files changed, 19 insertions(+), 15 deletions(-)

diff --git a/extra/leb128/leb128-tests.factor b/extra/leb128/leb128-tests.factor
index 6d9f83442a..e04e8eb50b 100644
--- a/extra/leb128/leb128-tests.factor
+++ b/extra/leb128/leb128-tests.factor
@@ -1,13 +1,17 @@
-
-USING: leb128 math tools.test ;
+USING: io.encodings.binary io.streams.byte-array leb128 math
+tools.test ;
 
 [ -1 >uleb128 ] [ non-negative-number-expected? ] must-fail-with
 { B{ 0xe5 0x8e 0x26 } } [ 624485 >uleb128 ] unit-test
 { 624485 } [ B{ 0xe5 0x8e 0x26 } uleb128> ] unit-test
+{ 624485 } [ B{ 0xe5 0x8e 0x26 } binary [ read-uleb128 ] with-byte-reader ] unit-test
 { B{ 255 255 127 } } [ 0x1fffff >uleb128 ] unit-test
 { 0x1fffff } [ B{ 255 255 127 } uleb128> ] unit-test
+{ 0x1fffff } [ B{ 255 255 127 } binary [ read-uleb128 ] with-byte-reader  ] unit-test
 
 { B{ 255 255 255 0 } } [ 0x1fffff >leb128 ] unit-test
 { 0x1fffff } [ B{ 255 255 255 0 } leb128> ] unit-test
+{ 0x1fffff } [ B{ 255 255 255 0 } binary [ read-leb128 ] with-byte-reader ] unit-test
 { B{ 0xc0 0xbb 0x78 } } [ -123456 >leb128 ] unit-test
 { -123456 } [ B{ 0xc0 0xbb 0x78 } leb128> ] unit-test
+{ -123456 } [ B{ 0xc0 0xbb 0x78 } binary [ read-leb128 ] with-byte-reader ] unit-test
diff --git a/extra/leb128/leb128.factor b/extra/leb128/leb128.factor
index 8478e95a1d..6c1bddde6a 100644
--- a/extra/leb128/leb128.factor
+++ b/extra/leb128/leb128.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2023 John Benediktsson
 ! See https://factorcode.org/license.txt for BSD license
 
-USING: byte-vectors combinators.short-circuit hints io
-io.streams.byte-array kernel math namespaces sequences typed ;
+USING: byte-arrays byte-vectors combinators hints io kernel math
+math.bitwise namespaces sequences typed ;
 
 IN: leb128
 
@@ -12,9 +12,8 @@ IN: leb128
 
 :: (write-uleb128) ( n quot: ( b -- ) -- )
     n assert-non-negative [
-        [ -7 shift dup ] [ 0x7f bitand ] bi :> ( i b )
-        dup zero? [ f b ] [ t b 0x80 bitor ] if
-        quot call
+        [ -7 shift dup 0 = not ] [ 7 bits ] bi
+        over [ 0x80 bitor ] when quot call
     ] loop drop ; inline
 
 HINTS: (write-uleb128) { fixnum object } ;
@@ -40,8 +39,8 @@ TYPED: >uleb128 ( n: integer -- byte-array )
 : read-uleb128 ( -- n )
     input-stream get stream-read-uleb128 ;
 
-: uleb128> ( byte-array -- n )
-    0 byte-reader boa stream-read-uleb128 ;
+TYPED: uleb128> ( byte-array: byte-array -- n )
+    0 [ [ 0x7f bitand ] [ 7 * shift ] bi* + ] reduce-index ;
 
 ! Signed LEB128
 
@@ -51,10 +50,10 @@ TYPED: >uleb128 ( n: integer -- byte-array )
     n [
         [ -7 shift dup ] [ 0x7f bitand ] bi :> ( i b )
         {
-            [ i zero? b 6 bit? not and ]
-            [ i -1 = b 6 bit? and ]
-        } 0|| [ f b ] [ t b 0x80 bitor ] if
-        quot call
+            { [ i  0 = ] [ b 6 bit? not ] }
+            { [ i -1 = ] [ b 6 bit? ] }
+            [ f ]
+        } cond [ f b ] [ t b 0x80 bitor ] if quot call
     ] loop drop ; inline
 
 HINTS: (write-leb128) { fixnum object } ;
@@ -84,5 +83,6 @@ TYPED: >leb128 ( n: integer -- byte-array )
 : read-leb128 ( -- n )
     input-stream get stream-read-leb128 ;
 
-: leb128> ( byte-array -- n )
-    0 byte-reader boa stream-read-leb128 ;
+TYPED: leb128> ( byte-array: byte-array -- n )
+    [ uleb128> ] keep dup last 6 bit?
+    [ length 7 * 2^ neg bitor ] [ drop ] if ;
-- 
2.34.1