Merge pull request #361 from zkFold/vks4git/322_memory_consumption

Variables can be forcefully evaluated

.gitignore

@@ -16,6 +16,8 @@ cabal.sandbox.config
 *.aux
 *.hp
 *.eventlog
+*.html
+*.ps
 .stack-work/
 cabal.project.local
 cabal.project.local~

symbolic-base/bench/BenchEC.hs

@@ -31,11 +31,15 @@ benchOps desc p0 op = env (fromIntegral <$> randomRIO (1 :: Integer, 3)) $ \ ~n
 
 main :: IO ()
 main = do
-  let a = fromConstant @Natural 0 :: FFA Ed25519_Scalar I
-  let b = fromConstant @Natural 1 :: FFA Ed25519_Scalar I
+  let a = fromConstant @Natural 0 :: FFA Ed25519_Scalar A
+--  let b = fromConstant @Natural 1 :: FFA Ed25519_Scalar A
   print a
-  print $ a // a
-  print $ b // a
+  let (FFA ap) = (a ^ (100000 :: Natural))
+--  let (FFA ap) = (scale (100000 :: Natural) a)
+  print $ exec ap
+  print a
+--  print $ a // a
+--  print $ b // a
 --  defaultMain
 --      [ bgroup "EC operations"
 --        [ benchOps "FFA Interpreter" (gen :: PtFFA I) scale

symbolic-base/src/ZkFold/Symbolic/Class.hs

@@ -2,6 +2,7 @@
 
 module ZkFold.Symbolic.Class where
 
+import           Control.DeepSeq                  (NFData)
 import           Control.Monad
 import           Data.Eq                          (Eq)
 import           Data.Foldable                    (Foldable)
@@ -21,7 +22,7 @@ import           ZkFold.Symbolic.MonadCircuit
 
 -- | Field of residues with decidable equality and ordering
 -- is called an ``arithmetic'' field.
-type Arithmetic a = (ResidueField Natural a, Eq a, Ord a)
+type Arithmetic a = (ResidueField Natural a, Eq a, Ord a, NFData a)
 
 -- | A type of mappings between functors inside a circuit.
 -- @fs@ are input functors, @g@ is an output functor, @c@ is context.
@@ -33,7 +34,7 @@ type Arithmetic a = (ResidueField Natural a, Eq a, Ord a)
 -- NOTE: the property above is correct by construction for each function of a
 -- suitable type, you don't have to check it yourself.
 type CircuitFun (fs :: [Type -> Type]) (g :: Type -> Type) (c :: (Type -> Type) -> Type) =
-  forall i m. MonadCircuit i (BaseField c) (WitnessField c) m => FunBody fs g i m
+  forall i m. (NFData i, MonadCircuit i (BaseField c) (WitnessField c) m) => FunBody fs g i m
 
 type family FunBody (fs :: [Type -> Type]) (g :: Type -> Type) (i :: Type) (m :: Type -> Type) where
   FunBody '[] g i m = m (g i)

symbolic-base/src/ZkFold/Symbolic/Compiler/ArithmeticCircuit/Instance.hs

@@ -6,6 +6,7 @@
 
 module ZkFold.Symbolic.Compiler.ArithmeticCircuit.Instance where
 
+import           Control.DeepSeq                                     (NFData)
 import           Data.Aeson                                          hiding (Bool)
 import           Data.Binary                                         (Binary)
 import           Data.Functor.Rep                                    (Representable (..))
@@ -35,6 +36,7 @@ instance
   , Arbitrary (Rep i)
   , Binary (Rep i)
   , Haskell.Ord (Rep i)
+  , NFData (Rep i)
   , Representable i
   , Haskell.Foldable i
   ) => Arbitrary (ArithmeticCircuit a i Par1) where
@@ -50,6 +52,7 @@ instance
   , Arbitrary (Rep i)
   , Binary (Rep i)
   , Haskell.Ord (Rep i)
+  , NFData (Rep i)
   , Representable i
   , Haskell.Foldable i
   , KnownNat l
@@ -61,7 +64,7 @@ instance
 
 arbitrary' ::
   forall a i .
-  (Arithmetic a, Binary a, Binary (Rep i), Haskell.Ord (Rep i)) =>
+  (Arithmetic a, Binary a, Binary (Rep i), Haskell.Ord (Rep i), NFData (Rep i)) =>
   (Representable i, Haskell.Foldable i) =>
   FieldElement (ArithmeticCircuit a i) -> Natural ->
   Gen (FieldElement (ArithmeticCircuit a i))

symbolic-base/src/ZkFold/Symbolic/Compiler/ArithmeticCircuit/Internal.hs

@@ -179,7 +179,7 @@ instance (Ord (Rep i), Ord a) => Package (ArithmeticCircuit a i) where
     packWith f (unzipDefault . fmap behead -> (cs, os)) = crown (fold cs) (f os)
 
 instance
-  (Arithmetic a, Binary a, Representable i, Binary (Rep i), Ord (Rep i)) =>
+  (Arithmetic a, Binary a, Representable i, Binary (Rep i), Ord (Rep i), NFData (Rep i)) =>
   Symbolic (ArithmeticCircuit a i) where
     type BaseField (ArithmeticCircuit a i) = a
     type WitnessField (ArithmeticCircuit a i) = WitnessF a (SysVar i)

symbolic-base/src/ZkFold/Symbolic/Data/FFA.hs

@@ -5,7 +5,7 @@
 module ZkFold.Symbolic.Data.FFA (FFA (..), Size, coprimesDownFrom, coprimes) where
 
 import           Control.Applicative              (pure)
-import           Control.DeepSeq                  (NFData)
+import           Control.DeepSeq                  (NFData, force)
 import           Control.Monad                    (Monad, forM, return, (>>=))
 import           Data.Foldable                    (any, foldlM)
 import           Data.Function                    (const, ($), (.))
@@ -141,8 +141,8 @@ cast xs = do
     newAssigned (($ dot) + fromConstant (m -! (mprod @a @p `mod` m)) * ($ residue))
         >>= bigSub m
 
-mul :: forall p i a w m. (KnownNat p, Arithmetic a, MonadCircuit i a w m) => Vector Size i -> Vector Size i -> m (Vector Size i)
-mul xs ys = zipWithM (\i j -> newAssigned (\w -> w i * w j)) xs ys >>= bigCut >>= cast @p
+mul :: forall p i a w m. (KnownNat p, Arithmetic a, NFData i, MonadCircuit i a w m) => Vector Size i -> Vector Size i -> m (Vector Size i)
+mul xs ys = Haskell.fmap force $ zipWithM (\i j -> newAssigned (\w -> w i * w j)) xs ys >>= bigCut >>= cast @p
 
 natPowM :: Monad m => (a -> a -> m a) -> m a -> Natural -> a -> m a
 natPowM _ z 0 _ = z

symbolic-base/src/ZkFold/Symbolic/Data/Input.hs

@@ -5,6 +5,7 @@ module ZkFold.Symbolic.Data.Input (
     SymbolicInput (..)
 ) where
 
+import           Control.DeepSeq                    (NFData)
 import           Control.Monad.Representable.Reader (Rep)
 import           Data.Functor.Rep                   (Representable)
 import           Data.Ord                           (Ord)
@@ -31,6 +32,7 @@ class
     , Representable (Layout d)
     , Binary (Rep (Layout d))
     , Ord (Rep (Layout d))
+    , NFData (Rep (Layout d))
     ) => SymbolicInput d where
     isValid :: d -> Bool (Context d)
 
