generate slightly better code for ccall argument-pushing on x86

[ghc-hetmet.git] / compiler / deSugar / DsMeta.hs

diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index c2d83d6..902eeb8 100644 (file)
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -338,10 +338,10 @@ repForD (L loc (ForeignImport name typ (CImport cc s ch cis)))
  where
     conv_cimportspec (CLabel cls) = notHandled "Foreign label" (doubleQuotes (ppr cls))
     conv_cimportspec (CFunction DynamicTarget) = return "dynamic"
-    conv_cimportspec (CFunction (StaticTarget fs)) = return (unpackFS fs)
+    conv_cimportspec (CFunction (StaticTarget fs _)) = return (unpackFS fs)
     conv_cimportspec CWrapper = return "wrapper"
     static = case cis of
-                 CFunction (StaticTarget _) -> "static "
+                 CFunction (StaticTarget _ _) -> "static "
                  _ -> ""
 repForD decl = notHandled "Foreign declaration" (ppr decl)
 
@@ -714,20 +714,26 @@ repE (HsLet bs e)         = do { (ss,ds) <- repBinds bs
                               ; e2 <- addBinds ss (repLE e)
                               ; z <- repLetE ds e2
                               ; wrapGenSyns ss z }
+
 -- FIXME: I haven't got the types here right yet
-repE (HsDo DoExpr sts body _) 
+repE e@(HsDo ctxt sts body _) 
+ | case ctxt of { DoExpr -> True; GhciStmt -> True; _ -> False }
  = do { (ss,zs) <- repLSts sts; 
        body'   <- addBinds ss $ repLE body;
        ret     <- repNoBindSt body';   
-        e       <- repDoE (nonEmptyCoreList (zs ++ [ret]));
-        wrapGenSyns ss e }
-repE (HsDo ListComp sts body _)
+        e'      <- repDoE (nonEmptyCoreList (zs ++ [ret]));
+        wrapGenSyns ss e' }
+
+ | ListComp <- ctxt
  = do { (ss,zs) <- repLSts sts; 
        body'   <- addBinds ss $ repLE body;
        ret     <- repNoBindSt body';   
-        e       <- repComp (nonEmptyCoreList (zs ++ [ret]));
-        wrapGenSyns ss e }
-repE e@(HsDo _ _ _ _) = notHandled "mdo and [: :]" (ppr e)
+        e'      <- repComp (nonEmptyCoreList (zs ++ [ret]));
+        wrapGenSyns ss e' }
+
+  | otherwise
+  = notHandled "mdo and [: :]" (ppr e)
+
 repE (ExplicitList _ es) = do { xs <- repLEs es; repListExp xs }
 repE e@(ExplicitPArr _ _) = notHandled "Parallel arrays" (ppr e)
 repE e@(ExplicitTuple es boxed)