use reuse, more keelung tests

src/Quarterround.hs

@@ -228,6 +228,10 @@ quarterroundEquations _ = error "input to `quarterroundEquations` must be a list
 
 -- | The quarterround expression as a keelung computation.
 quarterroundKeelung :: [UInt 32] -> Comp [UInt 32]
-quarterroundKeelung input = 
-    return [evalKeelung $ z0Keelung input, evalKeelung $ z1Keelung input,
-            evalKeelung $ z2Keelung input, evalKeelung $ z3Keelung input]
+quarterroundKeelung input = do
+    z1' <- reuse . evalKeelung . z1Keelung $ input
+    z2' <- reuse . evalKeelung . z2Keelung $ input
+    z3' <- reuse . evalKeelung . z3Keelung $ input
+    z0' <- reuse . evalKeelung . z0Keelung $ input
+
+    return [z0', z1', z2', z3']

src/Rowround.hs

@@ -70,7 +70,7 @@ algMapsDisplay (Quarterround a) = Quarterround.quarterroundDisplay a
 
 -- |The algebra maps for Keelung.
 algMapsKeelung :: ExprFKeelung (Comp [UInt 32]) -> Comp [UInt 32]
-algMapsKeelung (ConstK i) = return i
+algMapsKeelung (ConstK i) =  return i
 algMapsKeelung (QuarterroundK a) = Quarterround.quarterroundKeelung =<< a
 
 -- |The rowround evaluator.

test/unit/keelung/Spec.hs

@@ -9,6 +9,8 @@ import Test.HUnit
 import Keelung
 
 import Data.Word
