{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Definition of the lore used by the simplification engine.
module Futhark.Optimise.Simplify.Lore
  ( Wise,
    VarWisdom (..),
    ExpWisdom,
    removeStmWisdom,
    removeLambdaWisdom,
    removeFunDefWisdom,
    removeExpWisdom,
    removePatternWisdom,
    removeBodyWisdom,
    removeScopeWisdom,
    addScopeWisdom,
    addWisdomToPattern,
    mkWiseBody,
    mkWiseLetStm,
    mkWiseExpDec,
    CanBeWise (..),
  )
where

import Control.Category
import Control.Monad.Identity
import Control.Monad.Reader
import qualified Data.Kind
import qualified Data.Map.Strict as M
import Futhark.Analysis.Rephrase
import Futhark.Binder
import Futhark.IR
import Futhark.IR.Aliases
  ( AliasDec (..),
    ConsumedInExp,
    VarAliases,
    unAliases,
  )
import qualified Futhark.IR.Aliases as Aliases
import Futhark.IR.Prop.Aliases
import Futhark.Transform.Rename
import Futhark.Transform.Substitute
import GHC.Generics (Generic)
import Language.SexpGrammar as Sexp hiding (cons)
import Language.SexpGrammar.Generic
import Prelude hiding (id, (.))

data Wise lore

-- | The wisdom of the let-bound variable.
newtype VarWisdom = VarWisdom {VarWisdom -> VarAliases
varWisdomAliases :: VarAliases}
  deriving (VarWisdom -> VarWisdom -> Bool
(VarWisdom -> VarWisdom -> Bool)
-> (VarWisdom -> VarWisdom -> Bool) -> Eq VarWisdom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VarWisdom -> VarWisdom -> Bool
$c/= :: VarWisdom -> VarWisdom -> Bool
== :: VarWisdom -> VarWisdom -> Bool
$c== :: VarWisdom -> VarWisdom -> Bool
Eq, Eq VarWisdom
Eq VarWisdom
-> (VarWisdom -> VarWisdom -> Ordering)
-> (VarWisdom -> VarWisdom -> Bool)
-> (VarWisdom -> VarWisdom -> Bool)
-> (VarWisdom -> VarWisdom -> Bool)
-> (VarWisdom -> VarWisdom -> Bool)
-> (VarWisdom -> VarWisdom -> VarWisdom)
-> (VarWisdom -> VarWisdom -> VarWisdom)
-> Ord VarWisdom
VarWisdom -> VarWisdom -> Bool
VarWisdom -> VarWisdom -> Ordering
VarWisdom -> VarWisdom -> VarWisdom
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VarWisdom -> VarWisdom -> VarWisdom
$cmin :: VarWisdom -> VarWisdom -> VarWisdom
max :: VarWisdom -> VarWisdom -> VarWisdom
$cmax :: VarWisdom -> VarWisdom -> VarWisdom
>= :: VarWisdom -> VarWisdom -> Bool
$c>= :: VarWisdom -> VarWisdom -> Bool
> :: VarWisdom -> VarWisdom -> Bool
$c> :: VarWisdom -> VarWisdom -> Bool
<= :: VarWisdom -> VarWisdom -> Bool
$c<= :: VarWisdom -> VarWisdom -> Bool
< :: VarWisdom -> VarWisdom -> Bool
$c< :: VarWisdom -> VarWisdom -> Bool
compare :: VarWisdom -> VarWisdom -> Ordering
$ccompare :: VarWisdom -> VarWisdom -> Ordering
$cp1Ord :: Eq VarWisdom
Ord, Int -> VarWisdom -> ShowS
[VarWisdom] -> ShowS
VarWisdom -> String
(Int -> VarWisdom -> ShowS)
-> (VarWisdom -> String)
-> ([VarWisdom] -> ShowS)
-> Show VarWisdom
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VarWisdom] -> ShowS
$cshowList :: [VarWisdom] -> ShowS
show :: VarWisdom -> String
$cshow :: VarWisdom -> String
showsPrec :: Int -> VarWisdom -> ShowS
$cshowsPrec :: Int -> VarWisdom -> ShowS
Show, (forall x. VarWisdom -> Rep VarWisdom x)
-> (forall x. Rep VarWisdom x -> VarWisdom) -> Generic VarWisdom
forall x. Rep VarWisdom x -> VarWisdom
forall x. VarWisdom -> Rep VarWisdom x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VarWisdom x -> VarWisdom
$cfrom :: forall x. VarWisdom -> Rep VarWisdom x
Generic)

instance SexpIso VarWisdom where
  sexpIso :: Grammar Position (Sexp :- t) (VarWisdom :- t)
sexpIso = (Grammar Position (VarAliases :- t) (VarWisdom :- t)
 -> Grammar Position (Sexp :- t) (VarWisdom :- t))
-> Grammar Position (Sexp :- t) (VarWisdom :- t)
forall a b s t (c :: Meta) (d :: Meta) (f :: * -> *) p.
(Generic a, MkPrismList (Rep a), MkStackPrism f,
 Rep a ~ M1 D d (M1 C c f), StackPrismLhs f t ~ b, Constructor c) =>
(Grammar p b (a :- t) -> Grammar p s (a :- t))
-> Grammar p s (a :- t)
with ((Grammar Position (VarAliases :- t) (VarWisdom :- t)
  -> Grammar Position (Sexp :- t) (VarWisdom :- t))
 -> Grammar Position (Sexp :- t) (VarWisdom :- t))
-> (Grammar Position (VarAliases :- t) (VarWisdom :- t)
    -> Grammar Position (Sexp :- t) (VarWisdom :- t))
-> Grammar Position (Sexp :- t) (VarWisdom :- t)
forall a b. (a -> b) -> a -> b
$ \Grammar Position (VarAliases :- t) (VarWisdom :- t)
varwisdom -> Grammar Position (Sexp :- t) (VarAliases :- t)
forall a. SexpIso a => SexpGrammar a
sexpIso Grammar Position (Sexp :- t) (VarAliases :- t)
-> Grammar Position (VarAliases :- t) (VarWisdom :- t)
-> Grammar Position (Sexp :- t) (VarWisdom :- t)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Grammar Position (VarAliases :- t) (VarWisdom :- t)
varwisdom

instance Rename VarWisdom where
  rename :: VarWisdom -> RenameM VarWisdom
rename = VarWisdom -> RenameM VarWisdom
forall a. Substitute a => a -> RenameM a
substituteRename

instance Substitute VarWisdom where
  substituteNames :: Map VName VName -> VarWisdom -> VarWisdom
substituteNames Map VName VName
substs (VarWisdom VarAliases
als) =
    VarAliases -> VarWisdom
VarWisdom (Map VName VName -> VarAliases -> VarAliases
forall a. Substitute a => Map VName VName -> a -> a
substituteNames Map VName VName
substs VarAliases
als)

instance FreeIn VarWisdom where
  freeIn' :: VarWisdom -> FV
freeIn' (VarWisdom VarAliases
als) = VarAliases -> FV
forall a. FreeIn a => a -> FV
freeIn' VarAliases
als

