separate out language module

Author: martyall

Diff for: arithmetic-circuits.cabal

@@ -44,20 +44,14 @@ common deps
       aeson           >=1.4
     , base            >=4.10  && <5
     , containers      >=0.6.0
-    , data-reify
     , filepath        >=1.4.2
     , finite-typelits >=0.1.0
     , galois-field    >=2.0.0
-    , hashable
-    , intern
-    , microlens
     , process
     , propagators
     , protolude       >=0.2
     , semirings       >=0.7
     , text            >=1.2.3
-    , vector
-    , vector-sized
     , wl-pprint-text  >=1.2.0
 
 library
@@ -66,13 +60,9 @@ library
     Circuit
     Circuit.Affine
     Circuit.Arithmetic
-    Circuit.Compile
     Circuit.Dataflow
     Circuit.Solver
     Circuit.Dot
-    Circuit.Expr
-    Circuit.Lang
-    Circuit.TExpr
     R1CS
     Fresh
 
@@ -83,6 +73,29 @@ library
 
   default-language:   GHC2021
 
+library language
+  import: deps, extensions, warnings
+  visibility: public
+  exposed-modules:
+    Circuit.Language.Compile
+    Circuit.Language.Expr
+    Circuit.Language.TExpr
+    Circuit.Language.DSL
+    Circuit.Language
+
+  hs-source-dirs:     language/src
+  build-depends:
+      arithmetic-circuits
+    , hashable
+    , microlens
+    , vector
+    , vector-sized
+
+  ghc-options:        -freverse-errors -O2 -Wall
+
+  default-language:   GHC2021
+
+
 library circom-compat
   import: deps, extensions, warnings
   visibility: public
@@ -103,12 +116,47 @@ library circom-compat
 
   default-language:   GHC2021
 
+test-suite language-tests
+  import: deps, extensions
+  type:               exitcode-stdio-1.0
+  main-is:            Main.hs
+
+  other-modules:
+    Test.Circuit.Expr
+    Test.Circuit.Sudoku
+    Test.Circuit.Lang
+
+  hs-source-dirs:     language/test
+
+  ghc-options:        -freverse-errors -O2 -Wall -main-is Main
+  build-depends:
+      arithmetic-circuits
+    , arithmetic-circuits:language
+    , array
+    , distributive 
+    , fin
+    , quickcheck-instances  >=0.3
+    , QuickCheck
+    , random
+    , hspec
+    , tasty                 >=1.2
+    , tasty-hunit           >=0.10
+    , tasty-hspec
+    , tasty-quickcheck      >=0.10
+    , vec
+
+  build-tool-depends: tasty-discover:tasty-discover >=4.2
+
+  default-language:   GHC2021
+
+
 executable factors
   import:           warnings, extensions, deps
   main-is:          Main.hs
   build-depends:
       binary
     , arithmetic-circuits
+    , arithmetic-circuits:language
     , arithmetic-circuits:circom-compat
 
   hs-source-dirs:   circom-compat/app
@@ -123,20 +171,14 @@ test-suite circuit-tests
     Paths_arithmetic_circuits
     Test.Circuit.Affine
     Test.Circuit.Arithmetic
-    Test.Circuit.Expr
     Test.Circuit.R1CS
-    Test.Circuit.Sudoku
-    Test.Circuit.Lang
 
   hs-source-dirs:     test
 
   ghc-options:        -freverse-errors -O2 -Wall -main-is Main
   build-depends:
       arithmetic-circuits
     , array
-    , distributive 
-    , fin
-    , integer-logarithms
     , quickcheck-instances  >=0.3
     , QuickCheck
     , random
@@ -145,7 +187,6 @@ test-suite circuit-tests
     , tasty-hunit           >=0.10
     , tasty-hspec
     , tasty-quickcheck      >=0.10
-    , vec
 
   build-tool-depends: tasty-discover:tasty-discover >=4.2
 

Diff for: circom-compat/app/Main.hs

@@ -4,8 +4,9 @@
 module Main where
 
 import Circuit
+import Circuit.Language
 import Data.Binary (encodeFile)
-import Data.Field.Galois (GaloisField, Prime)
+import Data.Field.Galois (Prime)
 import Data.Map qualified as Map
 import Data.Set qualified as Set
 import Protolude
