import CLasH.Normalize.NormalizeTypes
import CLasH.Translator.TranslatorTypes
import CLasH.Normalize.NormalizeTools
import CLasH.Normalize.NormalizeTypes
import CLasH.Translator.TranslatorTypes
import CLasH.Normalize.NormalizeTools
import qualified CLasH.Utils as Utils
import CLasH.Utils.Core.CoreTools
import CLasH.Utils.Core.BinderTools
import qualified CLasH.Utils as Utils
import CLasH.Utils.Core.CoreTools
import CLasH.Utils.Core.BinderTools
-- argument) correspond exactly to this list, we then look up baz in
-- that list and replace the entire expression by the corresponding
-- argument to D:Baz.
-- argument) correspond exactly to this list, we then look up baz in
-- that list and replace the entire expression by the corresponding
-- argument to D:Baz.
+--
+-- We don't resolve methods that have a builtin translation (such as
+-- ==), since the actual implementation is not always (easily)
+-- translateable. For example, when deriving ==, GHC generates code
+-- using $con2tag functions to translate a datacon to an int and compare
+-- that with GHC.Prim.==# . Better to avoid that for now.
case Id.isClassOpId_maybe sel of
-- Not a class op selector
Nothing -> return expr
Just cls -> case collectArgs dict of
(_, []) -> return expr -- Dict is not an application (e.g., not inlined yet)
case Id.isClassOpId_maybe sel of
-- Not a class op selector
Nothing -> return expr
Just cls -> case collectArgs dict of
(_, []) -> return expr -- Dict is not an application (e.g., not inlined yet)
- (dictdc, (ty':selectors)) | tyargs_neq ty ty' -> error $ "Applying class selector to dictionary without matching type?\n" ++ pprString expr
+ (Var dictdc, (ty':selectors)) | not (Maybe.isJust (Id.isDataConId_maybe dictdc)) -> return expr -- Dictionary is not a datacon yet (but e.g., a top level binder)
+ | tyargs_neq ty ty' -> error $ "Applying class selector to dictionary without matching type?\n" ++ pprString expr
| otherwise ->
let selector_ids = Class.classSelIds cls in
-- Find the selector used in the class' list of selectors
| otherwise ->
let selector_ids = Class.classSelIds cls in
-- Find the selector used in the class' list of selectors
Nothing -> error $ "Selector not found in class' selector list? This should not happen!\nExpression: " ++ pprString expr ++ "\nClass: " ++ show cls ++ "\nSelectors: " ++ show selector_ids
-- Get the corresponding argument from the dictionary
Just n -> change (selectors!!n)
Nothing -> error $ "Selector not found in class' selector list? This should not happen!\nExpression: " ++ pprString expr ++ "\nClass: " ++ show cls ++ "\nSelectors: " ++ show selector_ids
-- Get the corresponding argument from the dictionary
Just n -> change (selectors!!n)
where
-- Compare two type arguments, returning True if they are _not_
-- equal
tyargs_neq (Type ty1) (Type ty2) = not $ Type.coreEqType ty1 ty2
tyargs_neq _ _ = True
where
-- Compare two type arguments, returning True if they are _not_
-- equal
tyargs_neq (Type ty1) (Type ty2) = not $ Type.coreEqType ty1 ty2
tyargs_neq _ _ = True
-- is bound to a new simple selector case statement and for each complex
-- expression. We do this only for representable types, to prevent loops with
-- inlinenonrep.
-- is bound to a new simple selector case statement and for each complex
-- expression. We do this only for representable types, to prevent loops with
-- inlinenonrep.
(bindingss, alts') <- (Monad.liftM unzip) $ mapM doalt alts
let bindings = concat bindingss
-- Replace the case with a let with bindings and a case
(bindingss, alts') <- (Monad.liftM unzip) $ mapM doalt alts
let bindings = concat bindingss
-- Replace the case with a let with bindings and a case
-- If there are no non-wild binders, or this case is already a simple
-- selector (i.e., a single alt with exactly one binding), already a simple
-- selector altan no bindings (i.e., no wild binders in the original case),
-- don't change anything, otherwise, replace the case.
if null bindings then return expr else change newlet
where
-- If there are no non-wild binders, or this case is already a simple
-- selector (i.e., a single alt with exactly one binding), already a simple
-- selector altan no bindings (i.e., no wild binders in the original case),
-- don't change anything, otherwise, replace the case.
if null bindings then return expr else change newlet
where
-- Generate a single wild binder, since they are all the same
wild = MkCore.mkWildBinder
-- Wilden the binders of one alt, producing a list of bindings as a
-- Generate a single wild binder, since they are all the same
wild = MkCore.mkWildBinder
-- Wilden the binders of one alt, producing a list of bindings as a
-- Replace a useless case by the value of its single alternative
caseremove (Case scrut b ty [(con, bndrs, expr)]) | not usesvars = change expr
-- Find if any of the binders are used by expr
-- Replace a useless case by the value of its single alternative
caseremove (Case scrut b ty [(con, bndrs, expr)]) | not usesvars = change expr
-- Find if any of the binders are used by expr
-- Leave all other expressions unchanged
caseremove expr = return expr
-- Perform this transform everywhere
-- Leave all other expressions unchanged
caseremove expr = return expr
-- Perform this transform everywhere