-- | Wisdom about an expression.
data ExpWisdom = ExpWisdom
  { ExpWisdom -> VarAliases
_expWisdomConsumed :: ConsumedInExp,
    ExpWisdom -> VarAliases
expWisdomFree :: AliasDec
  }
  deriving (ExpWisdom -> ExpWisdom -> Bool
(ExpWisdom -> ExpWisdom -> Bool)
-> (ExpWisdom -> ExpWisdom -> Bool) -> Eq ExpWisdom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExpWisdom -> ExpWisdom -> Bool
$c/= :: ExpWisdom -> ExpWisdom -> Bool
== :: ExpWisdom -> ExpWisdom -> Bool
$c== :: ExpWisdom -> ExpWisdom -> Bool
Eq, Eq ExpWisdom
Eq ExpWisdom
-> (ExpWisdom -> ExpWisdom -> Ordering)
-> (ExpWisdom -> ExpWisdom -> Bool)
-> (ExpWisdom -> ExpWisdom -> Bool)
-> (ExpWisdom -> ExpWisdom -> Bool)
-> (ExpWisdom -> ExpWisdom -> Bool)
-> (ExpWisdom -> ExpWisdom -> ExpWisdom)
-> (ExpWisdom -> ExpWisdom -> ExpWisdom)
-> Ord ExpWisdom
ExpWisdom -> ExpWisdom -> Bool
ExpWisdom -> ExpWisdom -> Ordering
ExpWisdom -> ExpWisdom -> ExpWisdom
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ExpWisdom -> ExpWisdom -> ExpWisdom
$cmin :: ExpWisdom -> ExpWisdom -> ExpWisdom
max :: ExpWisdom -> ExpWisdom -> ExpWisdom
$cmax :: ExpWisdom -> ExpWisdom -> ExpWisdom
>= :: ExpWisdom -> ExpWisdom -> Bool
$c>= :: ExpWisdom -> ExpWisdom -> Bool
> :: ExpWisdom -> ExpWisdom -> Bool
$c> :: ExpWisdom -> ExpWisdom -> Bool
<= :: ExpWisdom -> ExpWisdom -> Bool
$c<= :: ExpWisdom -> ExpWisdom -> Bool
< :: ExpWisdom -> ExpWisdom -> Bool
$c< :: ExpWisdom -> ExpWisdom -> Bool
compare :: ExpWisdom -> ExpWisdom -> Ordering
$ccompare :: ExpWisdom -> ExpWisdom -> Ordering
$cp1Ord :: Eq ExpWisdom
Ord, Int -> ExpWisdom -> ShowS
[ExpWisdom] -> ShowS
ExpWisdom -> String
(Int -> ExpWisdom -> ShowS)
-> (ExpWisdom -> String)
-> ([ExpWisdom] -> ShowS)
-> Show ExpWisdom
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExpWisdom] -> ShowS
$cshowList :: [ExpWisdom] -> ShowS
show :: ExpWisdom -> String
$cshow :: ExpWisdom -> String
showsPrec :: Int -> ExpWisdom -> ShowS
$cshowsPrec :: Int -> ExpWisdom -> ShowS
Show, (forall x. ExpWisdom -> Rep ExpWisdom x)
-> (forall x. Rep ExpWisdom x -> ExpWisdom) -> Generic ExpWisdom
forall x. Rep ExpWisdom x -> ExpWisdom
forall x. ExpWisdom -> Rep ExpWisdom x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExpWisdom x -> ExpWisdom
$cfrom :: forall x. ExpWisdom -> Rep ExpWisdom x
Generic)

instance SexpIso ExpWisdom where
  sexpIso :: Grammar Position (Sexp :- t) (ExpWisdom :- t)
sexpIso = (Grammar
   Position (VarAliases :- (VarAliases :- t)) (ExpWisdom :- t)
 -> Grammar Position (Sexp :- t) (ExpWisdom :- t))
-> Grammar Position (Sexp :- t) (ExpWisdom :- t)
forall a b s t (c :: Meta) (d :: Meta) (f :: * -> *) p.
(Generic a, MkPrismList (Rep a), MkStackPrism f,
 Rep a ~ M1 D d (M1 C c f), StackPrismLhs f t ~ b, Constructor c) =>
(Grammar p b (a :- t) -> Grammar p s (a :- t))
-> Grammar p s (a :- t)
with ((Grammar
    Position (VarAliases :- (VarAliases :- t)) (ExpWisdom :- t)
  -> Grammar Position (Sexp :- t) (ExpWisdom :- t))
 -> Grammar Position (Sexp :- t) (ExpWisdom :- t))
-> (Grammar
      Position (VarAliases :- (VarAliases :- t)) (ExpWisdom :- t)
    -> Grammar Position (Sexp :- t) (ExpWisdom :- t))
-> Grammar Position (Sexp :- t) (ExpWisdom :- t)
forall a b. (a -> b) -> a -> b
$ \Grammar Position (VarAliases :- (VarAliases :- t)) (ExpWisdom :- t)
expwisdom ->
    Grammar
  Position (List :- t) (List :- (VarAliases :- (VarAliases :- t)))
