kick off 0.76 with some minor cleanups of erg's md5 code

CHANGES.txt

@@ -1,3 +1,16 @@
+Factor 0.76:
+------------
+
++ Framework
+
+- md5 hashing algorithm in contrib/crypto/ (Doug Coleman).
+
+- New words:
+
+  math bitroll ( n s w -- n )
+  unparser hex-string ( str -- str )
+  sequences fourth ( seq -- elt )
+
 Factor 0.75:
 ------------
 

contrib/crypto/md5.factor

@@ -16,20 +16,6 @@ SYMBOL: old-d
 : nth-int ( string n -- int )
     4 * dup 4 + rot subseq le> ;
 
-: rotate ( integer shift -- integer )
-    32 mod [ shift ] 2keep dup 0 >= [
-        32 -
-    ] [
-        32 +
-    ] ifte shift bitor ;
-
-: hexstring ( str -- str )
-    [
-        [
-            dup -4 shift >hex % HEX: f bitand >hex %
-        ] each
-    ] make-string ;
-
 : initialize ( -- )
     HEX: 67452301 dup a set old-a set
     HEX: efcdab89 dup b set old-b set
@@ -55,12 +41,12 @@ SYMBOL: old-d
 ! a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s)
 
 : (F) ( vars func -- vars result )
-    >r dup second get over third get pick 3 swap nth get r> call ; inline
+    >r dup second get over third get pick fourth get r> call ; inline
 
 ! # bits to shift, input to float-sin, x, func
 : (ABCD) ( s i x vars func -- )
     (F) swap >r w+ swap float-sin w+ r> dup first >r swap r> update
-    dup first get rot rotate
+    dup first get rot 32 bitroll
     over second get w+ swap first set ; inline
 
 : ABCD [ a b c d ] swap (ABCD) ; inline
@@ -194,7 +180,7 @@ SYMBOL: old-d
 : get-md5 ( -- str )
     [
         [ a b c d ] [ get 4 >le % ] each
-    ] make-string hexstring ;
+    ] make-string hex-string ;
 
 : string>md5 ( string -- md5 )
     [

library/collections/sequences.factor

@@ -54,6 +54,7 @@ DEFER: subseq
 : first 0 swap nth ; inline
 : second 1 swap nth ; inline
 : third 2 swap nth ; inline
+: fourth 3 swap nth ; inline
 
 ! Some low-level code used by vectors and string buffers.
 IN: kernel-internals

library/math/integer.factor

@@ -25,6 +25,11 @@ UNION: integer fixnum bignum ;
     #! Compute the multiplicative inverse of x mod n.
     gcd 1 = [ "Non-trivial divisor found" throw ] unless ;
 
+: bitroll ( n s w -- n )
+    #! Roll n by s bits to the right, wrapping around after
+    #! w bits.
+    [ mod shift ] 3keep over 0 >= [ - ] [ + ] ifte shift bitor ;
+
 IN: math-internals
 
 : fraction> ( a b -- a/b )

library/syntax/unparser.factor

@@ -102,3 +102,6 @@ M: f unparse drop "f" ;
 
 M: dll unparse ( obj -- str )
     [ "DLL\" " , dll-path unparse-string CHAR: " , ] make-string ;
+
+: hex-string ( str -- str )
+    [ [ >hex 2 CHAR: 0 pad-left % ] each ] make-string ;

version.factor

@@ -1,2 +1,2 @@
 IN: kernel
-: version "0.75" ;
+: version "0.76" ;