From dfe5239fcbcf7dcdbe07fb2702bd46e5d1d33670 Mon Sep 17 00:00:00 2001 From: Balazs Komuves Date: Sun, 16 Mar 2025 20:10:19 +0100 Subject: [PATCH] Haskell: minor refactoring to help debugging (by which I mean debugging the Nim one...) --- haskell/src/Export.hs | 7 ++++++- haskell/src/Graph.hs | 19 +++++++++++++++++++ haskell/src/Main.hs | 17 +++++++++++------ haskell/src/Parser.hs | 2 +- haskell/src/Witness.hs | 25 ++++++++++++++++++------- 5 files changed, 55 insertions(+), 15 deletions(-) diff --git a/haskell/src/Export.hs b/haskell/src/Export.hs index afb111b..2bd4d64 100644 --- a/haskell/src/Export.hs +++ b/haskell/src/Export.hs @@ -21,10 +21,15 @@ import Witness -------------------------------------------------------------------------------- exportWitness :: FilePath -> Witness -> IO () -exportWitness fpath ws = do +exportWitness fpath (MkWitness ws) = do let bs = runPut (putWitness ws) L.writeFile fpath bs +exportFeltSequence :: FilePath -> Array Int F -> IO () +exportFeltSequence fpath arr = do + let bs = runPut $ putRawWitness (elems arr) + L.writeFile fpath bs + -------------------------------------------------------------------------------- putHeader :: Int -> Put diff --git a/haskell/src/Graph.hs b/haskell/src/Graph.hs index a3f490d..255d148 100644 --- a/haskell/src/Graph.hs +++ b/haskell/src/Graph.hs @@ -4,6 +4,7 @@ module Graph where -------------------------------------------------------------------------------- +import Control.Monad import Text.Printf -------------------------------------------------------------------------------- @@ -104,3 +105,21 @@ data GraphMetaData = GraphMetaData deriving (Show) -------------------------------------------------------------------------------- + +debugPrintGraph :: Graph -> IO () +debugPrintGraph (Graph nodes meta) = do + forM_ (zip [0..] nodes) $ \(i,node) -> do + putStrLn $ show i ++ " -> " ++ showNode node + +showNode :: Node -> String +showNode node = case node of + AnInputNode node -> show node + AConstantNode node -> show node + AnUnoOpNode node -> show node + ADuoOpNode node -> show node + ATresOpNode node -> show node + +printNode :: Node -> IO () +printNode = putStrLn . showNode + +-------------------------------------------------------------------------------- diff --git a/haskell/src/Main.hs b/haskell/src/Main.hs index 552ebd8..d4f364e 100644 --- a/haskell/src/Main.hs +++ b/haskell/src/Main.hs @@ -32,14 +32,19 @@ testInputs = Map.fromList graphFile = "../../tmp/graph4.bin" inputFile = "../../tmp/input4.json" wtnsFile = "../../tmp/my4.wtns" +fullFile = "../../tmp/my4_full.bin" main :: IO () main = do - Right graph <- parseGraphFile graphFile - putStrLn "" - inputs <- loadInputJsonFile inputFile - print (inputSignals $ graphMeta graph) - let wtns = witnessCalc inputs graph + Right graph <- parseGraphFile graphFile + inputs <- loadInputJsonFile inputFile + -- putStrLn "" - -- print wtns + -- print (inputSignals $ graphMeta graph) + + -- let full = fullComputation graph inputs + -- exportFeltSequence fullFile full + + let wtns = witnessCalc graph inputs exportWitness wtnsFile wtns + diff --git a/haskell/src/Parser.hs b/haskell/src/Parser.hs index 140b83f..9e2b0b0 100644 --- a/haskell/src/Parser.hs +++ b/haskell/src/Parser.hs @@ -70,7 +70,7 @@ readGraphFile h = do else do hSeekInt h (flen - 8) offset <- (fromIntegral . runGet getWord64le) <$> hGetBytes h 8 - putStrLn $ "metadata offset = " ++ show offset + -- putStrLn $ "metadata offset = " ++ show offset if (offset >= flen) || (offset <= 18) then return $ Left "invalid final `graphMetaData` offset bytes" else do diff --git a/haskell/src/Witness.hs b/haskell/src/Witness.hs index 002f1ea..8b70cc8 100644 --- a/haskell/src/Witness.hs +++ b/haskell/src/Witness.hs @@ -15,31 +15,42 @@ import BN254 import qualified Semantics as S ; import Semantics ( PrimOp , evalPrimOp ) import qualified Graph as G ; import Graph ( Graph(..) , Node(..) , UnoOpNode(..) , DuoOpNode(..) , TresOpNode(..) , SignalDescription(..) ) +import Debug.Trace +debug msg x y = trace (">>> " ++ msg ++ " ~> " ++ show x) y + -------------------------------------------------------------------------------- -type Witness = Array Int F +newtype Witness = MkWitness (Array Int F) type Inputs = Map String [Integer] -witnessCalc :: Inputs -> Graph -> Witness -witnessCalc inputs (Graph nodes meta) = witness where +-- | This includes all temporary values (one per graph node), not all of which is +-- present in the final witness +fullComputation :: Graph -> Inputs -> Array Int F +fullComputation (Graph nodes meta) inputs = rawWitness where nodesArr = listArray (0,length nodes-1) nodes rawWitness = evaluateNodes rawInputs nodesArr rawInputs = convertInputs (G.inputSignals meta) inputs + +fullLogToWitness :: Graph -> Array Int F -> Witness +fullLogToWitness (Graph nodes meta) fullLog = MkWitness witness where mapping_ = G.fromWitnessMapping (G.witnessMapping meta) wtnslen = length mapping_ mapping = listArray (0,wtnslen-1) mapping_ - witness = listArray (0,wtnslen-1) $ [ rawWitness!(fromIntegral (mapping!i)) | i<-[0..wtnslen-1] ] + witness = listArray (0,wtnslen-1) $ [ fullLog!(fromIntegral (mapping!i)) | i<-[0..wtnslen-1] ] + +witnessCalc :: Graph -> Inputs -> Witness +witnessCalc graph inputs = fullLogToWitness graph (fullComputation graph inputs) convertInputs :: [(String,SignalDescription)] -> Map String [Integer] -> IntMap F -convertInputs descTable inputTable = IntMap.fromList $ concatMap f descTable where +convertInputs descTable inputTable = IntMap.fromList $ (0,1) : concatMap f descTable where f :: (String,SignalDescription) -> [(Int,F)] f (name,desc) = case Map.lookup name inputTable of Nothing -> error $ "input signal `" ++ name ++ "` not found in the given inputs!" Just values -> if length values /= fromIntegral (signalLength desc) then error $ "input signal `" ++ name ++ "` has incorrect size" else let ofs = fromIntegral (signalOffset desc) :: Int - in (0,1) : zip [ofs..] (map toF values) + in zip [ofs..] (map toF values) -------------------------------------------------------------------------------- @@ -79,7 +90,7 @@ duoToPrimOp (DuoOpNode op arg1 arg2) = case op of G.Mul -> S.Mul arg1 arg2 G.Div -> S.Div arg1 arg2 G.Add -> S.Add arg1 arg2 - G.Sub -> S.Sub arg1 arg2 + G.Sub -> S.Sub arg1 arg2 -- debug "sub " (op,arg1,arg2) $ G.Pow -> S.Pow arg1 arg2 G.Idiv -> S.Idiv arg1 arg2 G.Mod -> S.Mod arg1 arg2