-> Grammar Position (Sexp :- t) (VarAliases :- (VarAliases :- t))
forall t t'.
Grammar Position (List :- t) (List :- t')
-> Grammar Position (Sexp :- t) t'
Sexp.list
      ( Grammar Position (Sexp :- t) (VarAliases :- t)
-> Grammar Position (List :- t) (List :- (VarAliases :- t))
forall t t'.
Grammar Position (Sexp :- t) t'
-> Grammar Position (List :- t) (List :- t')
Sexp.el Grammar Position (Sexp :- t) (VarAliases :- t)
forall a. SexpIso a => SexpGrammar a
sexpIso
          Grammar Position (List :- t) (List :- (VarAliases :- t))
-> Grammar
     Position
     (List :- (VarAliases :- t))
     (List :- (VarAliases :- (VarAliases :- t)))
-> Grammar
     Position (List :- t) (List :- (VarAliases :- (VarAliases :- t)))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Grammar
  Position
  (Sexp :- (VarAliases :- t))
  (VarAliases :- (VarAliases :- t))
-> Grammar
     Position
     (List :- (VarAliases :- t))
     (List :- (VarAliases :- (VarAliases :- t)))
forall t t'.
Grammar Position (Sexp :- t) t'
-> Grammar Position (List :- t) (List :- t')
Sexp.el Grammar
  Position
  (Sexp :- (VarAliases :- t))
  (VarAliases :- (VarAliases :- t))
forall a. SexpIso a => SexpGrammar a
sexpIso
      )
      Grammar Position (Sexp :- t) (VarAliases :- (VarAliases :- t))
-> Grammar
     Position (VarAliases :- (VarAliases :- t)) (ExpWisdom :- t)
-> Grammar Position (Sexp :- t) (ExpWisdom :- t)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Grammar Position (VarAliases :- (VarAliases :- t)) (ExpWisdom :- t)
expwisdom

instance FreeIn ExpWisdom where
  freeIn' :: ExpWisdom -> FV
freeIn' = ExpWisdom -> FV
forall a. Monoid a => a
mempty

instance FreeDec ExpWisdom where
  precomputed :: ExpWisdom -> FV -> FV
precomputed = FV -> FV -> FV
forall a b. a -> b -> a
const (FV -> FV -> FV) -> (ExpWisdom -> FV) -> ExpWisdom -> FV -> FV
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Names -> FV
fvNames (Names -> FV) -> (ExpWisdom -> Names) -> ExpWisdom -> FV
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. VarAliases -> Names
unAliases (VarAliases -> Names)
-> (ExpWisdom -> VarAliases) -> ExpWisdom -> Names
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ExpWisdom -> VarAliases
expWisdomFree

instance Substitute ExpWisdom where
  substituteNames :: Map VName VName -> ExpWisdom -> ExpWisdom
substituteNames Map VName VName
substs (ExpWisdom VarAliases
cons VarAliases
free) =
    VarAliases -> VarAliases -> ExpWisdom
ExpWisdom
      (Map VName VName -> VarAliases -> VarAliases
forall a. Substitute a => Map VName VName -> a -> a
substituteNames Map VName VName
substs VarAliases
cons)
      (Map VName VName -> VarAliases -> VarAliases
forall a. Substitute a => Map VName VName -> a -> a
substituteNames Map VName VName
substs VarAliases
free)

instance Rename ExpWisdom where
  rename :: ExpWisdom -> RenameM ExpWisdom
rename = ExpWisdom -> RenameM ExpWisdom
forall a. Substitute a => a -> RenameM a
substituteRename

-- | Wisdom about a body.
data BodyWisdom = BodyWisdom
  { BodyWisdom -> [VarAliases]
bodyWisdomAliases :: [VarAliases],
    BodyWisdom -> VarAliases
bodyWisdomConsumed :: ConsumedInExp,
    BodyWisdom -> VarAliases
bodyWisdomFree :: AliasDec
  }
  deriving (BodyWisdom -> BodyWisdom -> Bool
(BodyWisdom -> BodyWisdom -> Bool)
-> (BodyWisdom -> BodyWisdom -> Bool) -> Eq BodyWisdom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BodyWisdom -> BodyWisdom -> Bool
$c/= :: BodyWisdom -> BodyWisdom -> Bool
== :: BodyWisdom -> BodyWisdom -> Bool
$c== :: BodyWisdom -> BodyWisdom -> Bool
Eq, Eq BodyWisdom
Eq BodyWisdom
-> (BodyWisdom -> BodyWisdom -> Ordering)
-> (BodyWisdom -> BodyWisdom -> Bool)
-> (BodyWisdom -> BodyWisdom -> Bool)
-> (BodyWisdom -> BodyWisdom -> Bool)
-> (BodyWisdom -> BodyWisdom -> Bool)
-> (BodyWisdom -> BodyWisdom -> BodyWisdom)
-> (BodyWisdom -> BodyWisdom -> BodyWisdom)
-> Ord BodyWisdom
BodyWisdom -> BodyWisdom -> Bool
BodyWisdom -> BodyWisdom -> Ordering
BodyWisdom -> BodyWisdom -> BodyWisdom
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BodyWisdom -> BodyWisdom -> BodyWisdom
$cmin :: BodyWisdom -> BodyWisdom -> BodyWisdom
max :: BodyWisdom -> BodyWisdom -> BodyWisdom
$cmax :: BodyWisdom -> BodyWisdom -> BodyWisdom
>= :: BodyWisdom -> BodyWisdom -> Bool
$c>= :: BodyWisdom -> BodyWisdom -> Bool
> :: BodyWisdom -> BodyWisdom -> Bool
$c> :: BodyWisdom -> BodyWisdom -> Bool
<= :: BodyWisdom -> BodyWisdom -> Bool
$c<= :: BodyWisdom -> BodyWisdom -> Bool
< :: BodyWisdom -> BodyWisdom -> Bool
$c< :: BodyWisdom -> BodyWisdom -> Bool
compare :: BodyWisdom -> BodyWisdom -> Ordering
$ccompare :: BodyWisdom -> BodyWisdom -> Ordering
$cp1Ord :: Eq BodyWisdom
Ord, Int -> BodyWisdom -> ShowS
[BodyWisdom] -> ShowS
BodyWisdom -> String
(Int -> BodyWisdom -> ShowS)
-> (BodyWisdom -> String)
-> ([BodyWisdom] -> ShowS)
-> Show BodyWisdom
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BodyWisdom] -> ShowS
$cshowList :: [BodyWisdom] -> ShowS
show :: BodyWisdom -> String
$cshow :: BodyWisdom -> String
showsPrec :: Int -> BodyWisdom -> ShowS
$cshowsPrec :: Int -> BodyWisdom -> ShowS
Show, (forall x. BodyWisdom -> Rep BodyWisdom x)
-> (forall x. Rep BodyWisdom x -> BodyWisdom) -> Generic BodyWisdom
forall x. Rep BodyWisdom x -> BodyWisdom
forall x. BodyWisdom -> Rep BodyWisdom x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BodyWisdom x -> BodyWisdom
$cfrom :: forall x. BodyWisdom -> Rep BodyWisdom x
Generic)

instance SexpIso BodyWisdom where
  sexpIso :: Grammar Position (Sexp :- t) (BodyWisdom :- t)
sexpIso = (Grammar
   Position
   (VarAliases :- (VarAliases :- ([VarAliases] :- t)))
   (BodyWisdom :- t)
 -> Grammar Position (Sexp :- t) (BodyWisdom :- t))
-> Grammar Position (Sexp :- t) (BodyWisdom :- t)
forall a b s t (c :: Meta) (d :: Meta) (f :: * -> *) p.
(Generic a, MkPrismList (Rep a), MkStackPrism f,
 Rep a ~ M1 D d (M1 C c f), StackPrismLhs f t ~ b, Constructor c) =>
(Grammar p b (a :- t) -> Grammar p s (a :- t))
-> Grammar p s (a :- t)
with ((Grammar
    Position
    (VarAliases :- (VarAliases :- ([VarAliases] :- t)))
    (BodyWisdom :- t)
  -> Grammar Position (Sexp :- t) (BodyWisdom :- t))
 -> Grammar Position (Sexp :- t) (BodyWisdom :- t))
-> (Grammar
      Position
      (VarAliases :- (VarAliases :- ([VarAliases] :- t)))
      (BodyWisdom :- t)
    -> Grammar Position (Sexp :- t) (BodyWisdom :- t))
-> Grammar Position (Sexp :- t) (BodyWisdom :- t)
forall a b. (a -> b) -> a -> b
$ \Grammar
  Position
  (VarAliases :- (VarAliases :- ([VarAliases] :- t)))
  (BodyWisdom :- t)
bodywisdom ->
    Grammar
  Position
  (List :- t)
  (List :- (VarAliases :- (VarAliases :- ([VarAliases] :- t))))
-> Grammar
     Position
     (Sexp :- t)
     (VarAliases :- (VarAliases :- ([VarAliases] :- t)))
forall t t'.
Grammar Position (List :- t) (List :- t')
-> Grammar Position (Sexp :- t) t'
Sexp.list
      ( Grammar Position (Sexp :- t) ([VarAliases] :- t)
-> Grammar Position (List :- t) (List :- ([VarAliases] :- t))
forall t t'.
Grammar Position (Sexp :- t) t'
-> Grammar Position (List :- t) (List :- t')
Sexp.el Grammar Position (Sexp :- t) ([VarAliases] :- t)
forall a. SexpIso a => SexpGrammar a
sexpIso Grammar Position (List :- t) (List :- ([VarAliases] :- t))
-> Grammar
     Position
     (List :- ([VarAliases] :- t))
     (List :- (VarAliases :- (VarAliases :- ([VarAliases] :- t))))
-> Grammar
     Position
     (List :- t)
     (List :- (VarAliases :- (VarAliases :- ([VarAliases] :- t))))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Grammar
  Position
  (Sexp :- ([VarAliases] :- t))
  (VarAliases :- ([VarAliases] :- t))
-> Grammar
     Position
     (List :- ([VarAliases] :- t))
     (List :- (VarAliases :- ([VarAliases] :- t)))
forall t t'.
Grammar Position (Sexp :- t) t'
-> Grammar Position (List :- t) (List :- t')
Sexp.el Grammar
  Position
  (Sexp :- ([VarAliases] :- t))
  (VarAliases :- ([VarAliases] :- t))
forall a. SexpIso a => SexpGrammar a
sexpIso Grammar
  Position
  (List :- ([VarAliases] :- t))
  (List :- (VarAliases :- ([VarAliases] :- t)))
-> Grammar
     Position
     (List :- (VarAliases :- ([VarAliases] :- t)))
     (List :- (VarAliases :- (VarAliases :- ([VarAliases] :- t))))
-> Grammar
     Position
     (List :- ([VarAliases] :- t))
     (List :- (VarAliases :- (VarAliases :- ([VarAliases] :- t))))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Grammar
  Position
  (Sexp :- (VarAliases :- ([VarAliases] :- t)))
  (VarAliases :- (VarAliases :- ([VarAliases] :- t)))
-> Grammar
     Position
     (List :- (VarAliases :- ([VarAliases] :- t)))
     (List :- (VarAliases :- (VarAliases :- ([VarAliases] :- t))))
forall t t'.
Grammar Position (Sexp :- t) t'
-> Grammar Position (List :- t) (List :- t')
Sexp.el Grammar
  Position
  (Sexp :- (VarAliases :- ([VarAliases] :- t)))
  (VarAliases :- (VarAliases :- ([VarAliases] :- t)))
forall a. SexpIso a => SexpGrammar a
sexpIso
      )
      Grammar
  Position
  (Sexp :- t)
  (VarAliases :- (VarAliases :- ([VarAliases] :- t)))
-> Grammar
     Position
     (VarAliases :- (VarAliases :- ([VarAliases] :- t)))
     (BodyWisdom :- t)
-> Grammar Position (Sexp :- t) (BodyWisdom :- t)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Grammar
  Position
  (VarAliases :- (VarAliases :- ([VarAliases] :- t)))
  (BodyWisdom :- t)
bodywisdom

instance Rename BodyWisdom where
  rename :: BodyWisdom -> RenameM BodyWisdom
rename = BodyWisdom -> RenameM BodyWisdom
forall a. Substitute a => a -> RenameM a
substituteRename

instance Substitute BodyWisdom where
  substituteNames :: Map VName VName -> BodyWisdom -> BodyWisdom
substituteNames Map VName VName
substs (BodyWisdom [VarAliases]
als VarAliases
cons VarAliases
free) =
    [VarAliases] -> VarAliases -> VarAliases -> BodyWisdom
BodyWisdom
      (Map VName VName -> [VarAliases] -> [VarAliases]
forall a. Substitute a => Map VName VName -> a -> a
substituteNames Map VName VName
substs [VarAliases]
als)
      (Map VName VName -> VarAliases -> VarAliases
forall a. Substitute a => Map VName VName -> a -> a
substituteNames Map VName VName
substs VarAliases
cons)
      (Map VName VName -> VarAliases -> VarAliases
forall a. Substitute a => Map VName VName -> a -> a
substituteNames Map VName VName
substs VarAliases
free)

instance FreeIn BodyWisdom where
  freeIn' :: BodyWisdom -> FV
freeIn' (BodyWisdom [VarAliases]
als VarAliases
cons VarAliases
free) =
    [VarAliases] -> FV
forall a. FreeIn a => a -> FV
freeIn' [VarAliases]
als FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> VarAliases -> FV
forall a. FreeIn a => a -> FV
freeIn' VarAliases
cons FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> VarAliases -> FV
forall a. FreeIn a => a -> FV
freeIn' VarAliases
free

instance FreeDec BodyWisdom where
  precomputed :: BodyWisdom -> FV -> FV
precomputed = FV -> FV -> FV
forall a b. a -> b -> a
const (FV -> FV -> FV) -> (BodyWisdom -> FV) -> BodyWisdom -> FV -> FV
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Names -> FV
fvNames (Names -> FV) -> (BodyWisdom -> Names) -> BodyWisdom -> FV
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. VarAliases -> Names
unAliases (VarAliases -> Names)
-> (BodyWisdom -> VarAliases) -> BodyWisdom -> Names
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BodyWisdom -> VarAliases
bodyWisdomFree

instance
  ( Decorations lore,
    CanBeWise (Op lore)
  ) =>
  Decorations (Wise lore)
  where
  type LetDec (Wise lore) = (VarWisdom, LetDec lore)
  type ExpDec (Wise lore) = (ExpWisdom, ExpDec lore)
  type BodyDec (Wise lore) = (BodyWisdom, BodyDec lore)
  type FParamInfo (Wise lore) = FParamInfo lore
  type LParamInfo (Wise lore) = LParamInfo lore
  type RetType (Wise lore) = RetType lore
  type BranchType (Wise lore) = BranchType lore
  type Op (Wise lore) = OpWithWisdom (Op lore)

withoutWisdom ::
  (HasScope (Wise lore) m, Monad m) =>
  ReaderT (Scope lore) m a ->
  m a
withoutWisdom :: ReaderT (Scope lore) m a -> m a
withoutWisdom ReaderT (Scope lore) m a
m = do
  Scope lore
scope <- (Scope (Wise lore) -> Scope lore) -> m (Scope lore)
forall lore (m :: * -> *) a.
HasScope lore m =>
(Scope lore -> a) -> m a
asksScope Scope (Wise lore) -> Scope lore
forall lore. Scope (Wise lore) -> Scope lore
removeScopeWisdom
  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

instance (ASTLore lore, CanBeWise (Op lore)) => ASTLore (Wise lore) where
  expTypesFromPattern :: Pattern (Wise lore) -> m [BranchType (Wise lore)]
expTypesFromPattern =
    ReaderT (Scope lore) m [BranchType lore] -> m [BranchType lore]
forall lore (m :: * -> *) a.
(HasScope (Wise lore) m, Monad m) =>
ReaderT (Scope lore) m a -> m a
withoutWisdom (ReaderT (Scope lore) m [BranchType lore] -> m [BranchType lore])
-> (PatternT (VarWisdom, LetDec lore)
    -> ReaderT (Scope lore) m [BranchType lore])
-> PatternT (VarWisdom, LetDec lore)
-> m [BranchType lore]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 (VarWisdom, LetDec lore) -> PatternT (LetDec lore))
-> PatternT (VarWisdom, LetDec lore)
-> ReaderT (Scope lore) m [BranchType lore]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. PatternT (VarWisdom, LetDec lore) -> PatternT (LetDec lore)
forall a. PatternT (VarWisdom, a) -> PatternT a
removePatternWisdom

instance PrettyAnnot (PatElemT dec) => PrettyAnnot (PatElemT (VarWisdom, dec)) where
  ppAnnot :: PatElemT (VarWisdom, dec) -> Maybe Doc
ppAnnot = PatElemT dec -> Maybe Doc
forall a. PrettyAnnot a => a -> Maybe Doc
ppAnnot (PatElemT dec -> Maybe Doc)
-> (PatElemT (VarWisdom, dec) -> PatElemT dec)
-> PatElemT (VarWisdom, dec)
-> Maybe Doc
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((VarWisdom, dec) -> dec)
-> PatElemT (VarWisdom, dec) -> PatElemT dec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (VarWisdom, dec) -> dec
forall a b. (a, b) -> b
snd

instance (PrettyLore lore, CanBeWise (Op lore)) => PrettyLore (Wise lore) where
  ppExpLore :: ExpDec (Wise lore) -> Exp (Wise lore) -> Maybe Doc
ppExpLore (_, dec) = ExpDec lore -> Exp lore -> Maybe Doc
forall lore.
PrettyLore lore =>
ExpDec lore -> Exp lore -> Maybe Doc
ppExpLore ExpDec lore
dec (Exp lore -> Maybe Doc)
-> (Exp (Wise lore) -> Exp lore) -> Exp (Wise lore) -> Maybe Doc
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Exp (Wise lore) -> Exp lore
forall lore. CanBeWise (Op lore) => Exp (Wise lore) -> Exp lore
removeExpWisdom

instance AliasesOf (VarWisdom, dec) where
  aliasesOf :: (VarWisdom, dec) -> Names
aliasesOf = VarAliases -> Names
unAliases (VarAliases -> Names)
-> ((VarWisdom, dec) -> VarAliases) -> (VarWisdom, dec) -> Names
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. VarWisdom -> VarAliases
varWisdomAliases (VarWisdom -> VarAliases)
-> ((VarWisdom, dec) -> VarWisdom)
-> (VarWisdom, dec)
-> VarAliases
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (VarWisdom, dec) -> VarWisdom
forall a b. (a, b) -> a
fst

instance (ASTLore lore, CanBeWise (Op lore)) => Aliased (Wise lore) where
  bodyAliases :: Body (Wise lore) -> [Names]
bodyAliases = (VarAliases -> Names) -> [VarAliases] -> [Names]
forall a b. (a -> b) -> [a] -> [b]
map VarAliases -> Names
unAliases ([VarAliases] -> [Names])
-> (Body (Wise lore) -> [VarAliases])
-> Body (Wise lore)
-> [Names]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BodyWisdom -> [VarAliases]
bodyWisdomAliases (BodyWisdom -> [VarAliases])
-> (Body (Wise lore) -> BodyWisdom)
-> Body (Wise lore)
-> [VarAliases]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (BodyWisdom, BodyDec lore) -> BodyWisdom
forall a b. (a, b) -> a
fst ((BodyWisdom, BodyDec lore) -> BodyWisdom)
-> (Body (Wise lore) -> (BodyWisdom, BodyDec lore))
-> Body (Wise lore)
-> BodyWisdom
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Body (Wise lore) -> (BodyWisdom, BodyDec lore)
forall lore. BodyT lore -> BodyDec lore
bodyDec
  consumedInBody :: Body (Wise lore) -> Names
consumedInBody = VarAliases -> Names
unAliases (VarAliases -> Names)
-> (Body (Wise lore) -> VarAliases) -> Body (Wise lore) -> Names
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BodyWisdom -> VarAliases
bodyWisdomConsumed (BodyWisdom -> VarAliases)
-> (Body (Wise lore) -> BodyWisdom)
-> Body (Wise lore)
-> VarAliases
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (BodyWisdom, BodyDec lore) -> BodyWisdom
forall a b. (a, b) -> a
fst ((BodyWisdom, BodyDec lore) -> BodyWisdom)
-> (Body (Wise lore) -> (BodyWisdom, BodyDec lore))
-> Body (Wise lore)
-> BodyWisdom
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Body (Wise lore) -> (BodyWisdom, BodyDec lore)
forall lore. BodyT lore -> BodyDec lore
bodyDec

removeWisdom :: CanBeWise (Op lore) => Rephraser Identity (Wise lore) lore
removeWisdom :: Rephraser Identity (Wise lore) lore
removeWisdom =
  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 (Wise lore) -> Identity (ExpDec lore)
rephraseExpLore = ExpDec lore -> Identity (ExpDec lore)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExpDec lore -> Identity (ExpDec lore))
-> ((ExpWisdom, ExpDec lore) -> ExpDec lore)
-> (ExpWisdom, ExpDec lore)
-> Identity (ExpDec lore)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (ExpWisdom, ExpDec lore) -> ExpDec lore
forall a b. (a, b) -> b
snd,
      rephraseLetBoundLore :: LetDec (Wise lore) -> Identity (LetDec lore)
rephraseLetBoundLore = LetDec lore -> Identity (LetDec lore)
forall (m :: * -> *) a. Monad m => a -> m a
return (LetDec lore -> Identity (LetDec lore))
-> ((VarWisdom, LetDec lore) -> LetDec lore)
-> (VarWisdom, LetDec lore)
-> Identity (LetDec lore)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (VarWisdom, LetDec lore) -> LetDec lore
forall a b. (a, b) -> b
snd,
      rephraseBodyLore :: BodyDec (Wise lore) -> Identity (BodyDec lore)
rephraseBodyLore = BodyDec lore -> Identity (BodyDec lore)
forall (m :: * -> *) a. Monad m => a -> m a
return (BodyDec lore -> Identity (BodyDec lore))
-> ((BodyWisdom, BodyDec lore) -> BodyDec lore)
-> (BodyWisdom, BodyDec lore)
-> Identity (BodyDec lore)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (BodyWisdom, BodyDec lore) -> BodyDec lore
forall a b. (a, b) -> b
snd,
      rephraseFParamLore :: FParamInfo (Wise lore) -> Identity (FParamInfo lore)
rephraseFParamLore = FParamInfo (Wise lore) -> Identity (FParamInfo lore)
forall (m :: * -> *) a. Monad m => a -> m a
return,
      rephraseLParamLore :: LParamInfo (Wise lore) -> Identity (LParamInfo lore)
rephraseLParamLore = LParamInfo (Wise lore) -> Identity (LParamInfo lore)
forall (m :: * -> *) a. Monad m => a -> m a
return,
      rephraseRetType :: RetType (Wise lore) -> Identity (RetType lore)
rephraseRetType = RetType (Wise lore) -> Identity (RetType lore)
forall (m :: * -> *) a. Monad m => a -> m a
return,
      rephraseBranchType :: BranchType (Wise lore) -> Identity (BranchType lore)
rephraseBranchType = BranchType (Wise lore) -> Identity (BranchType lore)
forall (m :: * -> *) a. Monad m => a -> m a
return,
      rephraseOp :: Op (Wise lore) -> Identity (Op lore)
rephraseOp = Op lore -> Identity (Op lore)
forall (m :: * -> *) a. Monad m => a -> m a
return (Op lore -> Identity (Op lore))
-> (OpWithWisdom (Op lore) -> Op lore)
-> OpWithWisdom (Op lore)
-> Identity (Op lore)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. OpWithWisdom (Op lore) -> Op lore
forall op. CanBeWise op => OpWithWisdom op -> op
removeOpWisdom
    }

removeScopeWisdom :: Scope (Wise lore) -> Scope lore
removeScopeWisdom :: Scope (Wise lore) -> Scope lore
removeScopeWisdom = (NameInfo (Wise lore) -> NameInfo lore)
-> Scope (Wise lore) -> Scope lore
forall a b k. (a -> b) -> Map k a -> Map k b
M.map NameInfo (Wise lore) -> NameInfo lore
forall lore a lore.
(LetDec lore ~ (a, LetDec lore), FParamInfo lore ~ FParamInfo lore,
 LParamInfo lore ~ LParamInfo lore) =>
NameInfo lore -> NameInfo lore
unAlias
  where
    unAlias :: NameInfo lore -> NameInfo lore
unAlias (LetName (_, dec)) = LetDec lore -> NameInfo lore
forall lore. LetDec lore -> NameInfo lore
LetName LetDec lore
dec
    unAlias (FParamName FParamInfo lore
dec) = FParamInfo lore -> NameInfo lore
forall lore. FParamInfo lore -> NameInfo lore
FParamName FParamInfo lore
FParamInfo lore
dec
    unAlias (LParamName LParamInfo lore
dec) = LParamInfo lore -> NameInfo lore
forall lore. LParamInfo lore -> NameInfo lore
LParamName LParamInfo lore
LParamInfo lore
dec
    unAlias (IndexName IntType
it) = IntType -> NameInfo lore
forall lore. IntType -> NameInfo lore
IndexName IntType
it

addScopeWisdom :: Scope lore -> Scope (Wise lore)
addScopeWisdom :: Scope lore -> Scope (Wise lore)
addScopeWisdom = (NameInfo lore -> NameInfo (Wise lore))
-> Scope lore -> Scope (Wise lore)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map NameInfo lore -> NameInfo (Wise lore)
forall lore lore.
(LetDec lore ~ (VarWisdom, LetDec lore),
 FParamInfo lore ~ FParamInfo lore,
 LParamInfo lore ~ LParamInfo lore) =>
NameInfo lore -> NameInfo lore
alias
  where
    alias :: NameInfo lore -> NameInfo lore
alias (LetName LetDec lore
dec) = LetDec lore -> NameInfo lore
forall lore. LetDec lore -> NameInfo lore
LetName (VarAliases -> VarWisdom
VarWisdom VarAliases
forall a. Monoid a => a
mempty, LetDec lore
dec)
    alias (FParamName FParamInfo lore
dec) = FParamInfo lore -> NameInfo lore
forall lore. FParamInfo lore -> NameInfo lore
FParamName FParamInfo lore
FParamInfo lore
dec
    alias (LParamName LParamInfo lore
dec) = LParamInfo lore -> NameInfo lore
forall lore. LParamInfo lore -> NameInfo lore
LParamName LParamInfo lore
LParamInfo lore
dec
    alias (IndexName IntType
it) = IntType -> NameInfo lore
forall lore. IntType -> NameInfo lore
IndexName IntType
it

removeFunDefWisdom :: CanBeWise (Op lore) => FunDef (Wise lore) -> FunDef lore
removeFunDefWisdom :: FunDef (Wise lore) -> FunDef lore
removeFunDefWisdom = Identity (FunDef lore) -> FunDef lore
forall a. Identity a -> a
runIdentity (Identity (FunDef lore) -> FunDef lore)
-> (FunDef (Wise lore) -> Identity (FunDef lore))
-> FunDef (Wise lore)
-> FunDef lore
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rephraser Identity (Wise lore) lore
-> FunDef (Wise lore) -> Identity (FunDef lore)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> FunDef from -> m (FunDef to)
rephraseFunDef Rephraser Identity (Wise lore) lore
forall lore.
CanBeWise (Op lore) =>
Rephraser Identity (Wise lore) lore
removeWisdom

removeStmWisdom :: CanBeWise (Op lore) => Stm (Wise lore) -> Stm lore
removeStmWisdom :: Stm (Wise lore) -> Stm lore
removeStmWisdom = Identity (Stm lore) -> Stm lore
forall a. Identity a -> a
runIdentity (Identity (Stm lore) -> Stm lore)
-> (Stm (Wise lore) -> Identity (Stm lore))
-> Stm (Wise lore)
-> Stm lore
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rephraser Identity (Wise lore) lore
-> Stm (Wise lore) -> Identity (Stm lore)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> Stm from -> m (Stm to)
rephraseStm Rephraser Identity (Wise lore) lore
forall lore.
CanBeWise (Op lore) =>
Rephraser Identity (Wise lore) lore
removeWisdom

removeLambdaWisdom :: CanBeWise (Op lore) => Lambda (Wise lore) -> Lambda lore
removeLambdaWisdom :: Lambda (Wise lore) -> Lambda lore
removeLambdaWisdom = Identity (Lambda lore) -> Lambda lore
forall a. Identity a -> a
runIdentity (Identity (Lambda lore) -> Lambda lore)
-> (Lambda (Wise lore) -> Identity (Lambda lore))
-> Lambda (Wise lore)
-> Lambda lore
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rephraser Identity (Wise lore) lore
-> Lambda (Wise lore) -> Identity (Lambda lore)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> Lambda from -> m (Lambda to)
rephraseLambda Rephraser Identity (Wise lore) lore
forall lore.
CanBeWise (Op lore) =>
Rephraser Identity (Wise lore) lore
removeWisdom

removeBodyWisdom :: CanBeWise (Op lore) => Body (Wise lore) -> Body lore
removeBodyWisdom :: Body (Wise lore) -> Body lore
removeBodyWisdom = Identity (Body lore) -> Body lore
forall a. Identity a -> a
runIdentity (Identity (Body lore) -> Body lore)
-> (Body (Wise lore) -> Identity (Body lore))
-> Body (Wise lore)
-> Body lore
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rephraser Identity (Wise lore) lore
-> Body (Wise lore) -> Identity (Body lore)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> Body from -> m (Body to)
rephraseBody Rephraser Identity (Wise lore) lore
forall lore.
CanBeWise (Op lore) =>
Rephraser Identity (Wise lore) lore
removeWisdom

removeExpWisdom :: CanBeWise (Op lore) => Exp (Wise lore) -> Exp lore
removeExpWisdom :: Exp (Wise lore) -> Exp lore
removeExpWisdom = Identity (Exp lore) -> Exp lore
forall a. Identity a -> a
runIdentity (Identity (Exp lore) -> Exp lore)
-> (Exp (Wise lore) -> Identity (Exp lore))
-> Exp (Wise lore)
-> Exp lore
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rephraser Identity (Wise lore) lore
-> Exp (Wise lore) -> Identity (Exp lore)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> Exp from -> m (Exp to)
rephraseExp Rephraser Identity (Wise lore) lore
forall lore.
CanBeWise (Op lore) =>
Rephraser Identity (Wise lore) lore
removeWisdom

removePatternWisdom :: PatternT (VarWisdom, a) -> PatternT a
removePatternWisdom :: PatternT (VarWisdom, a) -> PatternT a
removePatternWisdom = Identity (PatternT a) -> PatternT a
forall a. Identity a -> a
runIdentity (Identity (PatternT a) -> PatternT a)
-> (PatternT (VarWisdom, a) -> Identity (PatternT a))
-> PatternT (VarWisdom, a)
-> PatternT a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((VarWisdom, a) -> Identity a)
-> PatternT (VarWisdom, 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)
-> ((VarWisdom, a) -> a) -> (VarWisdom, a) -> Identity a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (VarWisdom, a) -> a
forall a b. (a, b) -> b
snd)

addWisdomToPattern ::
  (ASTLore lore, CanBeWise (Op lore)) =>
  Pattern lore ->
  Exp (Wise lore) ->
  Pattern (Wise lore)
addWisdomToPattern :: Pattern lore -> Exp (Wise lore) -> Pattern (Wise lore)
addWisdomToPattern Pattern lore
pat Exp (Wise lore)
e =
  [PatElemT (VarWisdom, LetDec lore)]
-> [PatElemT (VarWisdom, LetDec lore)]
-> PatternT (VarWisdom, LetDec lore)
forall dec. [PatElemT dec] -> [PatElemT dec] -> PatternT dec
Pattern ((PatElemT (VarAliases, LetDec lore)
 -> PatElemT (VarWisdom, LetDec lore))
-> [PatElemT (VarAliases, LetDec lore)]
-> [PatElemT (VarWisdom, LetDec lore)]
forall a b. (a -> b) -> [a] -> [b]
map PatElemT (VarAliases, LetDec lore)
-> PatElemT (VarWisdom, LetDec lore)
forall b. PatElemT (VarAliases, b) -> PatElemT (VarWisdom, b)
f [PatElemT (VarAliases, LetDec lore)]
ctx) ((PatElemT (VarAliases, LetDec lore)
 -> PatElemT (VarWisdom, LetDec lore))
-> [PatElemT (VarAliases, LetDec lore)]
-> [PatElemT (VarWisdom, LetDec lore)]
forall a b. (a -> b) -> [a] -> [b]
map PatElemT (VarAliases, LetDec lore)
-> PatElemT (VarWisdom, LetDec lore)
forall b. PatElemT (VarAliases, b) -> PatElemT (VarWisdom, b)
f [PatElemT (VarAliases, LetDec lore)]
val)
  where
    ([PatElemT (VarAliases, LetDec lore)]
ctx, [PatElemT (VarAliases, LetDec lore)]
val) = Pattern lore
-> Exp (Wise lore)
-> ([PatElemT (VarAliases, LetDec lore)],
    [PatElemT (VarAliases, LetDec lore)])
forall lore dec.
(Aliased lore, Typed dec) =>
PatternT dec
-> Exp lore
-> ([PatElemT (VarAliases, dec)], [PatElemT (VarAliases, dec)])
Aliases.mkPatternAliases Pattern lore
pat Exp (Wise lore)
e
    f :: PatElemT (VarAliases, b) -> PatElemT (VarWisdom, b)
f PatElemT (VarAliases, b)
pe =
      let (VarAliases
als, b
dec) = PatElemT (VarAliases, b) -> (VarAliases, b)
forall dec. PatElemT dec -> dec
patElemDec PatElemT (VarAliases, b)
pe
       in PatElemT (VarAliases, b)
pe PatElemT (VarAliases, b)
-> (VarWisdom, b) -> PatElemT (VarWisdom, b)
forall oldattr newattr.
PatElemT oldattr -> newattr -> PatElemT newattr
`setPatElemLore` (VarAliases -> VarWisdom
VarWisdom VarAliases
als, b
dec)

mkWiseBody ::
  (ASTLore lore, CanBeWise (Op lore)) =>
  BodyDec lore ->
  Stms (Wise lore) ->
  Result ->
  Body (Wise lore)
mkWiseBody :: BodyDec lore -> Stms (Wise lore) -> Result -> Body (Wise lore)
mkWiseBody BodyDec lore
innerlore Stms (Wise lore)
bnds Result
res =
  BodyDec (Wise lore)
-> Stms (Wise lore) -> Result -> Body (Wise lore)
forall lore. BodyDec lore -> Stms lore -> Result -> BodyT lore
Body
    ( [VarAliases] -> VarAliases -> VarAliases -> BodyWisdom
BodyWisdom [VarAliases]
aliases VarAliases
consumed (Names -> VarAliases
AliasDec (Names -> VarAliases) -> Names -> VarAliases
forall a b. (a -> b) -> a -> b
$ FV -> Names
forall a. FreeIn a => a -> Names
freeIn (FV -> Names) -> FV -> Names
forall a b. (a -> b) -> a -> b
$ Stms (Wise lore) -> Result -> FV
forall lore.
(FreeIn (Op lore), FreeIn (LetDec lore), FreeIn (LParamInfo lore),
 FreeIn (FParamInfo lore), FreeDec (BodyDec lore),
 FreeDec (ExpDec lore)) =>
Stms lore -> Result -> FV
freeInStmsAndRes Stms (Wise lore)
bnds Result
res),
      BodyDec lore
innerlore
    )
    Stms (Wise lore)
bnds
    Result
res
  where
    ([VarAliases]
aliases, VarAliases
consumed) = Stms (Wise lore) -> Result -> ([VarAliases], VarAliases)
forall lore.
Aliased lore =>
Stms lore -> Result -> ([VarAliases], VarAliases)
Aliases.mkBodyAliases Stms (Wise lore)
bnds Result
res

mkWiseLetStm ::
  (ASTLore lore, CanBeWise (Op lore)) =>
  Pattern lore ->
  StmAux (ExpDec lore) ->
  Exp (Wise lore) ->
  Stm (Wise lore)
mkWiseLetStm :: Pattern lore
-> StmAux (ExpDec lore) -> Exp (Wise lore) -> Stm (Wise lore)
mkWiseLetStm Pattern lore
pat (StmAux Certificates
cs Attrs
attrs ExpDec lore
dec) Exp (Wise lore)
e =
  let pat' :: Pattern (Wise lore)
pat' = Pattern lore -> Exp (Wise lore) -> Pattern (Wise lore)
forall lore.
(ASTLore lore, CanBeWise (Op lore)) =>
Pattern lore -> Exp (Wise lore) -> Pattern (Wise lore)
addWisdomToPattern Pattern lore
pat Exp (Wise lore)
e
   in Pattern (Wise lore)
-> StmAux (ExpDec (Wise lore))
-> Exp (Wise lore)
-> Stm (Wise lore)
forall lore.
Pattern lore -> StmAux (ExpDec lore) -> Exp lore -> Stm lore
Let Pattern (Wise lore)
pat' (Certificates
-> Attrs
-> (ExpWisdom, ExpDec lore)
-> StmAux (ExpWisdom, ExpDec lore)
forall dec. Certificates -> Attrs -> dec -> StmAux dec
StmAux Certificates
cs Attrs
attrs ((ExpWisdom, ExpDec lore) -> StmAux (ExpWisdom, ExpDec lore))
-> (ExpWisdom, ExpDec lore) -> StmAux (ExpWisdom, ExpDec lore)
forall a b. (a -> b) -> a -> b
$ Pattern (Wise lore)
-> ExpDec lore -> Exp (Wise lore) -> ExpDec (Wise lore)
forall lore.
(ASTLore lore, CanBeWise (Op lore)) =>
Pattern (Wise lore)
-> ExpDec lore -> Exp (Wise lore) -> ExpDec (Wise lore)
mkWiseExpDec Pattern (Wise lore)
pat' ExpDec lore
dec Exp (Wise lore)
e) Exp (Wise lore)
e

