{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | A representation where all bindings are annotated with range
-- information.
module Futhark.Representation.Ranges
       ( -- * The Lore definition
         Ranges
       , module Futhark.Representation.AST.Attributes.Ranges
         -- * Module re-exports
       , module Futhark.Representation.AST.Attributes
       , module Futhark.Representation.AST.Traversals
       , module Futhark.Representation.AST.Pretty
       , module Futhark.Representation.AST.Syntax
         -- * Adding ranges
       , addRangesToPattern
       , mkRangedBody
       , mkPatternRanges
       , mkBodyRanges
         -- * Removing ranges
       , removeProgRanges
       , removeExpRanges
       , removeBodyRanges
       , removeStmRanges
       , removeLambdaRanges
       , removePatternRanges
       )
where

import Control.Monad.Identity
import Control.Monad.Reader

import Futhark.Representation.AST.Syntax
import Futhark.Representation.AST.Attributes
import Futhark.Representation.AST.Attributes.Aliases
import Futhark.Representation.AST.Attributes.Ranges
import Futhark.Representation.AST.Traversals
import Futhark.Representation.AST.Pretty
import Futhark.Analysis.Rephrase
import qualified Futhark.Util.Pretty as PP

-- | The lore for the basic representation.
data Ranges lore

instance (Annotations lore, CanBeRanged (Op lore)) =>
         Annotations (Ranges lore) where
  type LetAttr (Ranges lore) = (Range, LetAttr lore)
  type ExpAttr (Ranges lore) = ExpAttr lore
  type BodyAttr (Ranges lore) = ([Range], BodyAttr lore)
  type FParamAttr (Ranges lore) = FParamAttr lore
  type LParamAttr (Ranges lore) = LParamAttr lore
  type RetType (Ranges lore) = RetType lore
  type BranchType (Ranges lore) = BranchType lore
  type Op (Ranges lore) = OpWithRanges (Op lore)

withoutRanges :: (HasScope (Ranges lore) m, Monad m) =>
                 ReaderT (Scope lore) m a ->
                 m a
withoutRanges :: ReaderT (Scope lore) m a -> m a
withoutRanges ReaderT (Scope lore) m a
m = do
  Scope lore
scope <- (Scope (Ranges lore) -> Scope lore) -> m (Scope lore)
forall lore (m :: * -> *) a.
HasScope lore m =>
(Scope lore -> a) -> m a
asksScope ((Scope (Ranges lore) -> Scope lore) -> m (Scope lore))
-> (Scope (Ranges lore) -> Scope lore) -> m (Scope lore)
forall a b. (a -> b) -> a -> b
$ (NameInfo (Ranges lore) -> NameInfo lore)
-> Scope (Ranges lore) -> Scope lore
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NameInfo (Ranges lore) -> NameInfo lore
forall lore. NameInfo (Ranges lore) -> NameInfo lore
unRange
  ReaderT (Scope lore) m a -> Scope lore -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (Scope lore) m a
m Scope lore
scope
    where unRange :: NameInfo (Ranges lore) -> NameInfo lore
          unRange :: NameInfo (Ranges lore) -> NameInfo lore
unRange (LetInfo (_, x)) = LetAttr lore -> NameInfo lore
forall lore. LetAttr lore -> NameInfo lore
LetInfo LetAttr lore
x
          unRange (FParamInfo FParamAttr (Ranges lore)
x) = FParamAttr lore -> NameInfo lore
forall lore. FParamAttr lore -> NameInfo lore
FParamInfo FParamAttr lore
FParamAttr (Ranges lore)
x
          unRange (LParamInfo LParamAttr (Ranges lore)
x) = LParamAttr lore -> NameInfo lore
forall lore. LParamAttr lore -> NameInfo lore
LParamInfo LParamAttr lore
LParamAttr (Ranges lore)
x
          unRange (IndexInfo IntType
x) = IntType -> NameInfo lore
forall lore. IntType -> NameInfo lore
IndexInfo IntType
x

instance (Attributes lore, CanBeRanged (Op lore)) =>
         Attributes (Ranges lore) where
  expTypesFromPattern :: Pattern (Ranges lore) -> m [BranchType (Ranges lore)]
expTypesFromPattern =
    ReaderT (Scope lore) m [BranchType lore] -> m [BranchType lore]
forall lore (m :: * -> *) a.
(HasScope (Ranges lore) m, Monad m) =>
ReaderT (Scope lore) m a -> m a
withoutRanges (ReaderT (Scope lore) m [BranchType lore] -> m [BranchType lore])
-> (PatternT (Range, LetAttr lore)
    -> ReaderT (Scope lore) m [BranchType lore])
-> PatternT (Range, LetAttr lore)
-> m [BranchType lore]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatternT (LetAttr lore) -> ReaderT (Scope lore) m [BranchType lore]
forall lore (m :: * -> *).
(Attributes lore, HasScope lore m, Monad m) =>
Pattern lore -> m [BranchType lore]
expTypesFromPattern (PatternT (LetAttr lore)
 -> ReaderT (Scope lore) m [BranchType lore])
-> (PatternT (Range, LetAttr lore) -> PatternT (LetAttr lore))
-> PatternT (Range, LetAttr lore)
-> ReaderT (Scope lore) m [BranchType lore]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatternT (Range, LetAttr lore) -> PatternT (LetAttr lore)
forall a. PatternT (Range, a) -> PatternT a
removePatternRanges

instance RangeOf (Range, attr) where
  rangeOf :: (Range, attr) -> Range
rangeOf = (Range, attr) -> Range
forall a b. (a, b) -> a
fst

instance RangesOf ([Range], attr) where
  rangesOf :: ([Range], attr) -> [Range]
rangesOf = ([Range], attr) -> [Range]
forall a b. (a, b) -> a
fst

instance PrettyAnnot (PatElemT attr) =>
  PrettyAnnot (PatElemT (Range, attr)) where

  ppAnnot :: PatElemT (Range, attr) -> Maybe Doc
ppAnnot PatElemT (Range, attr)
patelem =
    Maybe Doc
range_annot Maybe Doc -> Maybe Doc -> Maybe Doc
forall a. Semigroup a => a -> a -> a
<> Maybe Doc
inner_annot
    where range_annot :: Maybe Doc
range_annot =
            case (Range, attr) -> Range
forall a b. (a, b) -> a
fst ((Range, attr) -> Range)
-> (PatElemT (Range, attr) -> (Range, attr))
-> PatElemT (Range, attr)
-> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatElemT (Range, attr) -> (Range, attr)
forall attr. PatElemT attr -> attr
patElemAttr (PatElemT (Range, attr) -> Range)
-> PatElemT (Range, attr) -> Range
forall a b. (a -> b) -> a -> b
$ PatElemT (Range, attr)
patelem of
              (Maybe KnownBound
Nothing, Maybe KnownBound
Nothing) -> Maybe Doc
forall a. Maybe a
Nothing
              Range
range ->
                Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
PP.oneLine (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                String -> Doc
PP.text String
"-- " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> VName -> Doc
forall a. Pretty a => a -> Doc
PP.ppr (PatElemT (Range, attr) -> VName
forall attr. PatElemT attr -> VName
patElemName PatElemT (Range, attr)
patelem) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
PP.text String
" range: " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
                Range -> Doc
forall a. Pretty a => a -> Doc
PP.ppr Range
range
          inner_annot :: Maybe Doc
inner_annot = PatElemT attr -> Maybe Doc
forall a. PrettyAnnot a => a -> Maybe Doc
ppAnnot (PatElemT attr -> Maybe Doc) -> PatElemT attr -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ ((Range, attr) -> attr) -> PatElemT (Range, attr) -> PatElemT attr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Range, attr) -> attr
forall a b. (a, b) -> b
snd PatElemT (Range, attr)
patelem


instance (PrettyLore lore, CanBeRanged (Op lore)) => PrettyLore (Ranges lore) where
  ppExpLore :: ExpAttr (Ranges lore) -> Exp (Ranges lore) -> Maybe Doc
ppExpLore ExpAttr (Ranges lore)
attr = ExpAttr lore -> Exp lore -> Maybe Doc
forall lore.
PrettyLore lore =>
ExpAttr lore -> Exp lore -> Maybe Doc
ppExpLore ExpAttr lore
ExpAttr (Ranges lore)
attr (Exp lore -> Maybe Doc)
-> (Exp (Ranges lore) -> Exp lore)
-> Exp (Ranges lore)
-> Maybe Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp (Ranges lore) -> Exp lore
forall lore. CanBeRanged (Op lore) => Exp (Ranges lore) -> Exp lore
removeExpRanges

removeRanges :: CanBeRanged (Op lore) => Rephraser Identity (Ranges lore) lore
removeRanges :: Rephraser Identity (Ranges lore) lore
removeRanges = Rephraser :: forall (m :: * -> *) from to.
(ExpAttr from -> m (ExpAttr to))
-> (LetAttr from -> m (LetAttr to))
-> (FParamAttr from -> m (FParamAttr to))
-> (LParamAttr from -> m (LParamAttr to))
-> (BodyAttr from -> m (BodyAttr to))
-> (RetType from -> m (RetType to))
-> (BranchType from -> m (BranchType to))
-> (Op from -> m (Op to))
-> Rephraser m from to
Rephraser { rephraseExpLore :: ExpAttr (Ranges lore) -> Identity (ExpAttr lore)
rephraseExpLore = ExpAttr (Ranges lore) -> Identity (ExpAttr lore)
forall (m :: * -> *) a. Monad m => a -> m a
return
                         , rephraseLetBoundLore :: LetAttr (Ranges lore) -> Identity (LetAttr lore)
rephraseLetBoundLore = LetAttr lore -> Identity (LetAttr lore)
forall (m :: * -> *) a. Monad m => a -> m a
return (LetAttr lore -> Identity (LetAttr lore))
-> ((Range, LetAttr lore) -> LetAttr lore)
-> (Range, LetAttr lore)
-> Identity (LetAttr lore)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Range, LetAttr lore) -> LetAttr lore
forall a b. (a, b) -> b
snd
                         , rephraseBodyLore :: BodyAttr (Ranges lore) -> Identity (BodyAttr lore)
rephraseBodyLore = BodyAttr lore -> Identity (BodyAttr lore)
forall (m :: * -> *) a. Monad m => a -> m a
return (BodyAttr lore -> Identity (BodyAttr lore))
-> (([Range], BodyAttr lore) -> BodyAttr lore)
-> ([Range], BodyAttr lore)
-> Identity (BodyAttr lore)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Range], BodyAttr lore) -> BodyAttr lore
forall a b. (a, b) -> b
snd
                         , rephraseFParamLore :: FParamAttr (Ranges lore) -> Identity (FParamAttr lore)
