ovsdb2ddlog: Add --intern-table CLI switch.

Added `--intern-table` flag to the compiler to declare input tables coming from
OVSDB as `Intern<...>`.  This is useful for tables whose records are copied
around as a whole and can therefore benefit from interning performance- and
memory-wise.  In the past we had to create a separate table and copy records
from the original input table to it while wrapping them in `Intern<>`.  With
this change, we avoid the extra copy and intern records as we ingest them
for selected tables.

I am not pushing any tests for the new feature with this commit.
Testing was done using the master branch of OVN that currently has a
bunch of nondet test failures, presumably due to race conditions in the
test harness.

CHANGELOG.md

@@ -26,6 +26,17 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/).
   replacing the standard collections (`Set`, `Map`, `Vec`) with functional
   versions.
 
+### ovsdb2ddlog compiler
+
+- Added `--intern-table` flag to the compiler to declare input tables coming from
+  OVSDB as `Intern<...>`.  This is useful for tables whose records are copied
+  around as a whole and can therefore benefit from interning performance- and
+  memory-wise.  In the past we had to create a separate table and copy records
+  from the original input table to it while wrapping them in `Intern<>`.  With
+  this change, we avoid the extra copy and intern records as we ingest them
+  for selected tables.
+
+
 ## [0.37.1] - Feb 23, 2021
 
 ### Optimizations

adapters/ovsdb/Main.hs