mkWiseExpDec ::
  (ASTLore lore, CanBeWise (Op lore)) =>
  Pattern (Wise lore) ->
  ExpDec lore ->
  Exp (Wise lore) ->
  ExpDec (Wise lore)
mkWiseExpDec :: Pattern (Wise lore)
-> ExpDec lore -> Exp (Wise lore) -> ExpDec (Wise lore)
mkWiseExpDec Pattern (Wise lore)
pat ExpDec lore
explore Exp (Wise lore)
e =
  ( VarAliases -> VarAliases -> ExpWisdom
ExpWisdom
      (Names -> VarAliases
AliasDec (Names -> VarAliases) -> Names -> VarAliases
forall a b. (a -> b) -> a -> b
$ Exp (Wise lore) -> Names
forall lore. Aliased lore => Exp lore -> Names
consumedInExp Exp (Wise lore)
e)
      (Names -> VarAliases
AliasDec (Names -> VarAliases) -> Names -> VarAliases
forall a b. (a -> b) -> a -> b
$ PatternT (VarWisdom, LetDec lore) -> Names
forall a. FreeIn a => a -> Names
freeIn PatternT (VarWisdom, LetDec lore)
Pattern (Wise lore)
pat Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> ExpDec lore -> Names
forall a. FreeIn a => a -> Names
freeIn ExpDec lore
explore Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> Exp (Wise lore) -> Names
forall a. FreeIn a => a -> Names
freeIn Exp (Wise lore)
e),
    ExpDec lore
explore
  )

