diff --git a/DSH.cabal b/DSH.cabal --- a/DSH.cabal +++ b/DSH.cabal @@ -1,5 +1,5 @@ Name: DSH -Version: 0.12.0.0 +Version: 0.12.0.1 Synopsis: Database Supported Haskell Description: This is a Haskell library for database-supported program diff --git a/src/Database/DSH/Compiler.hs b/src/Database/DSH/Compiler.hs --- a/src/Database/DSH/Compiler.hs +++ b/src/Database/DSH/Compiler.hs @@ -200,7 +200,7 @@ let fileName = "q_vl_" ++ h exportPlan fileName vl void $ runCommand $ printf ".cabal-sandbox/bin/vldot -i %s.plan | dot -Tpdf -o %s.pdf" fileName fileName - void $ runCommand $ printf "evince %s.pdf" fileName + void $ runCommand $ printf "evince %s.pdf 2>/dev/null" fileName -- | Show optimized vector plan (VL) showVectorizedOptQ :: forall a. QA a => Q a -> IO () @@ -211,5 +211,5 @@ let fileName = "q_vl_" ++ h exportPlan fileName vl void $ runCommand $ printf ".cabal-sandbox/bin/vldot -i %s.plan | dot -Tpdf -o %s.pdf" fileName fileName - void $ runCommand $ printf "evince %s.pdf" fileName + void $ runCommand $ printf "evince %s.pdf 2>/dev/null" fileName diff --git a/src/Database/DSH/Translate/CL2NKL.hs b/src/Database/DSH/Translate/CL2NKL.hs --- a/src/Database/DSH/Translate/CL2NKL.hs +++ b/src/Database/DSH/Translate/CL2NKL.hs @@ -348,18 +348,4 @@ -- | Express comprehensions through NKL iteration constructs map and -- concatMap and filter. desugarComprehensions :: CL.Expr -> NKL.Expr -desugarComprehensions e = -#ifdef DEBUGCOMP - trace (debugPrint eo) eo - - where - eo = runReader (expr e) [] - - padSep :: String -> String - padSep s = "\n" ++ s ++ " " ++ replicate (100 - length s) '=' ++ "\n" - - debugPrint :: NKL.Expr -> String - debugPrint e' = padSep "Desugared NKL" ++ pp e' ++ padSep "" -#else - runReader (expr e) [] -#endif +desugarComprehensions e = runReader (expr e) [] diff --git a/src/Database/DSH/VL/Opt/Properties/ReqColumns.hs b/src/Database/DSH/VL/Opt/Properties/ReqColumns.hs --- a/src/Database/DSH/VL/Opt/Properties/ReqColumns.hs +++ b/src/Database/DSH/VL/Opt/Properties/ReqColumns.hs @@ -116,10 +116,13 @@ childReqColumns ∪ VProp cols WinFun (wfun, _) -> do - cs <- (VProp $ Just $ winReqCols wfun) - ∪ - childReqColumns - cs ∪ ownReqColumns + -- Don't require the window function output from the child + -- operator. + VTDataVec w <- fromProp $ vectorTypeProp childBUProps + Just cols <- fromProp ownReqColumns + let cols' = VProp $ Just $ filter (/= (w + 1)) cols + cs <- (VProp $ Just $ winReqCols wfun) ∪ cols' + cs ∪ childReqColumns UniqueS -> ownReqColumns ∪ childReqColumns Unique -> ownReqColumns ∪ childReqColumns @@ -138,8 +141,8 @@ -- from the set of required columns Number -> do VTDataVec w <- fromProp $ vectorTypeProp childBUProps - Just cols <- fromProp ownReqColumns - let cols' = filter (/= w) cols + Just cols <- fromProp ownReqColumns + let cols' = filter (/= (w + 1)) cols VProp (Just cols') ∪ childReqColumns NumberS -> do VTDataVec w <- fromProp $ vectorTypeProp childBUProps @@ -289,7 +292,7 @@ (,) <$> (childReqColumns1 ∪ ownLeft) <*> (childReqColumns2 ∪ ownRight) Zip -> do - cols <- fromProp ownReqColumns + (cols, _, _) <- fromPropTriple ownReqColumns (ownLeft, ownRight) <- partitionCols childBUProps1 childBUProps2 cols (,) <$> (childReqColumns1 ∪ ownLeft) <*> (childReqColumns2 ∪ ownRight) diff --git a/src/Database/DSH/VL/Opt/Properties/TopDown.hs b/src/Database/DSH/VL/Opt/Properties/TopDown.hs --- a/src/Database/DSH/VL/Opt/Properties/TopDown.hs +++ b/src/Database/DSH/VL/Opt/Properties/TopDown.hs @@ -68,7 +68,7 @@ AppRep -> vPropPairSeed UnboxSng -> vPropPairSeed AggrS _ -> vPropSeed - Zip -> vPropSeed + Zip -> vPropTripleSeed Align -> vPropSeed CartProduct -> vPropTripleSeed CartProductS -> vPropTripleSeed diff --git a/src/Database/DSH/VL/Opt/Rewrite/Redundant.hs b/src/Database/DSH/VL/Opt/Rewrite/Redundant.hs --- a/src/Database/DSH/VL/Opt/Rewrite/Redundant.hs +++ b/src/Database/DSH/VL/Opt/Rewrite/Redundant.hs @@ -64,13 +64,15 @@ , zipZipLeft , alignWinLeft , alignWinRight + , zipWinLeft + , zipWinRight , alignWinRightPush , alignUnboxSngRight , alignUnboxSngLeft , alignCartProdRight , alignGroupJoinLeft , alignGroupJoinRight - -- , runningAggWin + , runningAggWin , inlineWinAggrProject , pullProjectNumber , constDist @@ -524,6 +526,23 @@ return $ do logRewrite "Redundant.Align.Self.Win.Right" q -- We get all columns from the left input. The WinAggr + -- operator produces the input column followed by the + -- window function result. + let proj = map Column $ [1 .. w] ++ [1 .. w] ++ [w+1] + -- logGeneral ("zipWinRight " ++ show proj) + void $ replaceWithNew q $ UnOp (Project proj) $(v "qw") |]) + +zipWinRight :: VLRule BottomUpProps +zipWinRight q = + $(dagPatMatch 'q "R1 ((q1) Zip (qw=WinFun _ (q2)))" + [| do + predicate $ $(v "q1") == $(v "q2") + + w <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1") + + return $ do + logRewrite "Redundant.Zip.Self.Win.Right" q + -- We get all columns from the left input. The WinAggr -- operator produces the input column followed the window -- function result. let proj = map Column $ [1 .. w] ++ [1 .. w] ++ [w+1] @@ -540,6 +559,22 @@ return $ do logRewrite "Redundant.Align.Self.Win.Left" q + -- We get all input columns plus the window function + -- output from the left. From the right we get all input + -- columns. + let proj = map Column $ [1 .. w] ++ [w+1] ++ [1 .. w] + void $ replaceWithNew q $ UnOp (Project proj) $(v "qw") |]) + +zipWinLeft :: VLRule BottomUpProps +zipWinLeft q = + $(dagPatMatch 'q "R1 ((qw=WinFun _ (q1)) Zip (q2))" + [| do + predicate $ $(v "q1") == $(v "q2") + + w <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1") + + return $ do + logRewrite "Redundant.Zip.Self.Win.Left" q -- We get all input columns plus the window function -- output from the left. From the right we get all input -- columns. diff --git a/src/Database/DSH/VL/Opt/Rewrite/Window.hs b/src/Database/DSH/VL/Opt/Rewrite/Window.hs --- a/src/Database/DSH/VL/Opt/Rewrite/Window.hs +++ b/src/Database/DSH/VL/Opt/Rewrite/Window.hs @@ -34,7 +34,7 @@ -- Turn a running aggregate based on a self-join into a window operator. runningAggWin :: VLRule BottomUpProps runningAggWin q = - $(dagPatMatch 'q "(qo) UnboxSng ((_) AggrS afun (R1 ((qn=Number (q1)) NestJoin p (Number (q2)))))" + $(dagPatMatch 'q "R1 ((qo) UnboxSng ((_) AggrS afun (R1 ((qn=Number (q1)) NestJoin p (Number (q2))))))" [| do predicate $ $(v "q1") == $(v "q2") predicate $ $(v "qo") == $(v "qn")