         [ -25 bitroll-32 ] tri
     ] [ bitxor ] reduce-outputs ; inline
 
-: slice3 ( n seq -- a b c ) [ dup 3 + ] dip <slice> first3 ; inline
+: process-M-256 ( n seq -- )
+    {
+        [ [ 16 - ] dip nth ]
+        [ [ 15 - ] dip nth s0-256 ]
+        [ [ 7 - ] dip nth ]
+        [ [ 2 - ] dip nth s1-256 w+ w+ w+ ]
+        [ ]
+    } 2cleave set-nth ; inline
 
-: T1 ( W n -- T1 )
-    [ swap nth ] keep
-    K get nth +
-    e vars get slice3 ch +
-    e vars get nth S1-256 +
-    h vars get nth w+ ;
+: ch ( x y z -- x' )
+    [ bitxor bitand ] keep bitxor ;
 
-: T2 ( -- T2 )
-    a vars get nth S0-256
-    a vars get slice3 maj w+ ;
+: maj ( x y z -- x' )
+    [ [ bitand ] [ bitor ] 2bi ] dip bitand bitor ;
 
-: update-vars ( T1 T2 -- )
-    vars get
+: prepare-message-schedule ( seq -- w-seq )
+    word-size get <sliced-groups> [ be> ] map block-size get 0 pad-tail
+    16 64 [a,b) over '[ _ process-M-256 ] each ;
+
+: slice3 ( n seq -- a b c )
+    [ dup 3 + ] dip <slice> first3 ; inline
+
+: T1 ( W n H -- T1 )
+    [
+        [ swap nth ] keep
+        K-256 nth +
+    ] dip
+    [ e swap slice3 ch w+ ]
+    [ e swap nth S1-256 w+ ]
+    [ h swap nth w+ ] tri ;
+
+: T2 ( H -- T2 )
+    [ a swap nth S0-256 ]
+    [ a swap slice3 maj w+ ] bi ;
+
+: update-H ( T1 T2 H -- )
     h g pick exchange
     g f pick exchange
     f e pick exchange

! See http://factorcode.org/license.txt for BSD license.
USING: kernel splitting grouping math sequences namespaces make
io.binary math.bitwise checksums checksums.common
sbufs strings combinators.smart math.ranges fry combinators ;
IN: checksums.sha2

<PRIVATE

SYMBOLS: vars K H process-M word-size block-size ;

CONSTANT: a 0
CONSTANT: b 1


M: sha-256 checksum-bytes
    drop [
        initial-H-256 H set
        4 word-size set
        64 block-size set
        byte-array>sha2

    ] with-scope ;
