haskell loader for AbstractInterpretationResult ; quick and dirty external dataflow evaluator

grin/grin.cabal

@@ -37,6 +37,8 @@ library
     AbstractInterpretation.IR
     AbstractInterpretation.BinaryIR
     AbstractInterpretation.PrettyIR
+    AbstractInterpretation.BinaryResult
+    AbstractInterpretation.ReduceCpp
     AbstractInterpretation.Reduce
     AbstractInterpretation.Util
     AbstractInterpretation.OptimiseAbstractProgram

grin/src/AbstractInterpretation/BinaryResult.hs

@@ -0,0 +1,65 @@
+{-# LANGUAGE LambdaCase, RecordWildCards #-}
+module AbstractInterpretation.BinaryResult where
+
+import Data.Int
+import Data.Set (Set)
+import qualified Data.Set as Set
+import Data.Map (Map)
+import qualified Data.Map.Strict as Map
+import Data.Vector (Vector)
+import qualified Data.Vector as V
+
+import Control.Monad
+
+import AbstractInterpretation.IR
+import AbstractInterpretation.Reduce (NodeSet(..), Value(..), ComputerState(..), AbstractInterpretationResult(..))
+import Data.Binary.Get
+import qualified Data.ByteString.Lazy as LBS
+
+checkTag :: Int32 -> String -> Get ()
+checkTag tag msg = do
+  i <- getInt32le
+  when (i /= tag) $ fail msg
+
+readTag :: Get Tag
+readTag = Tag <$> getWord32le
+
+readIntSet :: Get (Set Int32)
+readIntSet = do
+  checkTag 1000 "int set expected"
+  size <- fromIntegral <$> getInt32le
+  Set.fromList <$> replicateM size getInt32le
+
+readNodeItem :: Get (Vector (Set Int32))
+readNodeItem = do
+  checkTag 1001 "node item expected"
+  size <- fromIntegral <$> getInt32le
+  V.fromList <$> replicateM size readIntSet
+
+readNodeSet :: Get NodeSet
+readNodeSet = do
+  checkTag 1002 "node set expected"
+  size <- fromIntegral <$> getInt32le
+  NodeSet . Map.fromList <$> replicateM size ((,) <$> readTag <*> readNodeItem)
+
+readValue :: Get Value
+readValue = do
+  checkTag 1003 "value expected"
+  Value <$> readIntSet <*> readNodeSet
+
+readAbstractInterpretationResult :: Get AbstractInterpretationResult
+readAbstractInterpretationResult = do
+  iterCount <- fromIntegral <$> getInt32le
+  memCount <- fromIntegral <$> getInt32le
+  regCount <- fromIntegral <$> getInt32le
+  mem <- V.fromList <$> replicateM memCount readNodeSet
+  reg <- V.fromList <$> replicateM regCount readValue
+  pure $ AbsIntResult
+    { _airComp  = ComputerState {_memory = mem, _register = reg}
+    , _airIter  = iterCount
+    }
+
+
+loadAbstractInterpretationResult :: String -> IO AbstractInterpretationResult
+loadAbstractInterpretationResult fname = do
+  runGet readAbstractInterpretationResult <$> LBS.readFile fname

grin/src/AbstractInterpretation/ReduceCpp.hs

@@ -0,0 +1,25 @@
+{-# LANGUAGE LambdaCase, RecordWildCards, Strict #-}
+module AbstractInterpretation.ReduceCpp where
+
+import qualified Data.ByteString.Lazy as LBS
+import qualified System.Process
+import System.IO.Unsafe
+
+import AbstractInterpretation.IR
+import AbstractInterpretation.Reduce (AbstractInterpretationResult)
+import AbstractInterpretation.BinaryResult
+import AbstractInterpretation.BinaryIR
+
+evalAbstractProgramCpp :: AbstractProgram -> IO AbstractInterpretationResult
+evalAbstractProgramCpp prg = do
+  -- save abstract program to temp file
+  LBS.writeFile "dataflow_program.dfbin" $ encodeAbstractProgram prg
+
+  -- run external reducer
+  System.Process.callCommand "df_test dataflow_program.dfbin"
+
+  -- read back result
+  loadAbstractInterpretationResult "dataflow_program.dfbin.dat"
+
+evalAbstractProgramCppUnsafe :: AbstractProgram -> AbstractInterpretationResult
+evalAbstractProgramCppUnsafe a = unsafePerformIO $ evalAbstractProgramCpp a