@@ -46,6 +48,7 @@ instance
   ( Symbolic c
   , Binary (Rep f)
   , Ord (Rep f)
+  , NFData (Rep f)
   , Representable f) => SymbolicInput (c f) where
   isValid _ = true
 

symbolic-base/symbolic-base.cabal

@@ -269,6 +269,7 @@ test-suite symbolic-base-test
       constraints                                ,
       containers                                 ,
       containers                                 ,
+      deepseq                                    ,
       directory                        <= 1.3.8.4,
       filepath                         <= 1.5.2.0,
       hspec                                < 2.12,

symbolic-base/test/Tests/Arithmetization.hs

@@ -3,6 +3,7 @@
 
 module Tests.Arithmetization (specArithmetization) where
 
+import           Control.DeepSeq                             (NFData)
 import           Data.Binary                                 (Binary)
 import           Data.Functor.Rep                            (Representable (..))
 import           GHC.Generics                                (Par1)
@@ -31,7 +32,7 @@ specArithmetization' ::
   forall a i .
   (Arithmetic a, Arbitrary a, Binary a, Arbitrary (i a)) =>
   (Show a, Show (ArithmeticCircuitTest a i Par1)) =>
-  (Arbitrary (Rep i), Binary (Rep i), Ord (Rep i)) =>
+  (Arbitrary (Rep i), Binary (Rep i), Ord (Rep i), NFData (Rep i)) =>
   (Representable i, Traversable i) => IO ()
 specArithmetization' = hspec $ do
     describe "Arithmetization specification" $ do

symbolic-examples/bench/BenchCompiler.hs

@@ -26,7 +26,7 @@ metrics name circuit =
 
 
 benchmark ::
-  (NFData a, Arithmetic a, NFData (o (Var a i)), NFData (Rep i), Representable i) =>
+  (Arithmetic a, NFData (o (Var a i)), NFData (Rep i), Representable i) =>
   String -> (() -> ArithmeticCircuit a i o) -> Benchmark
 benchmark name circuit = bgroup name
   [ bench "compilation" $ nf circuit ()