rephraseFParamLore = FParamAttr (Ranges lore) -> Identity (FParamAttr lore)
forall (m :: * -> *) a. Monad m => a -> m a
return
                         , rephraseLParamLore :: LParamAttr (Ranges lore) -> Identity (LParamAttr lore)
rephraseLParamLore = LParamAttr (Ranges lore) -> Identity (LParamAttr lore)
forall (m :: * -> *) a. Monad m => a -> m a
return
                         , rephraseRetType :: RetType (Ranges lore) -> Identity (RetType lore)
rephraseRetType = RetType (Ranges lore) -> Identity (RetType lore)
forall (m :: * -> *) a. Monad m => a -> m a
return
                         , rephraseBranchType :: BranchType (Ranges lore) -> Identity (BranchType lore)
rephraseBranchType = BranchType (Ranges lore) -> Identity (BranchType lore)
forall (m :: * -> *) a. Monad m => a -> m a
return
                         , rephraseOp :: Op (Ranges lore) -> Identity (Op lore)
rephraseOp = Op lore -> Identity (Op lore)
forall (m :: * -> *) a. Monad m => a -> m a
return (Op lore -> Identity (Op lore))
-> (OpWithRanges (Op lore) -> Op lore)
-> OpWithRanges (Op lore)
-> Identity (Op lore)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpWithRanges (Op lore) -> Op lore
forall op. CanBeRanged op => OpWithRanges op -> op
removeOpRanges
                         }

