-- | Algorithm to infer csound rates. It's type inference for Csound.
--
-- It proceeds from epxression leaves to the top of the expression tree while assigning the rates.
-- The expression is DAG defined as list which is sorted by dependencies from bottom to top.
--
-- We traverse over the list and assign types to the terms.
-- Assumptions:
--
--  * type of primitive values is Ir or Sr
--  * type of numeric expression is minimal type of it's arguments
--
--  * type of opcode is determined by the choice of the most fit signature to the arguments
--     unless it's required by the user to be of specific type.
--     We try to find the signature that leads to lesser amount of destructive conversions overall.
--
--  * If-then-else type:
--      * for condition it is derived form ifRate in the argument of If-constructor
--      * the output is a minimum of types of the branches
--
--  * procedures' output is asssigned with Xr type
--
--  Note on type ordering they go in order of definition from amount of memory used:
--   Xr | Ar | Kr | Ir
--
--   So the Ar is the minimum
module Csound.Dynamic.Tfm.InferTypes
  ( inferTypes
  , InferenceOptions (..)
  , InferenceResult (..)
  , OpcodeInferenceStrategy (..)
  , Stmt(..)
  , Var(..)
  ) where

import Safe
import Control.Monad (zipWithM, foldM)
import Data.Semigroup (Min(..))
import Data.List qualified as List
import Control.Monad.Trans.State.Strict
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.ByteString (ByteString)
import Data.Default
import Data.HashSet (HashSet)
import Data.HashSet qualified as HashSet
import Data.Vector.Mutable (STVector)
import Data.Vector.Mutable qualified as Vector
import Control.Monad.ST
import Data.Maybe (fromMaybe)
import Data.IntMap (IntMap)
import Data.IntMap qualified as IntMap
import Data.Text qualified as Text

import Csound.Dynamic.Const qualified as Const
import Csound.Dynamic.Types.Exp hiding (Var, varType)
import Csound.Dynamic.Types.Exp qualified as Exp
-- import Debug.Trace (trace)

-- core types

data Stmt a = Stmt
  { forall a. Stmt a -> a
stmtLhs :: !a
  , forall a. Stmt a -> RatedExp a
stmtRhs :: !(RatedExp a)
  }
  deriving (Int -> Stmt a -> ShowS
[Stmt a] -> ShowS
Stmt a -> String
(Int -> Stmt a -> ShowS)
-> (Stmt a -> String) -> ([Stmt a] -> ShowS) -> Show (Stmt a)
forall a. Show a => Int -> Stmt a -> ShowS
forall a. Show a => [Stmt a] -> ShowS
forall a. Show a => Stmt a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Stmt a -> ShowS
showsPrec :: Int -> Stmt a -> ShowS
$cshow :: forall a. Show a => Stmt a -> String
show :: Stmt a -> String
$cshowList :: forall a. Show a => [Stmt a] -> ShowS
showList :: [Stmt a] -> ShowS
Show, Stmt a -> Stmt a -> Bool
(Stmt a -> Stmt a -> Bool)
-> (Stmt a -> Stmt a -> Bool) -> Eq (Stmt a)
forall a. Eq a => Stmt a -> Stmt a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Stmt a -> Stmt a -> Bool
== :: Stmt a -> Stmt a -> Bool
$c/= :: forall a. Eq a => Stmt a -> Stmt a -> Bool
/= :: Stmt a -> Stmt a -> Bool
Eq, Eq (Stmt a)
Eq (Stmt a) =>
(Stmt a -> Stmt a -> Ordering)
-> (Stmt a -> Stmt a -> Bool)
-> (Stmt a -> Stmt a -> Bool)
-> (Stmt a -> Stmt a -> Bool)
-> (Stmt a -> Stmt a -> Bool)
-> (Stmt a -> Stmt a -> Stmt a)
-> (Stmt a -> Stmt a -> Stmt a)
-> Ord (Stmt a)
Stmt a -> Stmt a -> Bool
Stmt a -> Stmt a -> Ordering
Stmt a -> Stmt a -> Stmt a
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
forall a. Ord a => Eq (Stmt a)
forall a. Ord a => Stmt a -> Stmt a -> Bool
forall a. Ord a => Stmt a -> Stmt a -> Ordering
forall a. Ord a => Stmt a -> Stmt a -> Stmt a
$ccompare :: forall a. Ord a => Stmt a -> Stmt a -> Ordering
compare :: Stmt a -> Stmt a -> Ordering
$c< :: forall a. Ord a => Stmt a -> Stmt a -> Bool
< :: Stmt a -> Stmt a -> Bool
$c<= :: forall a. Ord a => Stmt a -> Stmt a -> Bool
<= :: Stmt a -> Stmt a -> Bool
$c> :: forall a. Ord a => Stmt a -> Stmt a -> Bool
> :: Stmt a -> Stmt a -> Bool
$c>= :: forall a. Ord a => Stmt a -> Stmt a -> Bool
>= :: Stmt a -> Stmt a -> Bool
$cmax :: forall a. Ord a => Stmt a -> Stmt a -> Stmt a
max :: Stmt a -> Stmt a -> Stmt a
$cmin :: forall a. Ord a => Stmt a -> Stmt a -> Stmt a
min :: Stmt a -> Stmt a -> Stmt a
Ord)

data Var = Var
  { Var -> Rate
varType :: !Rate
  , Var -> Int
varId   :: !Int
  }
  deriving (Int -> Var -> ShowS
[Var] -> ShowS
Var -> String
(Int -> Var -> ShowS)
-> (Var -> String) -> ([Var] -> ShowS) -> Show Var
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Var -> ShowS
showsPrec :: Int -> Var -> ShowS
$cshow :: Var -> String
show :: Var -> String
$cshowList :: [Var] -> ShowS
showList :: [Var] -> ShowS
Show, Var -> Var -> Bool
(Var -> Var -> Bool) -> (Var -> Var -> Bool) -> Eq Var
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Var -> Var -> Bool
== :: Var -> Var -> Bool
$c/= :: Var -> Var -> Bool
/= :: Var -> Var -> Bool
Eq, Eq Var
Eq Var =>
(Var -> Var -> Ordering)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Var)
-> (Var -> Var -> Var)
-> Ord Var
Var -> Var -> Bool
Var -> Var -> Ordering
Var -> Var -> Var
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
$ccompare :: Var -> Var -> Ordering
compare :: Var -> Var -> Ordering
$c< :: Var -> Var -> Bool
< :: Var -> Var -> Bool
$c<= :: Var -> Var -> Bool
<= :: Var -> Var -> Bool
$c> :: Var -> Var -> Bool
> :: Var -> Var -> Bool
$c>= :: Var -> Var -> Bool
>= :: Var -> Var -> Bool
$cmax :: Var -> Var -> Var
max :: Var -> Var -> Var
$cmin :: Var -> Var -> Var
min :: Var -> Var -> Var
Ord)

data InferenceResult = InferenceResult
  { InferenceResult -> [Stmt Var]
typedProgram       :: ![Stmt Var]
  , InferenceResult -> Int
programLastFreshId :: !Int
  , InferenceResult -> Bool
programHasIfs      :: !Bool
      -- ^ does program has if-statemenrs
      -- we need it for the next optimization stage
  }

-- option types

data InferenceOptions = InferenceOptions
  { InferenceOptions -> OpcodeInferenceStrategy
opcodeInferenceStrategy    :: !OpcodeInferenceStrategy
  , InferenceOptions -> OpcodeInferencePreference
opcodeInferencePreference  :: !OpcodeInferencePreference
  }
  deriving (InferenceOptions -> InferenceOptions -> Bool
(InferenceOptions -> InferenceOptions -> Bool)
-> (InferenceOptions -> InferenceOptions -> Bool)
-> Eq InferenceOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InferenceOptions -> InferenceOptions -> Bool
== :: InferenceOptions -> InferenceOptions -> Bool
$c/= :: InferenceOptions -> InferenceOptions -> Bool
/= :: InferenceOptions -> InferenceOptions -> Bool
Eq, Eq InferenceOptions
Eq InferenceOptions =>
(InferenceOptions -> InferenceOptions -> Ordering)
-> (InferenceOptions -> InferenceOptions -> Bool)
-> (InferenceOptions -> InferenceOptions -> Bool)
-> (InferenceOptions -> InferenceOptions -> Bool)
-> (InferenceOptions -> InferenceOptions -> Bool)
-> (InferenceOptions -> InferenceOptions -> InferenceOptions)
-> (InferenceOptions -> InferenceOptions -> InferenceOptions)
-> Ord InferenceOptions
InferenceOptions -> InferenceOptions -> Bool
InferenceOptions -> InferenceOptions -> Ordering
InferenceOptions -> InferenceOptions -> InferenceOptions
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
$ccompare :: InferenceOptions -> InferenceOptions -> Ordering
compare :: InferenceOptions -> InferenceOptions -> Ordering
$c< :: InferenceOptions -> InferenceOptions -> Bool
< :: InferenceOptions -> InferenceOptions -> Bool
$c<= :: InferenceOptions -> InferenceOptions -> Bool
<= :: InferenceOptions -> InferenceOptions -> Bool
$c> :: InferenceOptions -> InferenceOptions -> Bool
> :: InferenceOptions -> InferenceOptions -> Bool
$c>= :: InferenceOptions -> InferenceOptions -> Bool
>= :: InferenceOptions -> InferenceOptions -> Bool
$cmax :: InferenceOptions -> InferenceOptions -> InferenceOptions
max :: InferenceOptions -> InferenceOptions -> InferenceOptions
$cmin :: InferenceOptions -> InferenceOptions -> InferenceOptions
min :: InferenceOptions -> InferenceOptions -> InferenceOptions
Ord, Int -> InferenceOptions -> ShowS
[InferenceOptions] -> ShowS
InferenceOptions -> String
(Int -> InferenceOptions -> ShowS)
-> (InferenceOptions -> String)
-> ([InferenceOptions] -> ShowS)
-> Show InferenceOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InferenceOptions -> ShowS
showsPrec :: Int -> InferenceOptions -> ShowS
$cshow :: InferenceOptions -> String
show :: InferenceOptions -> String
$cshowList :: [InferenceOptions] -> ShowS
showList :: [InferenceOptions] -> ShowS
Show, ReadPrec [InferenceOptions]
ReadPrec InferenceOptions
Int -> ReadS InferenceOptions
ReadS [InferenceOptions]
(Int -> ReadS InferenceOptions)
-> ReadS [InferenceOptions]
-> ReadPrec InferenceOptions
-> ReadPrec [InferenceOptions]
-> Read InferenceOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS InferenceOptions
readsPrec :: Int -> ReadS InferenceOptions
$creadList :: ReadS [InferenceOptions]
readList :: ReadS [InferenceOptions]
$creadPrec :: ReadPrec InferenceOptions
readPrec :: ReadPrec InferenceOptions
$creadListPrec :: ReadPrec [InferenceOptions]
readListPrec :: ReadPrec [InferenceOptions]
Read)

data OpcodeInferenceStrategy
  = PreferControlRate  -- prefer Kr-outputs for opcodes
  | PreferAudioRate    -- prefer Ar-outputs for opcodes
  deriving (OpcodeInferenceStrategy -> OpcodeInferenceStrategy -> Bool
(OpcodeInferenceStrategy -> OpcodeInferenceStrategy -> Bool)
-> (OpcodeInferenceStrategy -> OpcodeInferenceStrategy -> Bool)
-> Eq OpcodeInferenceStrategy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpcodeInferenceStrategy -> OpcodeInferenceStrategy -> Bool
== :: OpcodeInferenceStrategy -> OpcodeInferenceStrategy -> Bool
$c/= :: OpcodeInferenceStrategy -> OpcodeInferenceStrategy -> Bool
/= :: OpcodeInferenceStrategy -> OpcodeInferenceStrategy -> Bool
Eq, Eq OpcodeInferenceStrategy
Eq OpcodeInferenceStrategy =>
(OpcodeInferenceStrategy -> OpcodeInferenceStrategy -> Ordering)
-> (OpcodeInferenceStrategy -> OpcodeInferenceStrategy -> Bool)
-> (OpcodeInferenceStrategy -> OpcodeInferenceStrategy -> Bool)
-> (OpcodeInferenceStrategy -> OpcodeInferenceStrategy -> Bool)
-> (OpcodeInferenceStrategy -> OpcodeInferenceStrategy -> Bool)
-> (OpcodeInferenceStrategy
    -> OpcodeInferenceStrategy -> OpcodeInferenceStrategy)
-> (OpcodeInferenceStrategy
    -> OpcodeInferenceStrategy -> OpcodeInferenceStrategy)
-> Ord OpcodeInferenceStrategy
OpcodeInferenceStrategy -> OpcodeInferenceStrategy -> Bool
OpcodeInferenceStrategy -> OpcodeInferenceStrategy -> Ordering
OpcodeInferenceStrategy
-> OpcodeInferenceStrategy -> OpcodeInferenceStrategy
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
$ccompare :: OpcodeInferenceStrategy -> OpcodeInferenceStrategy -> Ordering
compare :: OpcodeInferenceStrategy -> OpcodeInferenceStrategy -> Ordering
$c< :: OpcodeInferenceStrategy -> OpcodeInferenceStrategy -> Bool
< :: OpcodeInferenceStrategy -> OpcodeInferenceStrategy -> Bool
$c<= :: OpcodeInferenceStrategy -> OpcodeInferenceStrategy -> Bool
<= :: OpcodeInferenceStrategy -> OpcodeInferenceStrategy -> Bool
$c> :: OpcodeInferenceStrategy -> OpcodeInferenceStrategy -> Bool
> :: OpcodeInferenceStrategy -> OpcodeInferenceStrategy -> Bool
$c>= :: OpcodeInferenceStrategy -> OpcodeInferenceStrategy -> Bool
>= :: OpcodeInferenceStrategy -> OpcodeInferenceStrategy -> Bool
$cmax :: OpcodeInferenceStrategy
-> OpcodeInferenceStrategy -> OpcodeInferenceStrategy
max :: OpcodeInferenceStrategy
-> OpcodeInferenceStrategy -> OpcodeInferenceStrategy
$cmin :: OpcodeInferenceStrategy
-> OpcodeInferenceStrategy -> OpcodeInferenceStrategy
min :: OpcodeInferenceStrategy
-> OpcodeInferenceStrategy -> OpcodeInferenceStrategy
Ord, Int -> OpcodeInferenceStrategy -> ShowS
[OpcodeInferenceStrategy] -> ShowS
OpcodeInferenceStrategy -> String
(Int -> OpcodeInferenceStrategy -> ShowS)
-> (OpcodeInferenceStrategy -> String)
-> ([OpcodeInferenceStrategy] -> ShowS)
-> Show OpcodeInferenceStrategy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpcodeInferenceStrategy -> ShowS
showsPrec :: Int -> OpcodeInferenceStrategy -> ShowS
$cshow :: OpcodeInferenceStrategy -> String
show :: OpcodeInferenceStrategy -> String
$cshowList :: [OpcodeInferenceStrategy] -> ShowS
showList :: [OpcodeInferenceStrategy] -> ShowS
Show, ReadPrec [OpcodeInferenceStrategy]
ReadPrec OpcodeInferenceStrategy
Int -> ReadS OpcodeInferenceStrategy
ReadS [OpcodeInferenceStrategy]
(Int -> ReadS OpcodeInferenceStrategy)
-> ReadS [OpcodeInferenceStrategy]
-> ReadPrec OpcodeInferenceStrategy
-> ReadPrec [OpcodeInferenceStrategy]
-> Read OpcodeInferenceStrategy
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS OpcodeInferenceStrategy
readsPrec :: Int -> ReadS OpcodeInferenceStrategy
$creadList :: ReadS [OpcodeInferenceStrategy]
readList :: ReadS [OpcodeInferenceStrategy]
$creadPrec :: ReadPrec OpcodeInferenceStrategy
readPrec :: ReadPrec OpcodeInferenceStrategy
$creadListPrec :: ReadPrec [OpcodeInferenceStrategy]
readListPrec :: ReadPrec [OpcodeInferenceStrategy]
Read)

