{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE PatternSynonyms #-}
module Ormolu.Printer.Operators
( OpTree (..),
pattern BinaryOpBranches,
OpInfo (..),
opTreeLoc,
reassociateOpTree,
isHardSplitterOp,
)
where
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import GHC.Types.Name.Reader
import GHC.Types.SrcLoc
import Ormolu.Fixity
import Ormolu.Utils
data OpTree ty op
=
OpNode ty
|
OpBranches (NonEmpty (OpTree ty op)) [op]
deriving (OpTree ty op -> OpTree ty op -> Bool
(OpTree ty op -> OpTree ty op -> Bool)
-> (OpTree ty op -> OpTree ty op -> Bool) -> Eq (OpTree ty op)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ty op.
(Eq ty, Eq op) =>
OpTree ty op -> OpTree ty op -> Bool
$c== :: forall ty op.
(Eq ty, Eq op) =>
OpTree ty op -> OpTree ty op -> Bool
== :: OpTree ty op -> OpTree ty op -> Bool
$c/= :: forall ty op.
(Eq ty, Eq op) =>
OpTree ty op -> OpTree ty op -> Bool
/= :: OpTree ty op -> OpTree ty op -> Bool
Eq, Int -> OpTree ty op -> ShowS
[OpTree ty op] -> ShowS
OpTree ty op -> String
(Int -> OpTree ty op -> ShowS)
-> (OpTree ty op -> String)
-> ([OpTree ty op] -> ShowS)
-> Show (OpTree ty op)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ty op. (Show ty, Show op) => Int -> OpTree ty op -> ShowS
forall ty op. (Show ty, Show op) => [OpTree ty op] -> ShowS
forall ty op. (Show ty, Show op) => OpTree ty op -> String
$cshowsPrec :: forall ty op. (Show ty, Show op) => Int -> OpTree ty op -> ShowS
showsPrec :: Int -> OpTree ty op -> ShowS
$cshow :: forall ty op. (Show ty, Show op) => OpTree ty op -> String
show :: OpTree ty op -> String
$cshowList :: forall ty op. (Show ty, Show op) => [OpTree ty op] -> ShowS
showList :: [OpTree ty op] -> ShowS
Show)
pattern BinaryOpBranches :: OpTree ty op -> op -> OpTree ty op -> OpTree ty op
pattern $mBinaryOpBranches :: forall {r} {ty} {op}.
OpTree ty op
-> (OpTree ty op -> op -> OpTree ty op -> r) -> ((# #) -> r) -> r
$bBinaryOpBranches :: forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
BinaryOpBranches x op y = OpBranches (x :| [y]) [op]
data OpInfo op = OpInfo
{
forall op. OpInfo op -> op
opiOp :: op,
forall op. OpInfo op -> Maybe RdrName
opiName :: Maybe RdrName,
forall op. OpInfo op -> FixityApproximation
opiFixityApproximation :: FixityApproximation
}
deriving (OpInfo op -> OpInfo op -> Bool
(OpInfo op -> OpInfo op -> Bool)
-> (OpInfo op -> OpInfo op -> Bool) -> Eq (OpInfo op)
forall op. Eq op => OpInfo op -> OpInfo op -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall op. Eq op => OpInfo op -> OpInfo op -> Bool
== :: OpInfo op -> OpInfo op -> Bool
$c/= :: forall op. Eq op => OpInfo op -> OpInfo op -> Bool
/= :: OpInfo op -> OpInfo op -> Bool
Eq)
compareOp :: OpInfo op -> OpInfo op -> Maybe Ordering
compareOp :: forall op. OpInfo op -> OpInfo op -> Maybe Ordering
compareOp
(OpInfo op
_ Maybe RdrName
mName1 FixityApproximation {faMinPrecedence :: FixityApproximation -> Int
faMinPrecedence = Int
min1, faMaxPrecedence :: FixityApproximation -> Int
faMaxPrecedence = Int
max1})
(OpInfo op
_ Maybe RdrName
mName2 FixityApproximation {faMinPrecedence :: FixityApproximation -> Int
faMinPrecedence = Int
min2, faMaxPrecedence :: FixityApproximation -> Int
faMaxPrecedence = Int
max2}) =
if
| Int
min1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
min2
Bool -> Bool -> Bool
&& Int
max1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
max2
Bool -> Bool -> Bool
&& (Int
min1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
max1 Bool -> Bool -> Bool
|| Bool
sameSymbol) ->
Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just Ordering
EQ
| Int
max1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
min2 -> Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just Ordering
LT
| Int
max2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
min1 -> Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just Ordering
GT
| Bool
otherwise -> Maybe Ordering
forall a. Maybe a
Nothing
where
sameSymbol :: Bool
sameSymbol = case (Maybe RdrName
mName1, Maybe RdrName
mName2) of
(Just RdrName
n1, Just RdrName
n2) -> RdrName
n1 RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName
n2
(Maybe RdrName, Maybe RdrName)
_ -> Bool
False
opTreeLoc :: (HasSrcSpan l) => OpTree (GenLocated l a) b -> SrcSpan
opTreeLoc :: forall l a b. HasSrcSpan l => OpTree (GenLocated l a) b -> SrcSpan
opTreeLoc (OpNode GenLocated l a
n) = GenLocated l a -> SrcSpan
forall l a. HasSrcSpan l => GenLocated l a -> SrcSpan
getLoc' GenLocated l a
n
opTreeLoc (OpBranches NonEmpty (OpTree (GenLocated l a) b)
exprs [b]
_) =
NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan)
-> (NonEmpty (OpTree (GenLocated l a) b) -> NonEmpty SrcSpan)
-> NonEmpty (OpTree (GenLocated l a) b)
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OpTree (GenLocated l a) b -> SrcSpan)
-> NonEmpty (OpTree (GenLocated l a) b) -> NonEmpty SrcSpan
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OpTree (GenLocated l a) b -> SrcSpan
forall l a b. HasSrcSpan l => OpTree (GenLocated l a) b -> SrcSpan
opTreeLoc (NonEmpty (OpTree (GenLocated l a) b) -> SrcSpan)
-> NonEmpty (OpTree (GenLocated l a) b) -> SrcSpan
forall a b. (a -> b) -> a -> b
$ NonEmpty (OpTree (GenLocated l a) b)
exprs
reassociateOpTree ::
Bool ->
(op -> Maybe RdrName) ->
ModuleFixityMap ->
OpTree ty op ->
OpTree ty (OpInfo op)
reassociateOpTree :: forall op ty.
Bool
-> (op -> Maybe RdrName)
-> ModuleFixityMap
-> OpTree ty op
-> OpTree ty (OpInfo op)
reassociateOpTree Bool
debug op -> Maybe RdrName
getOpName ModuleFixityMap
modFixityMap =
OpTree ty (OpInfo op) -> OpTree ty (OpInfo op)
forall ty op. OpTree ty (OpInfo op) -> OpTree ty (OpInfo op)
reassociateFlatOpTree
(OpTree ty (OpInfo op) -> OpTree ty (OpInfo op))
-> (OpTree ty op -> OpTree ty (OpInfo op))
-> OpTree ty op
-> OpTree ty (OpInfo op)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpTree ty (OpInfo op) -> OpTree ty (OpInfo op)
forall ty op. OpTree ty op -> OpTree ty op
makeFlatOpTree
(OpTree ty (OpInfo op) -> OpTree ty (OpInfo op))
-> (OpTree ty op -> OpTree ty (OpInfo op))
-> OpTree ty op
-> OpTree ty (OpInfo op)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> ModuleFixityMap
-> (op -> Maybe RdrName)
-> OpTree ty op
-> OpTree ty (OpInfo op)
forall op ty.
Bool
-> ModuleFixityMap
-> (op -> Maybe RdrName)
-> OpTree ty op
-> OpTree ty (OpInfo op)
addFixityInfo Bool
debug ModuleFixityMap
modFixityMap op -> Maybe RdrName
getOpName
addFixityInfo ::
Bool ->
ModuleFixityMap ->
(op -> Maybe RdrName) ->
OpTree ty op ->
OpTree ty (OpInfo op)
addFixityInfo :: forall op ty.
Bool
-> ModuleFixityMap
-> (op -> Maybe RdrName)
-> OpTree ty op
-> OpTree ty (OpInfo op)
addFixityInfo Bool
_ ModuleFixityMap
_ op -> Maybe RdrName
_ (OpNode ty
n) = ty -> OpTree ty (OpInfo op)
forall ty op. ty -> OpTree ty op
OpNode ty
n
addFixityInfo Bool
debug ModuleFixityMap
modFixityMap op -> Maybe RdrName
getOpName (OpBranches NonEmpty (OpTree ty op)
exprs [op]
ops) =
NonEmpty (OpTree ty (OpInfo op))
-> [OpInfo op] -> OpTree ty (OpInfo op)
forall ty op. NonEmpty (OpTree ty op) -> [op] -> OpTree ty op
OpBranches
(Bool
-> ModuleFixityMap
-> (op -> Maybe RdrName)
-> OpTree ty op
-> OpTree ty (OpInfo op)
forall op ty.
Bool
-> ModuleFixityMap
-> (op -> Maybe RdrName)
-> OpTree ty op
-> OpTree ty (OpInfo op)
addFixityInfo Bool
debug ModuleFixityMap
modFixityMap op -> Maybe RdrName
getOpName (OpTree ty op -> OpTree ty (OpInfo op))
-> NonEmpty (OpTree ty op) -> NonEmpty (OpTree ty (OpInfo op))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (OpTree ty op)
exprs)
(op -> OpInfo op
toOpInfo (op -> OpInfo op) -> [op] -> [OpInfo op]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [op]
ops)
where
toOpInfo :: op -> OpInfo op
toOpInfo op
o = op -> Maybe RdrName -> FixityApproximation -> OpInfo op
forall op. op -> Maybe RdrName -> FixityApproximation -> OpInfo op
OpInfo op
o Maybe RdrName
mrdrName FixityApproximation
fixityApproximation
where
mrdrName :: Maybe RdrName
mrdrName = op -> Maybe RdrName
getOpName op
o
fixityApproximation :: FixityApproximation
fixityApproximation = case Maybe RdrName
mrdrName of
Maybe RdrName
Nothing -> FixityApproximation
defaultFixityApproximation
Just RdrName
rdrName -> Bool -> RdrName -> ModuleFixityMap -> FixityApproximation
inferFixity Bool
debug RdrName
rdrName ModuleFixityMap
modFixityMap
makeFlatOpTree :: OpTree ty op -> OpTree ty op
makeFlatOpTree :: forall ty op. OpTree ty op -> OpTree ty op
makeFlatOpTree (OpNode ty
n) = ty -> OpTree ty op
forall ty op. ty -> OpTree ty op
OpNode ty
n
makeFlatOpTree (OpBranches NonEmpty (OpTree ty op)
exprs [op]
ops) =
NonEmpty (OpTree ty op) -> [op] -> OpTree ty op
forall ty op. NonEmpty (OpTree ty op) -> [op] -> OpTree ty op
OpBranches NonEmpty (OpTree ty op)
rExprs [op]
rOps
where
makeFlatOpTree' :: OpTree ty a -> (NonEmpty (OpTree ty a), [a])
makeFlatOpTree' OpTree ty a
expr = case OpTree ty a -> OpTree ty a
forall ty op. OpTree ty op -> OpTree ty op
makeFlatOpTree OpTree ty a
expr of
OpNode ty
n -> (OpTree ty a -> NonEmpty (OpTree ty a)
forall a. a -> NonEmpty a
NE.singleton (ty -> OpTree ty a
forall ty op. ty -> OpTree ty op
OpNode ty
n), [])
OpBranches NonEmpty (OpTree ty a)
noptExprs [a]
noptOps -> (NonEmpty (OpTree ty a)
noptExprs, [a]
noptOps)
flattenedSubTrees :: NonEmpty (NonEmpty (OpTree ty op), [op])
flattenedSubTrees = OpTree ty op -> (NonEmpty (OpTree ty op), [op])
forall {ty} {a}. OpTree ty a -> (NonEmpty (OpTree ty a), [a])
makeFlatOpTree' (OpTree ty op -> (NonEmpty (OpTree ty op), [op]))
-> NonEmpty (OpTree ty op)
-> NonEmpty (NonEmpty (OpTree ty op), [op])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (OpTree ty op)
exprs
rExprs :: NonEmpty (OpTree ty op)
rExprs = (NonEmpty (OpTree ty op), [op]) -> NonEmpty (OpTree ty op)
forall a b. (a, b) -> a
fst ((NonEmpty (OpTree ty op), [op]) -> NonEmpty (OpTree ty op))
-> NonEmpty (NonEmpty (OpTree ty op), [op])
-> NonEmpty (OpTree ty op)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< NonEmpty (NonEmpty (OpTree ty op), [op])
flattenedSubTrees
rOps :: [op]
rOps = [[op]] -> [op]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[op]] -> [op]) -> [[op]] -> [op]
forall a b. (a -> b) -> a -> b
$ [[op]] -> [[op]] -> [[op]]
forall {a}. [a] -> [a] -> [a]
interleave ((NonEmpty (OpTree ty op), [op]) -> [op]
forall a b. (a, b) -> b
snd ((NonEmpty (OpTree ty op), [op]) -> [op])
-> [(NonEmpty (OpTree ty op), [op])] -> [[op]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (NonEmpty (OpTree ty op), [op])
-> [(NonEmpty (OpTree ty op), [op])]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (NonEmpty (OpTree ty op), [op])
flattenedSubTrees) (op -> [op]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (op -> [op]) -> [op] -> [[op]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [op]
ops)
interleave :: [a] -> [a] -> [a]
interleave (a
x : [a]
xs) (a
y : [a]
ys) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
interleave [a]
xs [a]
ys
interleave [] [a]
ys = [a]
ys
interleave [a]
xs [] = [a]
xs
reassociateFlatOpTree ::
OpTree ty (OpInfo op) ->
OpTree ty (OpInfo op)
reassociateFlatOpTree :: forall ty op. OpTree ty (OpInfo op) -> OpTree ty (OpInfo op)
reassociateFlatOpTree tree :: OpTree ty (OpInfo op)
tree@(OpNode ty
_) = OpTree ty (OpInfo op)
tree
reassociateFlatOpTree tree :: OpTree ty (OpInfo op)
tree@(OpBranches NonEmpty (OpTree ty (OpInfo op))
noptExprs [OpInfo op]
noptOps) =
case [OpInfo op] -> (Maybe [Int], Maybe [Int])
forall {op}. [OpInfo op] -> (Maybe [Int], Maybe [Int])
indexOfMinMaxPrecOps [OpInfo op]
noptOps of
(Just [Int]
minIndices, Maybe [Int]
_) -> NonEmpty (OpTree ty (OpInfo op))
-> [OpInfo op] -> [Int] -> OpTree ty (OpInfo op)
forall {ty} {op}.
NonEmpty (OpTree ty (OpInfo op))
-> [OpInfo op] -> [Int] -> OpTree ty (OpInfo op)
splitTree NonEmpty (OpTree ty (OpInfo op))
noptExprs [OpInfo op]
noptOps [Int]
minIndices
(Maybe [Int]
_, Just [Int]
maxIndices) -> NonEmpty (OpTree ty (OpInfo op))
-> [OpInfo op] -> [Int] -> OpTree ty (OpInfo op)
forall {ty} {op}.
NonEmpty (OpTree ty (OpInfo op))
-> [OpInfo op] -> [Int] -> OpTree ty (OpInfo op)
groupTree NonEmpty (OpTree ty (OpInfo op))
noptExprs [OpInfo op]
noptOps [Int]
maxIndices
(Maybe [Int], Maybe [Int])
_ -> case [Int]
indicesOfHardSplitter of
[] -> OpTree ty (OpInfo op)
tree
[Int]
indices -> NonEmpty (OpTree ty (OpInfo op))
-> [OpInfo op] -> [Int] -> OpTree ty (OpInfo op)
forall {ty} {op}.
NonEmpty (OpTree ty (OpInfo op))
-> [OpInfo op] -> [Int] -> OpTree ty (OpInfo op)
splitTree NonEmpty (OpTree ty (OpInfo op))
noptExprs [OpInfo op]
noptOps [Int]
indices
where
indicesOfHardSplitter :: [Int]
indicesOfHardSplitter =
((Int, OpInfo op) -> Int) -> [(Int, OpInfo op)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, OpInfo op) -> Int
forall a b. (a, b) -> a
fst ([(Int, OpInfo op)] -> [Int]) -> [(Int, OpInfo op)] -> [Int]
forall a b. (a -> b) -> a -> b
$
((Int, OpInfo op) -> Bool)
-> [(Int, OpInfo op)] -> [(Int, OpInfo op)]
forall a. (a -> Bool) -> [a] -> [a]
filter (FixityApproximation -> Bool
isHardSplitterOp (FixityApproximation -> Bool)
-> ((Int, OpInfo op) -> FixityApproximation)
-> (Int, OpInfo op)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpInfo op -> FixityApproximation
forall op. OpInfo op -> FixityApproximation
opiFixityApproximation (OpInfo op -> FixityApproximation)
-> ((Int, OpInfo op) -> OpInfo op)
-> (Int, OpInfo op)
-> FixityApproximation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, OpInfo op) -> OpInfo op
forall a b. (a, b) -> b
snd) ([(Int, OpInfo op)] -> [(Int, OpInfo op)])
-> [(Int, OpInfo op)] -> [(Int, OpInfo op)]
forall a b. (a -> b) -> a -> b
$
[Int] -> [OpInfo op] -> [(Int, OpInfo op)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [OpInfo op]
noptOps
indexOfMinMaxPrecOps :: [OpInfo op] -> (Maybe [Int], Maybe [Int])
indexOfMinMaxPrecOps [] = (Maybe [Int]
forall a. Maybe a
Nothing, Maybe [Int]
forall a. Maybe a
Nothing)
indexOfMinMaxPrecOps (OpInfo op
oo : [OpInfo op]
oos) = [OpInfo op]
-> Int
-> OpInfo op
-> Maybe [Int]
-> OpInfo op
-> Maybe [Int]
-> (Maybe [Int], Maybe [Int])
forall op.
[OpInfo op]
-> Int
-> OpInfo op
-> Maybe [Int]
-> OpInfo op
-> Maybe [Int]
-> (Maybe [Int], Maybe [Int])
go [OpInfo op]
oos Int
1 OpInfo op
oo ([Int] -> Maybe [Int]
forall a. a -> Maybe a
Just [Int
0]) OpInfo op
oo ([Int] -> Maybe [Int]
forall a. a -> Maybe a
Just [Int
0])
where
go ::
[OpInfo op] ->
Int ->
OpInfo op ->
Maybe [Int] ->
OpInfo op ->
Maybe [Int] ->
(Maybe [Int], Maybe [Int])
go :: forall op.
[OpInfo op]
-> Int
-> OpInfo op
-> Maybe [Int]
-> OpInfo op
-> Maybe [Int]
-> (Maybe [Int], Maybe [Int])
go [] Int
_ OpInfo op
_ Maybe [Int]
minRes OpInfo op
_ Maybe [Int]
maxRes = ([Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> Maybe [Int] -> Maybe [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Int]
minRes, [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> Maybe [Int] -> Maybe [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Int]
maxRes)
go (OpInfo op
o : [OpInfo op]
os) Int
i OpInfo op
minOpi Maybe [Int]
minRes OpInfo op
maxOpi Maybe [Int]
maxRes =
let (OpInfo op
minOpi', Maybe [Int]
minRes') = case OpInfo op -> OpInfo op -> Maybe Ordering
forall op. OpInfo op -> OpInfo op -> Maybe Ordering
compareOp OpInfo op
o OpInfo op
minOpi of
Just Ordering
EQ -> (OpInfo op
minOpi, (:) Int
i ([Int] -> [Int]) -> Maybe [Int] -> Maybe [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Int]
minRes)
Just Ordering
LT -> (OpInfo op
o, [Int] -> Maybe [Int]
forall a. a -> Maybe a
Just [Int
i])
Just Ordering
GT -> (OpInfo op
minOpi, Maybe [Int]
minRes)
Maybe Ordering
Nothing -> (OpInfo op -> OpInfo op -> OpInfo op
forall {op} {op}. OpInfo op -> OpInfo op -> OpInfo op
combine OpInfo op
minOpi OpInfo op
o, Maybe [Int]
forall a. Maybe a
Nothing)
(OpInfo op
maxOpi', Maybe [Int]
maxRes') = case OpInfo op -> OpInfo op -> Maybe Ordering
forall op. OpInfo op -> OpInfo op -> Maybe Ordering
compareOp OpInfo op
o OpInfo op
maxOpi of
Just Ordering
EQ -> (OpInfo op
maxOpi, (:) Int
i ([Int] -> [Int]) -> Maybe [Int] -> Maybe [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Int]
maxRes)
Just Ordering
LT -> (OpInfo op
maxOpi, Maybe [Int]
maxRes)
Just Ordering
GT -> (OpInfo op
o, [Int] -> Maybe [Int]
forall a. a -> Maybe a
Just [Int
i])
Maybe Ordering
Nothing -> (OpInfo op -> OpInfo op -> OpInfo op
forall {op} {op}. OpInfo op -> OpInfo op -> OpInfo op
combine OpInfo op
maxOpi OpInfo op
o, Maybe [Int]
forall a. Maybe a
Nothing)
combine :: OpInfo op -> OpInfo op -> OpInfo op
combine (OpInfo op
x Maybe RdrName
_ FixityApproximation
fix1) (OpInfo op
_ Maybe RdrName
_ FixityApproximation
fix2) =
op -> Maybe RdrName -> FixityApproximation -> OpInfo op
forall op. op -> Maybe RdrName -> FixityApproximation -> OpInfo op
OpInfo op
x Maybe RdrName
forall a. Maybe a
Nothing (FixityApproximation
fix1 FixityApproximation -> FixityApproximation -> FixityApproximation
forall a. Semigroup a => a -> a -> a
<> FixityApproximation
fix2)
in [OpInfo op]
-> Int
-> OpInfo op
-> Maybe [Int]
-> OpInfo op
-> Maybe [Int]
-> (Maybe [Int], Maybe [Int])
forall op.
[OpInfo op]
-> Int
-> OpInfo op
-> Maybe [Int]
-> OpInfo op
-> Maybe [Int]
-> (Maybe [Int], Maybe [Int])
go [OpInfo op]
os (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) OpInfo op
minOpi' Maybe [Int]
minRes' OpInfo op
maxOpi' Maybe [Int]
maxRes'
splitTree :: NonEmpty (OpTree ty (OpInfo op))
-> [OpInfo op] -> [Int] -> OpTree ty (OpInfo op)
splitTree NonEmpty (OpTree ty (OpInfo op))
nExprs [OpInfo op]
nOps [Int]
indices = [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [Int]
-> Int
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> OpTree ty (OpInfo op)
forall ty op.
[OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [Int]
-> Int
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> OpTree ty (OpInfo op)
go (NonEmpty (OpTree ty (OpInfo op)) -> [OpTree ty (OpInfo op)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (OpTree ty (OpInfo op))
nExprs) [OpInfo op]
nOps [Int]
indices Int
0 [] [] [] []
where
go ::
[OpTree ty (OpInfo op)] ->
[OpInfo op] ->
[Int] ->
Int ->
[OpTree ty (OpInfo op)] ->
[OpInfo op] ->
[OpTree ty (OpInfo op)] ->
[OpInfo op] ->
OpTree ty (OpInfo op)
go :: forall ty op.
[OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [Int]
-> Int
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> OpTree ty (OpInfo op)
go [] [OpInfo op]
_ [Int]
_ Int
_ [OpTree ty (OpInfo op)]
subExprs [OpInfo op]
subOps [OpTree ty (OpInfo op)]
resExprs [OpInfo op]
resOps =
let resExpr :: OpTree ty (OpInfo op)
resExpr = NonEmpty (OpTree ty (OpInfo op))
-> [OpInfo op] -> OpTree ty (OpInfo op)
forall {ty} {op}.
NonEmpty (OpTree ty (OpInfo op))
-> [OpInfo op] -> OpTree ty (OpInfo op)
buildFromSub ([OpTree ty (OpInfo op)] -> NonEmpty (OpTree ty (OpInfo op))
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [OpTree ty (OpInfo op)]
subExprs) [OpInfo op]
subOps
in NonEmpty (OpTree ty (OpInfo op))
-> [OpInfo op] -> OpTree ty (OpInfo op)
forall ty op. NonEmpty (OpTree ty op) -> [op] -> OpTree ty op
OpBranches (NonEmpty (OpTree ty (OpInfo op))
-> NonEmpty (OpTree ty (OpInfo op))
forall a. NonEmpty a -> NonEmpty a
NE.reverse (OpTree ty (OpInfo op)
resExpr OpTree ty (OpInfo op)
-> [OpTree ty (OpInfo op)] -> NonEmpty (OpTree ty (OpInfo op))
forall a. a -> [a] -> NonEmpty a
:| [OpTree ty (OpInfo op)]
resExprs)) ([OpInfo op] -> [OpInfo op]
forall a. [a] -> [a]
reverse [OpInfo op]
resOps)
go (OpTree ty (OpInfo op)
x : [OpTree ty (OpInfo op)]
xs) (OpInfo op
o : [OpInfo op]
os) (Int
idx : [Int]
idxs) Int
i [OpTree ty (OpInfo op)]
subExprs [OpInfo op]
subOps [OpTree ty (OpInfo op)]
resExprs [OpInfo op]
resOps
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
idx =
let resExpr :: OpTree ty (OpInfo op)
resExpr = NonEmpty (OpTree ty (OpInfo op))
-> [OpInfo op] -> OpTree ty (OpInfo op)
forall {ty} {op}.
NonEmpty (OpTree ty (OpInfo op))
-> [OpInfo op] -> OpTree ty (OpInfo op)
buildFromSub (OpTree ty (OpInfo op)
x OpTree ty (OpInfo op)
-> [OpTree ty (OpInfo op)] -> NonEmpty (OpTree ty (OpInfo op))
forall a. a -> [a] -> NonEmpty a
:| [OpTree ty (OpInfo op)]
subExprs) [OpInfo op]
subOps
in [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [Int]
-> Int
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> OpTree ty (OpInfo op)
forall ty op.
[OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [Int]
-> Int
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> OpTree ty (OpInfo op)
go [OpTree ty (OpInfo op)]
xs [OpInfo op]
os [Int]
idxs (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [] [] (OpTree ty (OpInfo op)
resExpr OpTree ty (OpInfo op)
-> [OpTree ty (OpInfo op)] -> [OpTree ty (OpInfo op)]
forall a. a -> [a] -> [a]
: [OpTree ty (OpInfo op)]
resExprs) (OpInfo op
o OpInfo op -> [OpInfo op] -> [OpInfo op]
forall a. a -> [a] -> [a]
: [OpInfo op]
resOps)
go (OpTree ty (OpInfo op)
x : [OpTree ty (OpInfo op)]
xs) [OpInfo op]
ops [Int]
idxs Int
i [OpTree ty (OpInfo op)]
subExprs [OpInfo op]
subOps [OpTree ty (OpInfo op)]
resExprs [OpInfo op]
resOps =
let ([OpInfo op]
ops', [OpInfo op]
subOps') = [OpInfo op] -> [OpInfo op] -> ([OpInfo op], [OpInfo op])
forall {a}. [a] -> [a] -> ([a], [a])
moveOneIfPossible [OpInfo op]
ops [OpInfo op]
subOps
in [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [Int]
-> Int
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> OpTree ty (OpInfo op)
forall ty op.
[OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [Int]
-> Int
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> OpTree ty (OpInfo op)
go [OpTree ty (OpInfo op)]
xs [OpInfo op]
ops' [Int]
idxs (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (OpTree ty (OpInfo op)
x OpTree ty (OpInfo op)
-> [OpTree ty (OpInfo op)] -> [OpTree ty (OpInfo op)]
forall a. a -> [a] -> [a]
: [OpTree ty (OpInfo op)]
subExprs) [OpInfo op]
subOps' [OpTree ty (OpInfo op)]
resExprs [OpInfo op]
resOps
groupTree :: NonEmpty (OpTree ty (OpInfo op))
-> [OpInfo op] -> [Int] -> OpTree ty (OpInfo op)
groupTree NonEmpty (OpTree ty (OpInfo op))
nExprs [OpInfo op]
nOps [Int]
indices = [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [Int]
-> Int
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> OpTree ty (OpInfo op)
forall ty op.
[OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [Int]
-> Int
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> OpTree ty (OpInfo op)
go (NonEmpty (OpTree ty (OpInfo op)) -> [OpTree ty (OpInfo op)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (OpTree ty (OpInfo op))
nExprs) [OpInfo op]
nOps [Int]
indices Int
0 [] [] [] []
where
go ::
[OpTree ty (OpInfo op)] ->
[OpInfo op] ->
[Int] ->
Int ->
[OpTree ty (OpInfo op)] ->
[OpInfo op] ->
[OpTree ty (OpInfo op)] ->
[OpInfo op] ->
OpTree ty (OpInfo op)
go :: forall ty op.
[OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [Int]
-> Int
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> OpTree ty (OpInfo op)
go [] [OpInfo op]
_ [Int]
_ Int
_ [OpTree ty (OpInfo op)]
subExprs [OpInfo op]
subOps [OpTree ty (OpInfo op)]
resExprs [OpInfo op]
resOps =
let resExprs' :: NonEmpty (OpTree ty (OpInfo op))
resExprs' = case [OpTree ty (OpInfo op)] -> Maybe (NonEmpty (OpTree ty (OpInfo op)))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [OpTree ty (OpInfo op)]
subExprs of
Maybe (NonEmpty (OpTree ty (OpInfo op)))
Nothing -> [OpTree ty (OpInfo op)] -> NonEmpty (OpTree ty (OpInfo op))
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [OpTree ty (OpInfo op)]
resExprs
Just NonEmpty (OpTree ty (OpInfo op))
subExprs' -> NonEmpty (OpTree ty (OpInfo op))
-> [OpInfo op] -> OpTree ty (OpInfo op)
forall {ty} {op}.
NonEmpty (OpTree ty (OpInfo op))
-> [OpInfo op] -> OpTree ty (OpInfo op)
buildFromSub NonEmpty (OpTree ty (OpInfo op))
subExprs' [OpInfo op]
subOps OpTree ty (OpInfo op)
-> [OpTree ty (OpInfo op)] -> NonEmpty (OpTree ty (OpInfo op))
forall a. a -> [a] -> NonEmpty a
:| [OpTree ty (OpInfo op)]
resExprs
in NonEmpty (OpTree ty (OpInfo op))
-> [OpInfo op] -> OpTree ty (OpInfo op)
forall ty op. NonEmpty (OpTree ty op) -> [op] -> OpTree ty op
OpBranches (NonEmpty (OpTree ty (OpInfo op))
-> NonEmpty (OpTree ty (OpInfo op))
forall a. NonEmpty a -> NonEmpty a
NE.reverse NonEmpty (OpTree ty (OpInfo op))
resExprs') ([OpInfo op] -> [OpInfo op]
forall a. [a] -> [a]
reverse [OpInfo op]
resOps)
go (OpTree ty (OpInfo op)
x : [OpTree ty (OpInfo op)]
xs) (OpInfo op
o : [OpInfo op]
os) (Int
idx : [Int]
idxs) Int
i [OpTree ty (OpInfo op)]
subExprs [OpInfo op]
subOps [OpTree ty (OpInfo op)]
resExprs [OpInfo op]
resOps
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
idx =
[OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [Int]
-> Int
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> OpTree ty (OpInfo op)
forall ty op.
[OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [Int]
-> Int
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> OpTree ty (OpInfo op)
go [OpTree ty (OpInfo op)]
xs [OpInfo op]
os [Int]
idxs (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (OpTree ty (OpInfo op)
x OpTree ty (OpInfo op)
-> [OpTree ty (OpInfo op)] -> [OpTree ty (OpInfo op)]
forall a. a -> [a] -> [a]
: [OpTree ty (OpInfo op)]
subExprs) (OpInfo op
o OpInfo op -> [OpInfo op] -> [OpInfo op]
forall a. a -> [a] -> [a]
: [OpInfo op]
subOps) [OpTree ty (OpInfo op)]
resExprs [OpInfo op]
resOps
go (OpTree ty (OpInfo op)
x : [OpTree ty (OpInfo op)]
xs) [OpInfo op]
ops [Int]
idxs Int
i subExprs :: [OpTree ty (OpInfo op)]
subExprs@(OpTree ty (OpInfo op)
_ : [OpTree ty (OpInfo op)]
_) [OpInfo op]
subOps [OpTree ty (OpInfo op)]
resExprs [OpInfo op]
resOps =
let ([OpInfo op]
ops', [OpInfo op]
resOps') = [OpInfo op] -> [OpInfo op] -> ([OpInfo op], [OpInfo op])
forall {a}. [a] -> [a] -> ([a], [a])
moveOneIfPossible [OpInfo op]
ops [OpInfo op]
resOps
resExpr :: OpTree ty (OpInfo op)
resExpr = NonEmpty (OpTree ty (OpInfo op))
-> [OpInfo op] -> OpTree ty (OpInfo op)
forall {ty} {op}.
NonEmpty (OpTree ty (OpInfo op))
-> [OpInfo op] -> OpTree ty (OpInfo op)
buildFromSub (OpTree ty (OpInfo op)
x OpTree ty (OpInfo op)
-> [OpTree ty (OpInfo op)] -> NonEmpty (OpTree ty (OpInfo op))
forall a. a -> [a] -> NonEmpty a
:| [OpTree ty (OpInfo op)]
subExprs) [OpInfo op]
subOps
in [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [Int]
-> Int
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> OpTree ty (OpInfo op)
forall ty op.
[OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [Int]
-> Int
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> OpTree ty (OpInfo op)
go [OpTree ty (OpInfo op)]
xs [OpInfo op]
ops' [Int]
idxs (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [] [] (OpTree ty (OpInfo op)
resExpr OpTree ty (OpInfo op)
-> [OpTree ty (OpInfo op)] -> [OpTree ty (OpInfo op)]
forall a. a -> [a] -> [a]
: [OpTree ty (OpInfo op)]
resExprs) [OpInfo op]
resOps'
go (OpTree ty (OpInfo op)
x : [OpTree ty (OpInfo op)]
xs) [OpInfo op]
ops [Int]
idxs Int
i [] [OpInfo op]
subOps [OpTree ty (OpInfo op)]
resExprs [OpInfo op]
resOps =
let ([OpInfo op]
ops', [OpInfo op]
resOps') = [OpInfo op] -> [OpInfo op] -> ([OpInfo op], [OpInfo op])
forall {a}. [a] -> [a] -> ([a], [a])
moveOneIfPossible [OpInfo op]
ops [OpInfo op]
resOps
in [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [Int]
-> Int
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> OpTree ty (OpInfo op)
forall ty op.
[OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [Int]
-> Int
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> [OpTree ty (OpInfo op)]
-> [OpInfo op]
-> OpTree ty (OpInfo op)
go [OpTree ty (OpInfo op)]
xs [OpInfo op]
ops' [Int]
idxs (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [] [OpInfo op]
subOps (OpTree ty (OpInfo op)
x OpTree ty (OpInfo op)
-> [OpTree ty (OpInfo op)] -> [OpTree ty (OpInfo op)]
forall a. a -> [a] -> [a]
: [OpTree ty (OpInfo op)]
resExprs) [OpInfo op]
resOps'
moveOneIfPossible :: [a] -> [a] -> ([a], [a])
moveOneIfPossible [] [a]
bs = ([], [a]
bs)
moveOneIfPossible (a
a : [a]
as) [a]
bs = ([a]
as, a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
bs)
buildFromSub :: NonEmpty (OpTree ty (OpInfo op))
-> [OpInfo op] -> OpTree ty (OpInfo op)
buildFromSub NonEmpty (OpTree ty (OpInfo op))
subExprs [OpInfo op]
subOps = OpTree ty (OpInfo op) -> OpTree ty (OpInfo op)
forall ty op. OpTree ty (OpInfo op) -> OpTree ty (OpInfo op)
reassociateFlatOpTree (OpTree ty (OpInfo op) -> OpTree ty (OpInfo op))
-> OpTree ty (OpInfo op) -> OpTree ty (OpInfo op)
forall a b. (a -> b) -> a -> b
$ case NonEmpty (OpTree ty (OpInfo op))
subExprs of
OpTree ty (OpInfo op)
x :| [] -> OpTree ty (OpInfo op)
x
NonEmpty (OpTree ty (OpInfo op))
_ -> NonEmpty (OpTree ty (OpInfo op))
-> [OpInfo op] -> OpTree ty (OpInfo op)
forall ty op. NonEmpty (OpTree ty op) -> [op] -> OpTree ty op
OpBranches (NonEmpty (OpTree ty (OpInfo op))
-> NonEmpty (OpTree ty (OpInfo op))
forall a. NonEmpty a -> NonEmpty a
NE.reverse NonEmpty (OpTree ty (OpInfo op))
subExprs) ([OpInfo op] -> [OpInfo op]
forall a. [a] -> [a]
reverse [OpInfo op]
subOps)
isHardSplitterOp :: FixityApproximation -> Bool
isHardSplitterOp :: FixityApproximation -> Bool
isHardSplitterOp = (FixityApproximation -> FixityApproximation -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe FixityDirection -> Int -> Int -> FixityApproximation
FixityApproximation (FixityDirection -> Maybe FixityDirection
forall a. a -> Maybe a
Just FixityDirection
InfixR) Int
0 Int
0)