removeProgRanges :: CanBeRanged (Op lore) =>
                    Prog (Ranges lore) -> Prog lore
removeProgRanges :: Prog (Ranges lore) -> Prog lore
removeProgRanges = Identity (Prog lore) -> Prog lore
forall a. Identity a -> a
runIdentity (Identity (Prog lore) -> Prog lore)
-> (Prog (Ranges lore) -> Identity (Prog lore))
-> Prog (Ranges lore)
-> Prog lore
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rephraser Identity (Ranges lore) lore
-> Prog (Ranges lore) -> Identity (Prog lore)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> Prog from -> m (Prog to)
rephraseProg Rephraser Identity (Ranges lore) lore
forall lore.
CanBeRanged (Op lore) =>
Rephraser Identity (Ranges lore) lore
removeRanges

removeExpRanges :: CanBeRanged (Op lore) =>
                   Exp (Ranges lore) -> Exp lore
removeExpRanges :: Exp (Ranges lore) -> Exp lore
removeExpRanges = Identity (Exp lore) -> Exp lore
forall a. Identity a -> a
runIdentity (Identity (Exp lore) -> Exp lore)
-> (Exp (Ranges lore) -> Identity (Exp lore))
-> Exp (Ranges lore)
-> Exp lore
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rephraser Identity (Ranges lore) lore
-> Exp (Ranges lore) -> Identity (Exp lore)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> Exp from -> m (Exp to)
rephraseExp Rephraser Identity (Ranges lore) lore
forall lore.
CanBeRanged (Op lore) =>
Rephraser Identity (Ranges lore) lore
removeRanges

