Never try to normalize global binders.
authorMatthijs Kooijman <m.kooijman@student.utwente.nl>
Mon, 22 Jun 2009 08:17:29 +0000 (10:17 +0200)
committerMatthijs Kooijman <m.kooijman@student.utwente.nl>
Mon, 22 Jun 2009 08:17:29 +0000 (10:17 +0200)
These should mostly (always?) be functions imported from elsewhere (for
which we won't have a value) or dataconstructors.

Normalize.hs

index ea8dd045d60579df06df560667806ec4f51717d6..9aedb4b856a17f8292241262df1f9622527efb9a 100644 (file)
@@ -33,6 +33,7 @@ import Outputable ( showSDoc, ppr, nest )
 import NormalizeTypes
 import NormalizeTools
 import CoreTools
+import Pretty
 
 --------------------------------
 -- Start of transformations
@@ -430,45 +431,47 @@ normalizeModule uniqsupply bindings generate_for statefuls = runTransformSession
 
 normalizeBind :: CoreBndr -> TransformSession ()
 normalizeBind bndr =
-  -- Skip binders that have a polymorphic type, since it's impossible to
-  -- create polymorphic hardware.
-  if is_poly (Var bndr)
-    then
-      -- This should really only happen at the top level... TODO: Give
-      -- a different error if this happens down in the recursion.
-      error $ "Function " ++ show bndr ++ " is polymorphic, can't normalize"
-    else do
-      normalized_funcs <- getA tsNormalized
-      -- See if this function was normalized already
-      if VarSet.elemVarSet bndr normalized_funcs
-        then
-          -- Yup, don't do it again
-          return ()
-        else do
-          -- Nope, note that it has been and do it.
-          modA tsNormalized (flip VarSet.extendVarSet bndr)
-          expr_maybe <- getGlobalBind bndr
-          case expr_maybe of 
-            Just expr -> do
-              -- Introduce an empty Let at the top level, so there will always be
-              -- a let in the expression (none of the transformations will remove
-              -- the last let).
-              let expr' = Let (Rec []) expr
-              -- Normalize this expression
-              trace ("Transforming " ++ (show bndr) ++ "\nBefore:\n\n" ++ showSDoc ( ppr expr' ) ++ "\n") $ return ()
-              expr' <- dotransforms transforms expr'
-              trace ("\nAfter:\n\n" ++ showSDoc ( ppr expr')) $ return ()
-              -- And store the normalized version in the session
-              modA tsBindings (Map.insert bndr expr')
-              -- Find all vars used with a function type. All of these should be global
-              -- binders (i.e., functions used), since any local binders with a function
-              -- type should have been inlined already.
-              let used_funcs_set = CoreFVs.exprSomeFreeVars (\v -> (Type.isFunTy . snd . Type.splitForAllTys . Id.idType) v) expr'
-              let used_funcs = VarSet.varSetElems used_funcs_set
-              -- Process each of the used functions recursively
-              mapM normalizeBind used_funcs
-              return ()
-            -- We don't have a value for this binder, let's assume this is a builtin
-            -- function. This might need some extra checking and a nice error
-            -- message).
-            Nothing -> return ()
+  -- Don't normalize global variables, these should be either builtin
+  -- functions or data constructors.
+  Monad.when (Var.isLocalIdVar bndr) $ do
+    -- Skip binders that have a polymorphic type, since it's impossible to
+    -- create polymorphic hardware.
+    if is_poly (Var bndr)
+      then
+        -- This should really only happen at the top level... TODO: Give
+        -- a different error if this happens down in the recursion.
+        error $ "Function " ++ show bndr ++ " is polymorphic, can't normalize"
+      else do
+        normalized_funcs <- getA tsNormalized
+        -- See if this function was normalized already
+        if VarSet.elemVarSet bndr normalized_funcs
+          then
+            -- Yup, don't do it again
+            return ()
+          else do
+            -- Nope, note that it has been and do it.
+            modA tsNormalized (flip VarSet.extendVarSet bndr)
+            expr_maybe <- getGlobalBind bndr
+            case expr_maybe of 
+              Just expr -> do
+                -- Introduce an empty Let at the top level, so there will always be
+                -- a let in the expression (none of the transformations will remove
+                -- the last let).
+                let expr' = Let (Rec []) expr
+                -- Normalize this expression
+                trace ("Transforming " ++ (show bndr) ++ "\nBefore:\n\n" ++ showSDoc ( ppr expr' ) ++ "\n") $ return ()
+                expr' <- dotransforms transforms expr'
+                trace ("\nAfter:\n\n" ++ showSDoc ( ppr expr')) $ return ()
+                -- And store the normalized version in the session
+                modA tsBindings (Map.insert bndr expr')
+                -- Find all vars used with a function type. All of these should be global
+                -- binders (i.e., functions used), since any local binders with a function
+                -- type should have been inlined already.
+                let used_funcs_set = CoreFVs.exprSomeFreeVars (\v -> (Type.isFunTy . snd . Type.splitForAllTys . Id.idType) v) expr'
+                let used_funcs = VarSet.varSetElems used_funcs_set
+                -- Process each of the used functions recursively
+                mapM normalizeBind used_funcs
+                return ()
+              -- We don't have a value for this binder. This really shouldn't
+              -- happen for local id's...
+              Nothing -> error $ "No value found for binder " ++ pprString bndr ++ "? This should not happen!"