module Portage.Dependency.Normalize
  (
    normalize_depend
  ) where

import qualified Control.Arrow as A
import           Control.Monad
import qualified Data.List as L
import qualified Data.Set as S
import           Data.Maybe

import Portage.Dependency.Builder
import Portage.Dependency.Types
import Portage.Use

import Debug.Trace

mergeDRanges :: DRange -> DRange -> DRange
mergeDRanges :: DRange -> DRange -> DRange
mergeDRanges DRange
_ r :: DRange
r@(DExact Version
_) = DRange
r
mergeDRanges l :: DRange
l@(DExact Version
_) DRange
_ = DRange
l
mergeDRanges (DRange LBound
ll UBound
lu) (DRange LBound
rl UBound
ru) = LBound -> UBound -> DRange
DRange (LBound -> LBound -> LBound
forall a. Ord a => a -> a -> a
max LBound
ll LBound
rl) (UBound -> UBound -> UBound
forall a. Ord a => a -> a -> a
min UBound
lu UBound
ru)

stabilize_pass :: (Dependency -> Dependency) -> Dependency -> Dependency
stabilize_pass :: (Dependency -> Dependency) -> Dependency -> Dependency
stabilize_pass Dependency -> Dependency
pass Dependency
d
    | Dependency
d Dependency -> Dependency -> Bool
forall a. Eq a => a -> a -> Bool
== Dependency
d' = Dependency
d'
    | Bool
otherwise = Dependency -> Dependency
go Dependency
d'
    where go :: Dependency -> Dependency
go = (Dependency -> Dependency) -> Dependency -> Dependency
stabilize_pass Dependency -> Dependency
pass
          d' :: Dependency
d' = Dependency -> Dependency
pass Dependency
d

-- remove one layer of redundancy
normalization_step :: Int -> Dependency -> Dependency
normalization_step :: Int -> Dependency -> Dependency
normalization_step Int
level =
      Dependency -> Dependency
forall a. a -> a
id
    (Dependency -> Dependency)
-> (Dependency -> Dependency) -> Dependency -> Dependency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Dependency -> Dependency) -> Dependency -> Dependency
tp String
"PC2" ((Dependency -> Dependency) -> Dependency -> Dependency
stabilize_pass (String -> (Dependency -> Dependency) -> Dependency -> Dependency
tp String
"PC2 step" Dependency -> Dependency
propagate_context))
    (Dependency -> Dependency)
-> (Dependency -> Dependency) -> Dependency -> Dependency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Dependency -> Dependency) -> Dependency -> Dependency
tp String
"F3" ((Dependency -> Dependency) -> Dependency -> Dependency
stabilize_pass Dependency -> Dependency
flatten)
    (Dependency -> Dependency)
-> (Dependency -> Dependency) -> Dependency -> Dependency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Dependency -> Dependency) -> Dependency -> Dependency
tp String
"LC" Dependency -> Dependency
lift_context
    (Dependency -> Dependency)
-> (Dependency -> Dependency) -> Dependency -> Dependency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Dependency -> Dependency) -> Dependency -> Dependency
tp String
"PC1" ((Dependency -> Dependency) -> Dependency -> Dependency
stabilize_pass (String -> (Dependency -> Dependency) -> Dependency -> Dependency
tp String
"PC1 step" Dependency -> Dependency
propagate_context))
    (Dependency -> Dependency)
-> (Dependency -> Dependency) -> Dependency -> Dependency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Dependency -> Dependency) -> Dependency -> Dependency
tp String
"F2" ((Dependency -> Dependency) -> Dependency -> Dependency
stabilize_pass Dependency -> Dependency
flatten)
    (Dependency -> Dependency)
-> (Dependency -> Dependency) -> Dependency -> Dependency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Dependency -> Dependency) -> Dependency -> Dependency
tp String
"RD" ((Dependency -> Dependency) -> Dependency -> Dependency
stabilize_pass Dependency -> Dependency
remove_duplicates)
    (Dependency -> Dependency)
-> (Dependency -> Dependency) -> Dependency -> Dependency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Dependency -> Dependency) -> Dependency -> Dependency
tp String
"RE" ((Dependency -> Dependency) -> Dependency -> Dependency
stabilize_pass Dependency -> Dependency
remove_empty)
    (Dependency -> Dependency)
-> (Dependency -> Dependency) -> Dependency -> Dependency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Dependency -> Dependency) -> Dependency -> Dependency
tp String
"SD" Dependency -> Dependency
sort_deps
    (Dependency -> Dependency)
-> (Dependency -> Dependency) -> Dependency -> Dependency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Dependency -> Dependency) -> Dependency -> Dependency
tp String
"CUG" Dependency -> Dependency
combine_use_guards
    (Dependency -> Dependency)
-> (Dependency -> Dependency) -> Dependency -> Dependency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Dependency -> Dependency) -> Dependency -> Dependency
tp String
"F1" ((Dependency -> Dependency) -> Dependency -> Dependency
stabilize_pass Dependency -> Dependency
flatten)
    (Dependency -> Dependency)
-> (Dependency -> Dependency) -> Dependency -> Dependency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Dependency -> Dependency) -> Dependency -> Dependency
tp String
"CAR" Dependency -> Dependency
combine_atom_ranges
    where tp :: String -> (Dependency -> Dependency) -> Dependency -> Dependency
          tp :: String -> (Dependency -> Dependency) -> Dependency -> Dependency
tp String
pass_name Dependency -> Dependency
pass Dependency
d = Bool -> Dependency -> Dependency
forall a. Bool -> a -> a
t Bool
False Dependency
d'
              where d' :: Dependency
d' = Dependency -> Dependency
pass Dependency
d
                    t :: Bool -> a -> a
t Bool
False = a -> a
forall a. a -> a
id
                    t Bool
True  =
                        String -> a -> a
forall a. String -> a -> a
trace ([String] -> String
unwords [ String
"PASS"
                                       , Int -> String
forall a. Show a => a -> String
show Int
level
                                       , String
":"
                                       , String
pass_name
                                       , Int -> String
forall a. Show a => a -> String
show (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Dependency -> String
forall a. Show a => a -> String
show Dependency
d))
                                       , String
"->"
                                       , Int -> String
forall a. Show a => a -> String
show (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Dependency -> String
forall a. Show a => a -> String
show Dependency
d'))
                                       ])

remove_empty :: Dependency -> Dependency
remove_empty :: Dependency -> Dependency
remove_empty Dependency
d =
    case Dependency
