/ haskell / src / Graph.hs
Graph.hs
  1  
  2  {-# LANGUAGE StrictData #-}
  3  module Graph where
  4  
  5  --------------------------------------------------------------------------------
  6  
  7  import Control.Monad
  8  import Text.Printf
  9  
 10  --------------------------------------------------------------------------------
 11  
 12  import Data.Word
 13  
 14  data Graph = Graph
 15    { graphNodes :: [Node]
 16    , graphMeta  :: GraphMetaData
 17    }
 18    deriving Show
 19  
 20  --------------------------------------------------------------------------------
 21  
 22  -- | Unary operations
 23  data UnoOp
 24    = Neg       -- ^ @= 0@
 25    | Id        -- ^ @= 1@
 26    | Lnot      -- ^ @= 2@
 27    | Bnot      -- ^ @= 3@
 28    deriving (Eq,Enum,Bounded,Show)
 29  
 30  data DuoOp 
 31    = Mul       -- ^ @=  0@
 32    | Div       -- ^ @=  1@
 33    | Add       -- ^ @=  2@
 34    | Sub       -- ^ @=  3@
 35    | Pow       -- ^ @=  4@
 36    | Idiv      -- ^ @=  5@
 37    | Mod       -- ^ @=  6@
 38    | Eq_       -- ^ @=  7@
 39    | Neq       -- ^ @=  8@
 40    | Lt        -- ^ @=  9@
 41    | Gt        -- ^ @= 10@
 42    | Leq       -- ^ @= 11@
 43    | Geq       -- ^ @= 12@
 44    | Land      -- ^ @= 13@
 45    | Lor       -- ^ @= 14@
 46    | Shl       -- ^ @= 15@
 47    | Shr       -- ^ @= 16@
 48    | Bor       -- ^ @= 17@
 49    | Band      -- ^ @= 18@
 50    | Bxor      -- ^ @= 19@
 51    deriving (Eq,Enum,Bounded,Show)
 52  
 53  data TresOp
 54    = TernCond  -- ^ @= 0@
 55    deriving (Eq,Enum,Bounded,Show)
 56  
 57  --------------------------------------------------------------------------------
 58  
 59  newtype BigUInt 
 60    = BigUInt [Word8]      -- ^ little endian
 61  
 62  dummyBigUInt :: BigUInt
 63  dummyBigUInt = BigUInt [0]
 64  
 65  showBigUInt :: BigUInt -> String
 66  showBigUInt (BigUInt bytes) = "0x" ++ concatMap f (reverse bytes) where
 67    f :: Word8 -> String
 68    f = printf "%02x"
 69  
 70  instance Show BigUInt where show = showBigUInt
 71  
 72  newtype InputNode 
 73    = InputNode Word32
 74    deriving (Show)
 75   
 76  newtype ConstantNode 
 77    = ConstantNode BigUInt
 78    deriving (Show)
 79  
 80  data UnoOpNode  = UnoOpNode  !UnoOp  !Word32                 deriving (Show)
 81  data DuoOpNode  = DuoOpNode  !DuoOp  !Word32 !Word32         deriving (Show)
 82  data TresOpNode = TresOpNode !TresOp !Word32 !Word32 !Word32 deriving (Show)
 83  
 84  data Node 
 85    = AnInputNode    InputNode         -- @= 1@
 86    | AConstantNode  ConstantNode      -- @= 2@
 87    | AnUnoOpNode    UnoOpNode         -- @= 3@
 88    | ADuoOpNode     DuoOpNode         -- @= 4@
 89    | ATresOpNode    TresOpNode        -- @= 5@
 90    deriving (Show)
 91  
 92  data SignalDescription = SignalDescription
 93    { signalOffset :: !Word32
 94    , signalLength :: !Word32
 95    }
 96    deriving (Show)
 97  
 98  newtype WitnessMapping 
 99    = WitnessMapping { fromWitnessMapping :: [Word32] }
100    deriving (Show)
101  
102  type CircuitInputs = [(String, SignalDescription)]
103  
104  data Prime = Prime
105    { primeNumber  :: !BigUInt
106    , primeName    :: !String
107    }
108    deriving (Show)
109  
110  data GraphMetaData = GraphMetaData 
111    { witnessMapping :: WitnessMapping
112    , inputSignals   :: CircuitInputs  
113    , prime          :: Prime
114    }
115    deriving (Show)
116  
117  --------------------------------------------------------------------------------
118  
119  debugPrintGraph :: Graph -> IO ()
120  debugPrintGraph (Graph nodes meta) = do
121    forM_ (zip [0..] nodes) $ \(i,node) -> do
122      putStrLn $ show i ++ " -> " ++ showNode node
123  
124  showNode :: Node -> String
125  showNode node = case node of
126    AnInputNode    node -> show node
127    AConstantNode  node -> show node
128    AnUnoOpNode    node -> show node
129    ADuoOpNode     node -> show node
130    ATresOpNode    node -> show node
131  
132  printNode :: Node -> IO ()
133  printNode = putStrLn . showNode
134  
135  --------------------------------------------------------------------------------