removeBodyRanges :: CanBeRanged (Op lore) =>
                    Body (Ranges lore) -> Body lore
removeBodyRanges :: Body (Ranges lore) -> Body lore
removeBodyRanges = Identity (Body lore) -> Body lore
forall a. Identity a -> a
runIdentity (Identity (Body lore) -> Body lore)
-> (Body (Ranges lore) -> Identity (Body lore))
-> Body (Ranges lore)
-> Body lore
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rephraser Identity (Ranges lore) lore
-> Body (Ranges lore) -> Identity (Body lore)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> Body from -> m (Body to)
rephraseBody Rephraser Identity (Ranges lore) lore
forall lore.
CanBeRanged (Op lore) =>
Rephraser Identity (Ranges lore) lore
removeRanges

removeStmRanges :: CanBeRanged (Op lore) =>
                       Stm (Ranges lore) -> Stm lore
removeStmRanges :: Stm (Ranges lore) -> Stm lore
removeStmRanges = Identity (Stm lore) -> Stm lore
forall a. Identity a -> a
runIdentity (Identity (Stm lore) -> Stm lore)
-> (Stm (Ranges lore) -> Identity (Stm lore))
-> Stm (Ranges lore)
-> Stm lore
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rephraser Identity (Ranges lore) lore
-> Stm (Ranges lore) -> Identity (Stm lore)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> Stm from -> m (Stm to)
rephraseStm Rephraser Identity (Ranges lore) lore
forall lore.
CanBeRanged (Op lore) =>
Rephraser Identity (Ranges lore) lore
removeRanges

removeLambdaRanges :: CanBeRanged (Op lore) =>
                      Lambda (Ranges lore) -> Lambda lore
removeLambdaRanges :: Lambda (Ranges lore) -> Lambda lore
removeLambdaRanges = Identity (Lambda lore) -> Lambda lore
forall a. Identity a -> a
runIdentity (Identity (Lambda lore) -> Lambda lore)
-> (Lambda (Ranges lore) -> Identity (Lambda lore))
-> Lambda (Ranges lore)
-> Lambda lore
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rephraser Identity (Ranges lore) lore
-> Lambda (Ranges lore) -> Identity (Lambda lore)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> Lambda from -> m (Lambda to)
rephraseLambda Rephraser Identity (Ranges lore) lore
forall lore.
CanBeRanged (Op lore) =>
Rephraser Identity (Ranges lore) lore
removeRanges

removePatternRanges :: PatternT (Range, a)
                    -> PatternT a
removePatternRanges :: PatternT (Range, a) -> PatternT a
removePatternRanges = Identity (PatternT a) -> PatternT a
forall a. Identity a -> a
runIdentity (Identity (PatternT a) -> PatternT a)
-> (PatternT (Range, a) -> Identity (PatternT a))
-> PatternT (Range, a)
-> PatternT a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Range, a) -> Identity a)
-> PatternT (Range, a) -> Identity (PatternT a)
forall (m :: * -> *) from to.
Monad m =>
(from -> m to) -> PatternT from -> m (PatternT to)
rephrasePattern (a -> Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Identity a) -> ((Range, a) -> a) -> (Range, a) -> Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Range, a) -> a
forall a b. (a, b) -> b
snd)

addRangesToPattern :: (Attributes lore, CanBeRanged (Op lore)) =>
                      Pattern lore -> Exp (Ranges lore)
                   -> Pattern (Ranges lore)
addRangesToPattern :: Pattern lore -> Exp (Ranges lore) -> Pattern (Ranges lore)
addRangesToPattern Pattern lore
pat Exp (Ranges lore)
e =
  ([PatElemT (Range, LetAttr lore)]
 -> [PatElemT (Range, LetAttr lore)]
 -> PatternT (Range, LetAttr lore))