instance
  ( Bindable lore,
    CanBeWise (Op lore)
  ) =>
  Bindable (Wise lore)
  where
  mkExpPat :: [Ident] -> [Ident] -> Exp (Wise lore) -> Pattern (Wise lore)
mkExpPat [Ident]
ctx [Ident]
val Exp (Wise lore)
e =
    Pattern lore -> Exp (Wise lore) -> Pattern (Wise lore)
forall lore.
(ASTLore lore, CanBeWise (Op lore)) =>
Pattern lore -> Exp (Wise lore) -> Pattern (Wise lore)
addWisdomToPattern ([Ident] -> [Ident] -> Exp lore -> Pattern lore
forall lore.
Bindable lore =>
[Ident] -> [Ident] -> Exp lore -> Pattern lore
mkExpPat [Ident]
ctx [Ident]
val (Exp lore -> Pattern lore) -> Exp lore -> Pattern lore
forall a b. (a -> b) -> a -> b
$ Exp (Wise lore) -> Exp lore
forall lore. CanBeWise (Op lore) => Exp (Wise lore) -> Exp lore
removeExpWisdom Exp (Wise lore)
e) Exp (Wise lore)
e

  mkExpDec :: Pattern (Wise lore) -> Exp (Wise lore) -> ExpDec (Wise lore)
