cleanup in aisle crypto

diff --git a/extra/crypto/barrett/barrett.factor b/extra/crypto/barrett/barrett.factor
index 55da97202f6fbf2cdeae222e8745b3898eac5a5e..4a070190e314ca1f97455b9f117f0471a4d9bcfb 100644 (file)
--- a/extra/crypto/barrett/barrett.factor
+++ b/extra/crypto/barrett/barrett.factor
@@ -4,5 +4,11 @@ IN: crypto.barrett
 : barrett-mu ( n size -- mu )
     #! Calculates Barrett's reduction parameter mu
     #! size = word size in bits (8, 16, 32, 64, ...)
-    over log2 1+ over / 2 * >r 2 swap ^ r> ^ swap / floor ;
+    ! over log2 1+ over / 2 * >r 2 swap ^ r> ^ swap / floor ;
+    [
+        [ log2 1+ ] [ / 2 * ] bi*
+    ] [
+        2^ rot ^ swap /i
+    ] 2bi ;
+
 

diff --git a/extra/crypto/common/common.factor b/extra/crypto/common/common.factor
index b9f1d437842758af8664b564fd5f55a4205315d9..a714727ad9891c682cfab611c5b147e87492114b 100644 (file)
--- a/extra/crypto/common/common.factor
+++ b/extra/crypto/common/common.factor
@@ -50,9 +50,8 @@ SYMBOL: big-endian?
 
 : 2seq>seq ( seq1 seq2 -- seq )
     #! { aceg } { bdfh } -> { abcdefgh }
-    swap ! error?
     [ 2array flip concat ] keep like ;
 
 : mod-nth ( n seq -- elt )
     #! 5 "abcd" -> b
-    [ length mod ] keep nth ;
+    [ length mod ] [ nth ] bi ;

diff --git a/extra/crypto/hmac/hmac-tests.factor b/extra/crypto/hmac/hmac-tests.factor
index fa0cbef4c72569187a45fa0a3108d33ac83a8f69..eff95bbcd625c6876cccf5fb7b3076408576fcc9 100755 (executable)
--- a/extra/crypto/hmac/hmac-tests.factor
+++ b/extra/crypto/hmac/hmac-tests.factor
@@ -9,4 +9,3 @@ IN: crypto.hmac.tests
 [ "g[\u00000b:\eM\u0000dfN\u000012Hr\u0000dal/c+\u0000fe\u0000d9W\u0000e9" ] [ 16 11 <string> "Hi There" >byte-array byte-array>sha1-hmac >string ] unit-test
 [ "\u0000ef\u0000fc\u0000dfj\u0000e5\u0000eb/\u0000a2\u0000d2t\u000016\u0000d5\u0000f1\u000084\u0000df\u00009c%\u00009a|y" ] [ "Jefe" "what do ya want for nothing?" >byte-array byte-array>sha1-hmac >string ] unit-test
 [ "\u0000d70YM\u000016~5\u0000d5\u000095o\u0000d8\0=\r\u0000b3\u0000d3\u0000f4m\u0000c7\u0000bb" ] [ 16 HEX: aa <string> 50 HEX: dd <repetition> >byte-array byte-array>sha1-hmac >string ] unit-test
-

diff --git a/extra/crypto/hmac/hmac.factor b/extra/crypto/hmac/hmac.factor
index 3dad01fe3a0af5b83426cc15a7ce39337719243f..91d404aead4277ef93868894f85ff5b96cd7c93c 100755 (executable)
--- a/extra/crypto/hmac/hmac.factor
+++ b/extra/crypto/hmac/hmac.factor
@@ -37,7 +37,6 @@ MEMO: opad ( -- seq ) 64 HEX: 5c <array> ;
 : byte-array>sha1-hmac ( K string -- hmac )
     binary <byte-reader> stream>sha1-hmac ;
 
-
 : stream>md5-hmac ( K stream -- hmac )
     [ init-hmac md5-hmac ] with-stream ;
 

diff --git a/extra/crypto/md5/md5.factor b/extra/crypto/md5/md5.factor
index 7ecbd767b94f86803b6adee6fac3655bfa6e7a11..45e10da74df72c6a30b7d804b979cbe652c73f27 100755 (executable)
--- a/extra/crypto/md5/md5.factor
+++ b/extra/crypto/md5/md5.factor
@@ -3,7 +3,7 @@
 USING: kernel io io.binary io.files io.streams.byte-array math
 math.functions math.parser namespaces splitting strings
 sequences crypto.common byte-arrays locals sequences.private