-> ([PatElemT (Range, LetAttr lore)],
    [PatElemT (Range, LetAttr lore)])
-> PatternT (Range, LetAttr lore)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [PatElemT (Range, LetAttr lore)]
-> [PatElemT (Range, LetAttr lore)]
-> PatternT (Range, LetAttr lore)
forall attr. [PatElemT attr] -> [PatElemT attr] -> PatternT attr
Pattern (([PatElemT (Range, LetAttr lore)],
  [PatElemT (Range, LetAttr lore)])
 -> PatternT (Range, LetAttr lore))
-> ([PatElemT (Range, LetAttr lore)],
    [PatElemT (Range, LetAttr lore)])
-> PatternT (Range, LetAttr lore)
forall a b. (a -> b) -> a -> b
$ Pattern lore
-> Exp (Ranges lore)
-> ([PatElemT (Range, LetAttr lore)],
    [PatElemT (Range, LetAttr lore)])
forall lore.
(Attributes lore, CanBeRanged (Op lore)) =>
Pattern lore
-> Exp (Ranges lore)
-> ([PatElemT (Range, LetAttr lore)],
    [PatElemT (Range, LetAttr lore)])
mkPatternRanges Pattern lore
pat Exp (Ranges lore)
e

mkRangedBody :: BodyAttr lore -> Stms (Ranges lore) -> Result
             -> Body (Ranges lore)
mkRangedBody :: BodyAttr lore -> Stms (Ranges lore) -> Result -> Body (Ranges lore)
mkRangedBody BodyAttr lore
innerlore Stms (Ranges lore)
bnds Result
res =
  BodyAttr (Ranges lore)
-> Stms (Ranges lore) -> Result -> Body (Ranges lore)
forall lore. BodyAttr lore -> Stms lore -> Result -> BodyT lore
Body (Stms (Ranges lore) -> Result -> [Range]
forall lore. Stms lore -> Result -> [Range]
mkBodyRanges Stms (Ranges lore)
bnds Result
res, BodyAttr lore
innerlore) Stms (Ranges lore)
bnds Result
res

mkPatternRanges :: (Attributes lore, CanBeRanged (Op lore)) =>
                   Pattern lore
                -> Exp (Ranges lore)
                -> ([PatElemT (Range, LetAttr lore)],
                    [PatElemT (Range, LetAttr lore)])
mkPatternRanges :: Pattern lore
-> Exp (Ranges lore)
-> ([PatElemT (Range, LetAttr lore)],
    [PatElemT (Range, LetAttr lore)])