d of
        -- drop full empty nodes
        Dependency
_ | Dependency -> Bool
is_empty_dependency Dependency
d -> Dependency
empty_dependency
        -- drop partial empty nodes
        DependIfUse Use
use Dependency
td Dependency
fd   -> Use -> Dependency -> Dependency -> Dependency
DependIfUse Use
use (Dependency -> Dependency
go Dependency
td) (Dependency -> Dependency
go Dependency
fd)
        DependAllOf [Dependency]
deps        -> [Dependency] -> Dependency
DependAllOf ([Dependency] -> Dependency) -> [Dependency] -> Dependency
forall a b. (a -> b) -> a -> b
$ (Dependency -> Bool) -> [Dependency] -> [Dependency]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Dependency -> Bool) -> Dependency -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependency -> Bool
is_empty_dependency) ([Dependency] -> [Dependency]) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> a -> b
$ (Dependency -> Dependency) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> Dependency
go [Dependency]
deps
        DependAnyOf [Dependency]
deps        -> [Dependency] -> Dependency
DependAnyOf ([Dependency] -> Dependency) -> [Dependency] -> Dependency
forall a b. (a -> b) -> a -> b
$                                      (Dependency -> Dependency) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> Dependency
go [Dependency]
deps
        -- no change
        DependAtom Atom
_            -> Dependency
d
    where go :: Dependency -> Dependency
go = Dependency -> Dependency
remove_empty

s_uniq :: [Dependency] -> [Dependency]
s_uniq :: [Dependency] -> [Dependency]
s_uniq = Set Dependency -> [Dependency]
forall a. Set a -> [a]
S.toList (Set Dependency -> [Dependency])
-> ([Dependency] -> Set Dependency) -> [Dependency] -> [Dependency]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Dependency] -> Set Dependency
forall a. Ord a => [a] -> Set a
S.fromList

-- Ideally 'combine_atom_ranges' should handle those as well
remove_duplicates :: Dependency -> Dependency
remove_duplicates :: Dependency -> Dependency
remove_duplicates Dependency
d =
    case Dependency
d of
        DependIfUse Use
use Dependency
td Dependency
fd   -> Use -> Dependency -> Dependency -> Dependency
DependIfUse Use
use (Dependency -> Dependency
go Dependency
td) (Dependency -> Dependency
go Dependency
fd)
        DependAnyOf [Dependency]
deps        -> [Dependency] -> Dependency
DependAnyOf ([Dependency] -> Dependency) -> [Dependency] -> Dependency
forall a b. (a -> b) -> a -> b
$ [Dependency] -> [Dependency]
s_uniq ([Dependency] -> [Dependency]) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> a -> b
$ (Dependency -> Dependency) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> Dependency
go [Dependency]
deps
        DependAllOf [Dependency]
deps        -> [Dependency] -> Dependency
DependAllOf ([Dependency] -> Dependency) -> [Dependency] -> Dependency
forall a b. (a -> b) -> a -> b
$ [Dependency] -> [Dependency]
s_uniq ([Dependency] -> [Dependency]) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> a -> b
$ (Dependency -> Dependency) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> Dependency
go [Dependency]
deps
        DependAtom  Atom
_           -> Dependency
d
    where go :: Dependency -> Dependency
go = Dependency -> Dependency
remove_duplicates

-- TODO: implement flattening AnyOf the same way it's done for AllOf
--   DependAnyOf [DependAnyOf [something], rest] -> DependAnyOf $ something ++ rest
flatten :: Dependency -> Dependency
flatten :: Dependency -> Dependency
flatten Dependency
d =
    case Dependency
d of
        DependIfUse Use
use Dependency
td Dependency
fd   -> Use -> Dependency -> Dependency -> Dependency
DependIfUse Use
use (Dependency -> Dependency
go Dependency
td) (Dependency -> Dependency
go Dependency
fd)
        DependAnyOf [Dependency
dep]       -> Dependency -> Dependency
go Dependency
dep
        DependAnyOf [Dependency]
deps        -> [Dependency] -> Dependency
DependAnyOf ([Dependency] -> Dependency) -> [Dependency] -> Dependency
forall a b. (a -> b) -> a -> b
$ (Dependency -> Dependency) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> Dependency
go [Dependency]
deps

        DependAllOf [Dependency]
deps        -> case (Dependency -> Bool)
-> [Dependency] -> ([Dependency], [Dependency])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition Dependency -> Bool
is_dall_of [Dependency]
deps of
                                       ([], [])      -> Dependency
empty_dependency
                                       ([], [Dependency
dep])   -> Dependency
dep
                                       ([], [Dependency]
ndall)   -> [Dependency] -> Dependency
DependAllOf ([Dependency] -> Dependency) -> [Dependency] -> Dependency
forall a b. (a -> b) -> a -> b
$ (Dependency -> Dependency) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> Dependency
go [Dependency]
ndall
                                       ([Dependency]
dall, [Dependency]
ndall) -> Dependency -> Dependency
go (Dependency -> Dependency) -> Dependency -> Dependency
forall a b. (a -> b) -> a -> b
$ [Dependency] -> Dependency
DependAllOf ([Dependency] -> Dependency) -> [Dependency] -> Dependency
forall a b. (a -> b) -> a -> b
$ [Dependency] -> [Dependency]
s_uniq ([Dependency] -> [Dependency]) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> a -> b
$ ((Dependency -> [Dependency]) -> [Dependency] -> [Dependency]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Dependency -> [Dependency]
undall [Dependency]
dall) [Dependency] -> [Dependency] -> [Dependency]
forall a. [a] -> [a] -> [a]
++ [Dependency]
ndall
        DependAtom Atom
_            -> Dependency
d
  where go :: Dependency -> Dependency
        go :: Dependency -> Dependency
go = Dependency -> Dependency
flatten

        is_dall_of :: Dependency -> Bool
        is_dall_of :: Dependency -> Bool
is_dall_of Dependency
d' =
            case Dependency
d' of
                DependAllOf [Dependency]
_deps -> Bool
True
                Dependency
_                 -> Bool
False
        undall :: Dependency -> [Dependency]
        undall :: Dependency -> [Dependency]
undall ~(DependAllOf [Dependency]
ds) = [Dependency]
ds

-- joins atoms with different version boundaries
-- DependAllOf [ DRange ">=foo-1" Inf, Drange Zero "<foo-2" ] -> DRange ">=foo-1" "<foo-2"
combine_atom_ranges :: Dependency -> Dependency
combine_atom_ranges :: Dependency -> Dependency
combine_atom_ranges Dependency
d =
    case Dependency