mkExpDec Pattern (Wise lore)
pat Exp (Wise lore)
e =
    Pattern (Wise lore)
-> ExpDec lore -> Exp (Wise lore) -> ExpDec (Wise lore)
forall lore.
(ASTLore lore, CanBeWise (Op lore)) =>
Pattern (Wise lore)
-> ExpDec lore -> Exp (Wise lore) -> ExpDec (Wise lore)
mkWiseExpDec Pattern (Wise lore)
pat (Pattern lore -> Exp lore -> ExpDec lore
forall lore.
Bindable lore =>
Pattern lore -> Exp lore -> ExpDec lore
mkExpDec (PatternT (VarWisdom, LetDec lore) -> Pattern lore
forall a. PatternT (VarWisdom, a) -> PatternT a
removePatternWisdom PatternT (VarWisdom, LetDec lore)
Pattern (Wise lore)
pat) (Exp lore -> ExpDec lore) -> Exp lore -> ExpDec lore
forall a b. (a -> b) -> a -> b
$ Exp (Wise lore) -> Exp lore
forall lore. CanBeWise (Op lore) => Exp (Wise lore) -> Exp lore
removeExpWisdom Exp (Wise lore)
e) Exp (Wise lore)
e

  mkLetNames :: [VName] -> Exp (Wise lore) -> m (Stm (Wise lore))