mkPatternRanges Pattern lore
pat Exp (Ranges lore)
e =
  ((PatElemT (LetAttr lore) -> PatElemT (Range, LetAttr lore))
-> [PatElemT (LetAttr lore)] -> [PatElemT (Range, LetAttr lore)]
forall a b. (a -> b) -> [a] -> [b]
map (PatElemT (LetAttr lore) -> Range -> PatElemT (Range, LetAttr lore)
forall b a. PatElemT b -> a -> PatElemT (a, b)
`addRanges` Range
unknownRange) ([PatElemT (LetAttr lore)] -> [PatElemT (Range, LetAttr lore)])
-> [PatElemT (LetAttr lore)] -> [PatElemT (Range, LetAttr lore)]
forall a b. (a -> b) -> a -> b
$ Pattern lore -> [PatElemT (LetAttr lore)]
forall attr. PatternT attr -> [PatElemT attr]
patternContextElements Pattern lore
pat,
   (PatElemT (LetAttr lore)
 -> Range -> PatElemT (Range, LetAttr lore))
-> [PatElemT (LetAttr lore)]
-> [Range]
-> [PatElemT (Range, LetAttr lore)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith PatElemT (LetAttr lore) -> Range -> PatElemT (Range, LetAttr lore)
forall b a. PatElemT b -> a -> PatElemT (a, b)
addRanges (Pattern lore -> [PatElemT (LetAttr lore)]
forall attr. PatternT attr -> [PatElemT attr]
patternValueElements Pattern lore
pat) [Range]
ranges)
  where addRanges :: PatElemT b -> a -> PatElemT (a, b)
addRanges PatElemT b
patElem a
range =
          let innerlore :: b
innerlore = PatElemT b -> b
forall attr. PatElemT attr -> attr
patElemAttr PatElemT b
patElem
          in PatElemT b
patElem PatElemT b -> (a, b) -> PatElemT (a, b)
forall oldattr newattr.
PatElemT oldattr -> newattr -> PatElemT newattr
`setPatElemLore` (a
range, b
innerlore)
        ranges :: [Range]
ranges = Exp (Ranges lore) -> [Range]
forall lore. Ranged lore => Exp lore -> [Range]
expRanges Exp (Ranges lore)
e

mkBodyRanges :: Stms lore -> Result -> [Range]
mkBodyRanges :: Stms lore -> Result -> [Range]
mkBodyRanges Stms lore
bnds = (SubExp -> Range) -> Result -> [Range]
forall a b. (a -> b) -> [a] -> [b]
map ((SubExp -> Range) -> Result -> [Range])
-> (SubExp -> Range) -> Result -> [Range]
forall a b. (a -> b) -> a -> b
$ Range -> Range
removeUnknownBounds (Range -> Range) -> (SubExp -> Range) -> SubExp -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubExp -> Range
forall a. RangeOf a => a -> Range
rangeOf
  where boundInBnds :: Names
boundInBnds =
          (Stm lore -> Names) -> Stms lore -> Names
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ([VName] -> Names
namesFromList ([VName] -> Names) -> (Stm lore -> [VName]) -> Stm lore -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatternT (LetAttr lore) -> [VName]
forall attr. PatternT attr -> [VName]
patternNames (PatternT (LetAttr lore) -> [VName])
-> (Stm lore -> PatternT (LetAttr lore)) -> Stm lore -> [VName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stm lore -> PatternT (LetAttr lore)
forall lore. Stm lore -> Pattern lore
stmPattern) Stms lore
bnds
        removeUnknownBounds :: Range -> Range
removeUnknownBounds (Maybe KnownBound
lower,Maybe KnownBound
upper) =
          (Maybe KnownBound -> Maybe KnownBound
removeUnknownBound Maybe KnownBound
lower,
           Maybe KnownBound -> Maybe KnownBound
removeUnknownBound Maybe KnownBound
upper)
        removeUnknownBound :: Maybe KnownBound -> Maybe KnownBound
removeUnknownBound (Just KnownBound
bound)
          | KnownBound -> Names
forall a. FreeIn a => a -> Names
freeIn KnownBound
bound Names -> Names -> Bool
`namesIntersect` Names
boundInBnds = Maybe KnownBound
forall a. Maybe a
Nothing
          | Bool
otherwise                                 = KnownBound -> Maybe KnownBound
forall a. a -> Maybe a
Just KnownBound
bound
        removeUnknownBound Maybe KnownBound
Nothing =
          Maybe KnownBound
forall a. Maybe a
Nothing

-- It is convenient for a wrapped aliased lore to also be aliased.

instance AliasesOf attr => AliasesOf ([Range], attr) where
  aliasesOf :: ([Range], attr) -> Names
aliasesOf = attr -> Names
forall a. AliasesOf a => a -> Names
aliasesOf (attr -> Names)
-> (([Range], attr) -> attr) -> ([Range], attr) -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Range], attr) -> attr
forall a b. (a, b) -> b
snd

instance AliasesOf attr => AliasesOf (Range, attr) where
  aliasesOf :: (Range, attr) -> Names
aliasesOf = attr -> Names
forall a. AliasesOf a => a -> Names
aliasesOf (attr -> Names)
-> ((Range, attr) -> attr) -> (Range, attr) -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Range, attr) -> attr
forall a b. (a, b) -> b
snd

instance (Aliased lore, CanBeRanged (Op lore),
          AliasedOp (OpWithRanges (Op lore))) => Aliased (Ranges lore) where
  bodyAliases :: Body (Ranges lore) -> [Names]
bodyAliases = Body lore -> [Names]
forall lore. Aliased lore => Body lore -> [Names]
bodyAliases (Body lore -> [Names])
-> (Body (Ranges lore) -> Body lore)
-> Body (Ranges lore)
-> [Names]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Body (Ranges lore) -> Body lore
forall lore.
CanBeRanged (Op lore) =>
Body (Ranges lore) -> Body lore
removeBodyRanges
  consumedInBody :: Body (Ranges lore) -> Names
consumedInBody = Body lore -> Names
forall lore. Aliased lore => Body lore -> Names
consumedInBody (Body lore -> Names)
-> (Body (Ranges lore) -> Body lore) -> Body (Ranges lore) -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Body (Ranges lore) -> Body lore
forall lore.
CanBeRanged (Op lore) =>
Body (Ranges lore) -> Body lore
removeBodyRanges