-io.encodings.binary symbols ;
+io.encodings.binary symbols math.bitfields.lib ;
 IN: crypto.md5
 
 <PRIVATE
@@ -43,11 +43,11 @@ SYMBOLS: a b c d old-a old-b old-c old-d ;
 
 : F ( X Y Z -- FXYZ )
     #! F(X,Y,Z) = XY v not(X) Z
-    pick bitnot bitand >r bitand r> bitor ;
+    pick bitnot bitand [ bitand ] [ bitor ] bi* ;
 
 : G ( X Y Z -- GXYZ )
     #! G(X,Y,Z) = XZ v Y not(Z)
-    dup bitnot rot bitand >r bitand r> bitor ;
+    dup bitnot rot bitand [ bitand ] [ bitor ] bi* ;
 
 : H ( X Y Z -- HXYZ )
     #! H(X,Y,Z) = X xor Y xor Z

diff --git a/extra/crypto/rsa/rsa.factor b/extra/crypto/rsa/rsa.factor
index ccf17da4e809f2dea433988a16a12e78652e3ba2..5d3228db10443092f8571d0c7c9eb71b6ba3b54a 100644 (file)
--- a/extra/crypto/rsa/rsa.factor
+++ b/extra/crypto/rsa/rsa.factor
@@ -1,5 +1,5 @@
 USING: math.miller-rabin kernel math math.functions namespaces
-sequences ;
+sequences accessors ;
 IN: crypto.rsa
 
 ! The private key is the only secret.
@@ -39,7 +39,7 @@ PRIVATE>
     public-key <rsa> ;
 
 : rsa-encrypt ( message rsa -- encrypted )
-    [ rsa-public-key ] keep rsa-modulus ^mod ;
+    [ public-key>> ] [ modulus>> ] bi ^mod ;
 
 : rsa-decrypt ( encrypted rsa -- message )
-    [ rsa-private-key ] keep rsa-modulus ^mod ;
\ No newline at end of file
+    [ private-key>> ] [ modulus>> ] bi ^mod ;

diff --git a/extra/crypto/test/common.factor b/extra/crypto/test/common.factor
deleted file mode 100644 (file)
index 6050454..0000000
--- a/extra/crypto/test/common.factor
+++ /dev/null
@@ -1,15 +0,0 @@
-USING: kernel math test namespaces crypto ;
-
-[ 0 ] [ 1 0 0 bitroll ] unit-test
-[ 1 ] [ 1 0 1 bitroll ] unit-test
-[ 1 ] [ 1 1 1 bitroll ] unit-test
-[ 1 ] [ 1 0 2 bitroll ] unit-test
-[ 1 ] [ 1 0 1 bitroll ] unit-test
-[ 1 ] [ 1 20 2 bitroll ] unit-test
-[ 1 ] [ 1 8 8 bitroll ] unit-test
-[ 1 ] [ 1 -8 8 bitroll ] unit-test
-[ 1 ] [ 1 -32 8 bitroll ] unit-test
-[ 128 ] [ 1 -1 8 bitroll ] unit-test
-[ 8 ] [ 1 3 32 bitroll ] unit-test
-
-

diff --git a/extra/crypto/timing/timing.factor b/extra/crypto/timing/timing.factor
index da2603d92cac4e55cf46d889a976a990f80558b2..a17d65d90bfcde020aee0383b0a790ef69d6e46f 100644 (file)
--- a/extra/crypto/timing/timing.factor
+++ b/extra/crypto/timing/timing.factor
@@ -1,7 +1,6 @@
 USING: kernel math threads system ;
 IN: crypto.timing
 
-: with-timing ( ... quot n -- )
+: with-timing ( quot n -- )
     #! force the quotation to execute in, at minimum, n milliseconds
-    millis 2slip millis - + sleep ;
-
+    millis 2slip millis - + sleep ; inline

diff --git a/extra/crypto/xor/xor.factor b/extra/crypto/xor/xor.factor
index 0713e1984384f56cfa3d3fbd21d6b6e80a93851a..247387ebdfa37920b0df3d35ca43023d4a434992 100644 (file)
--- a/extra/crypto/xor/xor.factor
+++ b/extra/crypto/xor/xor.factor
@@ -1,8 +1,8 @@
 USING: crypto.common kernel math sequences ;
 IN: crypto.xor
 
-TUPLE: no-xor-key ;
+ERROR: no-xor-key ;
 
-: xor-crypt ( key seq -- seq )
-    over empty? [ no-xor-key construct-empty throw ] when
+: xor-crypt ( key seq -- seq' )
+    over empty? [ no-xor-key ] when
     dup length rot [ mod-nth bitxor ] curry 2map ;