@@ -14,7 +15,7 @@ import R1CS.Circom (r1csToCircomR1CS, witnessToCircomWitness)
 
 main :: IO ()
 main = do
-  let BuilderState {..} = snd $ runCircuitBuilder $ program @Fr
+  let BuilderState {..} = snd $ runCircuitBuilder program
       publicInputs = Map.fromList $ zip (Set.toAscList $ cvPublicInputs bsVars) [6]
       privateInputs = Map.fromList $ zip (Set.toAscList $ cvPrivateInputs bsVars) [2, 3]
       inputs = publicInputs <> privateInputs
@@ -25,7 +26,7 @@ main = do
 
 type Fr = Prime 21888242871839275222246405745257275088548364400416034343698204186575808495617
 
-program :: (GaloisField f) => ExprM f Wire
+program :: ExprM Fr Wire
 program = do
   n <- deref <$> fieldInput Public "n"
   a <- deref <$> fieldInput Private "a"

Diff for: language/src/Circuit/Language.hs

@@ -0,0 +1,10 @@
+module Circuit.Language
+  ( module Circuit.Language.Compile,
+    module Circuit.Language.DSL,
+    module Circuit.Language.TExpr,
+  )
+where
+
+import Circuit.Language.Compile
+import Circuit.Language.DSL
+import Circuit.Language.TExpr

Diff for: src/Circuit/Compile.hs renamed to language/src/Circuit/Language/Compile.hs

