Aelve Codesearch

grep over package repositories
Please provide a string to search for.
3+ characters are required.
Index updated about a month ago

total matches: more than 1000

Agda-2.6.0.1
1 matches
src/full/Agda/Compiler/Treeless/Identity.hs
        TVar x | x >= k    -> IdIn [x - k]
               | otherwise -> notId
        TLet _ b           -> go (k + 1) b
        TCase _ _ d bs     -> sconcat (go k d :| map (goAlt k) bs)
        TApp (TDef f) args
          | f == q         -> IdIn [ y | (TVar x, y) <- zip (reverse args) [0..], y + k == x ]
        TCoerce v          -> go k v
        TApp{}             -> notId
        TLam{}             -> notId

            
DSH-0.12.0.1
29 matches
src/Database/DSH/CL/Lang.hs
    pretty = pretty . toList

instance Functor NL where
    fmap f (a :* as) = (f a) :* (fmap f as)
    fmap f (S a)     = S (f a)

instance F.Foldable NL where
    foldr f z (a :* as) = f a (F.foldr f z as)
    foldr f z (S a)     = f a z


            
src/Database/DSH/CL/Lang.hs
instance Pretty Expr where
    pretty (AppE1 _ (TupElem n) e1) =
        parenthize e1 <> dot <> int (tupleIndex n)
    pretty (MkTuple _ es)     = prettyTuple $ map pretty es
    pretty (Table _ n _)      = kw (text "table") <> parens (text n)
    pretty (AppE1 _ p1 e)     = pretty p1 <+> (parenthize e)
    pretty (AppE2 _ p2 e1 e2)
        | isJoinOp p2 = prettyJoin (pretty p2) (parenthize e1) (parenthize e2)
        | otherwise   = prettyApp2 (pretty p2) (parenthize e1) (parenthize e2)

            
src/Database/DSH/CL/Lang.hs
    pretty (If _ c t e)       = prettyIf (pretty c) (pretty t) (pretty e)
    pretty (Lit _ v)          = pretty v
    pretty (Var _ s)          = text s
    pretty (Comp _ e qs)      = prettyComp (pretty e) (map pretty $ toList qs)
    pretty (Let _ x e1 e)     = prettyLet (text x) (pretty e1) (pretty e)

parenthize :: Expr -> Doc
parenthize e =
    case e of

            
