Support query for output record derivation trace.

1. Add maps to store all debug event entries and extract output record and its input record
   and store these information.
2. Add helper function to get predecessor operatorId for input record from syntax tree
3. Add tree-like 'DebuggerRecordNode' structure to store all possible derivation results
   for a given output record with operator id.

debugger/Main.hs

@@ -21,19 +21,126 @@ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
 SOFTWARE.
 -}
 
-import Language.DifferentialDatalog.Debugger.DebugEventParser
-import Text.Parsec
+{-# LANGUAGE RecordWildCards, ImplicitParams, LambdaCase, FlexibleContexts, TemplateHaskell #-}
+
 import System.Environment
+import System.Console.GetOpt
+import System.FilePath.Posix
+import Text.Parsec
+import Control.Exception
+import Control.Monad
+import Data.List
+import Debug.Trace
+
+import Language.DifferentialDatalog.Config
+import Language.DifferentialDatalog.Syntax
+import Language.DifferentialDatalog.Module
+import Language.DifferentialDatalog.Debugger.DebugTypes
+import Language.DifferentialDatalog.Debugger.DebugState
+import Language.DifferentialDatalog.Debugger.DebugEventParser
+import Language.DifferentialDatalog.DatalogProgram
+import Language.DifferentialDatalog.Validate
+import Language.DifferentialDatalog.Debug
+
+data TOption = Help
+             | DebugDumpFile String
+             | Datalog String
+             | LibDir String
+             | OutputDir String
+             | OutputInternal
+             | OutputInput String
+             | DumpFlat
 
-parseText :: String -> String
-parseText inputString = do
-                  case parse eventsParser "" inputString of
-                        Left e      -> errorWithoutStackTrace $ "Failed to parse input file: " ++ show e
-                        Right r     -> show r
+options :: [OptDescr TOption]
+options = [ Option ['h'] ["help"]             (NoArg Help)                          "Display help message."
+          , Option ['d'] []                   (ReqArg DebugDumpFile "DEBUG_FILE")   "Debug dumped file."
+          , Option ['i'] []                   (ReqArg Datalog  "FILE")              "DDlog program to compile."
+          , Option ['L'] []                   (ReqArg LibDir   "PATH")              "Extra DDlog library directory."
+          , Option ['o'] ["output-dir"]       (ReqArg OutputDir "DIR")              "Output directory (default based on program name)."
+          , Option []    ["output-internal-relations"]  (NoArg OutputInternal)  "All non-input relations are marked as output relations."
+          , Option []    ["output-input-relations"]  (ReqArg OutputInput "PREFIX") "Mirror each input relation into an output relation named by prepending the prefix."
+          ]
+
+addOption :: Config -> TOption -> IO Config
+addOption config (DebugDumpFile f) = return config { confDebugDumpFile = f}
+addOption config (Datalog f)       = return config { confDatalogFile  = f}
+addOption config (LibDir d)        = return config { confLibDirs = nub (d:confLibDirs config)}
+addOption config (OutputDir d)     = return config { confOutputDir = d }
+addOption config Help              = return config { confAction = ActionHelp}
+addOption config OutputInternal   = return config { confOutputInternal = True }
+addOption config (OutputInput p)  = return config { confOutputInput = p }
+addOption config DumpFlat         = return config { confDumpFlat = True }
+
+validateConfig :: Config -> IO ()
+validateConfig Config{..} = do
+    when (confDatalogFile == "" && confAction /= ActionHelp && confAction /= ActionVersion)
+         $ errorWithoutStackTrace "input file not specified"
 
 main :: IO ()
 main = do
-       (filename:_) <- getArgs
-       contents <- readFile filename
-       let result = parseText contents
-       putStr result
+       args <- getArgs
+       prog <- getProgName
+       home <- lookupEnv "DDLOG_HOME"
+       config <- case getOpt Permute options args of
+                      (flags, [], []) -> do
+                                            conf <- foldM addOption defaultConfig flags
+                                            validateConfig conf
+                                            return conf
+                                         `catch`
+                                         (\e -> do putStrLn $ usageInfo ("Usage: " ++ prog ++ " [OPTION...]") options
+                                                   throw (e::SomeException))
+                      _ -> errorWithoutStackTrace $ usageInfo ("Usage: " ++ prog ++ " [OPTION...]") options
+       config' <- case home of
+           Just(p) -> addOption config (LibDir $ p ++ "/lib")
+           _       -> return config
+       do
+            datalogProg <- parseProgram config'
+            events <- parseEventFromDumpFile config'
+            let recordMap = handleDebugEvents events emptyDebuggerMaps datalogProg
+                s = queryAll events (dbgRecordMap recordMap)
+            putStr $ show s
+
+queryAll :: [Event] -> DebuggerRecordMap -> String
+queryAll [] _ = "Finished"
+queryAll (event: events) dgbRecordMap =
+    let outputRecord = evtOutput event
+        operatorId = evtOperatorId event
+        operatorInput = InputOp operatorId
+        dbgRecord = DebuggerRecord {dbgRecord=outputRecord, dbgOperatorId=operatorInput}
+        dbgRecordNodes = queryDerivations dbgRecord dgbRecordMap
+    in trace (show dbgRecordNodes) $ queryAll events dgbRecordMap
+
+parseProgram :: Config -> IO (DatalogProgram)
+parseProgram Config{..} = do
+    fdata <- readFile confDatalogFile
+    (d, _, _) <- parseDatalogProgram (takeDirectory confDatalogFile:confLibDirs) True fdata confDatalogFile
+    d'' <- case confOutputInternal of
+        False -> return d
+        True ->  return $ progOutputInternalRelations d
+    d''' <- case confOutputInput of
+         "" -> return d''
+         x  ->  return $ progMirrorInputRelations d'' x
+    when confDumpFlat $
+         writeFile (replaceExtension confDatalogFile ".flat.ast") (show d''')
+    d'''' <- case validate d''' of
+         Left e   -> errorWithoutStackTrace $ "error: " ++ e
+         Right d'''' -> return d''''
+    return (progDebugUpdateRules d'''')
+
+parseEventFromDumpFile :: Config -> IO ([Event])
+parseEventFromDumpFile Config{..} = do
+    contents <- readFile confDebugDumpFile
+    return (parseDebugEvents contents)
+
+parseDebugEvents :: String -> [Event]
+parseDebugEvents inputString = do
+    case parse eventsParser "" inputString of
+        Left e      -> errorWithoutStackTrace $ "Failed to parse input file: " ++ show e
+        Right r     -> r
+
+progDebugUpdateRules :: DatalogProgram -> DatalogProgram
+progDebugUpdateRules d =
+  let
+    rules = progRules d
+    updatedRules = [(rules !! i) {ruleRHS = debugUpdateRHSRulesWithoutHooks d i (rules !! i)}  | i <- [0..length rules - 1]]
+  in d { progRules = updatedRules }

src/Language/DifferentialDatalog/Config.hs

@@ -51,6 +51,7 @@ data Config = Config { confDatalogFile   :: FilePath
                      , confDumpDebug     :: Bool
                      , confDumpOpt       :: Bool
                      , confReValidate    :: Bool
+                     , confDebugDumpFile :: FilePath
                      }
 
 defaultConfig :: Config
@@ -69,4 +70,5 @@ defaultConfig = Config { confDatalogFile   = ""
                        , confDumpDebug     = False
                        , confDumpOpt       = False
                        , confReValidate    = False
+                       , confDebugDumpFile = ""
                        }

src/Language/DifferentialDatalog/Debug.hs

@@ -30,6 +30,7 @@ Description: Helper functions for adding debug hooks to a 'DatalogProgram'.
 module Language.DifferentialDatalog.Debug (
     debugAggregateFunctions,
     debugUpdateRHSRules,
+    debugUpdateRHSRulesWithoutHooks,
 )
 where
 
@@ -182,12 +183,17 @@ insertRHSInspectDebugHooks d rlIdx rule =
 
 debugUpdateRHSRules :: DatalogProgram -> Int -> Rule -> [RuleRHS]
 debugUpdateRHSRules d rlIdx rule =
+  let rhs = debugUpdateRHSRulesWithoutHooks d rlIdx rule
+  in insertRHSInspectDebugHooks d rlIdx rule {ruleRHS = rhs}
+
+debugUpdateRHSRulesWithoutHooks :: DatalogProgram -> Int -> Rule -> [RuleRHS]
+debugUpdateRHSRulesWithoutHooks d rlIdx rule =
   let
     -- First pass updates RHSLiteral without any binding with a binding.
     rhs =  map addBindingToRHSLiteral $ zip (ruleRHS rule) [0..]
     -- Second pass updates RHSAggregate to use the debug function (so that inputs are not dropped).
-    rhs' = concatMap (updateRHSAggregate d rule{ruleRHS = rhs} rlIdx) [0..length rhs - 1]
-  in insertRHSInspectDebugHooks d rlIdx rule {ruleRHS = rhs'}
+  in concatMap (updateRHSAggregate d rule{ruleRHS = rhs} rlIdx) [0..length rhs - 1]
+
 
 -- Insert an aggregate function that wraps the original function used in the aggregate term.
 -- For example, if an aggregate operator uses std::group_max(), i.e., var c = Aggregate((a), group_max(b)).

src/Language/DifferentialDatalog/Debugger/DebugEventParser.hs

@@ -29,40 +29,11 @@ import Text.Parsec
 import Text.Parsec.Language
 import Data.Functor.Identity
 
-data Operator = OpMap | OpAggregate | OpCondition | OpJoin
-                | OpAntijoin | OpInspect | OpUndefined deriving (Show)
-
-data OperatorId = OperatorId {opRelId:: Int, opRule::Int, opOperaror::Int} deriving (Show)
-
-data Event = DebugEvent { evtOperatorId :: OperatorId
-                        , evtWeight :: Int
-                        , evtTimestamp :: Integer
-                        , evtOperator :: Operator
-                        , evtInput :: Record
-                        , evtOutput :: Record
-                        }
-            | DebugJoinEvent { evtOperatorId :: OperatorId
-                             , evtWeight :: Int
-                             , evtTimestamp :: Integer
-                             , evtOperator :: Operator
-                             , evtInput1 :: Record
-                             , evtInput2 :: Record
-                             , evtOutput :: Record
-                             }
-            deriving (Show)
-
-data Record = IntRecord {intVal :: Integer}
-            | BoolRecord {boolVal :: Bool}
-            | DoubleRecord {doubleVal :: Double}
-            | StringRecord {stringVal :: String}
-            | NamedStructRecord {name :: String, val :: [(String, Record)]}
-            | TupleRecord {tupleVal :: [Record]}
-            | ArrayRecord {arrayVal :: [Record]}
-            deriving (Show)
+import Language.DifferentialDatalog.Debugger.DebugTypes
 
 debugDef :: GenLanguageDef String u Data.Functor.Identity.Identity
-debugDef = emptyDef { T.identStart        = alphaNum
-                    , T.identLetter       = alphaNum
+debugDef = emptyDef { T.identStart        = alphaNum <|> char '_'
+                    , T.identLetter       = alphaNum <|> char '_' <|> char ':'
                     , T.caseSensitive     = True}
 
 identifier :: ParsecT String u Identity String
@@ -89,6 +60,9 @@ parens       = T.parens lexer
 brackets :: ParsecT String u Identity a -> ParsecT String u Identity a
 brackets     = T.brackets lexer
 
+integer :: ParsecT String u Identity Integer
+integer      = T.integer lexer
+
 decimal :: ParsecT String u Identity Integer
 decimal      = T.decimal lexer
 
@@ -143,7 +117,7 @@ debugEventParser :: ParsecT String u Identity Event
 debugEventParser = do
     opid <- parens (OperatorId <$> (fromIntegral <$> (decimal <* comma))
             <*> (fromIntegral <$> (decimal <* comma)) <*> (fromIntegral <$> decimal))
-    w <- fromIntegral <$> (comma *> decimal)
+    w <- fromIntegral <$> (comma *> integer)
     ts <- comma *> decimal <* comma
     op <- operatorParser
     case op of