{-# 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.IR.Ranges
       ( -- * The Lore definition
         Ranges
       , module Futhark.IR.Prop.Ranges
         -- * Module re-exports
       , module Futhark.IR.Prop
       , module Futhark.IR.Traversals
       , module Futhark.IR.Pretty
       , module Futhark.IR.Syntax
         -- * Adding ranges
       , addRangesToPattern
       , mkRangedBody
       , mkPatternRanges
       , mkBodyRanges
         -- * Removing ranges
       , removeProgRanges
       , removeStmRanges
       , removeLambdaRanges
       )
where

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

import Futhark.IR.Syntax
import Futhark.IR.Prop
import Futhark.IR.Prop.Aliases
import Futhark.IR.Prop.Ranges
import Futhark.IR.Traversals
import Futhark.IR.Pretty
import Futhark.Analysis.Rephrase
import qualified Futhark.Util.Pretty as PP

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

instance (Decorations lore, CanBeRanged (Op lore)) =>
         Decorations (Ranges lore) where
  type LetDec (Ranges lore) = (Range, LetDec lore)
  type ExpDec (Ranges lore) = ExpDec lore
  type BodyDec (Ranges lore) = ([Range], BodyDec lore)
  type FParamInfo (Ranges lore) = FParamInfo lore
  type LParamInfo (Ranges lore) = LParamInfo 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 (LetName (_, x)) = LetDec lore -> NameInfo lore
forall lore. LetDec lore -> NameInfo lore
LetName LetDec lore
x
          unRange (FParamName FParamInfo (Ranges lore)
x) = FParamInfo lore -> NameInfo lore
forall lore. FParamInfo lore -> NameInfo lore
FParamName FParamInfo lore
FParamInfo (Ranges lore)
x
          unRange (LParamName LParamInfo (Ranges lore)
x) = LParamInfo lore -> NameInfo lore
forall lore. LParamInfo lore -> NameInfo lore
LParamName LParamInfo lore
LParamInfo (Ranges lore)
x
          unRange (IndexName IntType
x) = IntType -> NameInfo lore
forall lore. IntType -> NameInfo lore
IndexName IntType
x

instance (ASTLore lore, CanBeRanged (Op lore)) =>
         ASTLore (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, LetDec lore)
    -> ReaderT (Scope lore) m [BranchType lore])
-> PatternT (Range, LetDec lore)
-> m [BranchType lore]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatternT (LetDec lore) -> ReaderT (Scope lore) m [BranchType lore]
forall lore (m :: * -> *).
(ASTLore lore, HasScope lore m, Monad m) =>
Pattern lore -> m [BranchType lore]
expTypesFromPattern (PatternT (LetDec lore)
 -> ReaderT (Scope lore) m [BranchType lore])
-> (PatternT (Range, LetDec lore) -> PatternT (LetDec lore))
-> PatternT (Range, LetDec lore)
-> ReaderT (Scope lore) m [BranchType lore]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatternT (Range, LetDec lore) -> PatternT (LetDec lore)
forall a. PatternT (Range, a) -> PatternT a
removePatternRanges

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

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

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

  ppAnnot :: PatElemT (Range, dec) -> Maybe Doc
ppAnnot PatElemT (Range, dec)
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, dec) -> Range
forall a b. (a, b) -> a
fst ((Range, dec) -> Range)
-> (PatElemT (Range, dec) -> (Range, dec))
-> PatElemT (Range, dec)
-> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatElemT (Range, dec) -> (Range, dec)
forall dec. PatElemT dec -> dec
patElemDec (PatElemT (Range, dec) -> Range) -> PatElemT (Range, dec) -> Range
forall a b. (a -> b) -> a -> b
$ PatElemT (Range, dec)
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, dec) -> VName
forall dec. PatElemT dec -> VName
patElemName PatElemT (Range, dec)
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 dec -> Maybe Doc
forall a. PrettyAnnot a => a -> Maybe Doc
ppAnnot (PatElemT dec -> Maybe Doc) -> PatElemT dec -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ ((Range, dec) -> dec) -> PatElemT (Range, dec) -> PatElemT dec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Range, dec) -> dec
forall a b. (a, b) -> b
snd PatElemT (Range, dec)
patelem


