module DDC.Core.Flow.Transform.Concretize
(concretizeModule)
where
import DDC.Core.Module
import DDC.Core.Flow.Compounds
import DDC.Core.Flow.Prim
import DDC.Core.Flow.Exp
import DDC.Core.Transform.TransformUpX
import qualified DDC.Type.Env as Env
import qualified Data.Map as Map
concretizeModule :: Module () Name -> Module () Name
concretizeModule mm
= transformSimpleUpX concretizeX Env.empty Env.empty mm
concretizeX
:: KindEnvF -> TypeEnvF
-> ExpF -> Maybe ExpF
concretizeX _kenv tenv xx
| Just ( NameOpLoop OpLoopLoop
, [XType tK, xF]) <- takeXPrimApps xx
, Just (nS, _, tA) <- findSeriesWithRate tenv tK
, xS <- XVar (UName nS)
= Just
$ xLoopLoopN
tK
(xRateOfSeries tK tA xS)
xF
| Just ( NameOpStore OpStoreNewVectorR
, [XType tA, XType tK]) <- takeXPrimApps xx
, Just (nS, _, tS) <- findSeriesWithRate tenv tK
, xS <- XVar (UName nS)
= Just
$ xNewVectorN
tA tK
(xRateOfSeries tK tS xS)
| otherwise
= Nothing
findSeriesWithRate
:: TypeEnvF
-> Type Name
-> Maybe (Name, Type Name, Type Name)
findSeriesWithRate tenv tR
= go (Map.toList (Env.envMap tenv))
where
go [] = Nothing
go ((n, tS) : moar)
= case isSeriesTypeOfRate tR tS of
Nothing -> go moar
Just (_, tA) -> Just (n, tR, tA)
isSeriesTypeOfRate
:: Type Name -> Type Name
-> Maybe (Type Name, Type Name)
isSeriesTypeOfRate tR tS
| Just ( NameTyConFlow TyConFlowSeries
, [tR', tA]) <- takePrimTyConApps tS
, tR == tR'
= Just (tR, tA)
| otherwise
= Nothing