d of
        DependIfUse Use
use Dependency
td Dependency
fd -> Use -> Dependency -> Dependency -> Dependency
DependIfUse Use
use (Dependency -> Dependency
go Dependency
td) (Dependency -> Dependency
go Dependency
fd)
        DependAllOf [Dependency]
deps      -> [Dependency] -> Dependency
DependAllOf ([Dependency] -> Dependency) -> [Dependency] -> Dependency
forall a b. (a -> b) -> a -> b
$ (Dependency -> Dependency) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> Dependency
go ([Dependency] -> [Dependency]) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> a -> b
$ [Dependency] -> [Dependency]
find_atom_intersections  [Dependency]
deps
        DependAnyOf [Dependency]
deps      -> [Dependency] -> Dependency
DependAnyOf ([Dependency] -> Dependency) -> [Dependency] -> Dependency
forall a b. (a -> b) -> a -> b
$ (Dependency -> Dependency) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> Dependency
go ([Dependency] -> [Dependency]) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> a -> b
$ [Dependency] -> [Dependency]
find_atom_concatenations [Dependency]
deps
        DependAtom  Atom
_         -> Dependency
d
    where go :: Dependency -> Dependency
go = Dependency -> Dependency
combine_atom_ranges

find_atom_intersections :: [Dependency] -> [Dependency]
find_atom_intersections :: [Dependency] -> [Dependency]
find_atom_intersections = ([Dependency] -> Dependency) -> [[Dependency]] -> [Dependency]
forall a b. (a -> b) -> [a] -> [b]
map [Dependency] -> Dependency
merge_depends ([[Dependency]] -> [Dependency])
-> ([Dependency] -> [[Dependency]]) -> [Dependency] -> [Dependency]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dependency -> Dependency -> Bool)
-> [Dependency] -> [[Dependency]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy Dependency -> Dependency -> Bool
is_mergeable
    where is_mergeable :: Dependency -> Dependency -> Bool
          is_mergeable :: Dependency -> Dependency -> Bool
is_mergeable (DependAtom (Atom PackageName
lpn DRange
_ldrange DAttr
lattr)) (DependAtom (Atom PackageName
rpn DRange
_rdrange DAttr
rattr))
                          = (PackageName
lpn, DAttr
lattr) (PackageName, DAttr) -> (PackageName, DAttr) -> Bool
forall a. Eq a => a -> a -> Bool
== (PackageName
rpn, DAttr
rattr)
          is_mergeable Dependency
_                                       Dependency
_
                          = Bool
False

          merge_depends :: [Dependency] -> Dependency
          merge_depends :: [Dependency] -> Dependency
merge_depends [Dependency
x] = Dependency
x
          merge_depends [Dependency]
xs = (Dependency -> Dependency -> Dependency)
-> [Dependency] -> Dependency
forall a. (a -> a -> a) -> [a] -> a
L.foldl1' Dependency -> Dependency -> Dependency
merge_pair [Dependency]
xs

          merge_pair :: Dependency -> Dependency -> Dependency
          merge_pair :: Dependency -> Dependency -> Dependency
merge_pair (DependAtom (Atom PackageName
lp DRange
ld DAttr
la)) (DependAtom (Atom PackageName
rp DRange
rd DAttr
ra))
              | PackageName
lp PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
/= PackageName
rp = String -> Dependency
forall a. HasCallStack => String -> a
error String
"merge_pair got different 'PackageName's"
              | DAttr
la DAttr -> DAttr -> Bool
forall a. Eq a => a -> a -> Bool
/= DAttr
ra = String -> Dependency
forall a. HasCallStack => String -> a
error String
"merge_pair got different 'DAttr's"
              | Bool
otherwise = Atom -> Dependency
DependAtom (PackageName -> DRange -> DAttr -> Atom
Atom PackageName
lp (DRange -> DRange -> DRange
mergeDRanges DRange
ld DRange
rd) DAttr
la)
          merge_pair Dependency
l Dependency
r = String -> Dependency
forall a. HasCallStack => String -> a
error (String -> Dependency) -> String -> Dependency
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"merge_pair can't merge non-atoms:", Dependency -> String
forall a. Show a => a -> String
show Dependency
l, Dependency -> String
forall a. Show a => a -> String
show Dependency
r]

-- TODO
find_atom_concatenations :: [Dependency] -> [Dependency]
find_atom_concatenations :: [Dependency] -> [Dependency]
find_atom_concatenations = [Dependency] -> [Dependency]
forall a. a -> a
id

-- Eliminate use guarded redundancy:
--   a? ( foo )
--   a? ( bar )
-- gets translated to
--   a? ( foo bar )

--   a? ( foo bar )
--   !a? ( foo baz )
-- gets translated to
--   foo
--   a? ( bar )
--   !a? ( baz )

combine_use_guards :: Dependency -> Dependency
combine_use_guards :: Dependency -> Dependency
combine_use_guards Dependency
d =
    case Dependency
d of
        DependIfUse Use
use Dependency
td Dependency
fd -> Dependency -> Dependency
pop_common (Dependency -> Dependency) -> Dependency -> Dependency
forall a b. (a -> b) -> a -> b
$ Use -> Dependency -> Dependency -> Dependency
DependIfUse Use
use (Dependency -> Dependency
go Dependency
td) (Dependency -> Dependency
go Dependency
fd)
        DependAllOf [Dependency]
deps      -> [Dependency] -> Dependency
DependAllOf ([Dependency] -> Dependency) -> [Dependency] -> Dependency
forall a b. (a -> b) -> a -> b
$ (Dependency -> Dependency) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> Dependency
go ([Dependency] -> [Dependency]) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> a -> b
$ [Dependency] -> [Dependency]
find_use_intersections  [Dependency]
deps
        DependAnyOf [Dependency]
deps      -> [Dependency] -> Dependency
DependAnyOf ([Dependency] -> Dependency) -> [Dependency] -> Dependency
forall a b. (a -> b) -> a -> b
$ (Dependency -> Dependency) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> Dependency
go ([Dependency] -> [Dependency]) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> a -> b
$ [Dependency] -> [Dependency]
find_use_concatenations [Dependency]
deps
        DependAtom Atom
_          -> Dependency
d
    where go :: Dependency -> Dependency
go = Dependency -> Dependency
combine_use_guards