data OpcodeInferencePreference = OpcodeInferencePreference
  { OpcodeInferencePreference -> HashSet Name
preferControlOpcodes :: HashSet Name  -- ^ set of opcode names to use Kr by default
  , OpcodeInferencePreference -> HashSet Name
preferAudioOpcodes   :: HashSet Name  -- ^ set of opcode names to use Ar by default
  }
  deriving (OpcodeInferencePreference -> OpcodeInferencePreference -> Bool
(OpcodeInferencePreference -> OpcodeInferencePreference -> Bool)
-> (OpcodeInferencePreference -> OpcodeInferencePreference -> Bool)
-> Eq OpcodeInferencePreference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpcodeInferencePreference -> OpcodeInferencePreference -> Bool
== :: OpcodeInferencePreference -> OpcodeInferencePreference -> Bool
$c/= :: OpcodeInferencePreference -> OpcodeInferencePreference -> Bool
/= :: OpcodeInferencePreference -> OpcodeInferencePreference -> Bool
Eq, Eq OpcodeInferencePreference
Eq OpcodeInferencePreference =>
(OpcodeInferencePreference
 -> OpcodeInferencePreference -> Ordering)
-> (OpcodeInferencePreference -> OpcodeInferencePreference -> Bool)
-> (OpcodeInferencePreference -> OpcodeInferencePreference -> Bool)
-> (OpcodeInferencePreference -> OpcodeInferencePreference -> Bool)
-> (OpcodeInferencePreference -> OpcodeInferencePreference -> Bool)
-> (OpcodeInferencePreference
    -> OpcodeInferencePreference -> OpcodeInferencePreference)
-> (OpcodeInferencePreference
    -> OpcodeInferencePreference -> OpcodeInferencePreference)
-> Ord OpcodeInferencePreference
OpcodeInferencePreference -> OpcodeInferencePreference -> Bool
OpcodeInferencePreference -> OpcodeInferencePreference -> Ordering
OpcodeInferencePreference
-> OpcodeInferencePreference -> OpcodeInferencePreference
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
$ccompare :: OpcodeInferencePreference -> OpcodeInferencePreference -> Ordering
compare :: OpcodeInferencePreference -> OpcodeInferencePreference -> Ordering
$c< :: OpcodeInferencePreference -> OpcodeInferencePreference -> Bool
< :: OpcodeInferencePreference -> OpcodeInferencePreference -> Bool
$c<= :: OpcodeInferencePreference -> OpcodeInferencePreference -> Bool
<= :: OpcodeInferencePreference -> OpcodeInferencePreference -> Bool
$c> :: OpcodeInferencePreference -> OpcodeInferencePreference -> Bool
> :: OpcodeInferencePreference -> OpcodeInferencePreference -> Bool
$c>= :: OpcodeInferencePreference -> OpcodeInferencePreference -> Bool
>= :: OpcodeInferencePreference -> OpcodeInferencePreference -> Bool
$cmax :: OpcodeInferencePreference
-> OpcodeInferencePreference -> OpcodeInferencePreference
max :: OpcodeInferencePreference
-> OpcodeInferencePreference -> OpcodeInferencePreference
$cmin :: OpcodeInferencePreference
-> OpcodeInferencePreference -> OpcodeInferencePreference
min :: OpcodeInferencePreference
-> OpcodeInferencePreference -> OpcodeInferencePreference
Ord, Int -> OpcodeInferencePreference -> ShowS
[OpcodeInferencePreference] -> ShowS
OpcodeInferencePreference -> String
(Int -> OpcodeInferencePreference -> ShowS)
-> (OpcodeInferencePreference -> String)
-> ([OpcodeInferencePreference] -> ShowS)
-> Show OpcodeInferencePreference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpcodeInferencePreference -> ShowS
showsPrec :: Int -> OpcodeInferencePreference -> ShowS
$cshow :: OpcodeInferencePreference -> String
show :: OpcodeInferencePreference -> String
$cshowList :: [OpcodeInferencePreference] -> ShowS
showList :: [OpcodeInferencePreference] -> ShowS
Show, ReadPrec [OpcodeInferencePreference]
ReadPrec OpcodeInferencePreference
Int -> ReadS OpcodeInferencePreference
ReadS [OpcodeInferencePreference]
(Int -> ReadS OpcodeInferencePreference)
-> ReadS [OpcodeInferencePreference]
-> ReadPrec OpcodeInferencePreference
-> ReadPrec [OpcodeInferencePreference]
-> Read OpcodeInferencePreference
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS OpcodeInferencePreference
readsPrec :: Int -> ReadS OpcodeInferencePreference
$creadList :: ReadS [OpcodeInferencePreference]
readList :: ReadS [OpcodeInferencePreference]
$creadPrec :: ReadPrec OpcodeInferencePreference
readPrec :: ReadPrec OpcodeInferencePreference
$creadListPrec :: ReadPrec [OpcodeInferencePreference]
readListPrec :: ReadPrec [OpcodeInferencePreference]
Read)


-- | Infer types/rates for a csound program
inferTypes :: InferenceOptions -> [Stmt Int] -> InferenceResult
inferTypes :: InferenceOptions -> [Stmt Int] -> InferenceResult
inferTypes InferenceOptions
opts [Stmt Int]
exprs = (forall s. ST s InferenceResult) -> InferenceResult
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s InferenceResult) -> InferenceResult)
-> (forall s. ST s InferenceResult) -> InferenceResult
forall a b. (a -> b) -> a -> b
$ do
  InferEnv s
env <- ST s (InferEnv s)
forall s. ST s (InferEnv s)
initEnv
  InferEnv s -> InferenceResult
forall {s}. InferEnv s -> InferenceResult
toResult (InferEnv s -> InferenceResult)
-> ST s (InferEnv s) -> ST s InferenceResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT (InferEnv s) (ST s) () -> InferEnv s -> ST s (InferEnv s)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT ((Stmt Int -> StateT (InferEnv s) (ST s) ())
-> [Stmt Int] -> StateT (InferEnv s) (ST s) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (InferenceOptions -> Stmt Int -> StateT (InferEnv s) (ST s) ()
forall s. InferenceOptions -> Stmt Int -> Infer s ()
inferIter InferenceOptions
opts) [Stmt Int]
exprs) InferEnv s
env
  where
    initEnv :: ST s (InferEnv s)
    initEnv :: forall s. ST s (InferEnv s)
initEnv = do
      STVector s Rate
typeMap <- Int -> Rate -> ST s (MVector (PrimState (ST s)) Rate)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MVector (PrimState m) a)
Vector.replicate Int
size Rate
Xr
      InferEnv s -> ST s (InferEnv s)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InferEnv
        { envTypeMap :: STVector s Rate
envTypeMap = STVector s Rate
typeMap
        , envConversions :: IntMap (Map Rate Var)
envConversions = IntMap (Map Rate Var)
forall a. IntMap a
IntMap.empty
        , envLastFreshId :: Int
envLastFreshId = Int
size
        , envResult :: [Stmt Var]
envResult = []
        , envHasIfs :: Bool
envHasIfs = Bool
False
        , envPrims :: Map Prim Var
envPrims = Map Prim Var
forall k a. Map k a
Map.empty
        }

    toResult :: InferEnv s -> InferenceResult
toResult InferEnv{Bool
Int
[Stmt Var]
Map Prim Var
IntMap (Map Rate Var)
STVector s Rate
envTypeMap :: forall s. InferEnv s -> STVector s Rate
envConversions :: forall s. InferEnv s -> IntMap (Map Rate Var)
envLastFreshId :: forall s. InferEnv s -> Int
envResult :: forall s. InferEnv s -> [Stmt Var]
envHasIfs :: forall s. InferEnv s -> Bool
envPrims :: forall s. InferEnv s -> Map Prim Var
envTypeMap :: STVector s Rate
envConversions :: IntMap (Map Rate Var)
envLastFreshId :: Int
envResult :: [Stmt Var]
envPrims :: Map Prim Var
envHasIfs :: Bool
..} =
      InferenceResult
        { typedProgram :: [Stmt Var]
typedProgram  = [Stmt Var] -> [Stmt Var]
forall a. [a] -> [a]
List.reverse [Stmt Var]
envResult
        , programLastFreshId :: Int
programLastFreshId = Int
envLastFreshId
        , programHasIfs :: Bool
programHasIfs = Bool
envHasIfs
        }

    size :: Int
size = Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> (Stmt Int -> Int) -> Maybe (Stmt Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Stmt Int -> Int
forall a. Stmt a -> a
stmtLhs (Maybe (Stmt Int) -> Int) -> Maybe (Stmt Int) -> Int
forall a b. (a -> b) -> a -> b
$ [Stmt Int] -> Maybe (Stmt Int)
forall a. [a] -> Maybe a
headMay ([Stmt Int] -> Maybe (Stmt Int)) -> [Stmt Int] -> Maybe (Stmt Int)
forall a b. (a -> b) -> a -> b
$ [Stmt Int] -> [Stmt Int]
forall a. [a] -> [a]
List.reverse [Stmt Int]
exprs

type Infer s a = StateT (InferEnv s) (ST s) a

-- | Type-inference state
data InferEnv s = InferEnv
  { forall s. InferEnv s -> STVector s Rate
envTypeMap     :: !(STVector s Rate)
      -- ^ types inferrred so far
  , forall s. InferEnv s -> IntMap (Map Rate Var)
envConversions :: !(IntMap (Map Rate Var))
     -- ^ conversions
  , forall s. InferEnv s -> Int
envLastFreshId :: !Int
      -- ^ last fresh id (we use it to insert new variables for conversions)
  , forall s. InferEnv s -> [Stmt Var]
envResult      :: ![Stmt Var]
      -- ^ typed program accumulated in reversed order
  , forall s. InferEnv s -> Map Prim Var
envPrims       :: Map Prim Var
      -- ^ sometimes we need to allocate new primitive value to convert it
  , forall s. InferEnv s -> Bool
envHasIfs      :: !Bool
  }

-------------------------------------------------------------------------------------
-- options

type OpcSignature = (Rate, [Rate])

preferOpc :: InferenceOptions -> Name -> Map Rate [Rate] -> Either [OpcSignature] OpcSignature
preferOpc :: InferenceOptions
-> Name -> Map Rate [Rate] -> Either [OpcSignature] OpcSignature
preferOpc (InferenceOptions OpcodeInferenceStrategy
strategy OpcodeInferencePreference
opcPrefs) Name
name Map Rate [Rate]
signatureMap
  | Just OpcSignature
sig <- Maybe OpcSignature
getControl = OpcSignature -> Either [OpcSignature] OpcSignature
forall a b. b -> Either a b
Right OpcSignature
sig
  | Just OpcSignature
sig <- Maybe OpcSignature
getAudio   = OpcSignature -> Either [OpcSignature] OpcSignature
forall a b. b -> Either a b
Right OpcSignature
sig
  | Bool
otherwise              = [OpcSignature] -> Either [OpcSignature] OpcSignature
forall a b. a -> Either a b
Left ([OpcSignature] -> Either [OpcSignature] OpcSignature)
-> [OpcSignature] -> Either [OpcSignature] OpcSignature
forall a b. (a -> b) -> a -> b
$
      case OpcodeInferenceStrategy
strategy of
        OpcodeInferenceStrategy
PreferControlRate -> [OpcSignature] -> [OpcSignature]
forall a. [a] -> [a]
List.reverse ([OpcSignature] -> [OpcSignature])
-> [OpcSignature] -> [OpcSignature]
forall a b. (a -> b) -> a -> b
$ Map Rate [Rate] -> [OpcSignature]
forall k a. Map k a -> [(k, a)]
Map.toList Map Rate [Rate]
signatureMap
        OpcodeInferenceStrategy
PreferAudioRate   -> Map Rate [Rate] -> [OpcSignature]
forall k a. Map k a -> [(k, a)]
Map.toList Map Rate [Rate]
signatureMap
  where
    getControl :: Maybe OpcSignature
getControl = Rate -> HashSet Name -> Maybe OpcSignature
getBy Rate
Kr (OpcodeInferencePreference -> HashSet Name
preferControlOpcodes OpcodeInferencePreference
opcPrefs)
    getAudio :: Maybe OpcSignature
getAudio = Rate -> HashSet Name -> Maybe OpcSignature
getBy Rate
Ar (OpcodeInferencePreference -> HashSet Name
preferAudioOpcodes OpcodeInferencePreference
opcPrefs)

    getBy :: Rate -> HashSet Name -> Maybe OpcSignature
getBy Rate
rate HashSet Name
s
      | Name -> HashSet Name -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member Name
name HashSet Name
s = (Rate
rate, ) ([Rate] -> OpcSignature) -> Maybe [Rate] -> Maybe OpcSignature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rate -> Map Rate [Rate] -> Maybe [Rate]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Rate
rate Map Rate [Rate]
signatureMap
      | Bool
otherwise = Maybe OpcSignature
forall a. Maybe a
Nothing

instance Default InferenceOptions where
  def :: InferenceOptions
def = InferenceOptions
    { opcodeInferenceStrategy :: OpcodeInferenceStrategy
opcodeInferenceStrategy   = OpcodeInferenceStrategy
PreferControlRate
    , opcodeInferencePreference :: OpcodeInferencePreference
opcodeInferencePreference =
        OpcodeInferencePreference
          { preferControlOpcodes :: HashSet Name
preferControlOpcodes = HashSet Name
Const.controlOpcodes
          , preferAudioOpcodes :: HashSet Name
preferAudioOpcodes   = HashSet Name
Const.audioOpcodes
          }
    }

-------------------------------------------------------------------------------------
-- inference

inferIter :: forall s . InferenceOptions -> Stmt Int -> Infer s ()
inferIter :: forall s. InferenceOptions -> Stmt Int -> Infer s ()
inferIter InferenceOptions
opts (Stmt Int
lhs RatedExp Int
rhs) =
  -- trace (unlines ["INFER RHS", show $ ratedExpExp rhs, show $ ratedExpRate rhs, "\n"]) $
  case RatedExp Int -> Exp Int
forall a. RatedExp a -> Exp a
ratedExpExp RatedExp Int
rhs of
    -- primitives
    ExpPrim Prim
p -> Prim -> Infer s ()
onPrim Prim
p

    -- | Application of the opcode: we have opcode information (Info) and the arguments [a]
    Tfm Info
info [PrimOr Int]
args -> Info -> [PrimOr Int] -> Infer s ()
onTfm Info
info [PrimOr Int]
args

    ConvertRate Rate
toRate Maybe Rate
fromRate PrimOr Int
a -> Rate -> Maybe Rate -> PrimOr Int -> Infer s ()
onConvertRate Rate
toRate Maybe Rate
fromRate PrimOr Int
a
    Select Rate
rate Int
outId PrimOr Int
arg -> Rate -> Int -> PrimOr Int -> Infer s ()
onSelect Rate
rate Int
outId PrimOr Int
arg

    -- | Numerical expressions (rendered in infix notation in the Csound)
    ExpNum NumExp (PrimOr Int)
args -> NumExp (PrimOr Int) -> Infer s ()
onExpNum NumExp (PrimOr Int)
args
    ExpBool BoolExp (PrimOr Int)
_ -> String -> Infer s ()
forall a. HasCallStack => String -> a
error String
"Bool Exp should be substituted"

    -- | Reading/writing a named variable
    InitVar Var
v PrimOr Int
arg -> Var -> PrimOr Int -> Infer s ()
onInitVar Var
v PrimOr Int
arg
    ReadVar Var
v -> Var -> Infer s ()
onReadVar Var
v
    WriteVar Var
v PrimOr Int
arg -> Var -> PrimOr Int -> Infer s ()
onWriteVar Var
v PrimOr Int
arg

    -- | Selects a cell from the tuple, here argument is always a tuple (result of opcode that returns several outputs)
    -- | if-then-else
    If IfRate
ifRate CondInfo (PrimOr Int)
cond PrimOr Int
th PrimOr Int
el -> IfRate
-> CondInfo (PrimOr Int) -> PrimOr Int -> PrimOr Int -> Infer s ()
onIf IfRate
ifRate CondInfo (PrimOr Int)
cond PrimOr Int
th PrimOr Int
el
    -- | Imperative If-then-else
    IfBlock IfRate
ifRate CondInfo (PrimOr Int)
cond CodeBlock (PrimOr Int)
th -> IfRate
-> CondInfo (PrimOr Int) -> CodeBlock (PrimOr Int) -> Infer s ()
onIfBlock IfRate
ifRate CondInfo (PrimOr Int)
cond CodeBlock (PrimOr Int)
th
    IfElseBlock IfRate
ifRate CondInfo (PrimOr Int)
cond CodeBlock (PrimOr Int)
th CodeBlock (PrimOr Int)
el -> IfRate
-> CondInfo (PrimOr Int)
-> CodeBlock (PrimOr Int)
-> CodeBlock (PrimOr Int)
-> Infer s ()
onIfElseBlock IfRate
ifRate CondInfo (PrimOr Int)
cond CodeBlock (PrimOr Int)
th CodeBlock (PrimOr Int)
el
    IfBegin IfRate
ifRate CondInfo (PrimOr Int)
cond -> IfRate -> CondInfo (PrimOr Int) -> Infer s ()
onIfBegin IfRate
ifRate CondInfo (PrimOr Int)
cond
    Exp Int
ElseBegin -> Exp Var -> Infer s ()
saveProcedure Exp Var
forall a. MainExp a
ElseBegin
    Exp Int
IfEnd -> Exp Var -> Infer s ()
saveProcedure Exp Var
forall a. MainExp a
IfEnd

    -- | Verbatim stmt
    Verbatim Name
txt -> Exp Var -> Infer s ()
saveProcedure (Name -> Exp Var
forall a. Name -> MainExp a
Verbatim Name
txt)

    -- | Arrays
    InitArr Var
v [PrimOr Int]
arrSize -> Var -> [PrimOr Int] -> Infer s ()
onInitArr Var
v [PrimOr Int]
arrSize
    ReadArr Var
v [PrimOr Int]
index -> Var -> [PrimOr Int] -> Infer s ()
onReadArr Var
v [PrimOr Int]
index
    WriteArr Var
v [PrimOr Int]
index PrimOr Int
val -> Var -> [PrimOr Int] -> PrimOr Int -> Infer s ()
onWriteArr Var
v [PrimOr Int]
index PrimOr Int
val
    WriteInitArr Var
v [PrimOr Int]
arrSize PrimOr Int
initVal -> Var -> [PrimOr Int] -> PrimOr Int -> Infer s ()
onWriteInitArr Var
v [PrimOr Int]
arrSize PrimOr Int
initVal
    TfmArr Bool
isArrInit Var
v Info
info [PrimOr Int]
args -> Bool -> Var -> Info -> [PrimOr Int] -> Infer s ()
onTfmArr Bool
isArrInit Var
v Info
info [PrimOr Int]
args

    -- | Pure arrays (read-only)
    InitPureArr Rate
outRate IfRate
procRate [PrimOr Int]
initVals -> Rate -> IfRate -> [PrimOr Int] -> Infer s ()
onInitPureArr Rate
outRate IfRate
procRate [PrimOr Int]
initVals
    ReadPureArr Rate
outRate IfRate
procRate PrimOr Int
inArr PrimOr Int
index -> Rate -> IfRate -> PrimOr Int -> PrimOr Int -> Infer s ()
onReadPureArr Rate
outRate IfRate
procRate PrimOr Int
inArr PrimOr Int
index

    -- | read macros arguments
    InitMacrosInt Name
name Int
n -> Exp Var -> Infer s ()
saveProcedure (Name -> Int -> Exp Var
forall a. Name -> Int -> MainExp a
InitMacrosInt Name
name Int
n)
    InitMacrosDouble Name
name Double
dbl -> Exp Var -> Infer s ()
saveProcedure (Name -> Double -> Exp Var
forall a. Name -> Double -> MainExp a
InitMacrosDouble Name
name Double
dbl)
    InitMacrosString Name
name Name
txt -> Exp Var -> Infer s ()
saveProcedure (Name -> Name -> Exp Var
forall a. Name -> Name -> MainExp a
InitMacrosString Name
name Name
txt)
    ReadMacrosInt Name
name -> Rate -> Exp Var -> Infer s ()
save Rate
Ir (Name -> Exp Var
forall a. Name -> MainExp a
ReadMacrosInt Name
name)
    ReadMacrosDouble Name
name -> Rate -> Exp Var -> Infer s ()
save Rate
Ir (Name -> Exp Var
forall a. Name -> MainExp a
ReadMacrosDouble Name
name)
    ReadMacrosString Name
name -> Rate -> Exp Var -> Infer s ()
save Rate
Ir (Name -> Exp Var
forall a. Name -> MainExp a
ReadMacrosString Name
name)

    -- | looping constructions
    UntilBlock IfRate
ifRate CondInfo (PrimOr Int)
cond CodeBlock (PrimOr Int)
th -> IfRate
-> CondInfo (PrimOr Int) -> CodeBlock (PrimOr Int) -> Infer s ()
onUntilBlock IfRate
ifRate CondInfo (PrimOr Int)
cond CodeBlock (PrimOr Int)
th
    WhileBlock IfRate
ifRate CondInfo (PrimOr Int)
cond CodeBlock (PrimOr Int)
th -> IfRate
-> CondInfo (PrimOr Int) -> CodeBlock (PrimOr Int) -> Infer s ()
onWhileBlock IfRate
ifRate CondInfo (PrimOr Int)
cond CodeBlock (PrimOr Int)
th
    WhileRefBlock Var
var CodeBlock (PrimOr Int)
th -> Var -> CodeBlock (PrimOr Int) -> Infer s ()
onWhileRefBlock Var
var CodeBlock (PrimOr Int)
th

    UntilBegin IfRate
ifRate CondInfo (PrimOr Int)
cond -> IfRate -> CondInfo (PrimOr Int) -> Infer s ()
onUntilBegin IfRate
ifRate CondInfo (PrimOr Int)
cond
    Exp Int
UntilEnd -> Exp Var -> Infer s ()
saveProcedure Exp Var
forall a. MainExp a
UntilEnd
    WhileBegin IfRate
ifRate CondInfo (PrimOr Int)
cond -> IfRate -> CondInfo (PrimOr Int) -> Infer s ()
onWhileBegin IfRate
ifRate CondInfo (PrimOr Int)
cond
    WhileRefBegin Var
v -> Exp Var -> Infer s ()
saveProcedure (Var -> Exp Var
forall a. Var -> MainExp a
WhileRefBegin Var
v)
    Exp Int
WhileEnd -> Exp Var -> Infer s ()
saveProcedure Exp Var
forall a. MainExp a
WhileEnd

    Exp Int
EmptyExp  -> Exp Var -> Infer s ()
saveProcedure Exp Var
forall a. MainExp a
EmptyExp

    -- | Dependency tracking
    Exp Int
Starts -> Exp Var -> Infer s ()
saveProcedure Exp Var
forall a. MainExp a
Starts
    Seq PrimOr Int
a PrimOr Int
b -> Exp Var -> Infer s ()
saveProcedure (PrimOr Var -> PrimOr Var -> Exp Var
forall a. a -> a -> MainExp a
Seq (PrimOr Int -> PrimOr Var
setXr PrimOr Int
a) (PrimOr Int -> PrimOr Var
setXr PrimOr Int
b))
    Ends PrimOr Int
a -> Exp Var -> Infer s ()
saveProcedure (PrimOr Var -> Exp Var
forall a. a -> MainExp a
Ends (PrimOr Int -> PrimOr Var
setXr PrimOr Int
a))

  where
    onPrim :: Prim -> Infer s ()
onPrim Prim
p = Rate -> Exp Var -> Infer s ()
save Rate
rate (Prim -> Exp Var
forall a. Prim -> MainExp a
ExpPrim Prim
p)
      where
        rate :: Rate
rate = Rate -> Maybe Rate -> Rate
forall a. a -> Maybe a -> a
fromMaybe (Prim -> Rate
primRate Prim
p) (Maybe Rate -> Rate) -> Maybe Rate -> Rate
forall a b. (a -> b) -> a -> b
$ RatedExp Int -> Maybe Rate
forall a. RatedExp a -> Maybe Rate
ratedExpRate RatedExp Int
rhs

    onTfm :: Info -> [PrimOr Int] -> Infer s ()
onTfm Info
info [PrimOr Int]
args =
      case Info -> Signature
infoSignature Info
info of
        MultiRate [Rate]
outRates [Rate]
inRates -> Info -> [Rate] -> [Rate] -> [PrimOr Int] -> Infer s ()
forall {p}. Info -> p -> [Rate] -> [PrimOr Int] -> Infer s ()
onMultiRateTfm Info
info [Rate]
outRates [Rate]
inRates [PrimOr Int]
args
        SingleRate Map Rate [Rate]
rateTab         -> Info -> Map Rate [Rate] -> [PrimOr Int] -> Infer s ()
onSingleRateTfm Info
info Map Rate [Rate]
rateTab [PrimOr Int]
args

    onMultiRateTfm :: Info -> p -> [Rate] -> [PrimOr Int] -> Infer s ()
onMultiRateTfm Info
info p
_outRates [Rate]
inRates [PrimOr Int]
args = do
      Exp Var
typedExpr <- Info -> [PrimOr Var] -> Exp Var
forall a. Info -> [a] -> MainExp a
Tfm Info
info ([PrimOr Var] -> Exp Var)
-> StateT (InferEnv s) (ST s) [PrimOr Var]
-> StateT (InferEnv s) (ST s) (Exp Var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Rate -> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var))
-> [Rate]
-> [PrimOr Int]
-> StateT (InferEnv s) (ST s) [PrimOr Var]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Rate -> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall s. Rate -> PrimOr Int -> Infer s (PrimOr Var)
applyArg [Rate]
inRates [PrimOr Int]
args
      Rate -> Exp Var -> Infer s ()
