X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=clash%2FCLasH%2FNormalize%2FNormalizeTypes.hs;h=f4e5e9b523eb9f3c0ace82aa90c06f6d23205ebf;hb=bebe01ce76e62bea88aba87d5cceecfab7a0c6c4;hp=4e98709eed26c2bf07dbbf5339014957cd44910d;hpb=ef7d876bddac1ebf8ae72dfac9aff33023650f53;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/clash/CLasH/Normalize/NormalizeTypes.hs b/clash/CLasH/Normalize/NormalizeTypes.hs index 4e98709..f4e5e9b 100644 --- a/clash/CLasH/Normalize/NormalizeTypes.hs +++ b/clash/CLasH/Normalize/NormalizeTypes.hs @@ -21,14 +21,39 @@ data CoreContext = AppFirst -- ^ The expression is the first | AppSecond -- ^ The expression is the second -- argument of an application -- (i.e., something is applied to it) - | LetBinding -- ^ The expression is bound in a + | LetBinding [CoreSyn.CoreBndr] + -- ^ The expression is bound in a -- (recursive or non-recursive) let -- expression. - | LetBody -- ^ The expression is the body of a + | LetBody [CoreSyn.CoreBndr] + -- ^ The expression is the body of a -- let expression - | LambdaBody -- ^ The expression is the body of a + | LambdaBody CoreSyn.CoreBndr + -- ^ The expression is the body of a -- lambda abstraction + | CaseAlt CoreSyn.CoreBndr + -- ^ The expression is the body of a + -- case alternative. | Other -- ^ Another context deriving (Eq, Show) -- | Transforms a CoreExpr and keeps track if it has changed. type Transform = [CoreContext] -> CoreSyn.CoreExpr -> TransformMonad CoreSyn.CoreExpr + +-- Predicates for each of the context types +is_appfirst_ctx, is_appsecond_ctx, is_letbinding_ctx, is_letbody_ctx, is_lambdabody_ctx + :: CoreContext -> Bool + +is_appfirst_ctx AppFirst = True +is_appfirst_ctx _ = False + +is_appsecond_ctx AppSecond = True +is_appsecond_ctx _ = False + +is_letbinding_ctx (LetBinding _) = True +is_letbinding_ctx _ = False + +is_letbody_ctx (LetBody _) = True +is_letbody_ctx _ = False + +is_lambdabody_ctx (LambdaBody _) = True +is_lambdabody_ctx _ = False