X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Normalize.hs;h=57af9125b0195c5194065f041e5c3a71dc77b634;hb=17852552fb024c01f8f8d76c8668c5327c32d4ff;hp=cbe2090e22def5d29d3b24bb878f37c68b81b3ea;hpb=031ee3b7556147516be038372de576b3db6b67ba;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/Normalize.hs b/Normalize.hs
index cbe2090..57af912 100644
--- a/Normalize.hs
+++ b/Normalize.hs
@@ -62,7 +62,7 @@ beta (App (Let binds expr) arg) = change $ Let binds (App expr arg)
 beta (App (Case scrut b ty alts) arg) = change $ Case scrut b ty' alts'
   where 
     alts' = map (\(con, bndrs, expr) -> (con, bndrs, (App expr arg))) alts
-    (_, ty') = Type.splitFunTy ty
+    ty' = CoreUtils.applyTypeToArg ty arg
 -- Leave all other expressions unchanged
 beta expr = return expr
 -- Perform this transform everywhere
@@ -302,14 +302,13 @@ typeprop, typeproptop :: Transform
 -- arguments without any free tyvars, since tyvars those wouldn't be in scope
 -- in the new function.
 typeprop expr@(App (Var f) arg@(Type ty)) | not $ has_free_tyvars arg = do
-  id <- cloneVar f
-  let newty = Type.applyTy (Id.idType f) ty
-  let newf = Var.setVarType id newty
   body_maybe <- Trans.lift $ getGlobalBind f
   case body_maybe of
     Just body -> do
       let newbody = App body (Type ty)
-      Trans.lift $ addGlobalBind newf newbody
+      -- Create a new function with the same name but a new body
+      newf <- mkFunction f newbody
+      -- Replace the application with this new function
       change (Var newf)
     -- If we don't have a body for the function called, leave it unchanged (it
     -- should be a primitive function then).
@@ -346,11 +345,8 @@ funprop expr@(App _ _) | is_var fexpr && not (any has_free_tyvars args) = do
           -- Create a new body that consists of a lambda for all new arguments and
           -- the old body applied to some arguments.
           let newbody = MkCore.mkCoreLams newparams (MkCore.mkCoreApps body oldargs)
-          -- Create a new function name
-          id <- cloneVar f
-          let newf = Var.setVarType id (CoreUtils.exprType newbody)
-          -- Add the new function
-          Trans.lift $ addGlobalBind newf newbody
+          -- Create a new function with the same name but a new body
+          newf <- mkFunction f newbody
           -- Replace the original application with one of the new function to the
           -- new arguments.
           change $ MkCore.mkCoreApps (Var newf) newargs
@@ -446,6 +442,10 @@ normalizeBind bndr = do
       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