save Rate
Xr Exp Var
typedExpr

    onSingleRateTfm :: Info -> Map Rate [Rate] -> [PrimOr Int] -> Infer s ()
onSingleRateTfm Info
info Map Rate [Rate]
rateTab [PrimOr Int]
args
      | Just OpcSignature
userRates <- Maybe OpcSignature
getUserDefinedRate = Info -> OpcSignature -> [PrimOr Int] -> Infer s ()
onFixedRateTfm Info
info OpcSignature
userRates [PrimOr Int]
args
      | Bool
otherwise                            = Info -> Map Rate [Rate] -> [PrimOr Int] -> Infer s ()
onFreeTfm Info
info Map Rate [Rate]
rateTab [PrimOr Int]
args
      where
        getUserDefinedRate :: Maybe OpcSignature
getUserDefinedRate = do
          Rate
userRate <- RatedExp Int -> Maybe Rate
forall a. RatedExp a -> Maybe Rate
ratedExpRate RatedExp Int
rhs
          (Rate
userRate, ) ([Rate] -> OpcSignature) -> Maybe [Rate] -> Maybe OpcSignature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rate -> Map Rate [Rate] -> Maybe [Rate]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Rate
userRate Map Rate [Rate]
rateTab

    onFixedRateTfm :: Info -> OpcSignature -> [PrimOr Int] -> Infer s ()
onFixedRateTfm Info
info (Rate
outRate, [Rate]
inRates) [PrimOr Int]
args = do
      Exp Var
typedExpr <- Info -> [PrimOr Var] -> Exp Var
forall a. Info -> [a] -> MainExp a
Tfm Info
info ([PrimOr Var] -> Exp Var)
-> StateT (InferEnv s) (ST s) [PrimOr Var]
-> StateT (InferEnv s) (ST s) (Exp Var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Rate -> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var))
-> [Rate]
-> [PrimOr Int]
-> StateT (InferEnv s) (ST s) [PrimOr Var]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Rate -> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall s. Rate -> PrimOr Int -> Infer s (PrimOr Var)
applyArg [Rate]
inRates [PrimOr Int]
args
      Rate -> Exp Var -> Infer s ()
save Rate
outRate Exp Var
typedExpr

    onFreeTfm :: Info -> Map Rate [Rate] -> [PrimOr Int] -> Infer s ()
onFreeTfm Info
info Map Rate [Rate]
rateTab [PrimOr Int]
args = do
      OpcSignature
signature <-
        case Map Rate [Rate] -> [OpcSignature]