find_use_intersections :: [Dependency] -> [Dependency]
find_use_intersections :: [Dependency] -> [Dependency]
find_use_intersections = ([Dependency] -> Dependency) -> [[Dependency]] -> [Dependency]
forall a b. (a -> b) -> [a] -> [b]
map [Dependency] -> Dependency
merge_use_intersections ([[Dependency]] -> [Dependency])
-> ([Dependency] -> [[Dependency]]) -> [Dependency] -> [Dependency]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dependency -> Dependency -> Bool)
-> [Dependency] -> [[Dependency]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy Dependency -> Dependency -> Bool
is_use_mergeable
    where
        is_use_mergeable :: Dependency -> Dependency -> Bool
        is_use_mergeable :: Dependency -> Dependency -> Bool
is_use_mergeable (DependIfUse Use
lu Dependency
_ltd Dependency
_lfd) (DependIfUse Use
ru Dependency
_rtd Dependency
_rfd)
            | Use
lu Use -> Use -> Bool
forall a. Eq a => a -> a -> Bool
== Use
ru       = Bool
True
        is_use_mergeable Dependency
_ Dependency
_ = Bool
False

        merge_use_intersections :: [Dependency] -> Dependency
        merge_use_intersections :: [Dependency] -> Dependency
merge_use_intersections [Dependency
x] = Dependency
x
        merge_use_intersections [Dependency]
ds = Dependency -> Dependency
pop_common (Dependency -> Dependency) -> Dependency -> Dependency
forall a b. (a -> b) -> a -> b
$ Use -> Dependency -> Dependency -> Dependency
DependIfUse Use
u ([Dependency] -> Dependency
DependAllOf [Dependency]
tds) ([Dependency] -> Dependency
DependAllOf [Dependency]
fds)
            where DependIfUse Use
u Dependency
_tf Dependency
_fd = [Dependency] -> Dependency
forall a. [a] -> a
head [Dependency]
ds
                  tfdeps :: Dependency -> (Dependency, Dependency)
tfdeps ~(DependIfUse Use
_u Dependency
td Dependency
fd) = (Dependency
td, Dependency
fd)
                  ([Dependency]
tds, [Dependency]
fds) = [(Dependency, Dependency)] -> ([Dependency], [Dependency])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Dependency, Dependency)] -> ([Dependency], [Dependency]))
-> [(Dependency, Dependency)] -> ([Dependency], [Dependency])
forall a b. (a -> b) -> a -> b
$ (Dependency -> (Dependency, Dependency))
-> [Dependency] -> [(Dependency, Dependency)]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> (Dependency, Dependency)
tfdeps [Dependency]
ds

pop_common :: Dependency -> Dependency
-- depend
--   a? ( x ) !a? ( x )
-- gets translated to
--   x
pop_common :: Dependency -> Dependency
pop_common (DependIfUse Use
_u Dependency
td Dependency
fd)
    | Dependency
td Dependency -> Dependency -> Bool
forall a. Eq a => a -> a -> Bool
== Dependency
fd = Dependency
fd
pop_common d' :: Dependency
d'@(DependIfUse Use
_u Dependency
td Dependency
fd) =
    case [Dependency]
td_ctx [Dependency] -> [Dependency] -> [Dependency]
forall a. Eq a => [a] -> [a] -> [a]
`L.intersect` [Dependency]
fd_ctx of
        [] -> Dependency
d'
        [Dependency]
common_ctx -> (Dependency -> Dependency) -> Dependency -> Dependency
stabilize_pass Dependency -> Dependency
flatten (Dependency -> Dependency) -> Dependency -> Dependency
forall a b. (a -> b) -> a -> b
$ [Dependency] -> Dependency
DependAllOf ([Dependency] -> Dependency) -> [Dependency] -> Dependency
forall a b. (a -> b) -> a -> b
$ [Dependency] -> Dependency -> Dependency
propagate_context' [Dependency]
common_ctx Dependency
d' Dependency -> [Dependency] -> [Dependency]
forall a. a -> [a] -> [a]
: [Dependency]
common_ctx
    where td_ctx :: [Dependency]
td_ctx = Dependency -> [Dependency]
lift_context' Dependency
td
          fd_ctx :: [Dependency]
fd_ctx = Dependency -> [Dependency]
lift_context' Dependency
fd
pop_common Dependency
x = Dependency
x

-- TODO
find_use_concatenations :: [Dependency] -> [Dependency]
find_use_concatenations :: [Dependency] -> [Dependency]
find_use_concatenations = [Dependency] -> [Dependency]
forall a. a -> a
id

-- Eliminate top-down redundancy:
--   foo/bar
--   u? ( foo/bar
--        bar/baz )
-- gets translated to
--   foo/bar
--   u? ( bar/baz )
--
-- and more complex redundancy:
--   v? ( foo/bar )
--   u? ( !v? ( foo/bar ) )
-- gets translated to
--   v? ( foo/bar )
--   u? ( foo/bar )
propagate_context :: Dependency -> Dependency
propagate_context :: Dependency -> Dependency
propagate_context = [Dependency] -> Dependency -> Dependency
propagate_context' []

-- very simple model: pick all sibling-atom deps and add them to context
--                    for downward proparation and remove from 'all_of' part
-- TODO: any-of part can benefit from it by removing unsatisfiable or satisfied alternative
propagate_context' :: [Dependency] -> Dependency -> Dependency
propagate_context' :: [Dependency] -> Dependency -> Dependency
propagate_context' [Dependency]
ctx Dependency
d =
    case Dependency
d of
        Dependency
_ | Dependency
d Dependency -> [Dependency] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Dependency]
ctx      -> Dependency
empty_dependency
        DependIfUse Use
use Dependency
td Dependency
fd -> let ([Dependency]
t_ctx_comp, [Dependency]
t_refined_ctx) = (Bool, Use) -> [Dependency] -> ([Dependency], [Dependency])
refine_context (Bool
True,  Use
use) [Dependency]
ctx
                                     ([Dependency]
f_ctx_comp, [Dependency]
f_refined_ctx) = (Bool, Use) -> [Dependency] -> ([Dependency], [Dependency])
refine_context (Bool
False, Use
use) [Dependency]
ctx
                                     tdr :: Dependency
tdr = [Dependency] -> Dependency -> Dependency
go [Dependency]
t_refined_ctx Dependency
td
                                     fdr :: Dependency
fdr = [Dependency] -> Dependency -> Dependency
go [Dependency]
f_refined_ctx Dependency
fd
                                     ctx_comp :: [Dependency]