@@ -1,5 +1,5 @@
 {-
-Copyright (c) 2018-2020 VMware, Inc.
+Copyright (c) 2018-2021 VMware, Inc.
 SPDX-License-Identifier: MIT
 
 Permission is hereby granted, free of charge, to any person obtaining a copy
@@ -40,6 +40,7 @@ import Language.DifferentialDatalog.OVSDB.Compile
 import Language.DifferentialDatalog.Version
 
 data TOption = OVSFile         String
+             | InternTable     String
              | OutputTable     String
              | OutputOnlyTable String
              | ROColumn        String
@@ -57,6 +58,7 @@ options :: [OptDescr TOption]
 options = [ Option ['v'] ["version"]            (NoArg Version)                     "Display DDlog version."
           , Option ['f'] ["schema-file"]        (ReqArg OVSFile     "FILE")         "OVSDB schema file."
           , Option ['c'] ["input-config"]       (ReqArg ConfigJsonI "FILE.json")    "Read options from Json configuration file (preceding options are ignored)."
+          , Option []    ["intern-table"]       (ReqArg InternTable "TABLE")        "Wrap records in TABLE in the 'Intern<>' type.  Interned values are copied and compared by reference."
           , Option ['O'] ["output-config"]      (ReqArg ConfigJsonO "FILE.json")    "Write preceding options to Json configuration file."
           , Option ['o'] ["output-table"]       (ReqArg OutputTable "TABLE")        "Mark TABLE as output."
           , Option []    ["output-only-table"]  (ReqArg OutputOnlyTable "TABLE")    "Mark TABLE as output-only.  DDlog will send updates to this table directly to OVSDB without comparing it with current OVSDB state."
@@ -73,6 +75,8 @@ addOption (a, config) (OVSFile f) = do
 addOption (a, config) (OutputFile f) = do
     when (isJust $ outputFile config) $ errorWithoutStackTrace "Multiple output files specified"
     return (a, config {outputFile = Just f})
+addOption (a, config) (InternTable t) = do
+    return (a, config{ internedTables = nub (t : internedTables config)})
 addOption (a, config) (OutputTable t) = do
     when (elem t $ outputOnlyTables config)
          $ errorWithoutStackTrace $ "Conflicting options --output-table and --output-only-table specified for table '" ++ t ++ "'"

src/Language/DifferentialDatalog/OVSDB/Compile.hs

@@ -1,5 +1,5 @@
 {-
-Copyright (c) 2018-2020 VMware, Inc.
+Copyright (c) 2018-2021 VMware, Inc.
 SPDX-License-Identifier: MIT
 
 Permission is hereby granted, free of charge, to any person obtaining a copy
@@ -106,6 +106,7 @@ data Config = Config { ovsSchemaFile    :: FilePath
                      , outputFile       :: Maybe FilePath
                      , outputTables     :: [OutputRelConfig]
                      , outputOnlyTables :: [String]
+                     , internedTables   :: [String]
                      }
               deriving (Eq, Show, Generic)
 
@@ -117,6 +118,7 @@ defaultConfig = Config { ovsSchemaFile    = ""
                        , outputFile       = Nothing
                        , outputTables     = []
                        , outputOnlyTables = []
+                       , internedTables   = []
                        }
 
 -- | Output relation configuration:
@@ -150,10 +152,12 @@ compileSchemaFile fname config = do
 compileSchema :: (MonadError String me) => OVSDBSchema -> Config -> me Doc
 compileSchema schema config = do
     let tables = schemaTables schema
+    mapM_ (\i -> do let t = find ((==i) . name) tables
+                    when (isNothing t) $ throwError $ "Table '" ++ i ++ "' not found") $ internedTables config
     mapM_ (\(o, _) -> do let t = find ((==o) . name) tables
-                         when (isNothing t) $ throwError $ "Table " ++ o ++ " not found") $ outputTables config
+                         when (isNothing t) $ throwError $ "Table '" ++ o ++ "' not found") $ outputTables config
     mapM_ (\o -> do let t = find ((==o) . name) tables
-                    when (isNothing t) $ throwError $ "Table " ++ o ++ " not found") $ outputOnlyTables config
+                    when (isNothing t) $ throwError $ "Table '" ++ o ++ "' not found") $ outputOnlyTables config
     uniqNames Nothing ("Multiple declarations of table " ++ ) tables
     let ?schema = schema
     let ?config = config
@@ -225,35 +229,48 @@ mkTable' tkind t@Table{..} = do
     let key = if tkind == TableInput
                  then "primary key (x) x._uuid"
                  else empty
-    return $ prefix <+> "relation" <+> pp tname <+> "("    $$
-             (nest' $ vcommaSep columns)                   $$
-             ")"                                           $$
-             key
+    if tableIsInterned t && tkind == TableInput
+    then return $ "typedef" <+> pp tname <+> "=" <+> pp tname <+> "{"                   $$
+                  (nest' $ vcommaSep columns)                                           $$
+                  "}"                                                                   $$
+                  prefix <+> "relation" <+> pp tname <+> "[Intern<" <> pp tname <> ">]" $$
+                  key
+    else return $ prefix <+> "relation" <+> pp tname <+> "("    $$
+                  (nest' $ vcommaSep columns)                   $$
+                  ")"                                           $$
+                  key
+
+tableIsInterned :: (?config::Config) => Table -> Bool
+tableIsInterned t = elem (name t) $ internedTables ?config
 
 mkDeltaPlusRules :: (?schema::OVSDBSchema, ?config::Config) => Table -> Doc
 mkDeltaPlusRules t =
     (mkTableName t TableDeltaPlus) <> "(" <> commaSep cols <> ") :-"        $$
     (nest' $ mkTableName t TableOutput <> "(" <> commaSep cols <> "),")     $$
-    (nest' $ "not" <+> mkTableName t TableInput <> "(._uuid = _uuid).")
+    (nest' $ "not " <> deref <> mkTableName t TableInput <> "(._uuid = _uuid).")
     where
+    deref = if tableIsInterned t then "&" else empty
     nonro_cols = tableGetNonROCols t
     cols = map (\c -> "." <> mkColName c <+> "=" <+> mkColName c) nonro_cols
 
 -- DeltaMinus(uuid) :- Input(uuid, key, _), not Output(_, key, _).
 mkDeltaMinusRules :: (?schema::OVSDBSchema, ?config::Config) => Table ->  Doc
 mkDeltaMinusRules t =
-    (mkTableName t TableDeltaMinus) <> "(uuid) :-"                         $$
-    (nest' $ mkTableName t TableInput <> "(._uuid = uuid),")   $$
+    (mkTableName t TableDeltaMinus) <> "(uuid) :-"                          $$
+    (nest' $ deref <> mkTableName t TableInput <> "(._uuid = uuid),")       $$
     (nest' $ "not" <+> mkTableName t TableOutput <> "(._uuid = uuid).")
+    where
+    deref = if tableIsInterned t then "&" else empty
 
 -- DeltaUpdate(uuid, new) :- Output(uuid, new), Input(uuid, old), old != new.
 mkDeltaUpdateRules :: (?schema::OVSDBSchema, ?config::Config) => Table -> Doc
 mkDeltaUpdateRules t =
     (mkTableName t TableDeltaUpdate) <> "(" <> commaSep outcols <> ") :-"               $$
     (nest' $ mkTableName t TableOutput <> "(" <> commaSep outcols <> "),")              $$
-    (nest' $ mkTableName t TableInput <> "(" <> commaSep realcols <> "),")              $$
+    (nest' $ deref <> mkTableName t TableInput <> "(" <> commaSep realcols <> "),")              $$
     (nest' $ (parens $ commaSep old_vars) <+> "!=" <+> (parens $ commaSep new_vars) <> ".")
     where
+    deref = if tableIsInterned t then "&" else empty
     nonro_cols = tableGetNonROCols t
     outcols = map (\c -> let n = mkColName c in
                          "." <> n <+> "=" <+> (if n == "_uuid" then n else "__new_" <> n))