Merge branch 'master' of http://git.stderr.nl/matthijs/master-project/cλash

[matthijs/master-project/cλash.git] / cλash / CLasH / Normalize.hs

diff --git a/cλash/CLasH/Normalize.hs b/cλash/CLasH/Normalize.hs
index 4a5ceec9c07683fe1c3fb89c8fca9a1be96621c4..31474d59328bd0342fc6244262061eba736b8c80 100644 (file)
--- a/cλash/CLasH/Normalize.hs
+++ b/cλash/CLasH/Normalize.hs
@@ -338,6 +338,13 @@ inlinenonreptop = everywhere ("inlinenonrep", inlinebind ((Monad.liftM not) . is
 -- doesn't seem to set all those names as "system names", we apply some
 -- guessing here.
 inlinetoplevel, inlinetopleveltop :: Transform
+-- HACK: Don't inline == and /=. The default (derived) implementation
+-- for /= uses the polymorphic version of ==, which gets a dictionary
+-- for Eq passed in, which contains a reference to itself, resulting in
+-- an infinite loop in transformation. Not inlining == is really a hack,
+-- but for now it keeps things working with the most common symptom of
+-- this problem.
+inlinetoplevel expr@(Var f) | Name.getOccString f `elem` ["==", "/="] = return expr
 -- Any system name is candidate for inlining. Never inline user-defined
 -- functions, to preserve structure.
 inlinetoplevel expr@(Var f) | not $ isUserDefined f = do
@@ -438,12 +445,12 @@ classopresolution expr@(App (App (Var sel) ty) dict) | not is_builtin =
     Just cls -> case collectArgs dict of
       (_, []) -> return expr -- Dict is not an application (e.g., not inlined yet)
       (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
+                                | tyargs_neq ty ty' -> error $ "Normalize.classopresolution: 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
         case List.elemIndex sel selector_ids of
-          Nothing -> error $ "Selector not found in class' selector list? This should not happen!\nExpression: " ++ pprString expr ++ "\nClass: " ++ show cls ++ "\nSelectors: " ++ show selector_ids
+          Nothing -> error $ "Normalize.classopresolution: 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)
       (_, _) -> return expr -- Not applying a variable? Don't touch