ctx_comp = (Dependency -> Bool) -> [Dependency] -> [Dependency]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Dependency -> Bool) -> Dependency -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependency -> Bool
is_empty_dependency) ([Dependency] -> [Dependency]) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> a -> b
$
                                                [[Dependency]] -> [Dependency]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ (Dependency -> [Dependency]
lift_context' Dependency
tdr [Dependency] -> [Dependency] -> [Dependency]
forall a. Eq a => [a] -> [a] -> [a]
`L.intersect` ((Dependency -> [Dependency]) -> [Dependency] -> [Dependency]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Dependency -> [Dependency]
lift_context' [Dependency]
t_ctx_comp))
                                                       , (Dependency -> [Dependency]
lift_context' Dependency
fdr [Dependency] -> [Dependency] -> [Dependency]
forall a. Eq a => [a] -> [a] -> [a]
`L.intersect` ((Dependency -> [Dependency]) -> [Dependency] -> [Dependency]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Dependency -> [Dependency]
lift_context' [Dependency]
f_ctx_comp))
                                                       ]
                                     diu_refined :: Dependency
diu_refined = Use -> Dependency -> Dependency -> Dependency
DependIfUse Use
use Dependency
tdr
                                                                   Dependency
fdr
                                 in case [Dependency]
ctx_comp of
                                    [] -> Dependency
diu_refined
                                    [Dependency]
_  -> [Dependency] -> Dependency -> Dependency
go [Dependency]
ctx (Dependency -> Dependency) -> Dependency -> Dependency
forall a b. (a -> b) -> a -> b
$
                                              [Dependency] -> Dependency
DependAllOf [ [Dependency] -> Dependency
DependAllOf [Dependency]
ctx_comp
                                                          , [Dependency] -> Dependency -> Dependency
go [Dependency]
ctx_comp Dependency
diu_refined
                                                          ]
        DependAllOf [Dependency]
deps      -> [Dependency] -> Dependency
DependAllOf ([Dependency] -> Dependency) -> [Dependency] -> Dependency
forall a b. (a -> b) -> a -> b
$ Maybe [Dependency] -> [Dependency]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [Dependency] -> [Dependency])
-> Maybe [Dependency] -> [Dependency]
forall a b. (a -> b) -> a -> b
$ [Maybe [Dependency]] -> Maybe [Dependency]
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe [Dependency]] -> Maybe [Dependency])
-> [Maybe [Dependency]] -> Maybe [Dependency]
forall a b. (a -> b) -> a -> b
$
                                                   [ Maybe [Dependency]
v
                                                   | (Dependency
optimized_d, [Dependency]
other_deps) <- [Dependency] -> [(Dependency, [Dependency])]
forall e. [e] -> [(e, [e])]
slice_list [Dependency]
deps
                                                   , let ctx' :: [Dependency]
ctx' = [Dependency]
ctx [Dependency] -> [Dependency] -> [Dependency]
forall a. [a] -> [a] -> [a]
++ [Dependency]
other_deps
                                                         d' :: Dependency
d'   = [Dependency] -> Dependency -> Dependency
go [Dependency]
ctx' Dependency
optimized_d
                                                         d'ctx :: [Dependency]
d'ctx = Dependency
d' Dependency -> [Dependency] -> [Dependency]
forall a. a -> [a] -> [a]
: [Dependency]
ctx
                                                         v :: Maybe [Dependency]
v    = case Dependency
d' Dependency -> Dependency -> Bool
forall a. Eq a => a -> a -> Bool
/= Dependency
optimized_d of
                                                                    Bool
True  -> [Dependency] -> Maybe [Dependency]
forall a. a -> Maybe a
Just (Dependency
d'Dependency -> [Dependency] -> [Dependency]
forall a. a -> [a] -> [a]
:(Dependency -> Dependency) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> [a] -> [b]
map ([Dependency] -> Dependency -> Dependency
go [Dependency]
d'ctx) [Dependency]
other_deps)
                                                                    Bool
False -> Maybe [Dependency]
forall a. Maybe a
Nothing -- haven't managed to optimize anything
                                                   ] [Maybe [Dependency]]
-> [Maybe [Dependency]] -> [Maybe [Dependency]]
forall a. [a] -> [a] -> [a]
++ [[Dependency] -> Maybe [Dependency]
forall a. a -> Maybe a
Just [Dependency]
deps] -- unmodified
        DependAnyOf [Dependency]
deps      -> [Dependency] -> Dependency
DependAnyOf ([Dependency] -> Dependency) -> [Dependency] -> Dependency
forall a b. (a -> b) -> a -> b
$ (Dependency -> Dependency) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> [a] -> [b]
map ([Dependency] -> Dependency -> Dependency
go [Dependency]
ctx) [Dependency]
deps
        DependAtom Atom
_          -> case (Dependency -> Bool) -> [Dependency] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Dependency -> Dependency -> Bool
dep_as_broad_as Dependency
d) [Dependency]
ctx of
                                     Bool
True  -> Dependency
empty_dependency
                                     Bool
False -> Dependency
d
  where go :: [Dependency] -> Dependency -> Dependency
go [Dependency]
c = [Dependency] -> Dependency -> Dependency
propagate_context' [Dependency]
c

-- returns (complement-dependencies, simplified-dependencies)
refine_context :: (Bool, Use) -> [Dependency] -> ([Dependency], [Dependency])
refine_context :: (Bool, Use) -> [Dependency] -> ([Dependency], [Dependency])
refine_context (Bool, Use)
use_cond = [(Dependency, Dependency)] -> ([Dependency], [Dependency])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Dependency, Dependency)] -> ([Dependency], [Dependency]))
-> ([Dependency] -> [(Dependency, Dependency)])
-> [Dependency]
-> ([Dependency], [Dependency])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dependency -> (Dependency, Dependency))
-> [Dependency] -> [(Dependency, Dependency)]
forall a b. (a -> b) -> [a] -> [b]
map ((Dependency -> Dependency)
-> (Dependency, Dependency) -> (Dependency, Dependency)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
A.second ((Dependency -> Dependency) -> Dependency -> Dependency
stabilize_pass Dependency -> Dependency
flatten) ((Dependency, Dependency) -> (Dependency, Dependency))
-> (Dependency -> (Dependency, Dependency))
-> Dependency
-> (Dependency, Dependency)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, Use) -> Dependency -> (Dependency, Dependency)
refine_ctx_unit (Bool, Use)
use_cond)
    where refine_ctx_unit :: (Bool, Use) -> Dependency -> (Dependency, Dependency)
          refine_ctx_unit :: (Bool, Use) -> Dependency -> (Dependency, Dependency)