instance (PrettyLore lore, CanBeRanged (Op lore)) => PrettyLore (Ranges lore) where
  ppExpLore :: ExpDec (Ranges lore) -> Exp (Ranges lore) -> Maybe Doc
ppExpLore ExpDec (Ranges lore)
dec = ExpDec lore -> Exp lore -> Maybe Doc
forall lore.
PrettyLore lore =>
ExpDec lore -> Exp lore -> Maybe Doc
ppExpLore ExpDec lore
ExpDec (Ranges lore)
dec (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.
(ExpDec from -> m (ExpDec to))
-> (LetDec from -> m (LetDec to))
-> (FParamInfo from -> m (FParamInfo to))
-> (LParamInfo from -> m (LParamInfo to))
-> (BodyDec from -> m (BodyDec to))
-> (RetType from -> m (RetType to))
-> (BranchType from -> m (BranchType to))
-> (Op from -> m (Op to))
-> Rephraser m from to
Rephraser { rephraseExpLore :: ExpDec (Ranges lore) -> Identity (ExpDec lore)
rephraseExpLore = ExpDec (Ranges lore) -> Identity (ExpDec lore)
forall (m :: * -> *) a. Monad m => a -> m a
return
                         , rephraseLetBoundLore :: LetDec (Ranges lore) -> Identity (LetDec lore)
rephraseLetBoundLore = LetDec lore -> Identity (LetDec lore)
forall (m :: * -> *) a. Monad m => a -> m a
return (LetDec lore -> Identity (LetDec lore))
-> ((Range, LetDec lore) -> LetDec lore)
-> (Range, LetDec lore)
-> Identity (LetDec lore)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Range, LetDec lore) -> LetDec lore
forall a b. (a, b) -> b
snd
                         , rephraseBodyLore :: BodyDec (Ranges lore) -> Identity (BodyDec lore)
rephraseBodyLore = BodyDec lore -> Identity (BodyDec lore)
forall (m :: * -> *) a. Monad m => a -> m a
return (BodyDec lore -> Identity (BodyDec lore))
-> (([Range], BodyDec lore) -> BodyDec lore)
-> ([Range], BodyDec lore)
-> Identity (BodyDec lore)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Range], BodyDec lore) -> BodyDec lore
forall a b. (a, b) -> b
snd
                         , rephraseFParamLore :: FParamInfo (Ranges lore) -> Identity (FParamInfo lore)
rephraseFParamLore = FParamInfo (Ranges lore) -> Identity (FParamInfo lore)
forall (m :: * -> *) a. Monad m => a -> m a
return
                         , rephraseLParamLore :: LParamInfo (Ranges lore) -> Identity (LParamInfo lore)
rephraseLParamLore = LParamInfo (Ranges lore) -> Identity (LParamInfo 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
                         }

-- | Remove range information from program.
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

-- | Remove range information from statement.
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

-- | Remove range information from lambda.
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)

-- | Add ranges to the pattern corresponding to this expression.
addRangesToPattern :: (ASTLore 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, LetDec lore)]
 -> [PatElemT (Range, LetDec lore)]
 -> PatternT (Range, LetDec lore))
-> ([PatElemT (Range, LetDec lore)],
    [PatElemT (Range, LetDec lore)])
-> PatternT (Range, LetDec lore)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [PatElemT (Range, LetDec lore)]
-> [PatElemT (Range, LetDec lore)] -> PatternT (Range, LetDec lore)
forall dec. [PatElemT dec] -> [PatElemT dec] -> PatternT dec
Pattern (([PatElemT (Range, LetDec lore)], [PatElemT (Range, LetDec lore)])
 -> PatternT (Range, LetDec lore))
-> ([PatElemT (Range, LetDec lore)],
    [PatElemT (Range, LetDec lore)])
