{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Ormolu.Printer.Operators
( OpTree (..),
OpInfo (..),
opTreeLoc,
reassociateOpTree,
isHardSplitterOp,
)
where
import Control.Applicative ((<|>))
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import GHC.Types.Name.Occurrence (occNameString)
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
(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
/= :: 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
[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
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
{
OpInfo op -> op
opiOp :: op,
OpInfo op -> Maybe String
opiName :: Maybe String,
OpInfo op -> FixityInfo
opiFix :: FixityInfo
}
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
/= :: 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 :: OpInfo op -> OpInfo op -> Maybe Ordering
compareOp
(OpInfo op
_ Maybe String
mName1 FixityInfo {fiMinPrecedence :: FixityInfo -> Int
fiMinPrecedence = Int
min1, fiMaxPrecedence :: FixityInfo -> Int
fiMaxPrecedence = Int
max1})
(OpInfo op
_ Maybe String
mName2 FixityInfo {fiMinPrecedence :: FixityInfo -> Int
fiMinPrecedence = Int
min2, fiMaxPrecedence :: FixityInfo -> Int
fiMaxPrecedence = 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 String
mName1, Maybe String
mName2) of
(Just String
n1, Just String
n2) -> String
n1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n2
(Maybe String, Maybe String)
_ -> Bool
False
opTreeLoc :: HasSrcSpan l => OpTree (GenLocated l a) b -> SrcSpan
opTreeLoc :: 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 [OpTree (GenLocated l a) b]
exprs [b]
_) =
NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan)
-> ([OpTree (GenLocated l a) b] -> NonEmpty SrcSpan)
-> [OpTree (GenLocated l a) b]
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SrcSpan] -> NonEmpty SrcSpan
forall a. [a] -> NonEmpty a
NE.fromList ([SrcSpan] -> NonEmpty SrcSpan)
-> ([OpTree (GenLocated l a) b] -> [SrcSpan])
-> [OpTree (GenLocated l a) b]
-> NonEmpty SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OpTree (GenLocated l a) b -> SrcSpan)
-> [OpTree (GenLocated l a) b] -> [SrcSpan]
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 ([OpTree (GenLocated l a) b] -> SrcSpan)
-> [OpTree (GenLocated l a) b] -> SrcSpan
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 :: (op -> Maybe RdrName)
-> FixityMap
-> LazyFixityMap
-> OpTree ty op
-> OpTree ty (OpInfo op)
reassociateOpTree op -> Maybe RdrName
getOpName FixityMap
fixityOverrides LazyFixityMap
fixityMap =
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
. FixityMap
-> LazyFixityMap
-> (op -> Maybe RdrName)
-> OpTree ty op
-> OpTree ty (OpInfo op)
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 :: FixityMap
-> LazyFixityMap
-> (op -> Maybe RdrName)
-> OpTree ty op
-> OpTree ty (OpInfo op)
addFixityInfo FixityMap
_ LazyFixityMap
_ op -> Maybe RdrName
_ (OpNode ty
n) = ty -> OpTree ty (OpInfo op)
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) =
[OpTree ty (OpInfo op)] -> [OpInfo op] -> OpTree ty (OpInfo op)
forall ty op. [OpTree ty op] -> [op] -> OpTree ty op
OpBranches
(FixityMap
-> LazyFixityMap
-> (op -> Maybe RdrName)
-> OpTree ty op
-> OpTree ty (OpInfo op)
forall op ty.
FixityMap
-> LazyFixityMap
-> (op -> Maybe RdrName)
-> OpTree ty op
-> OpTree ty (OpInfo op)
addFixityInfo FixityMap
fixityOverrides LazyFixityMap
fixityMap op -> Maybe RdrName
getOpName (OpTree ty op -> OpTree ty (OpInfo op))
-> [OpTree ty op] -> [OpTree ty (OpInfo op)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [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 String -> FixityInfo -> OpInfo op
forall op. op -> Maybe String -> FixityInfo -> OpInfo op
OpInfo op
o Maybe String
mName FixityInfo
fixityInfo
where
mName :: Maybe String
mName = OccName -> String
occNameString (OccName -> String) -> (RdrName -> OccName) -> RdrName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc (RdrName -> String) -> Maybe RdrName -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> op -> Maybe RdrName
getOpName op
o
fixityInfo :: FixityInfo
fixityInfo =
FixityInfo -> Maybe FixityInfo -> FixityInfo
forall a. a -> Maybe a -> a
fromMaybe
FixityInfo
defaultFixityInfo
( do
String
name <- Maybe String
mName
String -> FixityMap -> Maybe FixityInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name FixityMap
fixityOverrides Maybe FixityInfo -> Maybe FixityInfo -> Maybe FixityInfo
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> LazyFixityMap -> Maybe FixityInfo
lookupFixity String
name LazyFixityMap
fixityMap
)
makeFlatOpTree :: OpTree ty op -> OpTree ty op
makeFlatOpTree :: 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 [OpTree ty op]
exprs [op]
ops) =
[OpTree ty op] -> [op] -> OpTree ty op
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 OpTree ty a -> OpTree ty a
forall ty op. OpTree ty op -> OpTree ty op
makeFlatOpTree OpTree ty a
expr of
OpNode ty
n -> ([ty -> OpTree ty a
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 = OpTree ty op -> ([OpTree ty op], [op])
forall ty a. OpTree ty a -> ([OpTree ty a], [a])
makeFlatOpTree' (OpTree ty op -> ([OpTree ty op], [op]))
-> [OpTree ty op] -> [([OpTree ty op], [op])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OpTree ty op]
exprs
rExprs :: [OpTree ty op]
rExprs = (([OpTree ty op], [op]) -> [OpTree ty op])
-> [([OpTree ty op], [op])] -> [OpTree ty op]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([OpTree ty op], [op]) -> [OpTree ty op]
forall a b. (a, b) -> a
fst [([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 (([OpTree ty op], [op]) -> [op]
forall a b. (a, b) -> b
snd (([OpTree ty op], [op]) -> [op])
-> [([OpTree ty op], [op])] -> [[op]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([OpTree ty op], [op])]
flattenedSubTrees) (op -> [op]
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 :: 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 [OpInfo op] -> (Maybe [Int], Maybe [Int])
forall op. [OpInfo op] -> (Maybe [Int], Maybe [Int])
indexOfMinMaxPrecOps [OpInfo op]
noptOps of
(Just [Int]
minIndices, Maybe [Int]
_) -> [OpTree ty (OpInfo op)]
-> [OpInfo op] -> [Int] -> OpTree ty (OpInfo op)
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) -> [OpTree ty (OpInfo op)]
-> [OpInfo op] -> [Int] -> OpTree ty (OpInfo op)
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 -> [OpTree ty (OpInfo op)]
-> [OpInfo op] -> [Int] -> OpTree ty (OpInfo op)
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 =
((Int, OpInfo op) -> Int) -> [(Int, OpInfo op)] -> [Int]
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 (FixityInfo -> Bool
isHardSplitterOp (FixityInfo -> Bool)
-> ((Int, OpInfo op) -> FixityInfo) -> (Int, OpInfo op) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpInfo op -> FixityInfo
forall op. OpInfo op -> FixityInfo
opiFix (OpInfo op -> FixityInfo)
-> ((Int, OpInfo op) -> OpInfo op)
-> (Int, OpInfo op)
-> FixityInfo
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 :: [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 String
_ FixityInfo
fix1) (OpInfo op
_ Maybe String
_ FixityInfo
fix2) =
op -> Maybe String -> FixityInfo -> OpInfo op
forall op. op -> Maybe String -> FixityInfo -> OpInfo op
OpInfo op
x Maybe String
forall a. Maybe a
Nothing (FixityInfo
fix1 FixityInfo -> FixityInfo -> FixityInfo
forall a. Semigroup a => a -> a -> a
<> FixityInfo
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 :: [OpTree ty (OpInfo op)]
-> [OpInfo op] -> [Int] -> OpTree ty (OpInfo op)
splitTree [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 [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 :: [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 = [OpTree ty (OpInfo op)] -> [OpInfo op] -> OpTree ty (OpInfo op)
forall ty op.
[OpTree ty (OpInfo op)] -> [OpInfo op] -> OpTree ty (OpInfo op)
buildFromSub [OpTree ty (OpInfo op)]
subExprs [OpInfo op]
subOps
in [OpTree ty (OpInfo op)] -> [OpInfo op] -> OpTree ty (OpInfo op)
forall ty op. [OpTree ty op] -> [op] -> OpTree ty op
OpBranches ([OpTree ty (OpInfo op)] -> [OpTree ty (OpInfo op)]
forall a. [a] -> [a]
reverse (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] -> [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 = [OpTree ty (OpInfo op)] -> [OpInfo op] -> OpTree ty (OpInfo op)
forall ty op.
[OpTree ty (OpInfo op)] -> [OpInfo op] -> OpTree ty (OpInfo op)
buildFromSub (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
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 :: [OpTree ty (OpInfo op)]
-> [OpInfo op] -> [Int] -> OpTree ty (OpInfo op)
groupTree [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 [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 :: [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 [OpTree ty (OpInfo op)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OpTree ty (OpInfo op)]
subExprs
then [OpTree ty (OpInfo op)]
resExprs
else [OpTree ty (OpInfo op)] -> [OpInfo op] -> OpTree ty (OpInfo op)
forall ty op.
[OpTree ty (OpInfo op)] -> [OpInfo op] -> OpTree ty (OpInfo op)
buildFromSub [OpTree ty (OpInfo op)]
subExprs [OpInfo op]
subOps OpTree ty (OpInfo op)
-> [OpTree ty (OpInfo op)] -> [OpTree ty (OpInfo op)]
forall a. a -> [a] -> [a]
: [OpTree ty (OpInfo op)]
resExprs
in [OpTree ty (OpInfo op)] -> [OpInfo op] -> OpTree ty (OpInfo op)
forall ty op. [OpTree ty op] -> [op] -> OpTree ty op
OpBranches ([OpTree ty (OpInfo op)] -> [OpTree ty (OpInfo op)]
forall a. [a] -> [a]
reverse [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 = [OpTree ty (OpInfo op)] -> [OpInfo op] -> OpTree ty (OpInfo op)
forall ty op.
[OpTree ty (OpInfo op)] -> [OpInfo op] -> OpTree ty (OpInfo op)
buildFromSub (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
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 :: [OpTree ty (OpInfo op)] -> [OpInfo op] -> OpTree ty (OpInfo op)
buildFromSub [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 [OpTree ty (OpInfo op)]
subExprs of
[OpTree ty (OpInfo op)
x] -> OpTree ty (OpInfo op)
x
[OpTree ty (OpInfo op)]
_ -> [OpTree ty (OpInfo op)] -> [OpInfo op] -> OpTree ty (OpInfo op)
forall ty op. [OpTree ty op] -> [op] -> OpTree ty op
OpBranches ([OpTree ty (OpInfo op)] -> [OpTree ty (OpInfo op)]
forall a. [a] -> [a]
reverse [OpTree ty (OpInfo op)]
subExprs) ([OpInfo op] -> [OpInfo op]
forall a. [a] -> [a]
reverse [OpInfo op]
subOps)
isHardSplitterOp :: FixityInfo -> Bool
isHardSplitterOp :: FixityInfo -> Bool
isHardSplitterOp = (FixityInfo -> FixityInfo -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe FixityDirection -> Int -> Int -> FixityInfo
FixityInfo (FixityDirection -> Maybe FixityDirection
forall a. a -> Maybe a
Just FixityDirection
InfixR) Int
0 Int
0)