Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

ovsdb2ddlog: Add --intern-table CLI switch. #934

Merged
merged 1 commit into from
Mar 11, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
11 changes: 11 additions & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
6 changes: 5 additions & 1 deletion adapters/ovsdb/Main.hs
Original file line number Diff line number Diff line change
@@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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."
Expand All @@ -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 ++ "'"
Expand Down
39 changes: 28 additions & 11 deletions src/Language/DifferentialDatalog/OVSDB/Compile.hs
Original file line number Diff line number Diff line change
@@ -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
Expand Down Expand Up @@ -106,6 +106,7 @@ data Config = Config { ovsSchemaFile :: FilePath
, outputFile :: Maybe FilePath
, outputTables :: [OutputRelConfig]
, outputOnlyTables :: [String]
, internedTables :: [String]
}
deriving (Eq, Show, Generic)

Expand All @@ -117,6 +118,7 @@ defaultConfig = Config { ovsSchemaFile = ""
, outputFile = Nothing
, outputTables = []
, outputOnlyTables = []
, internedTables = []
}

-- | Output relation configuration:
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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))
Expand Down