+import Data.Either (fromRight)
+import Keelung.Constraint.R1CS (toR1Cs)
 
 demoInputUInt32 :: [UInt 32]
 demoInputUInt32 = [
@@ -28,60 +30,61 @@ main :: IO Counts
 main = do
     -- Run tests
 
-    putStrLn "Running Keelung quarterround tests:"
-    putStrLn ""
-
     let quarterround_computed = quarterroundCompute [1, 0, 0, 0]
-    putStrLn "Quarterround computed for input [1, 0, 0, 0]:"
-    print quarterround_computed
-
     quarterround_interpreted <- interpret gf181 (quarterroundKeelung [1, 0, 0, 0]) [] []
-    putStrLn "Quarterround simulated for input [1, 0, 0, 0]:"
-    print quarterround_interpreted
+    putStrLn $ if quarterround_computed == map fromIntegral quarterround_interpreted then "OK" else "FAIL!"
 
-    let quarterround_computed2 = quarterroundCompute [0xe7e8c006, 0xc4f9417d, 0x6479b4b2, 0x68c67137]
-    putStrLn "Quarterround computed for input [0xe7e8c006, 0xc4f9417d, 0x6479b4b2, 0x68c67137]:"
-    print quarterround_computed2
+    quarterround_compiled <- compile bn128 (quarterroundKeelung [1, 0, 0, 0])
+    let quarterround_constraints = length $ toR1Cs (fromRight (error "error parsing r1cs") quarterround_compiled)
+    putStrLn $ if quarterround_constraints == 2393 then "OK" else "FAIL!"
 
+    let quarterround_computed2 = quarterroundCompute [0xe7e8c006, 0xc4f9417d, 0x6479b4b2, 0x68c67137]
     quarterround_interpreted2 <- interpret gf181 (quarterroundKeelung [0xe7e8c006, 0xc4f9417d, 0x6479b4b2, 0x68c67137]) [] []
-    putStrLn "Quarterround simulated for input [0xe7e8c006, 0xc4f9417d, 0x6479b4b2, 0x68c67137]:"
-    print quarterround_interpreted2
+    putStrLn $ if quarterround_computed2 == map fromIntegral quarterround_interpreted2 then "OK" else "FAIL!"
 
-    _quarterround_compiled <- compile bn128 (quarterroundKeelung [1, 0, 0, 0])
-    --putStrLn "Quarterround compiled:"
-    --print quarterround_compiled
+    quarterround_compiled2 <- compile bn128 (quarterroundKeelung [0xe7e8c006, 0xc4f9417d, 0x6479b4b2, 0x68c67137])
+    let quarterround_constraints2 = length $ toR1Cs (fromRight (error "error parsing r1cs") quarterround_compiled2)
+    putStrLn $ if quarterround_constraints2 == 2393 then "OK" else "FAIL!"
 
     let rowround_computed = rowroundCompute demoInputWord32
-    putStrLn "Rowround computed for input demoInput:"
-    print rowround_computed
+    rowround_interpreted <- interpret gf181 (rowroundKeelung demoInputUInt32) [] []
+    putStrLn $ if rowround_computed == map fromIntegral rowround_interpreted then "OK" else "FAIL!"
 
-    rowround_interpreted2 <- interpret gf181 (rowroundKeelung demoInputUInt32) [] []
-    putStrLn "Rowround simulated for input demoInput:"
-    print rowround_interpreted2
+    rowround_compiled <- compile bn128 (rowroundKeelung demoInputUInt32)
+    let rowround_constraints = length $ toR1Cs (fromRight (error "error parsing r1cs") rowround_compiled)
+    putStrLn $ if rowround_constraints == 9572 then "OK" else "FAIL!"
 
     let columnround_computed = columnroundCompute demoInputWord32
-    putStrLn "Columnround computed for input demoInput:"
-    print columnround_computed
+    columnround_interpreted <- interpret gf181 (columnroundKeelung demoInputUInt32) [] []
+    putStrLn $ if columnround_computed == map fromIntegral columnround_interpreted then "OK" else "FAIL!"
 
-    columnround_interpreted2 <- interpret gf181 (columnroundKeelung demoInputUInt32) [] []
-    putStrLn "Columnround simulated for input demoInput:"
-    print columnround_interpreted2
+    columnround_compiled <- compile bn128 (columnroundKeelung demoInputUInt32)
+    let columnround_constraints = length $ toR1Cs (fromRight (error "error parsing r1cs") columnround_compiled)
+    putStrLn $ if columnround_constraints == 9572 then "OK" else "FAIL!"
 
     let doubleround_computed = doubleroundCompute demoInputWord32
-    putStrLn "Doubleround computed for input demoInput:"
-    print doubleround_computed
+    doubleround_interpreted <- interpret gf181 (doubleroundKeelung demoInputUInt32) [] []
+    putStrLn $ if doubleround_computed == map fromIntegral doubleround_interpreted then "OK" else "FAIL!"
+
+    doubleround_compiled <- compile bn128 (doubleroundKeelung demoInputUInt32)
+    let douleround_constraints = length $ toR1Cs (fromRight (error "error parsing r1cs") doubleround_compiled)
+    putStrLn $ if douleround_constraints == 18644 then "OK" else "FAIL!"
+
+    let doubleroundR_computed = doubleroundRCompute demoInputWord32 2
+    doubleroundR_interpreted <- interpret gf181 (doubleroundRKeelung demoInputUInt32 2) [] []
+    putStrLn $ if doubleroundR_computed == map fromIntegral doubleroundR_interpreted then "OK" else "FAIL!"
 
-    doubleround_interpreted2 <- interpret gf181 (doubleroundKeelung demoInputUInt32) [] []
-    putStrLn "Doubleround simulated for input demoInput:"
-    print doubleround_interpreted2
+    doubleroundR_compiled <- compile bn128 (doubleroundRKeelung demoInputUInt32 2)
+    let douleroundR_constraints = length $ toR1Cs (fromRight (error "error parsing r1cs") doubleroundR_compiled)
+    putStrLn $ if douleroundR_constraints == 36788 then "OK" else "FAIL!"
 
-    let doubleroundR_computed = doubleroundRCompute demoInputWord32 3
-    putStrLn "Doubleround computed for input demoInput and 2 rounds:"
-    print doubleroundR_computed
+    let doubleround10_computed = doubleroundRCompute demoInputWord32 10
+    doubleround10_interpreted <- interpret gf181 (doubleroundRKeelung demoInputUInt32 10) [] []
+    putStrLn $ if doubleround10_computed == map fromIntegral doubleround10_interpreted then "OK" else "FAIL!"
 
-    doubleroundR_interpreted2 <- interpret gf181 (doubleroundRKeelung demoInputUInt32 2) [] []
-    putStrLn "DoubleroundR simulated for input demoInput and 2 rounds:"
-    print doubleroundR_interpreted2
+    doubleround10_compiled <- compile bn128 (doubleroundRKeelung demoInputUInt32 10)
+    let douleround10_constraints = length $ toR1Cs (fromRight (error "error parsing r1cs") doubleround10_compiled)
+    putStrLn $ if douleround10_constraints == 181940 then "OK" else "FAIL!"
 
     -- just return an empty `Count` so we don't have to return the one from a specific test:
     return (Counts 0 0 0 0)