refine_ctx_unit uc :: (Bool, Use)
uc@(Bool
bu, Use
u) Dependency
d =
              case Dependency
d of
                DependIfUse Use
u' Dependency
td Dependency
fd
                  -> case Use
u Use -> Use -> Bool
forall a. Eq a => a -> a -> Bool
== Use
u' of
                         Bool
False -> ( Dependency
empty_dependency
                                  , Use -> Dependency -> Dependency -> Dependency
DependIfUse Use
u' ((Dependency, Dependency) -> Dependency
forall a b. (a, b) -> b
snd ((Dependency, Dependency) -> Dependency)
-> (Dependency, Dependency) -> Dependency
forall a b. (a -> b) -> a -> b
$ (Bool, Use) -> Dependency -> (Dependency, Dependency)
refine_ctx_unit (Bool, Use)
uc Dependency
td)
                                                   ((Dependency, Dependency) -> Dependency
forall a b. (a, b) -> b
snd ((Dependency, Dependency) -> Dependency)
-> (Dependency, Dependency) -> Dependency
forall a b. (a -> b) -> a -> b
$ (Bool, Use) -> Dependency -> (Dependency, Dependency)
refine_ctx_unit (Bool, Use)
uc Dependency
fd)
                                  )
                         Bool
True  -> case Bool
bu of
                                      Bool
True  -> (Dependency
fd, (Dependency, Dependency) -> Dependency
forall a b. (a, b) -> b
snd ((Dependency, Dependency) -> Dependency)
-> (Dependency, Dependency) -> Dependency
forall a b. (a -> b) -> a -> b
$ (Bool, Use) -> Dependency -> (Dependency, Dependency)
refine_ctx_unit (Bool, Use)
uc Dependency
td)
                                      Bool
False -> (Dependency
td, (Dependency, Dependency) -> Dependency
forall a b. (a, b) -> b
snd ((Dependency, Dependency) -> Dependency)
-> (Dependency, Dependency) -> Dependency
forall a b. (a -> b) -> a -> b
$ (Bool, Use) -> Dependency -> (Dependency, Dependency)
refine_ctx_unit (Bool, Use)
uc Dependency
fd)
                Dependency
_ -> (Dependency
empty_dependency, Dependency
d)

-- generates all pairs of:
-- (list_element, list_without_element)
-- example:
--   [1,2,3]
-- yields
--   [(1, [2,3]), (2,[1,3]), (3,[1,2])]
slice_list :: [e] -> [(e, [e])]
slice_list :: [e] -> [(e, [e])]
slice_list [] = []
slice_list (e
e:[e]
es) = (e
e, [e]
es) (e, [e]) -> [(e, [e])] -> [(e, [e])]
forall a. a -> [a] -> [a]
: ((e, [e]) -> (e, [e])) -> [(e, [e])] -> [(e, [e])]
forall a b. (a -> b) -> [a] -> [b]
map (\(e
v, [e]
vs) -> (e
v, e
e e -> [e] -> [e]
forall a. a -> [a] -> [a]
: [e]
vs)) ([e] -> [(e, [e])]
forall e. [e] -> [(e, [e])]
slice_list [e]
es)

-- Eliminate bottom-up redundancy:
--   || ( ( foo/bar bar/baz )
--        ( foo/bar bar/quux ) )
-- gets translated to
--   foo/bar
--   || ( ( foo/bar bar/baz )
--        ( foo/bar bar/quux ) )
-- It looks like became more gross,
-- but 'propagate_context' phase
-- cleanups it to the following state:
--   foo/bar
--   || ( bar/baz
--        bar/quux )
-- TODO: better add propagation in this exact place to keep tree shrinking only
lift_context :: Dependency -> Dependency
lift_context :: Dependency -> Dependency
lift_context Dependency
d =
    case Dependency
d of
        DependIfUse Use
_use Dependency
_td Dependency
_fd -> case Dependency -> [Dependency] -> [Dependency]
forall a. Eq a => a -> [a] -> [a]
L.delete Dependency
d [Dependency]
new_ctx of
                                        []       -> Dependency
d
                                        [Dependency]
new_ctx' -> Dependency -> Dependency
propagate_context (Dependency -> Dependency) -> Dependency -> Dependency
forall a b. (a -> b) -> a -> b
$ [Dependency] -> Dependency
DependAllOf ([Dependency] -> Dependency) -> [Dependency] -> Dependency
forall a b. (a -> b) -> a -> b
$ Dependency
d Dependency -> [Dependency] -> [Dependency]
forall a. a -> [a] -> [a]
: [Dependency]
new_ctx'
        DependAllOf [Dependency]
deps         -> case [Dependency]
new_ctx [Dependency] -> [Dependency] -> [Dependency]
forall a. Eq a => [a] -> [a] -> [a]
L.\\ [Dependency]
deps of
                                        []       -> Dependency
d
                                        [Dependency]
new_ctx' -> [Dependency] -> Dependency
DependAllOf ([Dependency] -> Dependency) -> [Dependency] -> Dependency
forall a b. (a -> b) -> a -> b
$ [Dependency]
deps [Dependency] -> [Dependency] -> [Dependency]
forall a. [a] -> [a] -> [a]
++ [Dependency]
new_ctx'
        -- the lift itself
        DependAnyOf [Dependency]
_deps        -> case Dependency -> [Dependency] -> [Dependency]
forall a. Eq a => a -> [a] -> [a]
L.delete Dependency
d [Dependency]
new_ctx of
                                         []       -> Dependency
d
                                         [Dependency]
new_ctx' -> Dependency -> Dependency
propagate_context (Dependency -> Dependency) -> Dependency -> Dependency
forall a b. (a -> b) -> a -> b
$ [Dependency] -> Dependency
DependAllOf ([Dependency] -> Dependency) -> [Dependency] -> Dependency
forall a b. (a -> b) -> a -> b
$ Dependency
d Dependency -> [Dependency] -> [Dependency]
forall a. a -> [a] -> [a]
: [Dependency]
new_ctx'
        DependAtom  Atom
_            -> Dependency
d
  where new_ctx :: [Dependency]
new_ctx = Dependency -> [Dependency]
lift_context' Dependency
d

