X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FNormalize%2FNormalizeTypes.hs;h=80d39ac19ce10dbfccb75af33057a49e24f0c9a1;hb=bcaa7ec85a9025a95c431f550bb5ea0cf5af5375;hp=90589f85e16b74445058f9bf43a96d9d33714fae;hpb=d30d9fe36698d9d9b5e44099fba9ba090e54064f;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git "a/c\316\273ash/CLasH/Normalize/NormalizeTypes.hs" "b/c\316\273ash/CLasH/Normalize/NormalizeTypes.hs" index 90589f8..80d39ac 100644 --- "a/c\316\273ash/CLasH/Normalize/NormalizeTypes.hs" +++ "b/c\316\273ash/CLasH/Normalize/NormalizeTypes.hs" @@ -1,57 +1,33 @@ -{-# LANGUAGE TemplateHaskell #-} module CLasH.Normalize.NormalizeTypes where - -- Standard modules import qualified Control.Monad.Trans.Writer as Writer -import qualified Control.Monad.Trans.State as State import qualified Data.Monoid as Monoid -import qualified Data.Accessor.Template -import Data.Accessor -import qualified Data.Map as Map -import Debug.Trace -- GHC API -import CoreSyn -import qualified UniqSupply -import qualified VarSet -import Outputable ( Outputable, showSDoc, ppr ) +import qualified CoreSyn -- Local imports -import CLasH.Utils.Core.CoreShow -import CLasH.Utils.Pretty -import CLasH.VHDL.VHDLTypes -- For TypeState - -data TransformState = TransformState { - tsUniqSupply_ :: UniqSupply.UniqSupply - , tsBindings_ :: Map.Map CoreBndr CoreExpr - , tsNormalized_ :: VarSet.VarSet -- ^ The binders that have been normalized - , tsType_ :: TypeState -} +import CLasH.Translator.TranslatorTypes -$( Data.Accessor.Template.deriveAccessors ''TransformState ) - --- A session of multiple transformations over multiple expressions -type TransformSession = (State.State TransformState) --- Wrap a writer around a TransformSession, to run a single transformation +-- Wrap a writer around a TranslatorSession, to run a single transformation -- over a single expression and track if the expression was changed. -type TransformMonad = Writer.WriterT Monoid.Any TransformSession - +type TransformMonad = Writer.WriterT Monoid.Any TranslatorSession + +-- | In what context does a core expression occur? +data CoreContext = AppFirst -- ^ The expression is the first + -- argument of an application (i.e., + -- it is applied) + | AppSecond -- ^ The expression is the second + -- argument of an application + -- (i.e., something is applied to it) + | LetBinding -- ^ The expression is bound in a + -- (recursive or non-recursive) let + -- expression. + | LetBody -- ^ The expression is the body of a + -- let expression + | LambdaBody -- ^ The expression is the body of a + -- lambda abstraction + | Other -- ^ Another context -- | Transforms a CoreExpr and keeps track if it has changed. -type Transform = CoreExpr -> TransformMonad CoreExpr - --- Finds the value of a global binding, if available -getGlobalBind :: CoreBndr -> TransformSession (Maybe CoreExpr) -getGlobalBind bndr = do - bindings <- getA tsBindings - return $ Map.lookup bndr bindings - --- Adds a new global binding with the given value -addGlobalBind :: CoreBndr -> CoreExpr -> TransformSession () -addGlobalBind bndr expr = modA tsBindings (Map.insert bndr expr) - --- Returns a list of all global binders -getGlobalBinders :: TransformSession [CoreBndr] -getGlobalBinders = do - bindings <- getA tsBindings - return $ Map.keys bindings +type Transform = [CoreContext] -> CoreSyn.CoreExpr -> TransformMonad CoreSyn.CoreExpr