forall k a. Map k a -> [(k, a)]
Map.toList Map Rate [Rate]
rateTab of
          [OpcSignature
rateInfo] -> OpcSignature -> StateT (InferEnv s) (ST s) OpcSignature
forall a. a -> StateT (InferEnv s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OpcSignature
rateInfo
          [OpcSignature]
_ ->
            case InferenceOptions
-> Name -> Map Rate [Rate] -> Either [OpcSignature] OpcSignature
preferOpc InferenceOptions
opts (Info -> Name
infoName Info
info) Map Rate [Rate]
rateTab of
              Right OpcSignature
opcRate -> OpcSignature -> StateT (InferEnv s) (ST s) OpcSignature
forall a. a -> StateT (InferEnv s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OpcSignature
opcRate
              Left [OpcSignature]
opcRates -> [PrimOr Int]
-> [OpcSignature] -> StateT (InferEnv s) (ST s) OpcSignature
findSignature [PrimOr Int]
args [OpcSignature]
opcRates
      Info -> OpcSignature -> [PrimOr Int] -> Infer s ()
onFixedRateTfm Info
info OpcSignature
signature [PrimOr Int]
args

    findSignature :: [PrimOr Int] -> [OpcSignature] -> Infer s OpcSignature
    findSignature :: [PrimOr Int]
-> [OpcSignature] -> StateT (InferEnv s) (ST s) OpcSignature
findSignature [PrimOr Int]
args [OpcSignature]
allOpcRates = OpcSignature
-> Maybe SignatureChoice
-> [OpcSignature]
-> StateT (InferEnv s) (ST s) OpcSignature
go (OpcSignature -> Maybe OpcSignature -> OpcSignature
forall a. a -> Maybe a -> a
fromMaybe (Rate
Kr, []) (Maybe OpcSignature -> OpcSignature)
-> Maybe OpcSignature -> OpcSignature
forall a b. (a -> b) -> a -> b
$ [OpcSignature] -> Maybe OpcSignature
forall a. [a] -> Maybe a
headMay [OpcSignature]
allOpcRates) Maybe SignatureChoice
forall a. Maybe a
Nothing [OpcSignature]
allOpcRates
      where
        go :: OpcSignature -> Maybe SignatureChoice -> [OpcSignature] -> Infer s OpcSignature
        go :: OpcSignature
-> Maybe SignatureChoice
-> [OpcSignature]
-> StateT (InferEnv s) (ST s) OpcSignature
go OpcSignature
defaultRate Maybe SignatureChoice
mBestFit [OpcSignature]
candidateRates =
          case [OpcSignature]
candidateRates of
            [] -> OpcSignature -> StateT (InferEnv s) (ST s) OpcSignature
forall a. a -> StateT (InferEnv s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OpcSignature -> StateT (InferEnv s) (ST s) OpcSignature)
-> OpcSignature -> StateT (InferEnv s) (ST s) OpcSignature
forall a b. (a -> b) -> a -> b
$ OpcSignature
-> (SignatureChoice -> OpcSignature)
-> Maybe SignatureChoice
-> OpcSignature
forall b a. b -> (a -> b) -> Maybe a -> b
maybe OpcSignature
defaultRate SignatureChoice -> OpcSignature
signatureCandidate Maybe SignatureChoice
mBestFit
            OpcSignature
candidate : [OpcSignature]
rest -> do
              SignatureChoice
scores <- OpcSignature -> Infer s SignatureChoice
tryCandidate OpcSignature
candidate
              if SignatureChoice -> Bool
isFit SignatureChoice
scores
                then OpcSignature -> StateT (InferEnv s) (ST s) OpcSignature
forall a. a -> StateT (InferEnv s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OpcSignature
candidate
                else OpcSignature
-> Maybe SignatureChoice
-> [OpcSignature]
-> StateT (InferEnv s) (ST s) OpcSignature
go OpcSignature
defaultRate (SignatureChoice -> Maybe SignatureChoice
forall a. a -> Maybe a
Just (SignatureChoice -> Maybe SignatureChoice)
-> SignatureChoice -> Maybe SignatureChoice
forall a b. (a -> b) -> a -> b
$ SignatureChoice -> Maybe SignatureChoice -> SignatureChoice
getBestFit SignatureChoice
scores Maybe SignatureChoice
mBestFit) [OpcSignature]
rest

        tryCandidate :: OpcSignature -> Infer s SignatureChoice
        tryCandidate :: OpcSignature -> Infer s SignatureChoice
tryCandidate candidate :: OpcSignature
candidate@(Rate
_outRate, [Rate]
inRates) = do
          Int
conversions <- [Rate] -> Infer s Int
countDestructiveConversions [Rate]
inRates
          SignatureChoice -> Infer s SignatureChoice
forall a. a -> StateT (InferEnv s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SignatureChoice -> Infer s SignatureChoice)
-> SignatureChoice -> Infer s SignatureChoice
forall a b. (a -> b) -> a -> b
$ SignatureChoice
            { destructiveConversionsCount :: Int
destructiveConversionsCount = Int
conversions
            , signatureCandidate :: OpcSignature
signatureCandidate = OpcSignature
candidate
            }

        countDestructiveConversions :: [Rate] -> Infer s Int
        countDestructiveConversions :: [Rate] -> Infer s Int
countDestructiveConversions [Rate]
rates = (Int -> (Rate, PrimOr Int) -> Infer s Int)
-> Int -> [(Rate, PrimOr Int)] -> Infer s Int
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Int -> (Rate, PrimOr Int) -> Infer s Int
countConversion Int
0 ([(Rate, PrimOr Int)] -> Infer s Int)
-> [(Rate, PrimOr Int)] -> Infer s Int
forall a b. (a -> b) -> a -> b
$ [Rate] -> [PrimOr Int] -> [(Rate, PrimOr Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Rate]
rates [PrimOr Int]
args

        countConversion :: Int -> (Rate, PrimOr Int) -> Infer s Int
        countConversion :: Int -> (Rate, PrimOr Int) -> Infer s Int
countConversion Int
total (Rate
targetRate, PrimOr Int
arg) = do
          PrimOr Var
argVar <- (Int -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PrimOr a -> m (PrimOr b)
mapM (Rate -> Int -> StateT (InferEnv s) (ST s) Var
forall s. Rate -> Int -> Infer s Var
getVar Rate
targetRate) PrimOr Int
arg
          let opcodeArg :: OpcodeArg
opcodeArg =
                OpcodeArg
                  { opcodeTo :: Rate
opcodeTo = Rate
targetRate
                  , opcodeFrom :: PrimOr Rate
opcodeFrom = Var -> Rate
varType (Var -> Rate) -> PrimOr Var -> PrimOr Rate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrimOr Var
argVar
                  }
          Int -> Infer s Int
forall a. a -> StateT (InferEnv s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Infer s Int) -> Int -> Infer s Int
forall a b. (a -> b) -> a -> b
$ if Bool -> Bool
not (OpcodeArg -> Bool
destructiveConversion OpcodeArg
opcodeArg) Bool -> Bool -> Bool
|| OpcodeArg -> Bool
unifies OpcodeArg
opcodeArg
            then Int
total
            else Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

        isFit :: SignatureChoice -> Bool
isFit (SignatureChoice Int
score OpcSignature
_candidate) = Int
score Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0

        getBestFit :: SignatureChoice -> Maybe SignatureChoice -> SignatureChoice
getBestFit (SignatureChoice Int
scores OpcSignature
candidate) = \case
          Just (SignatureChoice Int
prevScores OpcSignature
prevCandidate) | Int
prevScores Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
scores -> (Int -> OpcSignature -> SignatureChoice
SignatureChoice Int
prevScores OpcSignature
prevCandidate)
          Maybe SignatureChoice
_ -> (Int -> OpcSignature -> SignatureChoice
SignatureChoice Int
scores OpcSignature
candidate)

    onConvertRate :: Rate -> Maybe Rate -> PrimOr Int -> Infer s ()
onConvertRate Rate
toRate Maybe Rate
mFromRate PrimOr Int
arg = do
      Rate
fromRate <- StateT (InferEnv s) (ST s) Rate
-> (Rate -> StateT (InferEnv s) (ST s) Rate)
-> Maybe Rate
-> StateT (InferEnv s) (ST s) Rate
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((Prim -> Rate) -> (Var -> Rate) -> Either Prim Var -> Rate
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Prim -> Rate
primRate Var -> Rate
varType (Either Prim Var -> Rate)
-> (PrimOr Var -> Either Prim Var) -> PrimOr Var -> Rate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimOr Var -> Either Prim Var
forall a. PrimOr a -> Either Prim a
unPrimOr (PrimOr Var -> Rate)
-> StateT (InferEnv s) (ST s) (PrimOr Var)
-> StateT (InferEnv s) (ST s) Rate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PrimOr a -> m (PrimOr b)
mapM (Rate -> Int -> StateT (InferEnv s) (ST s) Var
forall s. Rate -> Int -> Infer s Var
getVar Rate
Ir) PrimOr Int
arg) Rate -> StateT (InferEnv s) (ST s) Rate
forall a. a -> StateT (InferEnv s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Rate
mFromRate
      Rate -> Exp Var -> Infer s ()
save Rate
toRate (Rate -> Maybe Rate -> PrimOr Var -> Exp Var
forall a. Rate -> Maybe Rate -> a -> MainExp a
ConvertRate Rate
toRate (Rate -> Maybe Rate
forall a. a -> Maybe a
Just Rate
fromRate) (Rate -> Int -> Var
Var Rate
fromRate (Int -> Var) -> PrimOr Int -> PrimOr Var
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrimOr Int
arg))

    setXr :: PrimOr Int -> PrimOr Var
setXr = (Int -> Var) -> PrimOr Int -> PrimOr Var
forall a b. (a -> b) -> PrimOr a -> PrimOr b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rate -> Int -> Var
Var Rate
Xr)

    onSelect :: Rate -> Int -> PrimOr Int -> Infer s ()
onSelect Rate
rate Int
outId PrimOr Int
arg =
      Rate -> Exp Var -> Infer s ()
save Rate
rate (Rate -> Int -> PrimOr Var -> Exp Var
forall a. Rate -> Int -> a -> MainExp a
Select Rate
rate Int
outId (Rate -> Int -> Var
Var Rate
Xr (Int -> Var) -> PrimOr Int -> PrimOr Var
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrimOr Int
arg))

    onInitVar :: Var -> PrimOr Int -> Infer s ()
onInitVar Var
v PrimOr Int
arg = Rate -> Exp Var -> Infer s ()
save (Var -> Rate
Exp.varRate Var
v) (Exp Var -> Infer s ())
-> StateT (InferEnv s) (ST s) (Exp Var) -> Infer s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StateT (InferEnv s) (ST s) (Exp Var)
forall {s}. StateT (InferEnv s) (ST s) (Exp Var)
typedRhs
      where
        typedRhs :: StateT (InferEnv s) (ST s) (Exp Var)
typedRhs = do
          PrimOr Var
argVar <- (Int -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PrimOr a -> m (PrimOr b)
mapM (Rate -> Int -> StateT (InferEnv s) (ST s) Var
forall s. Rate -> Int -> Infer s Var
getVar Rate
Ir) PrimOr Int
arg
          Exp Var -> StateT (InferEnv s) (ST s) (Exp Var)
forall a. a -> StateT (InferEnv s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var -> PrimOr Var -> Exp Var
forall a. Var -> a -> MainExp a
InitVar Var
v PrimOr Var
argVar)

    onReadVar :: Var -> Infer s ()
onReadVar Var
v = Rate -> Exp Var -> Infer s ()
save (Var -> Rate
Exp.varRate Var
v) (Var -> Exp Var
forall a. Var -> MainExp a
ReadVar Var
v)

    onWriteVar :: Var -> PrimOr Int -> Infer s ()
onWriteVar Var
v PrimOr Int
arg = Exp Var -> Infer s ()
saveProcedure (Exp Var -> Infer s ())
-> StateT (InferEnv s) (ST s) (Exp Var) -> Infer s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StateT (InferEnv s) (ST s) (Exp Var)
forall {s}. StateT (InferEnv s) (ST s) (Exp Var)
typedRhs
      where
        typedRhs :: StateT (InferEnv s) (ST s) (Exp Var)
typedRhs = do
          PrimOr Var
argVar <- (Int -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PrimOr a -> m (PrimOr b)
mapM (Rate -> Int -> StateT (InferEnv s) (ST s) Var
forall s. Rate -> Int -> Infer s Var
getVar (Var -> Rate
Exp.varRate Var
v)) PrimOr Int
arg
          Exp Var -> StateT (InferEnv s) (ST s) (Exp Var)
forall a. a -> StateT (InferEnv s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp Var -> StateT (InferEnv s) (ST s) (Exp Var))
-> Exp Var -> StateT (InferEnv s) (ST s) (Exp Var)
forall a b. (a -> b) -> a -> b
$ Var -> PrimOr Var -> Exp Var
forall a. Var -> a -> MainExp a
WriteVar Var
v PrimOr Var
argVar

    onExpNum :: NumExp (PrimOr Int) -> Infer s ()
onExpNum NumExp (PrimOr Int)
args = do
      PreInline NumOp (PrimOr Var)
argVars <- (PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var))
-> NumExp (PrimOr Int)
-> StateT (InferEnv s) (ST s) (PreInline NumOp (PrimOr Var))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PreInline NumOp a -> m (PreInline NumOp b)
mapM ((Int -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PrimOr a -> m (PrimOr b)
mapM ((Int -> StateT (InferEnv s) (ST s) Var)
 -> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var))
-> (Int -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Int
-> StateT (InferEnv s) (ST s) (PrimOr Var)
forall a b. (a -> b) -> a -> b
$ Rate -> Int -> StateT (InferEnv s) (ST s) Var
forall s. Rate -> Int -> Infer s Var
getVar Rate
Ir) NumExp (PrimOr Int)
args
      Rate -> Exp Var -> Infer s ()
save (PreInline NumOp (PrimOr Var) -> Rate
numRate PreInline NumOp (PrimOr Var)
argVars) (PreInline NumOp (PrimOr Var) -> Exp Var
forall a. NumExp a -> MainExp a
ExpNum PreInline NumOp (PrimOr Var)
argVars)
      where
        numRate :: NumExp (PrimOr Var) -> Rate
        numRate :: PreInline NumOp (PrimOr Var) -> Rate
numRate PreInline NumOp (PrimOr Var)
e = Rate -> Rate -> Rate
forall a. Ord a => a -> a -> a
max Rate
Ar (Rate -> Rate) -> Rate -> Rate
forall a b. (a -> b) -> a -> b
$ Min Rate -> Rate
forall a. Min a -> a
getMin (Min Rate -> Rate) -> Min Rate -> Rate
forall a b. (a -> b) -> a -> b
$ (PrimOr Var -> Min Rate)
-> PreInline NumOp (PrimOr Var) -> Min Rate
forall m a. Monoid m => (a -> m) -> PreInline NumOp a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Rate -> Min Rate
forall a. a -> Min a
Min (Rate -> Min Rate)
-> (PrimOr Var -> Rate) -> PrimOr Var -> Min Rate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimOr Var -> Rate
primOrRate) PreInline NumOp (PrimOr Var)
e

    onIf :: IfRate
-> CondInfo (PrimOr Int) -> PrimOr Int -> PrimOr Int -> Infer s ()
onIf IfRate
ifRate CondInfo (PrimOr Int)
cond PrimOr Int
th PrimOr Int
el = do
      Infer s ()
forall s. Infer s ()
setHasIfs
      PrimOr Var
thVar <- (Int -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PrimOr a -> m (PrimOr b)
mapM (Rate -> Int -> StateT (InferEnv s) (ST s) Var
forall s. Rate -> Int -> Infer s Var
getVar Rate
condMaxRate) PrimOr Int
th
      PrimOr Var
elVar <- (Int -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PrimOr a -> m (PrimOr b)
mapM (Rate -> Int -> StateT (InferEnv s) (ST s) Var
forall s. Rate -> Int -> Infer s Var
getVar Rate
condMaxRate) PrimOr Int
el
      let rate :: Rate
rate = Rate -> Rate -> Rate
forall a. Ord a => a -> a -> a
min (PrimOr Var -> Rate
primOrRate PrimOr Var
thVar ) (PrimOr Var -> Rate
primOrRate PrimOr Var
elVar)
      Inline CondOp (PrimOr Var)
condVar <- (PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var))
-> CondInfo (PrimOr Int)
-> StateT (InferEnv s) (ST s) (Inline CondOp (PrimOr Var))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Inline CondOp a -> m (Inline CondOp b)
mapM ((Int -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PrimOr a -> m (PrimOr b)
mapM ((Int -> StateT (InferEnv s) (ST s) Var)
 -> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var))
-> (Int -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Int
-> StateT (InferEnv s) (ST s) (PrimOr Var)
forall a b. (a -> b) -> a -> b
$ Rate -> Int -> StateT (InferEnv s) (ST s) Var
forall s. Rate -> Int -> Infer s Var
getVar Rate
condMaxRate) CondInfo (PrimOr Int)
cond
      Inline CondOp (PrimOr Var)
condVarSafe <- Rate
-> Inline CondOp (PrimOr Var)
-> StateT (InferEnv s) (ST s) (Inline CondOp (PrimOr Var))
forall s.
Rate
-> Inline CondOp (PrimOr Var)
-> Infer s (Inline CondOp (PrimOr Var))
insertBoolConverters Rate
condMaxRate Inline CondOp (PrimOr Var)
condVar
      case IfRate
ifRate of
        IfRate
IfIr -> Rate
-> Inline CondOp (PrimOr Var)
-> PrimOr Var
-> PrimOr Var
-> Infer s ()
saveIr Rate
rate Inline CondOp (PrimOr Var)
condVarSafe PrimOr Var
thVar PrimOr Var
elVar
        IfRate
IfKr -> Rate
-> Inline CondOp (PrimOr Var)
-> PrimOr Var
-> PrimOr Var
-> Infer s ()
saveKr Rate
rate Inline CondOp (PrimOr Var)
condVarSafe PrimOr Var
thVar PrimOr Var
elVar
      where
        condMaxRate :: Rate
condMaxRate = IfRate -> Rate
fromIfRate IfRate
ifRate

        saveIr :: Rate
-> Inline CondOp (PrimOr Var)
-> PrimOr Var
-> PrimOr Var
-> Infer s ()
saveIr Rate
rate Inline CondOp (PrimOr Var)
condVarSafe PrimOr Var
thVar PrimOr Var
elVar
          | Rate
rate Rate -> Rate -> Bool
forall a. Ord a => a -> a -> Bool
< Rate
Ir = do
              PrimOr Var
thVar1 <- Rate -> PrimOr Var -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall s. Rate -> PrimOr Var -> Infer s (PrimOr Var)
convertIf Rate
Ir PrimOr Var
thVar
              PrimOr Var
elVar1 <- Rate -> PrimOr Var -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall s. Rate -> PrimOr Var -> Infer s (PrimOr Var)
convertIf Rate
Ir PrimOr Var
elVar
              Rate -> Exp Var -> Infer s ()
save Rate
Ir (IfRate
-> Inline CondOp (PrimOr Var)
-> PrimOr Var
-> PrimOr Var
-> Exp Var
forall a. IfRate -> CondInfo a -> a -> a -> MainExp a
If IfRate
ifRate Inline CondOp (PrimOr Var)
condVarSafe PrimOr Var
thVar1 PrimOr Var
elVar1)
          | Bool
otherwise = Rate -> Exp Var -> Infer s ()
save Rate
rate (IfRate
-> Inline CondOp (PrimOr Var)
-> PrimOr Var
-> PrimOr Var
-> Exp Var
forall a. IfRate -> CondInfo a -> a -> a -> MainExp a
If IfRate
ifRate Inline CondOp (PrimOr Var)
condVarSafe PrimOr Var
thVar PrimOr Var
elVar)

        saveKr :: Rate
-> Inline CondOp (PrimOr Var)
-> PrimOr Var
-> PrimOr Var
-> Infer s ()
saveKr Rate
rate Inline CondOp (PrimOr Var)
condVarSafe PrimOr Var
thVar PrimOr Var
elVar
          | Rate
rate Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate
Ir = do
              PrimOr Var
thVar1 <- Rate -> PrimOr Var -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall s. Rate -> PrimOr Var -> Infer s (PrimOr Var)
convertIf Rate
Kr PrimOr Var
thVar
              PrimOr Var
elVar1 <- Rate -> PrimOr Var -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall s. Rate -> PrimOr Var -> Infer s (PrimOr Var)
convertIf Rate
Kr PrimOr Var
elVar
              Rate -> Exp Var -> Infer s ()
save Rate
Kr (IfRate
-> Inline CondOp (PrimOr Var)
-> PrimOr Var
-> PrimOr Var
-> Exp Var
forall a. IfRate -> CondInfo a -> a -> a -> MainExp a
If IfRate
ifRate Inline CondOp (PrimOr Var)
condVarSafe PrimOr Var
thVar1 PrimOr Var
elVar1)
          | Bool
otherwise  = Rate -> Exp Var -> Infer s ()
save Rate
rate (IfRate
-> Inline CondOp (PrimOr Var)
-> PrimOr Var
-> PrimOr Var
-> Exp Var
forall a. IfRate -> CondInfo a -> a -> a -> MainExp a
If IfRate
ifRate Inline CondOp (PrimOr Var)
condVarSafe PrimOr Var
thVar PrimOr Var
elVar)

    onIfBlock :: IfRate
-> CondInfo (PrimOr Int) -> CodeBlock (PrimOr Int) -> Infer s ()
onIfBlock = (IfRate
 -> Inline CondOp (PrimOr Var) -> CodeBlock (PrimOr Var) -> Exp Var)
-> IfRate
-> CondInfo (PrimOr Int)
-> CodeBlock (PrimOr Int)
-> Infer s ()
forall {f :: * -> *} {f :: * -> *}.
(Functor f, Functor f) =>
(IfRate -> Inline CondOp (PrimOr Var) -> f (f Var) -> Exp Var)
-> IfRate -> CondInfo (PrimOr Int) -> f (f Int) -> Infer s ()
onIfBlockBy IfRate
-> Inline CondOp (PrimOr Var) -> CodeBlock (PrimOr Var) -> Exp Var
forall a. IfRate -> CondInfo a -> CodeBlock a -> MainExp a
IfBlock

    onUntilBlock :: IfRate
-> CondInfo (PrimOr Int) -> CodeBlock (PrimOr Int) -> Infer s ()
onUntilBlock = (IfRate
 -> Inline CondOp (PrimOr Var) -> CodeBlock (PrimOr Var) -> Exp Var)
-> IfRate
-> CondInfo (PrimOr Int)
-> CodeBlock (PrimOr Int)
-> Infer s ()
forall {f :: * -> *} {f :: * -> *}.
(Functor f, Functor f) =>
(IfRate -> Inline CondOp (PrimOr Var) -> f (f Var) -> Exp Var)
-> IfRate -> CondInfo (PrimOr Int) -> f (f Int) -> Infer s ()
onIfBlockBy IfRate
-> Inline CondOp (PrimOr Var) -> CodeBlock (PrimOr Var) -> Exp Var
forall a. IfRate -> CondInfo a -> CodeBlock a -> MainExp a
UntilBlock

    onWhileBlock :: IfRate
-> CondInfo (PrimOr Int) -> CodeBlock (PrimOr Int) -> Infer s ()
onWhileBlock = (IfRate
 -> Inline CondOp (PrimOr Var) -> CodeBlock (PrimOr Var) -> Exp Var)
-> IfRate
-> CondInfo (PrimOr Int)
-> CodeBlock (PrimOr Int)
-> Infer s ()
forall {f :: * -> *} {f :: * -> *}.
(Functor f, Functor f) =>
(IfRate -> Inline CondOp (PrimOr Var) -> f (f Var) -> Exp Var)
-> IfRate -> CondInfo (PrimOr Int) -> f (f Int) -> Infer s ()
onIfBlockBy IfRate
-> Inline CondOp (PrimOr Var) -> CodeBlock (PrimOr Var) -> Exp Var
forall a. IfRate -> CondInfo a -> CodeBlock a -> MainExp a
WhileBlock

    onWhileRefBlock :: Var -> CodeBlock (PrimOr Int) -> Infer s ()
onWhileRefBlock Var
var CodeBlock (PrimOr Int)
th = do
      Infer s ()
forall s. Infer s ()
setHasIfs
      Exp Var -> Infer s ()
saveProcedure (Var -> CodeBlock (PrimOr Var) -> Exp Var
forall a. Var -> CodeBlock a -> MainExp a
WhileRefBlock Var
var ((Int -> Var) -> PrimOr Int -> PrimOr Var
forall a b. (a -> b) -> PrimOr a -> PrimOr b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rate -> Int -> Var
Var Rate
Xr) (PrimOr Int -> PrimOr Var)
-> CodeBlock (PrimOr Int) -> CodeBlock (PrimOr Var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodeBlock (PrimOr Int)
th))

    onIfBlockBy :: (IfRate -> Inline CondOp (PrimOr Var) -> f (f Var) -> Exp Var)
-> IfRate -> CondInfo (PrimOr Int) -> f (f Int) -> Infer s ()
onIfBlockBy IfRate -> Inline CondOp (PrimOr Var) -> f (f Var) -> Exp Var
cons IfRate
ifRate CondInfo (PrimOr Int)
cond f (f Int)
th = do
      Infer s ()
forall s. Infer s ()
setHasIfs
      Inline CondOp (PrimOr Var)
condVar <- (PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var))
-> CondInfo (PrimOr Int)
-> StateT (InferEnv s) (ST s) (Inline CondOp (PrimOr Var))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Inline CondOp a -> m (Inline CondOp b)
mapM ((Int -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PrimOr a -> m (PrimOr b)
mapM ((Int -> StateT (InferEnv s) (ST s) Var)
 -> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var))
-> (Int -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Int
-> StateT (InferEnv s) (ST s) (PrimOr Var)
forall a b. (a -> b) -> a -> b
$ Rate -> Int -> StateT (InferEnv s) (ST s) Var
forall s. Rate -> Int -> Infer s Var
getVar Rate
condMaxRate) CondInfo (PrimOr Int)
cond
      Inline CondOp (PrimOr Var)
condVarSafe <- Rate
-> Inline CondOp (PrimOr Var)
-> StateT (InferEnv s) (ST s) (Inline CondOp (PrimOr Var))
forall s.
Rate
-> Inline CondOp (PrimOr Var)
-> Infer s (Inline CondOp (PrimOr Var))
insertBoolConverters Rate
condMaxRate Inline CondOp (PrimOr Var)
condVar
      Exp Var -> Infer s ()
saveProcedure (IfRate -> Inline CondOp (PrimOr Var) -> f (f Var) -> Exp Var
cons IfRate
ifRate Inline CondOp (PrimOr Var)
condVarSafe ((Int -> Var) -> f Int -> f Var
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rate -> Int -> Var
Var Rate
Xr) (f Int -> f Var) -> f (f Int) -> f (f Var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (f Int)
th))
      where
        condMaxRate :: Rate
condMaxRate = IfRate -> Rate
fromIfRate IfRate
ifRate

    onIfElseBlock :: IfRate
-> CondInfo (PrimOr Int)
-> CodeBlock (PrimOr Int)
-> CodeBlock (PrimOr Int)
-> Infer s ()
onIfElseBlock IfRate
ifRate CondInfo (PrimOr Int)
cond CodeBlock (PrimOr Int)
th CodeBlock (PrimOr Int)
el = do
      Infer s ()
forall s. Infer s ()
setHasIfs
      Inline CondOp (PrimOr Var)
condVar <- (PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var))
-> CondInfo (PrimOr Int)
-> StateT (InferEnv s) (ST s) (Inline CondOp (PrimOr Var))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Inline CondOp a -> m (Inline CondOp b)
mapM ((Int -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PrimOr a -> m (PrimOr b)
mapM ((Int -> StateT (InferEnv s) (ST s) Var)
 -> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var))
-> (Int -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Int
-> StateT (InferEnv s) (ST s) (PrimOr Var)
forall a b. (a -> b) -> a -> b
$ Rate -> Int -> StateT (InferEnv s) (ST s) Var
forall s. Rate -> Int -> Infer s Var
getVar Rate
condMaxRate) CondInfo (PrimOr Int)
cond
      Inline CondOp (PrimOr Var)
condVarSafe <- Rate
-> Inline CondOp (PrimOr Var)
-> StateT (InferEnv s) (ST s) (Inline CondOp (PrimOr Var))
forall s.
Rate
-> Inline CondOp (PrimOr Var)
-> Infer s (Inline CondOp (PrimOr Var))
insertBoolConverters Rate
condMaxRate Inline CondOp (PrimOr Var)
condVar
      Exp Var -> Infer s ()
saveProcedure (IfRate
-> Inline CondOp (PrimOr Var)
-> CodeBlock (PrimOr Var)
-> CodeBlock (PrimOr Var)
-> Exp Var
forall a.
IfRate -> CondInfo a -> CodeBlock a -> CodeBlock a -> MainExp a
IfElseBlock IfRate
ifRate Inline CondOp (PrimOr Var)
condVarSafe ((Int -> Var) -> PrimOr Int -> PrimOr Var
forall a b. (a -> b) -> PrimOr a -> PrimOr b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rate -> Int -> Var
Var Rate
Xr) (PrimOr Int -> PrimOr Var)
-> CodeBlock (PrimOr Int) -> CodeBlock (PrimOr Var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodeBlock (PrimOr Int)
th) ((Int -> Var) -> PrimOr Int -> PrimOr Var
forall a b. (a -> b) -> PrimOr a -> PrimOr b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rate -> Int -> Var
Var Rate
Xr) (PrimOr Int -> PrimOr Var)
-> CodeBlock (PrimOr Int) -> CodeBlock (PrimOr Var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodeBlock (PrimOr Int)
el))
      where
        condMaxRate :: Rate
condMaxRate = IfRate -> Rate
fromIfRate IfRate
ifRate

    onIfBegin :: IfRate -> CondInfo (PrimOr Int) -> Infer s ()
onIfBegin IfRate
ifRate CondInfo (PrimOr Int)
cond = do
      Infer s ()
forall s. Infer s ()
setHasIfs
      (IfRate -> Inline CondOp (PrimOr Var) -> Exp Var)
-> IfRate -> CondInfo (PrimOr Int) -> Infer s ()
ifBeginBy IfRate -> Inline CondOp (PrimOr Var) -> Exp Var
forall a. IfRate -> CondInfo a -> MainExp a
IfBegin IfRate
ifRate CondInfo (PrimOr Int)
cond

    onWhileBegin :: IfRate -> CondInfo (PrimOr Int) -> Infer s ()
onWhileBegin = (IfRate -> Inline CondOp (PrimOr Var) -> Exp Var)
-> IfRate -> CondInfo (PrimOr Int) -> Infer s ()
ifBeginBy IfRate -> Inline CondOp (PrimOr Var) -> Exp Var
forall a. IfRate -> CondInfo a -> MainExp a
WhileBegin
    onUntilBegin :: IfRate -> CondInfo (PrimOr Int) -> Infer s ()
onUntilBegin = (IfRate -> Inline CondOp (PrimOr Var) -> Exp Var)
-> IfRate -> CondInfo (PrimOr Int) -> Infer s ()
ifBeginBy IfRate -> Inline CondOp (PrimOr Var) -> Exp Var
forall a. IfRate -> CondInfo a -> MainExp a
UntilBegin

    ifBeginBy :: (IfRate -> Inline CondOp (PrimOr Var) -> Exp Var)
-> IfRate -> CondInfo (PrimOr Int) -> Infer s ()
ifBeginBy IfRate -> Inline CondOp (PrimOr Var) -> Exp Var
cons IfRate
ifRate CondInfo (PrimOr Int)
cond = do
      Inline CondOp (PrimOr Var)
condVar <- (PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var))
-> CondInfo (PrimOr Int)
-> StateT (InferEnv s) (ST s) (Inline CondOp (PrimOr Var))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Inline CondOp a -> m (Inline CondOp b)
mapM ((Int -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PrimOr a -> m (PrimOr b)
mapM ((Int -> StateT (InferEnv s) (ST s) Var)
 -> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var))
-> (Int -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Int
-> StateT (InferEnv s) (ST s) (PrimOr Var)
forall a b. (a -> b) -> a -> b
$ Rate -> Int -> StateT (InferEnv s) (ST s) Var
forall s. Rate -> Int -> Infer s Var
getVar Rate
condMaxRate) CondInfo (PrimOr Int)
cond
      Inline CondOp (PrimOr Var)
condVarSafe <- Rate
-> Inline CondOp (PrimOr Var)
-> StateT (InferEnv s) (ST s) (Inline CondOp (PrimOr Var))
forall s.
Rate
-> Inline CondOp (PrimOr Var)
-> Infer s (Inline CondOp (PrimOr Var))
insertBoolConverters Rate
condMaxRate Inline CondOp (PrimOr Var)
condVar
      Exp Var -> Infer s ()
saveProcedure (IfRate -> Inline CondOp (PrimOr Var) -> Exp Var
cons IfRate
ifRate Inline CondOp (PrimOr Var)
condVarSafe)
      where
        condMaxRate :: Rate
condMaxRate = IfRate -> Rate
fromIfRate IfRate
ifRate

    -------------------------------------------------------------
    -- arrays

    onInitArr :: Var -> [PrimOr Int] -> Infer s ()
onInitArr Var
v [PrimOr Int]
arrSize = do
      [PrimOr Var]
typedArrSize <- (PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var))
-> [PrimOr Int] -> StateT (InferEnv s) (ST s) [PrimOr Var]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Int -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PrimOr a -> m (PrimOr b)
mapM (Rate -> Int -> StateT (InferEnv s) (ST s) Var
forall s. Rate -> Int -> Infer s Var
getVar Rate
Ir)) [PrimOr Int]
arrSize
      Exp Var -> Infer s ()
saveProcedure (Var -> [PrimOr Var] -> Exp Var
forall a. Var -> [a] -> MainExp a
InitArr Var
v [PrimOr Var]
typedArrSize)

    onReadArr :: Var -> [PrimOr Int] -> Infer s ()
onReadArr Var
v [PrimOr Int]
index = Rate -> Exp Var -> Infer s ()
save (Var -> Rate
Exp.varRate Var
v) (Exp Var -> Infer s ())
-> ([PrimOr Var] -> Exp Var) -> [PrimOr Var] -> Infer s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> [PrimOr Var] -> Exp Var
forall a. Var -> [a] -> MainExp a
ReadArr Var
v ([PrimOr Var] -> Infer s ())
-> StateT (InferEnv s) (ST s) [PrimOr Var] -> Infer s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StateT (InferEnv s) (ST s) [PrimOr Var]
forall {s}. StateT (InferEnv s) (ST s) [PrimOr Var]
typedIndex
      where
        indexRate :: Rate
indexRate = Var -> Rate
getArrIndexRate Var
v
        typedIndex :: StateT (InferEnv s) (ST s) [PrimOr Var]
typedIndex = (PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var))
-> [PrimOr Int] -> StateT (InferEnv s) (ST s) [PrimOr Var]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Int -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PrimOr a -> m (PrimOr b)
mapM (Rate -> Int -> StateT (InferEnv s) (ST s) Var
forall s. Rate -> Int -> Infer s Var
getVar Rate
indexRate)) [PrimOr Int]
index

    onWriteArr :: Var -> [PrimOr Int] -> PrimOr Int -> Infer s ()
onWriteArr Var
v [PrimOr Int]
index PrimOr Int
arg = do
      [PrimOr Var]
typedIndex <- (PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var))
-> [PrimOr Int] -> StateT (InferEnv s) (ST s) [PrimOr Var]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Int -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PrimOr a -> m (PrimOr b)
mapM (Rate -> Int -> StateT (InferEnv s) (ST s) Var
forall s. Rate -> Int -> Infer s Var
getVar Rate
indexRate)) [PrimOr Int]
index
      PrimOr Var
argVar <- (Int -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PrimOr a -> m (PrimOr b)
mapM (Rate -> Int -> StateT (InferEnv s) (ST s) Var
forall s. Rate -> Int -> Infer s Var
getVar (Var -> Rate
Exp.varRate Var
v)) PrimOr Int
arg
      Exp Var -> Infer s ()
saveProcedure (Var -> [PrimOr Var] -> PrimOr Var -> Exp Var
forall a. Var -> [a] -> a -> MainExp a
WriteArr Var
v [PrimOr Var]
typedIndex PrimOr Var
argVar)
      where
        indexRate :: Rate
indexRate = Var -> Rate
getArrIndexRate Var
v

    onWriteInitArr :: Var -> [PrimOr Int] -> PrimOr Int -> Infer s ()
onWriteInitArr Var
v [PrimOr Int]
arrSize PrimOr Int
initVal = do
      [PrimOr Var]
typedArrSize <- (PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var))
-> [PrimOr Int] -> StateT (InferEnv s) (ST s) [PrimOr Var]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Int -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PrimOr a -> m (PrimOr b)
mapM (Rate -> Int -> StateT (InferEnv s) (ST s) Var
forall s. Rate -> Int -> Infer s Var
getVar Rate
Ir)) [PrimOr Int]
arrSize
      PrimOr Var
typedInitVal <- (Int -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PrimOr a -> m (PrimOr b)
mapM (Rate -> Int -> StateT (InferEnv s) (ST s) Var
forall s. Rate -> Int -> Infer s Var
getVar (Var -> Rate
Exp.varRate Var
v)) PrimOr Int
initVal
      Exp Var -> Infer s ()
saveProcedure (Var -> [PrimOr Var] -> PrimOr Var -> Exp Var
forall a. Var -> [a] -> a -> MainExp a
WriteInitArr Var
v [PrimOr Var]
typedArrSize PrimOr Var
typedInitVal)

    getArrIndexRate :: Var -> Rate
getArrIndexRate Var
v=
      case Var -> Rate
Exp.varRate Var
v of
        Rate
Ir -> Rate
Ir
        Rate
Sr -> Rate
Ir
        Rate
_  -> Rate
Kr

    onTfmArr :: Bool -> Var -> Info -> [PrimOr Int] -> Infer s ()
onTfmArr Bool
isArrInit Var
vout Info
info [PrimOr Int]
args = do
      [PrimOr Var]
typedArgs <- [PrimOr Int] -> StateT (InferEnv s) (ST s) [PrimOr Var]
forall {s}. [PrimOr Int] -> StateT (InferEnv s) (ST s) [PrimOr Var]
getTypedArrArgs [PrimOr Int]
args
      Exp Var -> Infer s ()
saveProcedure (Bool -> Var -> Info -> [PrimOr Var] -> Exp Var
forall a. Bool -> Var -> Info -> [a] -> MainExp a
TfmArr Bool
isArrInit Var
vout Info
info [PrimOr Var]
typedArgs)
      where
        outRate :: Rate
outRate = Var -> Rate
Exp.varRate Var
vout

        inRates :: [Rate]
inRates =
          case Info -> Signature
infoSignature Info
info of
            SingleRate Map Rate [Rate]
rateMap ->
              case Rate -> Map Rate [Rate] -> Maybe [Rate]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Rate
outRate Map Rate [Rate]
rateMap of
                Just [Rate]
res -> [Rate]
res
                Maybe [Rate]
Nothing -> String -> [Rate]
forall {a}. String -> a
toError String
"Rate conversion is not supported for arrays"
            MultiRate [Rate]
_ [Rate]
_ -> String -> [Rate]
forall {a}. String -> a
toError String
"Arrays with multiple argument s are not supported"
          where
            toError :: String -> a
toError String
msg = String -> a
forall a. HasCallStack => String -> a
error ([String] -> String
unwords [String
msg, String
"Found on array opcode", Name -> String
Text.unpack (Name -> String) -> Name -> String
forall a b. (a -> b) -> a -> b
$ Info -> Name
infoName Info
info])

        getTypedArrArgs :: [PrimOr Int] -> StateT (InferEnv s) (ST s) [PrimOr Var]
getTypedArrArgs [PrimOr Int]
ins = (Rate -> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var))
-> [Rate]
-> [PrimOr Int]
-> StateT (InferEnv s) (ST s) [PrimOr Var]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Rate -> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall s. Rate -> PrimOr Int -> Infer s (PrimOr Var)
applyArg [Rate]
inRates [PrimOr Int]
ins

    -------------------------------------------------------------
    -- pure (read-only) arrays

    onInitPureArr :: Rate -> IfRate -> [PrimOr Int] -> Infer s ()
onInitPureArr Rate
outRate IfRate
processingRate [PrimOr Int]
initVals = do
      [PrimOr Var]
typedInits <- (PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var))
-> [PrimOr Int] -> StateT (InferEnv s) (ST s) [PrimOr Var]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Int -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PrimOr a -> m (PrimOr b)
mapM (Rate -> Int -> StateT (InferEnv s) (ST s) Var
forall s. Rate -> Int -> Infer s Var
getVar Rate
initRate)) [PrimOr Int]
initVals
      Rate -> Exp Var -> Infer s ()
