newtype hash

Author: martyall

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

@@ -23,7 +23,7 @@ import Circuit.Language.Expr
     UnOp (..),
     getAnnotation,
     hashCons,
-    unType,
+    unType, Hash (Hash),
   )
 import Circuit.Language.TExpr qualified as TExpr
 import Data.Field.Galois (GaloisField)
@@ -41,7 +41,7 @@ data BuilderState f = BuilderState
   { bsCircuit :: ArithCircuit f,
     bsNextVar :: Int,
     bsVars :: CircuitVars Text,
-    bsSharedMap :: Map Int (V.Vector (SignalSource f))
+    bsSharedMap :: Map Hash (V.Vector (SignalSource f))
   }
 
 defaultBuilderState :: BuilderState f
@@ -206,7 +206,7 @@ compileWithWires ::
   m (V.Vector Wire)
 compileWithWires ws expr = do
   let e = hashCons $ unType expr
-  compileOut <- memoizedCompile $ e
+  compileOut <- memoizedCompile e
   for (V.zip compileOut ws) $ \(o, freshWire) -> do
     case o of
       WireSource wire -> do
@@ -238,7 +238,7 @@ assertSameSourceSize l r =
 
 withCompilerCache ::
   (MonadState (BuilderState f) m) =>
-  Int ->
+  Hash ->
   m (V.Vector (SignalSource f)) ->
   m (V.Vector (SignalSource f))
 withCompilerCache i m = do
@@ -251,7 +251,7 @@ _compile ::
   (Hashable f, GaloisField f) =>
   (MonadState (BuilderState f) m) =>
   (MonadError (CircuitBuilderError f) m) =>
-  Expr Int Wire f ->
+  Expr Hash Wire f ->
   m (V.Vector (SignalSource f))
 _compile expr = withCompilerCache (getAnnotation expr) $ case expr of
   EVal _ f -> pure $ V.singleton $ AffineSource $ ConstGate f
@@ -310,7 +310,7 @@ _compile expr = withCompilerCache (getAnnotation expr) $ case expr of
   -- EQ(lhs, rhs) = (lhs - rhs == 1) only allowed for field comparison
   EEq _ lhs rhs -> do
     -- assertSingle is justified as the lhs and rhs must be of type f
-    let e = EBinOp (hash (BSub, getAnnotation lhs, getAnnotation rhs)) BSub lhs rhs
+    let e = EBinOp (Hash $ hash (BSub, getAnnotation lhs, getAnnotation rhs)) BSub lhs rhs
     eqInWire <- do
       eOut <- withCompilerCache (getAnnotation e) (memoizedCompile e)
       assertSingleSource eOut >>= addWire
@@ -330,7 +330,7 @@ _compile expr = withCompilerCache (getAnnotation expr) $ case expr of
         outputs
         ( \o ->
             let v = UVar o
-                e = EVar (hash v) v
+                e = EVar (Hash $ hash v) v
              in memoizedCompile e
         )
     where
@@ -358,7 +358,7 @@ memoizedCompile ::
   (Hashable f, GaloisField f) =>
   (MonadState (BuilderState f) m) =>
   (MonadError (CircuitBuilderError f) m) =>
-  Expr Int Wire f ->
+  Expr Hash Wire f ->
   m (V.Vector (SignalSource f))
 memoizedCompile expr = do
   m <- gets bsSharedMap

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

@@ -1,4 +1,13 @@
-module Circuit.Language.Expr where
+module Circuit.Language.Expr  
+  (  Expr(..),
+  UVar(..),
+  BinOp(..),
+  UnOp(..),
+  unType,
+  Hash(..),
+  hashCons,
+  getAnnotation,
+  ) where
 
 import Circuit.Language.TExpr qualified as TExpr
 import Data.Vector qualified as V
@@ -77,52 +86,56 @@ getAnnotation = \case
   EUpdateIndex a _ _ _ -> a
   EBundle a _ -> a
 
-hashCons :: (Hashable i, Hashable f) => Expr () i f -> Expr Int i f
+newtype Hash = Hash Int
+  deriving (Show, Eq, Ord)
+  deriving (Hashable) via Int
+
+hashCons :: (Hashable i, Hashable f) => Expr () i f -> Expr Hash i f
 hashCons = \case
   EVal _ f ->
-    let i = hash (hash @Text "EVal", f)
+    let i = Hash $ hash (hash @Text "EVal", f)
      in EVal i f
   EVar _ v ->
-    let i = hash (hash @Text "EVar", v)
+    let i = Hash $ hash (hash @Text "EVar", v)
      in EVar i v
   EUnOp _ op e ->
     let e' = hashCons e
-        i = hash (hash @Text "EUnOp", op, getAnnotation e')
+        i = Hash $ hash (hash @Text "EUnOp", op, getAnnotation e')
      in EUnOp i op e'
   EBinOp _ op e1 e2 ->
     let e1' = hashCons e1
         e2' = hashCons e2
-        i = hash (hash @Text "EBinOp", op, getAnnotation e1', getAnnotation e2')
+        i = Hash $ hash (hash @Text "EBinOp", op, getAnnotation e1', getAnnotation e2')
      in EBinOp i op e1' e2'
   EIf _ b t e ->
     let b' = hashCons b
         t' = hashCons t
         e' = hashCons e
-        i = hash (hash @Text "EIf", getAnnotation b', getAnnotation t', getAnnotation e')
+        i = Hash $ hash (hash @Text "EIf", getAnnotation b', getAnnotation t', getAnnotation e')
      in EIf i b' t' e'
   EEq _ l r ->
     let l' = hashCons l
         r' = hashCons r
-        i = hash (hash @Text "EEq", getAnnotation l', getAnnotation r')
+        i = Hash $ hash (hash @Text "EEq", getAnnotation l', getAnnotation r')
      in EEq i l' r'
   ESplit _ n e ->
     let e' = hashCons e
-        i = hash (hash @Text "ESplit", n, getAnnotation e')
+        i = Hash $ hash (hash @Text "ESplit", n, getAnnotation e')
      in ESplit i n e'
   EJoin _ e ->
     let e' = hashCons e
-        i = hash (hash @Text "EJoin", getAnnotation e')
+        i = Hash $ hash (hash @Text "EJoin", getAnnotation e')
      in EJoin i e'
   EAtIndex _ v ix ->
     let v' = hashCons v
-        i = hash (hash @Text "AtIndex", getAnnotation v', ix)
+        i = Hash $ hash (hash @Text "AtIndex", getAnnotation v', ix)
      in EAtIndex i v' ix
   EUpdateIndex _ p b v ->
     let b' = hashCons b
         v' = hashCons v
-        i = hash (hash @Text "UpdateIndex", p, getAnnotation b', getAnnotation v')
+        i = Hash $ hash (hash @Text "UpdateIndex", p, getAnnotation b', getAnnotation v')
      in EUpdateIndex i p b' v'
   EBundle _ b ->
     let b' = V.map hashCons b
-        i = hash (hash @Text "Bundle", toList $ fmap getAnnotation b')
+        i = Hash $ hash (hash @Text "Bundle", toList $ fmap getAnnotation b')
      in EBundle i b'