-- lift everything that can be shared somewhere else
-- propagate_context will then pick some bits from here
-- and remove them deep inside.
-- It's the most fragile and powerfull pass
lift_context' :: Dependency -> [Dependency]
lift_context' :: Dependency -> [Dependency]
lift_context' Dependency
d =
    case Dependency
d of
        DependIfUse Use
_use Dependency
td Dependency
fd   -> Dependency
d Dependency -> [Dependency] -> [Dependency]
forall a. a -> [a] -> [a]
: [[Dependency]] -> [Dependency]
extract_common_constraints ((Dependency -> [Dependency]) -> [Dependency] -> [[Dependency]]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> [Dependency]
lift_context' [Dependency
td, Dependency
fd])
        DependAllOf [Dependency]
deps         -> [Dependency] -> [Dependency]
forall a. Eq a => [a] -> [a]
L.nub ([Dependency] -> [Dependency]) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> a -> b
$ (Dependency -> [Dependency]) -> [Dependency] -> [Dependency]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Dependency -> [Dependency]
lift_context' [Dependency]
deps
        DependAnyOf [Dependency]
deps         -> Dependency
d Dependency -> [Dependency] -> [Dependency]
forall a. a -> [a] -> [a]
: [[Dependency]] -> [Dependency]
extract_common_constraints ((Dependency -> [Dependency]) -> [Dependency] -> [[Dependency]]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> [Dependency]
lift_context' [Dependency]
deps)
        DependAtom  Atom
_            -> [Dependency
d]

-- it extracts common part of dependency comstraints.
-- Some examples:
--  'a b c' and 'b c d' have common 'b c'
--  'u? ( a  b )' and 'u? ( b c )' have common 'u? ( b )' part
--  'a? ( b? ( x y ) )' and !a? ( b? ( y z ) )' have common 'b? ( y )'
extract_common_constraints :: [[Dependency]] -> [Dependency]
extract_common_constraints :: [[Dependency]] -> [Dependency]
extract_common_constraints [] = []
extract_common_constraints dss :: [[Dependency]]
dss@([Dependency]
ds:[[Dependency]]
dst) = [Dependency]
common_atoms [Dependency] -> [Dependency] -> [Dependency]
forall a. [a] -> [a] -> [a]
++ [Dependency]
common_use_guards
    where common_atoms :: [Dependency]
          common_atoms :: [Dependency]
common_atoms = ([Dependency] -> [Dependency] -> [Dependency])
-> [[Dependency]] -> [Dependency]
forall a. (a -> a -> a) -> [a] -> a
L.foldl1' [Dependency] -> [Dependency] -> [Dependency]
forall a. Eq a => [a] -> [a] -> [a]
L.intersect [[Dependency]]
dss
          common_use_guards :: [Dependency]
          common_use_guards :: [Dependency]
common_use_guards = [ Use -> Dependency -> Dependency -> Dependency
DependIfUse Use
u ([Dependency] -> Dependency
DependAllOf [Dependency]
tdi) ([Dependency] -> Dependency
DependAllOf [Dependency]
fdi)
                              | DependIfUse Use
u Dependency
td Dependency
fd <- [Dependency]
ds
                              , Just ([[Dependency]]
tds, [[Dependency]]
fds) <- [[[Dependency]]
-> Use
-> ([[Dependency]], [[Dependency]])
-> Maybe ([[Dependency]], [[Dependency]])
find_matching_use_deps [[Dependency]]
dst Use
u ([Dependency -> [Dependency]
lift_context' Dependency
td], [Dependency -> [Dependency]
lift_context' Dependency
fd])]
                              , let tdi :: [Dependency]
tdi = [[Dependency]] -> [Dependency]
extract_common_constraints [[Dependency]]
tds
                                    fdi :: [Dependency]
fdi = [[Dependency]] -> [Dependency]
extract_common_constraints [[Dependency]]
fds
                              , Bool -> Bool
not ([Dependency] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Dependency]
tdi Bool -> Bool -> Bool
&& [Dependency] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Dependency]
fdi)
                              ]

find_matching_use_deps :: [[Dependency]] -> Use -> ([[Dependency]], [[Dependency]]) -> Maybe ([[Dependency]], [[Dependency]])
find_matching_use_deps :: [[Dependency]]
-> Use
-> ([[Dependency]], [[Dependency]])
-> Maybe ([[Dependency]], [[Dependency]])
find_matching_use_deps [[Dependency]]
dss Use
u ([[Dependency]]
tds, [[Dependency]]
fds) =
    case [[Dependency]]
dss of
        []       -> ([[Dependency]], [[Dependency]])
-> Maybe ([[Dependency]], [[Dependency]])
forall a. a -> Maybe a
Just ([[Dependency]]
tds, [[Dependency]]
fds)
        ([Dependency]
ds:[[Dependency]]
dst) -> case [ ([Dependency]
tc, [Dependency]
fc)
                         | DependIfUse Use
u' Dependency
td Dependency
fd <- [Dependency]
ds
                         , Use
u' Use -> Use -> Bool
forall a. Eq a => a -> a -> Bool
== Use
u
                         , let tc :: [Dependency]
tc = Dependency -> [Dependency]
lift_context' Dependency
td
                               fc :: [Dependency]
fc = Dependency -> [Dependency]
lift_context' Dependency
fd
                         , Bool -> Bool
not ([Dependency] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Dependency]
tc Bool -> Bool -> Bool
&& [Dependency] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Dependency]
fc)
                         ] of
                        []    -> Maybe ([[Dependency]], [[Dependency]])
forall a. Maybe a
Nothing
                        [([Dependency], [Dependency])]
pairs -> [[Dependency]]
-> Use
-> ([[Dependency]], [[Dependency]])
-> Maybe ([[Dependency]], [[Dependency]])
find_matching_use_deps [[Dependency]]
dst Use
u ((([Dependency], [Dependency]) -> [Dependency])
-> [([Dependency], [Dependency])] -> [[Dependency]]
forall a b. (a -> b) -> [a] -> [b]
map ([Dependency], [Dependency]) -> [Dependency]
forall a b. (a, b) -> a
fst [([Dependency], [Dependency])]
pairs [[Dependency]] -> [[Dependency]] -> [[Dependency]]
forall a. [a] -> [a] -> [a]
++ [[Dependency]]
tds, (([Dependency], [Dependency]) -> [Dependency])
-> [([Dependency], [Dependency])] -> [[Dependency]]
forall a b. (a -> b) -> [a] -> [b]
map ([Dependency], [Dependency]) -> [Dependency]
forall a b. (a, b) -> b
snd [([Dependency], [Dependency])]
pairs [[Dependency]] -> [[Dependency]] -> [[Dependency]]
forall a. [a] -> [a] -> [a]
++ [[Dependency]]
fds)