save (Rate -> Rate
toArrRate Rate
outRate) (Rate -> IfRate -> [PrimOr Var] -> Exp Var
forall a. Rate -> IfRate -> [a] -> MainExp a
InitPureArr Rate
outRate IfRate
processingRate [PrimOr Var]
typedInits)
      where
        initRate :: Rate
initRate = IfRate -> Rate
fromIfRate IfRate
processingRate

    onReadPureArr :: Rate -> IfRate -> PrimOr Int -> PrimOr Int -> Infer s ()
onReadPureArr Rate
outRate IfRate
processingRate PrimOr Int
arr PrimOr Int
index = do
      PrimOr Var
typedIndex <- (Int -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PrimOr a -> m (PrimOr b)
mapM (Rate -> Int -> StateT (InferEnv s) (ST s) Var
forall s. Rate -> Int -> Infer s Var
getVar Rate
initRate) PrimOr Int
index
      PrimOr Var
typedArr <- (Int -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Int -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PrimOr a -> m (PrimOr b)
mapM (Rate -> Int -> StateT (InferEnv s) (ST s) Var
forall s. Rate -> Int -> Infer s Var
getVar Rate
outRate) PrimOr Int
arr
      Rate -> Exp Var -> Infer s ()
save Rate
outRate (Rate -> IfRate -> PrimOr Var -> PrimOr Var -> Exp Var
forall a. Rate -> IfRate -> a -> a -> MainExp a
ReadPureArr Rate
outRate IfRate
processingRate PrimOr Var
typedArr PrimOr Var
typedIndex)
      where
        initRate :: Rate
initRate = IfRate -> Rate
fromIfRate IfRate
processingRate

    -------------------------------------------------------------
    -- generic funs

    save :: Rate -> Exp Var -> Infer s ()
    save :: Rate -> Exp Var -> Infer s ()
save Rate
rate Exp Var
typedRhs =
      Stmt Var -> Infer s ()
forall s. Stmt Var -> Infer s ()
saveStmt (Stmt Var -> Infer s ()) -> Stmt Var -> Infer s ()
forall a b. (a -> b) -> a -> b
$ Stmt
        { stmtLhs :: Var
stmtLhs = Rate -> Int -> Var
Var Rate
rate Int
lhs
        , stmtRhs :: RatedExp Var
stmtRhs = RatedExp Int
rhs { ratedExpExp = typedRhs }
        }

    -- procedure does not save output rate to type map, as it's never going to
    -- be referenced from any right hand side of the expression
    --
    -- Procedures always have Xr as output rate
    saveProcedure :: Exp Var -> Infer s ()
    saveProcedure :: Exp Var -> Infer s ()
saveProcedure Exp Var
typedRhs =
      Stmt Var -> Infer s ()
forall s. Stmt Var -> Infer s ()
appendResult (Stmt Var -> Infer s ()) -> Stmt Var -> Infer s ()
forall a b. (a -> b) -> a -> b
$ Stmt
        { stmtLhs :: Var
stmtLhs = Rate -> Int -> Var
Var Rate
Xr Int
lhs
        , stmtRhs :: RatedExp Var
stmtRhs = RatedExp Int
rhs { ratedExpExp = typedRhs }
        }

-------------------------------------------------------------
-- generic funs

setType :: Var -> Infer s ()
setType :: forall s. Var -> Infer s ()
setType (Var Rate
rate Int
name) = do
  STVector s Rate
typeMap <- (InferEnv s -> STVector s Rate)
-> StateT (InferEnv s) (ST s) (STVector s Rate)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets InferEnv s -> STVector s Rate
forall s. InferEnv s -> STVector s Rate
envTypeMap
  MVector (PrimState (StateT (InferEnv s) (ST s))) Rate
-> Int -> Rate -> Infer s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
Vector.write STVector s Rate
MVector (PrimState (StateT (InferEnv s) (ST s))) Rate
typeMap Int
name Rate
rate

appendResult :: Stmt Var -> Infer s ()
appendResult :: forall s. Stmt Var -> Infer s ()
appendResult Stmt Var
expr = (InferEnv s -> InferEnv s) -> StateT (InferEnv s) (ST s) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' ((InferEnv s -> InferEnv s) -> StateT (InferEnv s) (ST s) ())
-> (InferEnv s -> InferEnv s) -> StateT (InferEnv s) (ST s) ()
forall a b. (a -> b) -> a -> b
$ \InferEnv s
s -> InferEnv s
s { envResult = expr : envResult s }

data SignatureChoice = SignatureChoice
  { SignatureChoice -> Int
destructiveConversionsCount :: !Int
  , SignatureChoice -> OpcSignature
signatureCandidate          :: !OpcSignature
  }

data OpcodeArg = OpcodeArg
  { OpcodeArg -> Rate
opcodeTo   :: !Rate
  , OpcodeArg -> PrimOr Rate
opcodeFrom :: !(PrimOr Rate)
  }

unifies :: OpcodeArg -> Bool
unifies :: OpcodeArg -> Bool
unifies (OpcodeArg Rate
to (PrimOr Either Prim Rate
from)) =
  case Rate
to of
    Rate
Xr -> Bool
True
    Rate
Ar -> Rate -> Bool
is Rate
Ar
    Rate
Kr -> Rate -> Bool
is Rate
Kr Bool -> Bool -> Bool
|| Rate -> Bool
is Rate
Ir Bool -> Bool -> Bool
|| Bool
isPrim
    Rate
Ir -> Rate -> Bool
is Rate
Ir
    Rate
_  -> Rate -> Bool
is Rate
to
  where
    is :: Rate -> Bool
is Rate
r = (Prim -> Rate) -> (Rate -> Rate) -> Either Prim Rate -> Rate
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Prim -> Rate
primRate Rate -> Rate
forall a. a -> a
id Either Prim Rate
from Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate
r

    isPrim :: Bool
isPrim = (Prim -> Bool) -> (Rate -> Bool) -> Either Prim Rate -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> Prim -> Bool
forall a b. a -> b -> a
const Bool
True) (Bool -> Rate -> Bool
forall a b. a -> b -> a
const Bool
False) Either Prim Rate
from

-- | Checks if opcode conversion is destructive
-- Note that we rely on Haskell type-checker and don't consider
-- cases of type-mismatch lke comparing number with string.
--
-- There are two cases of destructive updates:
--
-- * Ar or Kr is converted to Ir
-- * Ar is converted to Kr
destructiveConversion :: OpcodeArg -> Bool
destructiveConversion :: OpcodeArg -> Bool
destructiveConversion (OpcodeArg Rate
to (PrimOr Either Prim Rate
from)) =
  case Rate
to of
    Rate
Ir -> Rate
fromRate Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
/= Rate
Ir
    Rate
Kr -> Rate
fromRate Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate
Ar
    Rate
_  -> Bool
False
  where
    fromRate :: Rate
fromRate = (Prim -> Rate) -> (Rate -> Rate) -> Either Prim Rate -> Rate
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Prim -> Rate
primRate Rate -> Rate
forall a. a -> a
id Either Prim Rate
from

applyArg :: Rate -> PrimOr Int -> Infer s (PrimOr Var)
applyArg :: forall s. Rate -> PrimOr Int -> Infer s (PrimOr Var)
applyArg Rate
targetRate PrimOr Int
arg = do
  PrimOr Var
argVar <- (Int -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Int -> Infer s (PrimOr Var)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PrimOr a -> m (PrimOr b)
mapM (Rate -> Int -> StateT (InferEnv s) (ST s) Var
forall s. Rate -> Int -> Infer s Var
getVar Rate
Ir) PrimOr Int
arg
  let opcArg :: OpcodeArg
opcArg =
        OpcodeArg
          { opcodeTo :: Rate
opcodeTo = Rate
targetRate
          , opcodeFrom :: PrimOr Rate
opcodeFrom = Var -> Rate
varType (Var -> Rate) -> PrimOr Var -> PrimOr Rate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrimOr Var
argVar
          }
  if OpcodeArg -> Bool
unifies OpcodeArg
opcArg
    then PrimOr Var -> Infer s (PrimOr Var)
forall a. a -> StateT (InferEnv s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimOr Var
argVar
    else Either Prim Var -> PrimOr Var
forall a. Either Prim a -> PrimOr a
PrimOr (Either Prim Var -> PrimOr Var)
-> (Var -> Either Prim Var) -> Var -> PrimOr Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> Either Prim Var
forall a b. b -> Either a b
Right (Var -> PrimOr Var)
-> StateT (InferEnv s) (ST s) Var -> Infer s (PrimOr Var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rate -> PrimOr Var -> StateT (InferEnv s) (ST s) Var
forall s. Rate -> PrimOr Var -> Infer s Var
convert (OpcodeArg -> Rate
opcodeTo OpcodeArg
opcArg) PrimOr Var
argVar

-------------------------------------------------------------------
-- utils

getVar :: Rate -> Int -> Infer s Var
getVar :: forall s. Rate -> Int -> Infer s Var
getVar Rate
_defaultRate Int
vid = do
  STVector s Rate
types <- (InferEnv s -> STVector s Rate)
-> StateT (InferEnv s) (ST s) (STVector s Rate)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets InferEnv s -> STVector s Rate
forall s. InferEnv s -> STVector s Rate
envTypeMap
  Rate
ty <- MVector (PrimState (StateT (InferEnv s) (ST s))) Rate
-> Int -> StateT (InferEnv s) (ST s) Rate
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
Vector.read STVector s Rate
MVector (PrimState (StateT (InferEnv s) (ST s))) Rate
types Int
vid
  Var -> Infer s Var
forall a. a -> StateT (InferEnv s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rate -> Int -> Var
Var Rate
ty Int
vid)

convert :: Rate -> PrimOr Var -> Infer s Var
convert :: forall s. Rate -> PrimOr Var -> Infer s Var
convert Rate
toRate (PrimOr Either Prim Var
fromVar) = do
  case Either Prim Var
fromVar of
    Left Prim
p  -> Prim -> Infer s Var
forall s. Prim -> Infer s Var
convertPrim Prim
p
    Right Var
v -> Var -> Infer s Var
forall s. Var -> Infer s Var
convertVar Var
v
  where
    convertPrim :: Prim -> Infer s Var
    convertPrim :: forall s. Prim -> Infer s Var
convertPrim Prim
prim = do
      Map Prim Var
primMap <- (InferEnv s -> Map Prim Var)
-> StateT (InferEnv s) (ST s) (Map Prim Var)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets InferEnv s -> Map Prim Var
forall s. InferEnv s -> Map Prim Var
envPrims
      Var
v <- case Prim -> Map Prim Var -> Maybe Var
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Prim
prim Map Prim Var
primMap of
        Just Var
v  -> Var -> Infer s Var
forall a. a -> StateT (InferEnv s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Var
v
        Maybe Var
Nothing -> Prim -> Infer s Var
forall s. Prim -> Infer s Var
allocatePrim Prim
prim
      Var -> Infer s Var
forall s. Var -> Infer s Var
convertVar Var
v

    convertVar :: Var -> Infer s Var
    convertVar :: forall s. Var -> Infer s Var
convertVar Var
inVar = do
      Maybe Var
mOutVar <- Var -> Infer s (Maybe Var)
forall s. Var -> Infer s (Maybe Var)
tryExistingConverters Var
inVar
      case Maybe Var
mOutVar of
        Just Var
outVar -> Var -> Infer s Var
forall a. a -> StateT (InferEnv s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Var
outVar
        Maybe Var
Nothing     -> do
          let rhs :: RatedExp Var
rhs = Exp Var -> RatedExp Var
forall a. Exp a -> RatedExp a
newExp (Exp Var -> RatedExp Var) -> Exp Var -> RatedExp Var
forall a b. (a -> b) -> a -> b
$ Rate -> Maybe Rate -> PrimOr Var -> Exp Var
forall a. Rate -> Maybe Rate -> a -> MainExp a
ConvertRate Rate
toRate (Rate -> Maybe Rate
forall a. a -> Maybe a
Just (Rate -> Maybe Rate) -> Rate -> Maybe Rate
forall a b. (a -> b) -> a -> b
$ Var -> Rate
varType Var
inVar) (Either Prim Var -> PrimOr Var
forall a. Either Prim a -> PrimOr a
PrimOr (Either Prim Var -> PrimOr Var) -> Either Prim Var -> PrimOr Var
forall a b. (a -> b) -> a -> b
$ Var -> Either Prim Var
forall a b. b -> Either a b
Right Var
inVar)
          Var
outVar <- Rate -> RatedExp Var -> Infer s Var
forall s. Rate -> RatedExp Var -> Infer s Var
defineVar Rate
toRate RatedExp Var
rhs
          Var -> Var -> Infer s ()
forall s. Var -> Var -> Infer s ()
saveConversion Var
outVar Var
inVar
          Var -> Infer s Var
forall a. a -> StateT (InferEnv s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Var
outVar

    tryExistingConverters :: Var -> Infer s (Maybe Var)
    tryExistingConverters :: forall s. Var -> Infer s (Maybe Var)
tryExistingConverters (Var Rate
_ Int
name) = do
      IntMap (Map Rate Var)
convMap <- (InferEnv s -> IntMap (Map Rate Var))
-> StateT (InferEnv s) (ST s) (IntMap (Map Rate Var))
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets InferEnv s -> IntMap (Map Rate Var)
forall s. InferEnv s -> IntMap (Map Rate Var)
envConversions
      Maybe Var -> Infer s (Maybe Var)
forall a. a -> StateT (InferEnv s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Var -> Infer s (Maybe Var))
-> Maybe Var -> Infer s (Maybe Var)
forall a b. (a -> b) -> a -> b
$ Rate -> Map Rate Var -> Maybe Var
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Rate
toRate (Map Rate Var -> Maybe Var) -> Maybe (Map Rate Var) -> Maybe Var
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IntMap (Map Rate Var) -> Maybe (Map Rate Var)
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
name IntMap (Map Rate Var)
convMap

    allocatePrim :: Prim -> Infer s Var
    allocatePrim :: forall s. Prim -> Infer s Var
allocatePrim Prim
prim = do
      Var
var <- Rate -> RatedExp Var -> Infer s Var
forall s. Rate -> RatedExp Var -> Infer s Var
defineVar (Prim -> Rate
primRate Prim
prim) (Exp Var -> RatedExp Var
forall a. Exp a -> RatedExp a
newExp (Exp Var -> RatedExp Var) -> Exp Var -> RatedExp Var
forall a b. (a -> b) -> a -> b
$ Prim -> Exp Var
forall a. Prim -> MainExp a
ExpPrim Prim
prim)
      (InferEnv s -> InferEnv s) -> StateT (InferEnv s) (ST s) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' ((InferEnv s -> InferEnv s) -> StateT (InferEnv s) (ST s) ())
-> (InferEnv s -> InferEnv s) -> StateT (InferEnv s) (ST s) ()
forall a b. (a -> b) -> a -> b
$ \InferEnv s
s -> InferEnv s
s { envPrims = Map.insert prim var $ envPrims s }
      Var -> Infer s Var
forall a. a -> StateT (InferEnv s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Var
var

-- | Checks if convertion is identity, then returns original
convertIf :: Rate -> PrimOr Var -> Infer s (PrimOr Var)
convertIf :: forall s. Rate -> PrimOr Var -> Infer s (PrimOr Var)
convertIf Rate
toRate PrimOr Var
var
  | Rate
toRate Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== PrimOr Var -> Rate
primOrRate PrimOr Var
var = PrimOr Var -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall a. a -> StateT (InferEnv s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimOr Var
var
  | Bool
otherwise                = Either Prim Var -> PrimOr Var
forall a. Either Prim a -> PrimOr a
PrimOr (Either Prim Var -> PrimOr Var)
-> (Var -> Either Prim Var) -> Var -> PrimOr Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> Either Prim Var
forall a b. b -> Either a b
Right (Var -> PrimOr Var)
-> StateT (InferEnv s) (ST s) Var
-> StateT (InferEnv s) (ST s) (PrimOr Var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rate -> PrimOr Var -> StateT (InferEnv s) (ST s) Var
forall s. Rate -> PrimOr Var -> Infer s Var
convert Rate
toRate PrimOr Var
var

newExp :: Exp a -> RatedExp a
newExp :: forall a. Exp a -> RatedExp a
newExp Exp a
rhs =
  RatedExp
    { ratedExpHash :: ByteString
ratedExpHash = ByteString
ignoreHash
    , ratedExpRate :: Maybe Rate
ratedExpRate = Maybe Rate
forall a. Maybe a
Nothing
    , ratedExpDepends :: Maybe Int
ratedExpDepends = Maybe Int
forall a. Maybe a
Nothing
    , ratedExpExp :: Exp a
ratedExpExp = Exp a
rhs
    }

-- | On this stage we don't need expression hashes anymore
ignoreHash :: ByteString
ignoreHash :: ByteString
ignoreHash = ByteString
""

-- | Allocate new var and assign RHS expression to it
defineVar :: Rate -> RatedExp Var -> Infer s Var
defineVar :: forall s. Rate -> RatedExp Var -> Infer s Var
defineVar Rate
rate RatedExp Var
rhs = do
  Var
v <- Rate -> Infer s Var
forall s. Rate -> Infer s Var
freshVar Rate
rate
  Stmt Var -> Infer s ()
forall s. Stmt Var -> Infer s ()
appendResult (Var -> RatedExp Var -> Stmt Var
forall a. a -> RatedExp a -> Stmt a
Stmt Var
v RatedExp Var
rhs)
  Var -> Infer s Var
forall a. a -> StateT (InferEnv s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Var
v

-- | Allocate fresh variable with given rate
freshVar :: Rate -> Infer s Var
freshVar :: forall s. Rate -> Infer s Var
freshVar Rate
rate = Rate -> Int -> Var
Var Rate
rate (Int -> Var)
-> StateT (InferEnv s) (ST s) Int -> StateT (InferEnv s) (ST s) Var
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT (InferEnv s) (ST s) Int
forall s. Infer s Int
freshId

-- | Allocate new fresh id
freshId :: Infer s Int
freshId :: forall s. Infer s Int
freshId = do
  Int
lastFreshId <- (InferEnv s -> Int) -> Infer s Int
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets InferEnv s -> Int
forall s. InferEnv s -> Int
envLastFreshId
  (InferEnv s -> InferEnv s) -> StateT (InferEnv s) (ST s) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' ((InferEnv s -> InferEnv s) -> StateT (InferEnv s) (ST s) ())
-> (InferEnv s -> InferEnv s) -> StateT (InferEnv s) (ST s) ()
forall a b. (a -> b) -> a -> b
$ \InferEnv s
s -> InferEnv s
s { envLastFreshId = lastFreshId + 1 }
  Int -> Infer s Int
forall a. a -> StateT (InferEnv s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
lastFreshId

insertBoolConverters :: Rate -> CondInfo (PrimOr Var) -> Infer s (CondInfo (PrimOr Var))
insertBoolConverters :: forall s.
Rate
-> Inline CondOp (PrimOr Var)
-> Infer s (Inline CondOp (PrimOr Var))
insertBoolConverters Rate
ifRate = (PrimOr Var -> StateT (InferEnv s) (ST s) (PrimOr Var))
-> Inline CondOp (PrimOr Var)
-> StateT (InferEnv s) (ST s) (Inline CondOp (PrimOr Var))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Inline CondOp a -> m (Inline CondOp b)
mapM ((Var -> StateT (InferEnv s) (ST s) Var)
-> PrimOr Var -> StateT (InferEnv s) (ST s) (PrimOr Var)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PrimOr a -> m (PrimOr b)
mapM Var -> StateT (InferEnv s) (ST s) Var
forall s. Var -> Infer s Var
go)
  where
    go :: Var -> Infer s Var
    go :: forall s. Var -> Infer s Var
go Var
v
      | Rate
ifRate Rate -> Rate -> Bool
forall a. Ord a => a -> a -> Bool
>= Var -> Rate
varType Var
v = Var -> StateT (InferEnv s) (ST s) Var
forall a. a -> StateT (InferEnv s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Var
v
      | Bool
otherwise           = Rate -> PrimOr Var -> StateT (InferEnv s) (ST s) Var
forall s. Rate -> PrimOr Var -> Infer s Var
convert Rate
ifRate (Either Prim Var -> PrimOr Var
forall a. Either Prim a -> PrimOr a
PrimOr (Either Prim Var -> PrimOr Var) -> Either Prim Var -> PrimOr Var
forall a b. (a -> b) -> a -> b
$ Var -> Either Prim Var
forall a b. b -> Either a b
Right Var
v)

saveStmt :: Stmt Var -> Infer s ()
saveStmt :: forall s. Stmt Var -> Infer s ()
saveStmt Stmt Var
expr = do
  Var -> Infer s ()
forall s. Var -> Infer s ()
setType (Stmt Var -> Var
forall a. Stmt a -> a
stmtLhs Stmt Var
expr)
  Stmt Var -> Infer s ()
forall s. Stmt Var -> Infer s ()
appendResult Stmt Var
expr

saveConversion :: Var -> Var -> Infer s ()
saveConversion :: forall s. Var -> Var -> Infer s ()
saveConversion Var
outVar Var
inVar =
  (InferEnv s -> InferEnv s) -> StateT (InferEnv s) (ST s) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' ((InferEnv s -> InferEnv s) -> StateT (InferEnv s) (ST s) ())
-> (InferEnv s -> InferEnv s) -> StateT (InferEnv s) (ST s) ()
forall a b. (a -> b) -> a -> b
$ \InferEnv s
s -> InferEnv s
s { envConversions = update $ envConversions s }
  where
    update :: IntMap (Map Rate Var) -> IntMap (Map Rate Var)
update IntMap (Map Rate Var)
conversionMap = (Maybe (Map Rate Var) -> Maybe (Map Rate Var))
-> Int -> IntMap (Map Rate Var) -> IntMap (Map Rate Var)
forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IntMap.alter Maybe (Map Rate Var) -> Maybe (Map Rate Var)
go (Var -> Int
varId Var
inVar) IntMap (Map Rate Var)
conversionMap

    go :: Maybe (Map Rate Var) -> Maybe (Map Rate Var)
go = Map Rate Var -> Maybe (Map Rate Var)
forall a. a -> Maybe a
Just (Map Rate Var -> Maybe (Map Rate Var))
-> (Maybe (Map Rate Var) -> Map Rate Var)
-> Maybe (Map Rate Var)
-> Maybe (Map Rate Var)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      Maybe (Map Rate Var)
Nothing -> Rate -> Var -> Map Rate Var
forall k a. k -> a -> Map k a
Map.singleton (Var -> Rate
varType Var
outVar) Var
outVar
      Just Map Rate Var
m  -> Rate -> Var -> Map Rate Var -> Map Rate Var
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Var -> Rate
varType Var
outVar) Var
outVar Map Rate Var
m

setHasIfs :: Infer s ()
setHasIfs :: forall s. Infer s ()
setHasIfs = (InferEnv s -> InferEnv s) -> StateT (InferEnv s) (ST s) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' ((InferEnv s -> InferEnv s) -> StateT (InferEnv s) (ST s) ())
-> (InferEnv s -> InferEnv s) -> StateT (InferEnv s) (ST s) ()
forall a b. (a -> b) -> a -> b
$ \InferEnv s
s -> InferEnv s
s { envHasIfs = True }

----------------------------------------------------------------
-- rate calculations

primRate :: Prim -> Rate
primRate :: Prim -> Rate
primRate = \case
  PrimString Name
_ -> Rate
Sr
  PrimVar Rate
r Var
_  -> Rate
r
  Prim
_            -> Rate
Ir

primOrRate :: PrimOr Var -> Rate
primOrRate :: PrimOr Var -> Rate
primOrRate = (Prim -> Rate) -> (Var -> Rate) -> Either Prim Var -> Rate
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Prim -> Rate
primRate Var -> Rate
varType (Either Prim Var -> Rate)
-> (PrimOr Var -> Either Prim Var) -> PrimOr Var -> Rate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimOr Var -> Either Prim Var
forall a. PrimOr a -> Either Prim a
unPrimOr