{-# LANGUAGE MultiWayIf #-}
module Ormolu.Printer.Operators
( OpTree (..),
OpInfo (..),
opTreeLoc,
reassociateOpTree,
isHardSplitterOp,
)
where
import Control.Applicative ((<|>))
import Data.List.NonEmpty qualified as NE
import Data.Map.Strict qualified as Map
import Data.Maybe (fromMaybe)
import GHC.Types.Name.Reader
import GHC.Types.SrcLoc
import Ormolu.Fixity
import Ormolu.Utils
data OpTree ty op
=
OpNode ty
|
OpBranches [OpTree ty op] [op]
deriving (OpTree ty op -> OpTree ty op -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
$c== :: forall ty op.
(Eq ty, Eq op) =>
OpTree ty op -> OpTree ty op -> Bool
Eq, Int -> OpTree ty op -> ShowS
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
showList :: [OpTree ty op] -> ShowS
$cshowList :: forall ty op. (Show ty, Show op) => [OpTree ty op] -> ShowS
show :: OpTree ty op -> String
$cshow :: forall ty op. (Show ty, Show op) => OpTree ty op -> String
showsPrec :: Int -> OpTree ty op -> ShowS
$cshowsPrec :: forall ty op. (Show ty, Show op) => Int -> OpTree ty op -> ShowS
Show)
data OpInfo op = OpInfo
{
forall op. OpInfo op -> op
opiOp :: op,
forall op. OpInfo op -> Maybe OpName
opiName :: Maybe OpName,
forall op. OpInfo op -> FixityInfo
opiFix :: FixityInfo
}
deriving (OpInfo op -> OpInfo op -> Bool
forall op. Eq op => OpInfo op -> OpInfo op -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpInfo op -> OpInfo op -> Bool
$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
Eq)
compareOp :: OpInfo op -> OpInfo op -> Maybe Ordering
compareOp :: forall op. OpInfo op -> OpInfo op -> Maybe Ordering
compareOp
(OpInfo op
_ Maybe OpName
mName1 FixityInfo {fiMinPrecedence :: FixityInfo -> Int
fiMinPrecedence = Int
min1, fiMaxPrecedence :: FixityInfo -> Int
fiMaxPrecedence = Int
max1})
(OpInfo op
_ Maybe OpName
mName2 FixityInfo {fiMinPrecedence :: FixityInfo -> Int
fiMinPrecedence = Int
min2, fiMaxPrecedence :: FixityInfo -> Int
fiMaxPrecedence = Int
max2}) =
if
| Int
min1 forall a. Eq a => a -> a -> Bool
== Int
min2
Bool -> Bool -> Bool
&& Int
max1 forall a. Eq a => a -> a -> Bool
== Int
max2
Bool -> Bool -> Bool
&& (Int
min1 forall a. Eq a => a -> a -> Bool
== Int
max1 Bool -> Bool -> Bool
|| Bool
sameSymbol) ->
forall a. a -> Maybe a
Just Ordering
EQ
| Int
max1 forall a. Ord a => a -> a -> Bool
< Int
min2 -> forall a. a -> Maybe a
Just Ordering
LT
| Int
max2 forall a. Ord a => a -> a -> Bool
< Int
min1 -> forall a. a -> Maybe a
Just Ordering
GT
| Bool
otherwise -> forall a. Maybe a
Nothing
where
sameSymbol :: Bool
sameSymbol = case (Maybe OpName
mName1, Maybe OpName
mName2) of
(Just OpName
n1, Just OpName
n2) -> OpName
n1 forall a. Eq a => a -> a -> Bool
== OpName
n2
(Maybe OpName, Maybe OpName)
_ -> 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) = forall l a. HasSrcSpan l => GenLocated l a -> SrcSpan
getLoc' GenLocated l a
n
opTreeLoc (OpBranches [OpTree (GenLocated l a) b]
exprs [b]
_) =
NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> NonEmpty a
NE.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall l a b. HasSrcSpan l => OpTree (GenLocated l a) b -> SrcSpan
opTreeLoc forall a b. (a -> b) -> a -> b
$ [OpTree (GenLocated l a) b]
exprs
reassociateOpTree ::
(op -> Maybe RdrName) ->
FixityMap ->
LazyFixityMap ->
OpTree ty op ->
OpTree ty (OpInfo op)
reassociateOpTree :: forall op ty.
(op -> Maybe RdrName)
-> FixityMap
-> LazyFixityMap
-> OpTree ty op
-> OpTree ty (OpInfo op)
reassociateOpTree op -> Maybe RdrName
getOpName FixityMap
fixityOverrides LazyFixityMap
fixityMap =
forall ty op. OpTree ty (OpInfo op) -> OpTree ty (OpInfo op)
reassociateFlatOpTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ty op. OpTree ty op -> OpTree ty op
makeFlatOpTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall op ty.
FixityMap
-> LazyFixityMap
-> (op -> Maybe RdrName)
-> OpTree ty op
-> OpTree ty (OpInfo op)
addFixityInfo FixityMap
fixityOverrides LazyFixityMap
fixityMap op -> Maybe RdrName
getOpName
addFixityInfo ::
FixityMap ->
LazyFixityMap ->
(op -> Maybe RdrName) ->
OpTree ty op ->
OpTree ty (OpInfo op)
addFixityInfo :: forall op ty.
FixityMap
-> LazyFixityMap
-> (op -> Maybe RdrName)
-> OpTree ty op
-> OpTree ty (OpInfo op)
addFixityInfo FixityMap
_ LazyFixityMap
_ op -> Maybe RdrName
_ (OpNode ty
n) = forall ty op. ty -> OpTree ty op
OpNode ty
n
addFixityInfo FixityMap
fixityOverrides LazyFixityMap
fixityMap op -> Maybe RdrName
getOpName (OpBranches [OpTree ty op]
exprs [op]
ops) =
forall ty op. [OpTree ty op] -> [op] -> OpTree ty op
OpBranches
(forall op ty.
FixityMap
-> LazyFixityMap
-> (op -> Maybe RdrName)
-> OpTree ty op
-> OpTree ty (OpInfo op)
addFixityInfo FixityMap
fixityOverrides LazyFixityMap
fixityMap op -> Maybe RdrName
getOpName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OpTree ty op]
exprs)
(op -> OpInfo op
toOpInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [op]
ops)
where
toOpInfo :: op -> OpInfo op
toOpInfo op
o = forall op. op -> Maybe OpName -> FixityInfo -> OpInfo op
OpInfo op
o Maybe OpName
mName FixityInfo
fixityInfo
where
mName :: Maybe OpName
mName = OccName -> OpName
occOpName forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> op -> Maybe RdrName
getOpName op
o
fixityInfo :: FixityInfo
fixityInfo =
forall a. a -> Maybe a -> a
fromMaybe
FixityInfo
defaultFixityInfo
( do
OpName
name <- Maybe OpName
mName
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup OpName
name FixityMap
fixityOverrides forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OpName -> LazyFixityMap -> Maybe FixityInfo
lookupFixity OpName
name LazyFixityMap
fixityMap
)
makeFlatOpTree :: OpTree ty op -> OpTree ty op
makeFlatOpTree :: forall ty op. OpTree ty op -> OpTree ty op
makeFlatOpTree (OpNode ty
n) = forall ty op. ty -> OpTree ty op
OpNode ty
n
makeFlatOpTree (OpBranches [OpTree ty op]
exprs [op]
ops) =
forall ty op. [OpTree ty op] -> [op] -> OpTree ty op
OpBranches [OpTree ty op]
rExprs [op]
rOps
where
makeFlatOpTree' :: OpTree ty a -> ([OpTree ty a], [a])
makeFlatOpTree' OpTree ty a
expr = case forall ty op. OpTree ty op -> OpTree ty op
makeFlatOpTree OpTree ty a
expr of
OpNode ty
n -> ([forall ty op. ty -> OpTree ty op
OpNode ty
n], [])
OpBranches [OpTree ty a]
noptExprs [a]
noptOps -> ([OpTree ty a]
noptExprs, [a]
noptOps)
flattenedSubTrees :: [([OpTree ty op], [op])]
flattenedSubTrees = forall {ty} {a}. OpTree ty a -> ([OpTree ty a], [a])
makeFlatOpTree' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OpTree ty op]
exprs
rExprs :: [OpTree ty op]
rExprs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> a
fst [([OpTree ty op], [op])]
flattenedSubTrees
rOps :: [op]
rOps = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall {a}. [a] -> [a] -> [a]
interleave (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([OpTree ty op], [op])]
flattenedSubTrees) (forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 forall a. a -> [a] -> [a]
: a
y 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 [OpTree ty (OpInfo op)]
noptExprs [OpInfo op]
noptOps) =
case forall {op}. [OpInfo op] -> (Maybe [Int], Maybe [Int])
indexOfMinMaxPrecOps [OpInfo op]
noptOps of
(Just [Int]
minIndices, Maybe [Int]
_) -> forall {ty} {op}.
[OpTree ty (OpInfo op)]
-> [OpInfo op] -> [Int] -> OpTree ty (OpInfo op)
splitTree [OpTree ty (OpInfo op)]
noptExprs [OpInfo op]
noptOps [Int]
minIndices
(Maybe [Int]
_, Just [Int]
maxIndices) -> forall {ty} {op}.
[OpTree ty (OpInfo op)]
-> [OpInfo op] -> [Int] -> OpTree ty (OpInfo op)
groupTree [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 -> forall {ty} {op}.
[OpTree ty (OpInfo op)]
-> [OpInfo op] -> [Int] -> OpTree ty (OpInfo op)
splitTree [OpTree ty (OpInfo op)]
noptExprs [OpInfo op]
noptOps [Int]
indices
where
indicesOfHardSplitter :: [Int]
indicesOfHardSplitter =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
filter (FixityInfo -> Bool
isHardSplitterOp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall op. OpInfo op -> FixityInfo
opiFix forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [OpInfo op]
noptOps
indexOfMinMaxPrecOps :: [OpInfo op] -> (Maybe [Int], Maybe [Int])
indexOfMinMaxPrecOps [] = (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
indexOfMinMaxPrecOps (OpInfo op
oo : [OpInfo op]
oos) = 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 (forall a. a -> Maybe a
Just [Int
0]) OpInfo op
oo (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 = (forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Int]
minRes, forall a. [a] -> [a]
reverse 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 forall op. OpInfo op -> OpInfo op -> Maybe Ordering
compareOp OpInfo op
o OpInfo op
minOpi of
Just Ordering
EQ -> (OpInfo op
minOpi, (:) Int
i forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Int]
minRes)
Just Ordering
LT -> (OpInfo op
o, forall a. a -> Maybe a
Just [Int
i])
Just Ordering
GT -> (OpInfo op
minOpi, Maybe [Int]
minRes)
Maybe Ordering
Nothing -> (forall {op} {op}. OpInfo op -> OpInfo op -> OpInfo op
combine OpInfo op
minOpi OpInfo op
o, forall a. Maybe a
Nothing)
(OpInfo op
maxOpi', Maybe [Int]
maxRes') = case forall op. OpInfo op -> OpInfo op -> Maybe Ordering
compareOp OpInfo op
o OpInfo op
maxOpi of
Just Ordering
EQ -> (OpInfo op
maxOpi, (:) Int
i 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, forall a. a -> Maybe a
Just [Int
i])
Maybe Ordering
Nothing -> (forall {op} {op}. OpInfo op -> OpInfo op -> OpInfo op
combine OpInfo op
maxOpi OpInfo op
o, forall a. Maybe a
Nothing)
combine :: OpInfo op -> OpInfo op -> OpInfo op
combine (OpInfo op
x Maybe OpName
_ FixityInfo
fix1) (OpInfo op
_ Maybe OpName
_ FixityInfo
fix2) =
forall op. op -> Maybe OpName -> FixityInfo -> OpInfo op
OpInfo op
x forall a. Maybe a
Nothing (FixityInfo
fix1 forall a. Semigroup a => a -> a -> a
<> FixityInfo
fix2)
in forall op.
[OpInfo op]
-> Int
-> OpInfo op
-> Maybe [Int]
-> OpInfo op
-> Maybe [Int]
-> (Maybe [Int], Maybe [Int])
go [OpInfo op]
os (Int
i forall a. Num a => a -> a -> a
+ Int
1) OpInfo op
minOpi' Maybe [Int]
minRes' OpInfo op
maxOpi' Maybe [Int]
maxRes'
splitTree :: [OpTree ty (OpInfo op)]
-> [OpInfo op] -> [Int] -> OpTree ty (OpInfo op)
splitTree [OpTree ty (OpInfo op)]
nExprs [OpInfo op]
nOps [Int]
indices = 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)]
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 = forall {ty} {op}.
[OpTree ty (OpInfo op)] -> [OpInfo op] -> OpTree ty (OpInfo op)
buildFromSub [OpTree ty (OpInfo op)]
subExprs [OpInfo op]
subOps
in forall ty op. [OpTree ty op] -> [op] -> OpTree ty op
OpBranches (forall a. [a] -> [a]
reverse (OpTree ty (OpInfo op)
resExpr forall a. a -> [a] -> [a]
: [OpTree ty (OpInfo op)]
resExprs)) (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 forall a. Eq a => a -> a -> Bool
== Int
idx =
let resExpr :: OpTree ty (OpInfo op)
resExpr = forall {ty} {op}.
[OpTree ty (OpInfo op)] -> [OpInfo op] -> OpTree ty (OpInfo op)
buildFromSub (OpTree ty (OpInfo op)
x forall a. a -> [a] -> [a]
: [OpTree ty (OpInfo op)]
subExprs) [OpInfo op]
subOps
in 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 forall a. Num a => a -> a -> a
+ Int
1) [] [] (OpTree ty (OpInfo op)
resExpr forall a. a -> [a] -> [a]
: [OpTree ty (OpInfo op)]
resExprs) (OpInfo op
o 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') = forall {a}. [a] -> [a] -> ([a], [a])
moveOneIfPossible [OpInfo op]
ops [OpInfo op]
subOps
in 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 forall a. Num a => a -> a -> a
+ Int
1) (OpTree ty (OpInfo op)
x forall a. a -> [a] -> [a]
: [OpTree ty (OpInfo op)]
subExprs) [OpInfo op]
subOps' [OpTree ty (OpInfo op)]
resExprs [OpInfo op]
resOps
groupTree :: [OpTree ty (OpInfo op)]
-> [OpInfo op] -> [Int] -> OpTree ty (OpInfo op)
groupTree [OpTree ty (OpInfo op)]
nExprs [OpInfo op]
nOps [Int]
indices = 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)]
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' :: [OpTree ty (OpInfo op)]
resExprs' =
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OpTree ty (OpInfo op)]
subExprs
then [OpTree ty (OpInfo op)]
resExprs
else forall {ty} {op}.
[OpTree ty (OpInfo op)] -> [OpInfo op] -> OpTree ty (OpInfo op)
buildFromSub [OpTree ty (OpInfo op)]
subExprs [OpInfo op]
subOps forall a. a -> [a] -> [a]
: [OpTree ty (OpInfo op)]
resExprs
in forall ty op. [OpTree ty op] -> [op] -> OpTree ty op
OpBranches (forall a. [a] -> [a]
reverse [OpTree ty (OpInfo op)]
resExprs') (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 forall a. Eq a => a -> a -> Bool
== Int
idx =
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 forall a. Num a => a -> a -> a
+ Int
1) (OpTree ty (OpInfo op)
x forall a. a -> [a] -> [a]
: [OpTree ty (OpInfo op)]
subExprs) (OpInfo op
o 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') = forall {a}. [a] -> [a] -> ([a], [a])
moveOneIfPossible [OpInfo op]
ops [OpInfo op]
resOps
resExpr :: OpTree ty (OpInfo op)
resExpr = forall {ty} {op}.
[OpTree ty (OpInfo op)] -> [OpInfo op] -> OpTree ty (OpInfo op)
buildFromSub (OpTree ty (OpInfo op)
x forall a. a -> [a] -> [a]
: [OpTree ty (OpInfo op)]
subExprs) [OpInfo op]
subOps
in 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 forall a. Num a => a -> a -> a
+ Int
1) [] [] (OpTree ty (OpInfo op)
resExpr 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') = forall {a}. [a] -> [a] -> ([a], [a])
moveOneIfPossible [OpInfo op]
ops [OpInfo op]
resOps
in 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 forall a. Num a => a -> a -> a
+ Int
1) [] [OpInfo op]
subOps (OpTree ty (OpInfo op)
x 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 forall a. a -> [a] -> [a]
: [a]
bs)
buildFromSub :: [OpTree ty (OpInfo op)] -> [OpInfo op] -> OpTree ty (OpInfo op)
buildFromSub [OpTree ty (OpInfo op)]
subExprs [OpInfo op]
subOps = forall ty op. OpTree ty (OpInfo op) -> OpTree ty (OpInfo op)
reassociateFlatOpTree forall a b. (a -> b) -> a -> b
$ case [OpTree ty (OpInfo op)]
subExprs of
[OpTree ty (OpInfo op)
x] -> OpTree ty (OpInfo op)
x
[OpTree ty (OpInfo op)]
_ -> forall ty op. [OpTree ty op] -> [op] -> OpTree ty op
OpBranches (forall a. [a] -> [a]
reverse [OpTree ty (OpInfo op)]
subExprs) (forall a. [a] -> [a]
reverse [OpInfo op]
subOps)
isHardSplitterOp :: FixityInfo -> Bool
isHardSplitterOp :: FixityInfo -> Bool
isHardSplitterOp = (forall a. Eq a => a -> a -> Bool
== Maybe FixityDirection -> Int -> Int -> FixityInfo
FixityInfo (forall a. a -> Maybe a
Just FixityDirection
InfixR) Int
0 Int
0)