We already have a fixed VHDL translation for these, and usually the
actual implementation is not translateable (for example, the derived Eq
instances translate dataconstructors to Int#'s and use GHC.Prim.==# to
compare them).
import qualified Type
import qualified Id
import qualified Var
import qualified Type
import qualified Id
import qualified Var
import qualified VarSet
import qualified CoreFVs
import qualified Class
import qualified VarSet
import qualified CoreFVs
import qualified Class
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 CLasH.VHDL.Constants (builtinIds)
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.
classopresolution, classopresolutiontop :: Transform
classopresolution, classopresolutiontop :: Transform
-classopresolution expr@(App (App (Var sel) ty) dict) =
+classopresolution expr@(App (App (Var sel) ty) dict) | not is_builtin =
case Id.isClassOpId_maybe sel of
-- Not a class op selector
Nothing -> return expr
case Id.isClassOpId_maybe sel of
-- Not a class op selector
Nothing -> return expr
-- equal
tyargs_neq (Type ty1) (Type ty2) = not $ Type.coreEqType ty1 ty2
tyargs_neq _ _ = True
-- equal
tyargs_neq (Type ty1) (Type ty2) = not $ Type.coreEqType ty1 ty2
tyargs_neq _ _ = True
+ -- Is this a builtin function / method?
+ is_builtin = elem (Name.getOccString sel) builtinIds
-- Leave all other expressions unchanged
classopresolution expr = return expr
-- Leave all other expressions unchanged
classopresolution expr = return expr