-- reorders depends to make them more attractive
-- for other normalization algorithms
-- and for final pretty-printer
sort_deps :: Dependency -> Dependency
sort_deps :: Dependency -> Dependency
sort_deps Dependency
d =
    case Dependency
d of
        DependIfUse Use
lu Dependency
lt Dependency
lf
            | Dependency -> Bool
is_empty_dependency Dependency
lf ->
                case Dependency
lt of
                    DependIfUse Use
ru Dependency
rt Dependency
rf
                        -- b? ( a? ( d ) )
                        | Use
ru Use -> Use -> Bool
forall a. Ord a => a -> a -> Bool
< Use
lu Bool -> Bool -> Bool
&& Dependency -> Bool
is_empty_dependency Dependency
rf -> (Bool, Use) -> Dependency -> Dependency
mkUseDependency (Bool
True,  Use
ru) (Dependency -> Dependency) -> Dependency -> Dependency
forall a b. (a -> b) -> a -> b
$ (Bool, Use) -> Dependency -> Dependency
mkUseDependency (Bool
True, Use
lu) (Dependency -> Dependency
go Dependency
rt)
                        -- b? ( !a? ( d ) )
                        | Use
ru Use -> Use -> Bool
forall a. Ord a => a -> a -> Bool
< Use
lu Bool -> Bool -> Bool
&& Dependency -> Bool
is_empty_dependency Dependency
rt -> (Bool, Use) -> Dependency -> Dependency
mkUseDependency (Bool
False, Use
ru) (Dependency -> Dependency) -> Dependency -> Dependency
forall a b. (a -> b) -> a -> b
$ (Bool, Use) -> Dependency -> Dependency
mkUseDependency (Bool
True, Use
lu) (Dependency -> Dependency
go Dependency
rf)
                    Dependency
_ -> Use -> Dependency -> Dependency -> Dependency
DependIfUse Use
lu (Dependency -> Dependency
go Dependency
lt) (Dependency -> Dependency
go Dependency
lf)
            | Dependency -> Bool
is_empty_dependency Dependency
lt ->
                case Dependency
lf of
                    DependIfUse Use
ru Dependency
rt Dependency
rf
                        -- !b? ( a? ( d ) )
                        | Use
ru Use -> Use -> Bool
forall a. Ord a => a -> a -> Bool
< Use
lu Bool -> Bool -> Bool
&& Dependency -> Bool
is_empty_dependency Dependency
rf -> (Bool, Use) -> Dependency -> Dependency
mkUseDependency (Bool
True,  Use
ru) (Dependency -> Dependency) -> Dependency -> Dependency
forall a b. (a -> b) -> a -> b
$ (Bool, Use) -> Dependency -> Dependency
mkUseDependency (Bool
False, Use
lu) (Dependency -> Dependency
go Dependency
rt)
                        -- !b? ( !a? ( d ) )
                        | Use
ru Use -> Use -> Bool
forall a. Ord a => a -> a -> Bool
< Use
lu Bool -> Bool -> Bool
&& Dependency -> Bool
is_empty_dependency Dependency
rt -> (Bool, Use) -> Dependency -> Dependency
mkUseDependency (Bool
False, Use
ru) (Dependency -> Dependency) -> Dependency -> Dependency
forall a b. (a -> b) -> a -> b
$ (Bool, Use) -> Dependency -> Dependency
mkUseDependency (Bool
False, Use
lu) (Dependency -> Dependency
go Dependency
rf)
                    Dependency
_ -> Use -> Dependency -> Dependency -> Dependency
DependIfUse Use
lu (Dependency -> Dependency
go Dependency
lt) (Dependency -> Dependency
go Dependency
lf)
        DependIfUse Use
use Dependency
td Dependency
fd   -> Use -> Dependency -> Dependency -> Dependency
DependIfUse Use
use (Dependency -> Dependency
go Dependency
td) (Dependency -> Dependency
go Dependency
fd)
        DependAnyOf [Dependency]
deps        -> [Dependency] -> Dependency
DependAnyOf ([Dependency] -> Dependency) -> [Dependency] -> Dependency
forall a b. (a -> b) -> a -> b
$ [Dependency] -> [Dependency]
forall a. Ord a => [a] -> [a]
L.sort ([Dependency] -> [Dependency]) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> a -> b
$ (Dependency -> Dependency) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> Dependency
go [Dependency]
deps
        DependAllOf [Dependency]
deps        -> [Dependency] -> Dependency
DependAllOf ([Dependency] -> Dependency) -> [Dependency] -> Dependency
forall a b. (a -> b) -> a -> b
$ [Dependency] -> [Dependency]
forall a. Ord a => [a] -> [a]
L.sort ([Dependency] -> [Dependency]) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> a -> b
$ (Dependency -> Dependency) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> Dependency
go [Dependency]
deps
        DependAtom  Atom
_           -> Dependency
d
    where go :: Dependency -> Dependency
go = Dependency -> Dependency
sort_deps

-- remove various types of redundancy
normalize_depend :: Dependency -> Dependency
normalize_depend :: Dependency -> Dependency
normalize_depend = Int -> Int -> Dependency -> Dependency
normalize_depend' Int
50 Int
0 -- arbitrary limit

normalize_depend' :: Int -> Int -> Dependency -> Dependency
normalize_depend' :: Int -> Int -> Dependency -> Dependency
normalize_depend' Int
max_level Int
level Dependency
d
    | Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
max_level = String -> Dependency -> Dependency
forall a. String -> a -> a
trace String
"WARNING: Normalize_depend hung up. Optimization is incomplete." Dependency
d
normalize_depend' Int
max_level Int
level Dependency
d = Dependency -> Dependency
next_step Dependency
next_d
    where next_d :: Dependency
next_d = Int -> Dependency -> Dependency
normalization_step Int
level Dependency
d
          next_step :: Dependency -> Dependency
next_step | Dependency
d Dependency -> Dependency -> Bool
forall a. Eq a => a -> a -> Bool
== Dependency
next_d = Dependency -> Dependency
forall a. a -> a
id
                    | Bool
otherwise   = Int -> Int -> Dependency -> Dependency
normalize_depend' Int
max_level (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)