@@ -1,4 +1,4 @@
-module Circuit.Compile
+module Circuit.Language.Compile
   ( ExprM,
     BuilderState (..),
     execCircuitBuilder,
@@ -16,7 +16,7 @@ where
 
 import Circuit.Affine
 import Circuit.Arithmetic
-import Circuit.Expr
+import Circuit.Language.Expr
   ( BinOp (..),
     Expr (..),
     UVar (..),
@@ -25,9 +25,8 @@ import Circuit.Expr
     hashCons,
     unType,
   )
-import Circuit.TExpr qualified as TExpr
+import Circuit.Language.TExpr qualified as TExpr
 import Data.Field.Galois (GaloisField)
-import Data.Interned
 import Data.Map qualified as Map
 import Data.Set qualified as Set
 import Data.Vector qualified as V
@@ -42,7 +41,7 @@ data BuilderState f = BuilderState
   { bsCircuit :: ArithCircuit f,
     bsNextVar :: Int,
     bsVars :: CircuitVars Text,
-    bsSharedMap :: Map Id (V.Vector (SignalSource f))
+    bsSharedMap :: Map Int (V.Vector (SignalSource f))
   }
 
 defaultBuilderState :: BuilderState f
@@ -64,32 +63,31 @@ instance (GaloisField f) => Pretty (CircuitBuilderError f) where
     ExpectedSingleWire wires -> "Expected a single wire, but got:" <+> pretty (toList wires)
     MismatchedWireTypes l r -> "Mismatched wire types:" <+> pretty (toList l) <+> pretty (toList r)
 
-type ExprM f a = ExceptT (CircuitBuilderError f) (StateT (BuilderState f) IO) a
+type ExprM f a = ExceptT (CircuitBuilderError f) (State (BuilderState f)) a
 
-runExprM :: (GaloisField f) => ExprM f a -> BuilderState f -> IO (a, BuilderState f)
+runExprM :: (GaloisField f) => ExprM f a -> BuilderState f -> (a, BuilderState f)
 runExprM m s = do
-  res <- runStateT (runExceptT m) s
+  let res = runState (runExceptT m) s
   case res of
     (Left e, _) -> panic $ Protolude.show $ pretty e
-    (Right a, s') -> pure $ (a, s')
+    (Right a, s') -> (a, s')
 
-execCircuitBuilder :: (GaloisField f) => ExprM f a -> IO (ArithCircuit f)
-execCircuitBuilder m = reverseCircuit . bsCircuit . snd <$> runExprM m defaultBuilderState
+execCircuitBuilder :: (GaloisField f) => ExprM f a -> (ArithCircuit f)
+execCircuitBuilder m = reverseCircuit . bsCircuit . snd $ runExprM m defaultBuilderState
   where
     reverseCircuit = \(ArithCircuit cs) -> ArithCircuit $ reverse cs
 
-evalCircuitBuilder :: (GaloisField f) => ExprM f a -> IO a
-evalCircuitBuilder e = fst <$> runCircuitBuilder e
+evalCircuitBuilder :: (GaloisField f) => ExprM f a -> a
+evalCircuitBuilder e = fst $ runCircuitBuilder e
 
-runCircuitBuilder :: (GaloisField f) => ExprM f a -> IO (a, BuilderState f)
+runCircuitBuilder :: (GaloisField f) => ExprM f a -> (a, BuilderState f)
 runCircuitBuilder m = do
-  (a, s) <- runExprM m defaultBuilderState
-  pure
-    ( a,
-      s
-        { bsCircuit = reverseCircuit $ bsCircuit s
-        }
-    )
+  let (a, s) = runExprM m defaultBuilderState
+   in ( a,
+        s
+          { bsCircuit = reverseCircuit $ bsCircuit s
+          }
+      )
   where
     reverseCircuit = \(ArithCircuit cs) -> ArithCircuit $ reverse cs
 
@@ -190,7 +188,6 @@ addWire x = case x of
 
 compileWithWire ::
   (Hashable f, GaloisField f) =>
-  (MonadIO m) =>
   (MonadState (BuilderState f) m) =>
   (MonadError (CircuitBuilderError f) m) =>
   m (TExpr.Var Wire f ty) ->
@@ -202,7 +199,6 @@ compileWithWire freshWire e = do
 
 compileWithWires ::
   (Hashable f, GaloisField f) =>
-  (MonadIO m) =>
   (MonadState (BuilderState f) m) =>
   (MonadError (CircuitBuilderError f) m) =>
   V.Vector (m (TExpr.Var Wire f f)) ->
@@ -242,7 +238,7 @@ assertSameSourceSize l r =
 
 withCompilerCache ::
   (MonadState (BuilderState f) m) =>
-  Id ->
+  Int ->
   m (V.Vector (SignalSource f)) ->
   m (V.Vector (SignalSource f))
 withCompilerCache i m = do
@@ -380,4 +376,4 @@ exprToArithCircuit ::
 exprToArithCircuit expr output = do
   let e = hashCons $ unType expr
   compileOut <- memoizedCompile e >>= assertSingleSource
-  emit $ Mul (ConstGate 1) (addVar compileOut) output
+  emit $ Mul (ConstGate 1) (addVar compileOut) output

Diff for: src/Circuit/Lang.hs renamed to language/src/Circuit/Language/DSL.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE TypeFamilies #-}
 
 -- | Surface language
-module Circuit.Lang
+module Circuit.Language.DSL
   ( Signal,
     Bundle,
     cField,
@@ -39,16 +39,16 @@ module Circuit.Lang
 where
 
 import Circuit.Arithmetic (InputType (Private, Public), Wire (..))
-import Circuit.TExpr
+import Circuit.Language.Compile
+import Circuit.Language.TExpr
 import Data.Field.Galois (GaloisField, PrimeField)
 import Data.Finite (Finite)
 import Data.Maybe (fromJust)
+import Data.Vector qualified as V
 import Data.Vector.Sized (Vector)
 import Data.Vector.Sized qualified as SV
-import Data.Vector qualified as V
 import Protolude
 import Unsafe.Coerce (unsafeCoerce)
-import Circuit.Compile
 
 --------------------------------------------------------------------------------
 type Signal f = Expr Wire f
@@ -128,14 +128,14 @@ bundle = EBundle
 boolToField :: Signal f Bool -> Signal f f
 boolToField = unsafeCoerce
 
-
-unBundle :: forall n f ty. 
-  (KnownNat n, GaloisField f, Hashable f) => 
-  Expr Wire f (Vector n ty) -> 
+unBundle ::
+  forall n f ty.
+  (KnownNat n, GaloisField f, Hashable f) =>
+  Expr Wire f (Vector n ty) ->
   ExprM f (Vector n (Expr Wire f f))
 unBundle b = do
   let freshWires = V.replicate (fromIntegral $ natVal $ Proxy @n) (VarField <$> imm)
-  bis <- compileWithWires freshWires b 
+  bis <- compileWithWires freshWires b
   pure $ fromJust $ SV.toSized (EVar . VarField <$> bis)
 
 --------------------------------------------------------------------------------