mkLetNames [VName]
names Exp (Wise lore)
e = do
    Scope lore
env <- (Scope (Wise lore) -> Scope lore) -> m (Scope lore)
forall lore (m :: * -> *) a.
HasScope lore m =>
(Scope lore -> a) -> m a
asksScope Scope (Wise lore) -> Scope lore
forall lore. Scope (Wise lore) -> Scope lore
removeScopeWisdom
    (ReaderT (Scope lore) m (Stm (Wise lore))
 -> Scope lore -> m (Stm (Wise lore)))
-> Scope lore
-> ReaderT (Scope lore) m (Stm (Wise lore))
-> m (Stm (Wise lore))
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (Scope lore) m (Stm (Wise lore))
-> Scope lore -> m (Stm (Wise lore))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Scope lore
env (ReaderT (Scope lore) m (Stm (Wise lore)) -> m (Stm (Wise lore)))
-> ReaderT (Scope lore) m (Stm (Wise lore)) -> m (Stm (Wise lore))
forall a b. (a -> b) -> a -> b
$ do
      Let Pattern lore
pat StmAux (ExpDec lore)
dec Exp lore
_ <- [VName] -> Exp lore -> ReaderT (Scope lore) m (Stm lore)
forall lore (m :: * -> *).
(Bindable lore, MonadFreshNames m, HasScope lore m) =>
[VName] -> Exp lore -> m (Stm lore)
mkLetNames [VName]
names (Exp lore -> ReaderT (Scope lore) m (Stm lore))
-> Exp lore -> ReaderT (Scope lore) m (Stm lore)
forall a b. (a -> b) -> a -> b
$ Exp (Wise lore) -> Exp lore
forall lore. CanBeWise (Op lore) => Exp (Wise lore) -> Exp lore
removeExpWisdom Exp (Wise lore)
e
      Stm (Wise lore) -> ReaderT (Scope lore) m (Stm (Wise lore))