-> PatternT (Range, LetDec lore)
forall a b. (a -> b) -> a -> b
$ Pattern lore
-> Exp (Ranges lore)
-> ([PatElemT (Range, LetDec lore)],
    [PatElemT (Range, LetDec lore)])
forall lore.
(ASTLore lore, CanBeRanged (Op lore)) =>
Pattern lore
-> Exp (Ranges lore)
-> ([PatElemT (Range, LetDec lore)],
    [PatElemT (Range, LetDec lore)])
mkPatternRanges Pattern lore
pat Exp (Ranges lore)
e

-- | Construct a body with the 'Ranges' lore.
mkRangedBody :: BodyDec lore -> Stms (Ranges lore) -> Result
             -> Body (Ranges lore)
mkRangedBody :: BodyDec lore -> Stms (Ranges lore) -> Result -> Body (Ranges lore)
mkRangedBody BodyDec lore
innerlore Stms (Ranges lore)
bnds Result
res =
  BodyDec (Ranges lore)
-> Stms (Ranges lore) -> Result -> Body (Ranges lore)
forall lore. BodyDec 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, BodyDec lore
innerlore) Stms (Ranges lore)
bnds Result
res

-- | Find the ranges for the pattern elements.
mkPatternRanges :: (ASTLore lore, CanBeRanged (Op lore)) =>
                   Pattern lore
                -> Exp (Ranges lore)
                -> ([PatElemT (Range, LetDec lore)],
                    [PatElemT (Range, LetDec lore)])
mkPatternRanges :: Pattern lore
-> Exp (Ranges lore)
-> ([PatElemT (Range, LetDec lore)],
    [PatElemT (Range, LetDec lore)])
mkPatternRanges Pattern lore
pat Exp (Ranges lore)
e =
  ((PatElemT (LetDec lore) -> PatElemT (Range, LetDec lore))
-> [PatElemT (LetDec lore)] -> [PatElemT (Range, LetDec lore)]
forall a b. (a -> b) -> [a] -> [b]
map (PatElemT (LetDec lore) -> Range -> PatElemT (Range, LetDec lore)
forall b a. PatElemT b -> a -> PatElemT (a, b)
`addRanges` Range
unknownRange) ([PatElemT (LetDec lore)] -> [PatElemT (Range, LetDec lore)])
-> [PatElemT (LetDec lore)] -> [PatElemT (Range, LetDec lore)]
forall a b. (a -> b) -> a -> b
$ Pattern lore -> [PatElemT (LetDec lore)]
forall dec. PatternT dec -> [PatElemT dec]
patternContextElements Pattern lore
pat,
   (PatElemT (LetDec lore) -> Range -> PatElemT (Range, LetDec lore))
-> [PatElemT (LetDec lore)]
-> [Range]
-> [PatElemT (Range, LetDec lore)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith PatElemT (LetDec lore) -> Range -> PatElemT (Range, LetDec lore)
forall b a. PatElemT b -> a -> PatElemT (a, b)
addRanges (Pattern lore -> [PatElemT (LetDec lore)]
forall dec. PatternT dec -> [PatElemT dec]
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 dec. PatElemT dec -> dec
patElemDec 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

-- | Find the ranges for the body result.
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 (LetDec lore) -> [VName]
forall dec. PatternT dec -> [VName]
patternNames (PatternT (LetDec lore) -> [VName])
-> (Stm lore -> PatternT (LetDec lore)) -> Stm lore -> [VName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stm lore -> PatternT (LetDec 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 dec => AliasesOf ([Range], dec) where
  aliasesOf :: ([Range], dec) -> Names
aliasesOf = dec -> Names
forall a. AliasesOf a => a -> Names
aliasesOf (dec -> Names)
-> (([Range], dec) -> dec) -> ([Range], dec) -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Range], dec) -> dec
forall a b. (a, b) -> b
snd

instance AliasesOf dec => AliasesOf (Range, dec) where
  aliasesOf :: (Range, dec) -> Names
aliasesOf = dec -> Names
forall a. AliasesOf a => a -> Names
aliasesOf (dec -> Names) -> ((Range, dec) -> dec) -> (Range, dec) -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Range, dec) -> dec
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