src/Database/DSH/CL/Opt/AntiJoin.hs
                          c : cs -> return $ c :| cs
                          []     -> fail "no correlated predicates for the join"

        corrPreds <- constT (return corrExprs') >>> mapT (splitJoinPredT x y)
        return (corrPreds, nonCorrExprs)

    -- If the predicate is a simple relational operator, but
    -- non-negated, try to negate the operator itself.
    ExprCL (BinOp t (SBRelOp op) e1 e2) -> do

            
src/Database/DSH/CL/Opt/AntiJoin.hs
        yt  = elemT yst

    let innerQuals = case nonCorrPreds of
                         p : ps -> BindQ y ys :* fmap GuardQ (fromListSafe p ps)
                         []     -> S $ BindQ y ys

    -- Filter the inner source with the range
    -- predicates. Additionally, filter it with the non-correlated
    -- predicates extracted from the quantifier predicate.

            
src/Database/DSH/CL/Opt/AntiJoin.hs
                     -> Expr
                     -> TransformC (NL Qual) Qual
mkUniversalRangeAntiJoinT (x, xs) (y, ys) ps q = do
    psExprs <- constT $ T.mapM fromGuard ps
    let psFVs = sort $ nub $ concatMap freeVars $ toList psExprs
        qFVs  = sort $ nub $ freeVars q

    let xy = sort [x, y]


            
src/Database/DSH/CL/Opt/AntiJoin.hs

        -- Class 15: p(x, y), q(y)
        (psvs@[_, _], [y']) | psvs == xy && y == y' -> do
            psConjs <- constT (return psExprs) >>> mapT (splitJoinPredT x y)
            let psPred = JoinPred $ toNonEmpty psConjs
            mkClass15AntiJoinT (x, xs) (y, ys) psPred q

        -- Class 16: p(x, y), q(x, y)
        (psvs@[_, _], qsvs@[_, _]) | psvs == xy && qsvs == xy -> do

            
src/Database/DSH/CL/Opt/AntiJoin.hs

        -- Class 16: p(x, y), q(x, y)
        (psvs@[_, _], qsvs@[_, _]) | psvs == xy && qsvs == xy -> do
            psConjs <- constT (return psExprs) >>> mapT (splitJoinPredT x y)

            -- Even if q itself references x and y, there might be
            -- parts of the predicate (conjuncts) which only reference
            -- y. These parts can (and should) be evaluated on ys.
            (qPred, nonCorrPreds) <- constT (return q) >>> injectT >>> quantifierPredicateT x y

            
src/Database/DSH/CL/Opt/AntiJoin.hs
                         c : cs -> appendNL ps (fromListSafe c cs)
                         []     -> ps

    let ys' = Comp yst (Var yt y) (BindQ y ys :* fmap GuardQ innerPreds)

    -- xs ▷_ps [ y | y <- ys, not qs ]
    return $ BindQ x (P.antijoin xs ys' qs)

-- This rewrite implements plan 14 for Query Class 15 in Claussen et al.,

            
src/Database/DSH/CL/Opt/AntiJoin.hs
        yt  = elemT yst

    let ys' = case nonCorrPreds of
                  c : cs -> let quals = BindQ y ys :* fmap GuardQ (fromListSafe c cs)
                            in Comp yst (Var yt y) quals
                  []     -> ys

    -- xs ▷_(p && not q) ys
    return $ BindQ x (P.antijoin xs ys' $ JoinPred $ ps <> qs)

            
src/Database/DSH/CL/Opt/Auxiliary.hs

-- | Split a conjunctive combination of join predicates.
joinConjunctsT :: Ident -> Ident -> TransformC CL (NonEmpty (JoinConjunct JoinExpr))
joinConjunctsT x y = conjunctsT >>> mapT (splitJoinPredT x y)

-- | Split a combination of logical conjunctions into its sub-terms.
conjunctsT :: TransformC CL (NonEmpty Expr)
conjunctsT = readerT $ \e -> case e of
    -- For a logical AND, turn the left and right arguments into lists

            
src/Database/DSH/CL/Opt/Auxiliary.hs
-- Computation of free variables

freeVarsT :: TransformC CL [Ident]
freeVarsT = fmap nub $ crushbuT $ promoteT $ do (ctx, Var _ v) <- exposeT
                                                guardM (v `freeIn` ctx)
                                                return [v]

-- | Compute free variables of the given expression
freeVars :: Expr -> [Ident]

            
src/Database/DSH/CL/Opt/Auxiliary.hs
    aux (GuardQ _) ns  = ns

boundVarsT :: TransformC CL [Ident]
boundVarsT = fmap nub $ crushbuT $ promoteT $ readerT $ \expr -> case expr of
     Comp _ _ qs -> return $ compBoundVars qs
     Let _ v _ _ -> return [v]
     _           -> return []

-- | Compute all names that are bound in the given expression. Note

            
src/Database/DSH/CL/Opt/Auxiliary.hs
    ExprCL (Comp ty e qs) <- idR

    -- Separate generators from guards
    ((g : gs), guards@(_:_)) <- return $ partitionEithers $ map fromQual $ toList qs

    let initialComp = C ty e (fmap (uncurry BindQ) $ fromListSafe g gs)

    -- Try to merge one guard with some generators
    (C _ e' qs', remGuards) <- constT (return ())
                               >>> tryGuards mergeGuardR initialComp guards []


            
src/Database/DSH/CL/Opt/Auxiliary.hs
    -- If there are any guards remaining which we could not turn into
    -- joins, append them at the end of the new qualifier list
    case remGuards of
        rg : rgs -> let rqs = fmap GuardQ $ fromListSafe rg rgs
                    in return $ ExprCL $ Comp ty e' (appendNL qs' rqs)
        []       -> return $ ExprCL $ Comp ty e' qs'

--------------------------------------------------------------------------------
-- Traversal functions

            
src/Database/DSH/CL/Opt/NestJoin.hs
        _                 -> fail "no match"

    guardM $ not $ x `elem` freeVars ys
    guards <- constT $ mapM fromGuard qsr

    p <- snocPathToPath <$> absPathT
    return (p, NestedComp t h (y, ys) guards)

-- | Search through the qualifiers of a comprehension that itself was

            
src/Database/DSH/CL/Opt/NestJoin.hs
        p : ps -> do
            -- Split the join predicate
            p'  <- constT (return p) >>> splitJoinPredT x y
            ps' <- constT (return ps) >>> mapT (splitJoinPredT x y)

            return $ NestJoin $ JoinPred $ p' N.:| ps'

    -- Identify predicates which only refer to y and can be evaluated
    -- on the right nestjoin input.

            
src/Database/DSH/CL/Opt/NestJoin.hs
    -- If there are inner predicates which only refer to y,
    -- evaluate them on the right (ys) nestjoin input.
    let ys' = case fromList yPreds of
                  Just ps -> Comp (ListT yt) (Var yt y) (BindQ y ys :* fmap GuardQ ps)
                  Nothing -> ys

    -- the nesting operator combining xs and ys:
    -- xs nj(p) ys
    let xs'        = AppE2 (ListT tupType) nestOp xs ys'

            
src/Database/DSH/CL/Opt/NestJoin.hs

    -- Do the same on left over predicates, which will be
    -- evaluated on the nestjoin result.
    remPreds <- sequence $ map tuplifyInnerVarR leftOverPreds
    let remGuards = map GuardQ remPreds

    -- Construct the inner comprehension with the tuplified head
    -- and apply left-over predicates to the inner comprehension.
    let ti = hType headComp
    let headComp' = case remGuards of

            
src/Database/DSH/CL/Opt/NestJoin.hs

    -- In the outer comprehension's qualifier list, x is replaced by
    -- the first pair component of the join result.
    qsr' <- constT (return $ map inject qsr)
            >>> mapT (tryR tuplifyOuterR)
            >>> mapT projectT

    -- ExprCL tuplifiedHead <- constNodeT ho' >>> tryR tuplifyOuterR

    return $ inject $ Comp to unnestedHo (fromListSafe (BindQ x nestOp) qsr')


            
src/Database/DSH/CL/Opt/NestJoin.hs
unnestGuardR :: [Expr] -> [Expr] -> TransformC CL (CL, [Expr], [Expr])
unnestGuardR candGuards failedGuards = do
    Comp t _ qs      <- promoteT idR
    let localGenVars = concatMap (either ((: []) . fst) (const [])) $ map fromQual $ toList qs
    let unnestR = anytdR (promoteR $ unnestQualsR localGenVars) >>> projectT
    ((tuplifyVarR, Just guardExpr), qs') <- statefulT (idR, Nothing) $ childT CompQuals unnestR

    h'               <- childT CompHead tuplifyVarR >>> projectT
    let tuplifyM e = constNodeT e >>> tuplifyVarR >>> projectT

            
src/Database/DSH/CL/Opt/NestJoin.hs

    h'               <- childT CompHead tuplifyVarR >>> projectT
    let tuplifyM e = constNodeT e >>> tuplifyVarR >>> projectT
    candGuards'      <- mapM tuplifyM candGuards
    failedGuards'    <- mapM tuplifyM failedGuards
    return (inject $ Comp t h' qs', candGuards', guardExpr : failedGuards')

-- | Worker for the MergeGuard iterator: Insert the current guard into
-- the qualifier list and search for an unnesting opportunity.
unnestGuardWorkerR :: MergeGuard

            
src/Database/DSH/CL/Opt/PredPushdown.hs
    varPaths <- collectT $ varPathT x
    guardM $ not $ null varPaths
    parentPathLen <- length <$> snocPathToPath <$> absPathT
    let localPaths = map (init . drop parentPathLen) varPaths
    return localPaths

-- | All occurences of variable x must occur in the form of a tuple
-- accessor, either fst or snd. Remove this tuple accessor.
unTuplifyR :: (Prim1 -> Bool) -> PathC -> RewriteC CL

            
src/Database/DSH/CL/Opt/PredPushdown.hs

    localPaths <- predTrans >>> allVarPathsT x

    ExprCL p' <- predTrans >>> andR (map (unTuplifyR (== (TupElem First))) localPaths)

    let xst = typeOf xs

    let filterComp = Comp xst (Var (elemT xst) x) (BindQ x xs :* S (GuardQ p'))
    return $ inject $ AppE2 t op filterComp ys

            
src/Database/DSH/CL/Opt/PredPushdown.hs

    localPaths <- predTrans >>> allVarPathsT x

    ExprCL p' <- predTrans >>> andR (map (unTuplifyR (== (TupElem (Next (First))))) localPaths)

    let yst = typeOf ys

    let filterComp = Comp yst (Var (elemT yst) x) (BindQ x ys :* S (GuardQ p'))
    return $ inject $ AppE2 t op xs filterComp

            
src/Database/DSH/CL/Opt/PredPushdown.hs
    rightVarPaths <- constRightExpr >>> allVarPathsT x

    leftExpr'     <- constLeftExpr
                         >>> andR (map (unTuplifyR (== (TupElem First))) leftVarPaths)
                         >>> projectT
                         >>> toJoinExpr x

    rightExpr'    <- constRightExpr
                         >>> andR (map (unTuplifyR (== (TupElem (Next First)))) rightVarPaths)

            
src/Database/DSH/CL/Opt/PredPushdown.hs
                         >>> toJoinExpr x

    rightExpr'    <- constRightExpr
                         >>> andR (map (unTuplifyR (== (TupElem (Next First)))) rightVarPaths)
                         >>> projectT
                         >>> toJoinExpr x

    return $ JoinConjunct leftExpr' op rightExpr'


            
src/Database/DSH/CL/Opt/SemiJoin.hs

    -- All inner qualifiers have to be guards.
    guardExprs <- case mps of
        Just ps -> constT (T.mapM fromGuard ps) >>^ toList
        Nothing -> return []

    quantExprs <- case mq of
        Just q  -> constT (return $ inject q) >>> conjunctsT >>^ NL.toList
        Nothing -> return []

            
src/Database/DSH/CL/Opt/SemiJoin.hs
                                              allExprs

    let ys' = case innerGuards of
          ige : iges -> let igs = fmap GuardQ $ fromListSafe ige iges
                        in Comp yst (Var yt y) (BindQ y ys :* igs)
          []         -> ys

    corrPreds <- constT (return corrGuards) >>> mapT (splitJoinPredT x y)

    case corrPreds of
        cp : cps -> return $ BindQ x $ P.semijoin xs ys' (JoinPred $ cp :| cps)
        _        -> fail "there have to be correlation predicates for a semijoin"