forall (m :: * -> *) a. Monad m => a -> m a
return (Stm (Wise lore) -> ReaderT (Scope lore) m (Stm (Wise lore)))
-> Stm (Wise lore) -> ReaderT (Scope lore) m (Stm (Wise lore))
forall a b. (a -> b) -> a -> b
$ Pattern lore
-> StmAux (ExpDec lore) -> Exp (Wise lore) -> Stm (Wise lore)
forall lore.
(ASTLore lore, CanBeWise (Op lore)) =>
Pattern lore
-> StmAux (ExpDec lore) -> Exp (Wise lore) -> Stm (Wise lore)
mkWiseLetStm Pattern lore
pat StmAux (ExpDec lore)
dec Exp (Wise lore)
e

  mkBody :: Stms (Wise lore) -> Result -> Body (Wise lore)
mkBody Stms (Wise lore)
bnds Result
res =
    let Body BodyDec lore
bodylore Stms lore
_ Result
_ = Stms lore -> Result -> BodyT lore
forall lore. Bindable lore => Stms lore -> Result -> Body lore
mkBody ((Stm (Wise lore) -> Stm lore) -> Stms (Wise lore) -> Stms lore
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stm (Wise lore) -> Stm lore
forall lore. CanBeWise (Op lore) => Stm (Wise lore) -> Stm lore
removeStmWisdom Stms (Wise lore)
bnds) Result
res
     in BodyDec lore -> Stms (Wise lore) -> Result -> Body (Wise lore)
forall lore.
(ASTLore lore, CanBeWise (Op lore)) =>
BodyDec lore -> Stms (Wise lore) -> Result -> Body (Wise lore)
mkWiseBody BodyDec lore
bodylore Stms (Wise lore)
bnds Result
res

class
  ( AliasedOp (OpWithWisdom op),
    IsOp (OpWithWisdom op)
  ) =>
  CanBeWise op
  where
  type OpWithWisdom op :: Data.Kind.Type
  removeOpWisdom :: OpWithWisdom op -> op

instance CanBeWise () where
  type OpWithWisdom () = ()
  removeOpWisdom :: OpWithWisdom () -> ()
removeOpWisdom () = ()