Another round of External Core fixes

With this patch, GHC should now be printing External Core in a format
that a stand-alone program can parse and typecheck. Major bug fixes:

- The printer now handles qualified/unqualified declarations correctly
   (particularly data constructor declarations)
- It prints newtype declarations with enough information to
  typecheck code that uses the induced coercions (this required a
syntax change)
- It expands type synonyms correctly

Documentation and external tool patches will follow.

diff --git a/compiler/coreSyn/ExternalCore.lhs b/compiler/coreSyn/ExternalCore.lhs
index 2a8d152..d3b6e3a 100644 (file)
--- a/compiler/coreSyn/ExternalCore.lhs
+++ b/compiler/coreSyn/ExternalCore.lhs
@@ -13,17 +13,19 @@ data Tdef
   | Newtype (Qual Tcon) [Tbind] Axiom (Maybe Ty)
 
 data Cdef 
   | Newtype (Qual Tcon) [Tbind] Axiom (Maybe Ty)
 
 data Cdef 

-  = Constr Dcon [Tbind] [Ty]
-  | GadtConstr Dcon Ty
+  = Constr (Qual Dcon) [Tbind] [Ty]
+  | GadtConstr (Qual Dcon) Ty

 
 -- Newtype coercion
 
 -- Newtype coercion

-type Axiom = (Qual Tcon, Kind)
+type Axiom = (Qual Tcon, [Tbind], Kind)

 
 data Vdefg 
   = Rec [Vdef]
   | Nonrec Vdef
 
 
 data Vdefg 
   = Rec [Vdef]
   | Nonrec Vdef
 

-type Vdef = (Bool,Var,Ty,Exp)  -- Top level bindings are unqualified now
+-- Top-level bindings are qualified, so that the printer doesn't have to pass
+-- around the module name.
+type Vdef = (Bool,Qual Var,Ty,Exp)

 
 data Exp 
   = Var (Qual Var)
 
 data Exp 
   = Var (Qual Var)

diff --git a/compiler/coreSyn/MkExternalCore.lhs b/compiler/coreSyn/MkExternalCore.lhs
index 3e8a989..337b21a 100644 (file)
--- a/compiler/coreSyn/MkExternalCore.lhs
+++ b/compiler/coreSyn/MkExternalCore.lhs
@@ -22,39 +22,50 @@ import Var
 import IdInfo
 import Literal
 import Name
 import IdInfo
 import Literal
 import Name

-import NameSet
-import UniqSet

 import Outputable
 import Encoding
 import ForeignCall
 import DynFlags
 import StaticFlags
 import Outputable
 import Encoding
 import ForeignCall
 import DynFlags
 import StaticFlags

-import IO

 import FastString
 
 import FastString
 

+import IO

 import Data.Char
 
 import Data.Char
 

-emitExternalCore :: DynFlags -> NameSet -> CgGuts -> IO ()
-emitExternalCore dflags exports cg_guts
+emitExternalCore :: DynFlags -> CgGuts -> IO ()
+emitExternalCore dflags cg_guts

  | opt_EmitExternalCore 
  = (do handle <- openFile corename WriteMode
  | opt_EmitExternalCore 
  = (do handle <- openFile corename WriteMode

-       hPutStrLn handle (show (mkExternalCore exports cg_guts))      
+       hPutStrLn handle (show (mkExternalCore cg_guts))      

        hClose handle)
    `catch` (\_ -> pprPanic "Failed to open or write external core output file"
                            (text corename))
    where corename = extCoreName dflags
        hClose handle)
    `catch` (\_ -> pprPanic "Failed to open or write external core output file"
                            (text corename))
    where corename = extCoreName dflags

-emitExternalCore _ _ _
+emitExternalCore _ _

  | otherwise
  = return ()
 
  | otherwise
  = return ()
 

-
-mkExternalCore :: NameSet -> CgGuts -> C.Module
+-- Reinventing the Reader monad; whee.
+newtype CoreM a = CoreM (CoreState -> (CoreState, a))
+type CoreState = Module
+instance Monad CoreM where
+  (CoreM m) >>= f = CoreM (\ s -> case m s of
+                                    (s',r) -> case f r of
+                                                CoreM f' -> f' s')
+  return x = CoreM (\ s -> (s, x))
+runCoreM :: CoreM a -> CoreState -> a
+runCoreM (CoreM f) s = snd $ f s
+ask :: CoreM CoreState
+ask = CoreM (\ s -> (s,s))
+
+mkExternalCore :: CgGuts -> C.Module

 -- The ModGuts has been tidied, but the implicit bindings have
 -- not been injected, so we have to add them manually here
 -- We don't include the strange data-con *workers* because they are
 -- implicit in the data type declaration itself
 -- The ModGuts has been tidied, but the implicit bindings have
 -- not been injected, so we have to add them manually here
 -- We don't include the strange data-con *workers* because they are
 -- implicit in the data type declaration itself

-mkExternalCore exports (CgGuts {cg_module=this_mod, cg_tycons = tycons, cg_binds = binds})
-  = C.Module mname tdefs (map (make_vdef exports) binds)
+mkExternalCore (CgGuts {cg_module=this_mod, cg_tycons = tycons, cg_binds = binds})
+  = (C.Module mname tdefs (runCoreM (mapM (make_vdef True) binds) 
+                            this_mod))

   where
     mname  = make_mid this_mod
     tdefs  = foldr collect_tdefs [] tycons
   where
     mname  = make_mid this_mod
     tdefs  = foldr collect_tdefs [] tycons

@@ -66,25 +77,27 @@ collect_tdefs tcon tdefs
     tdef | isNewTyCon tcon = 
                 C.Newtype (qtc tcon) (map make_tbind tyvars) 
                   (case newTyConCo_maybe tcon of
     tdef | isNewTyCon tcon = 
                 C.Newtype (qtc tcon) (map make_tbind tyvars) 
                   (case newTyConCo_maybe tcon of

-                     Just coercion -> (qtc coercion, 
-                       make_kind $ (uncurry mkCoKind) $  
-                                  case isCoercionTyCon_maybe coercion of
-                                    -- See Note [Newtype coercions] in 
-                                    -- types/TyCon
-                                    Just (arity,coKindFun) -> coKindFun $
-                                       map mkTyVarTy $ take arity tyvars
-                                    Nothing -> pprPanic ("MkExternalCore:\
-                                      coercion tcon should have a kind fun")
-                                        (ppr tcon))
+                     Just co -> (qtc co, 
+                        map make_tbind vs, 
+                        make_kind (mkCoKind l r))
+                       where (vs,l,r) = coercionAxiom co

                      Nothing       -> pprPanic ("MkExternalCore: newtype tcon\
                                        should have a coercion: ") (ppr tcon))
                    repclause 
          | otherwise = 
                      Nothing       -> pprPanic ("MkExternalCore: newtype tcon\
                                        should have a coercion: ") (ppr tcon))
                    repclause 
          | otherwise = 

-                C.Data (qtc tcon) (map make_tbind tyvars) (map make_cdef (tyConDataCons tcon)) 
+                C.Data (qtc tcon) (map make_tbind tyvars) 
+                   (map make_cdef (tyConDataCons tcon)) 

          where repclause | isRecursiveTyCon tcon || isOpenTyCon tcon= Nothing
          where repclause | isRecursiveTyCon tcon || isOpenTyCon tcon= Nothing

-                        | otherwise = Just (make_ty (repType rhs))
-                                           where (_, rhs) = newTyConRhs tcon
+                        | otherwise = Just (make_ty (snd (newTyConRhs tcon)))

     tyvars = tyConTyVars tcon
     tyvars = tyConTyVars tcon

+    coercionAxiom co = 
+      case isCoercionTyCon_maybe co of
+        -- See Note [Newtype coercions] in 
+        -- types/TyCon
+        Just (arity,coKindFun) | (l,r) <- (coKindFun $ map mkTyVarTy vs) -> 
+            (vs,l,r) where vs = take arity tyvars
+        Nothing -> pprPanic "MkExternalCore: coercion tcon lacks a kind fun"
+                     (ppr tcon)

 
 collect_tdefs _ tdefs = tdefs
 
 
 collect_tdefs _ tdefs = tdefs
 

@@ -95,7 +108,7 @@ qtc = make_con_qid . tyConName
 make_cdef :: DataCon -> C.Cdef
 make_cdef dcon =  C.Constr dcon_name existentials tys
   where 
 make_cdef :: DataCon -> C.Cdef
 make_cdef dcon =  C.Constr dcon_name existentials tys
   where 

-    dcon_name    = make_var_id (dataConName dcon)
+    dcon_name    = make_qid False False (dataConName dcon)

     existentials = map make_tbind ex_tyvars
     ex_tyvars    = dataConExTyVars dcon
     tys         = map make_ty (dataConRepArgTys dcon)
     existentials = map make_tbind ex_tyvars
     ex_tyvars    = dataConExTyVars dcon
     tys         = map make_ty (dataConRepArgTys dcon)

@@ -106,53 +119,74 @@ make_tbind tv = (make_var_id (tyVarName tv), make_kind (tyVarKind tv))
 make_vbind :: Var -> C.Vbind
 make_vbind v = (make_var_id  (Var.varName v), make_ty (idType v))
 
 make_vbind :: Var -> C.Vbind
 make_vbind v = (make_var_id  (Var.varName v), make_ty (idType v))
 

-make_vdef :: NameSet -> CoreBind -> C.Vdefg
-make_vdef exports b = 
+make_vdef :: Bool -> CoreBind -> CoreM C.Vdefg
+make_vdef topLevel b = 

   case b of
   case b of

-    NonRec v e -> C.Nonrec (f (v,e))
-    Rec ves -> C.Rec (map f ves)
+    NonRec v e -> f (v,e)     >>= (return . C.Nonrec)
+    Rec ves    -> mapM f ves  >>= (return . C.Rec)

   where
   where

-  f (v,e) = (local, make_var_id (Var.varName v), make_ty (idType v),make_exp e)
-       where local = not $ elementOfUniqSet (Var.varName v) exports
-       -- Top level bindings are unqualified now
-
-make_exp :: CoreExpr -> C.Exp
-make_exp (Var v) =  
-  case globalIdDetails v of
-     -- a DataConId represents the Id of a worker, which is a varName. -- sof 4/02
---    DataConId _ -> C.Dcon (make_con_qid (Var.varName v))
-    FCallId (CCall (CCallSpec (StaticTarget nm) callconv _)) 
-        -> C.External (unpackFS nm) (showSDoc (ppr callconv)) (make_ty (idType v))
-    FCallId (CCall (CCallSpec DynamicTarget     callconv _)) 
-        -> C.DynExternal            (showSDoc (ppr callconv)) (make_ty (idType v))
-    FCallId _ 
-        -> pprPanic "MkExternalCore died: can't handle non-{static,dynamic}-C foreign call"
+  f :: (CoreBndr,CoreExpr) -> CoreM C.Vdef
+  f (v,e) = do
+          localN <- isALocal vName
+          let local = not topLevel || localN
+          rhs <- make_exp e
+          -- use local flag to determine where to add the module name
+          return (local, make_qid local True vName, make_ty (idType v),rhs)
+       where vName = Var.varName v
+
+make_exp :: CoreExpr -> CoreM C.Exp
+make_exp (Var v) = do
+  let vName = Var.varName v
+  isLocal <- isALocal vName
+  return $
+     case globalIdDetails v of
+       FCallId (CCall (CCallSpec (StaticTarget nm) callconv _)) 
+           -> C.External (unpackFS nm) (showSDoc (ppr callconv)) (make_ty (idType v))
+       FCallId (CCall (CCallSpec DynamicTarget     callconv _)) 
+           -> C.DynExternal            (showSDoc (ppr callconv)) (make_ty (idType v))
+       FCallId _ 
+           -> pprPanic "MkExternalCore died: can't handle non-{static,dynamic}-C foreign call"

                     (ppr v)
                     (ppr v)

-    _ -> C.Var (make_var_qid (Var.varName v))
-make_exp (Lit (MachLabel s _)) = C.Label (unpackFS s)
-make_exp (Lit l) = C.Lit (make_lit l)
-make_exp (App e (Type t)) = C.Appt (make_exp e) (make_ty t)
-make_exp (App e1 e2) = C.App (make_exp e1) (make_exp e2)
-make_exp (Lam v e) | isTyVar v = C.Lam (C.Tb (make_tbind v)) (make_exp e)
-make_exp (Lam v e) | otherwise = C.Lam (C.Vb (make_vbind v)) (make_exp e)
-make_exp (Cast e co) = C.Cast (make_exp e) (make_ty co)
-make_exp (Let b e) = C.Let (make_vdef emptyNameSet b) (make_exp e)
--- gaw 2004
-make_exp (Case e v ty alts) = C.Case (make_exp e) (make_vbind v) (make_ty ty) (map make_alt alts)
-make_exp (Note (SCC _) e) = C.Note "SCC"  (make_exp e) -- temporary
-make_exp (Note (CoreNote s) e) = C.Note s (make_exp e)  -- hdaume: core annotations
-make_exp (Note InlineMe e) = C.Note "InlineMe" (make_exp e)
+       -- Constructors are always exported, so make sure to declare them
+       -- with qualified names
+       DataConWorkId _ -> C.Var (make_var_qid False vName)
+       DataConWrapId _ -> C.Var (make_var_qid False vName)
+       _ -> C.Var (make_var_qid isLocal vName)
+make_exp (Lit (MachLabel s _)) = return $ C.Label (unpackFS s)
+make_exp (Lit l) = return $ C.Lit (make_lit l)
+make_exp (App e (Type t)) = make_exp e >>= (\ b -> return $ C.Appt b (make_ty t))
+make_exp (App e1 e2) = do
+   rator <- make_exp e1
+   rand <- make_exp e2
+   return $ C.App rator rand
+make_exp (Lam v e) | isTyVar v = make_exp e >>= (\ b -> 
+                                    return $ C.Lam (C.Tb (make_tbind v)) b)
+make_exp (Lam v e) | otherwise = make_exp e >>= (\ b -> 
+                                    return $ C.Lam (C.Vb (make_vbind v)) b)
+make_exp (Cast e co) = make_exp e >>= (\ b -> return $ C.Cast b (make_ty co))
+make_exp (Let b e) = do
+  vd   <- make_vdef False b
+  body <- make_exp e
+  return $ C.Let vd body
+make_exp (Case e v ty alts) = do
+  scrut <- make_exp e
+  newAlts  <- mapM make_alt alts
+  return $ C.Case scrut (make_vbind v) (make_ty ty) newAlts
+make_exp (Note (SCC _) e) = make_exp e >>= (return . C.Note "SCC") -- temporary
+make_exp (Note (CoreNote s) e) = make_exp e >>= (return . C.Note s)  -- hdaume: core annotations
+make_exp (Note InlineMe e) = make_exp e >>= (return . C.Note "InlineMe")

 make_exp _ = error "MkExternalCore died: make_exp"
 
 make_exp _ = error "MkExternalCore died: make_exp"
 

-make_alt :: CoreAlt -> C.Alt
-make_alt (DataAlt dcon, vs, e) = 
-    C.Acon (make_con_qid (dataConName dcon))
+make_alt :: CoreAlt -> CoreM C.Alt
+make_alt (DataAlt dcon, vs, e) = do
+    newE <- make_exp e
+    return $ C.Acon (make_con_qid (dataConName dcon))

            (map make_tbind tbs)
            (map make_vbind vbs)
            (map make_tbind tbs)
            (map make_vbind vbs)

-          (make_exp e)    
+          newE

        where (tbs,vbs) = span isTyVar vs
        where (tbs,vbs) = span isTyVar vs

-make_alt (LitAlt l,_,e)   = C.Alit (make_lit l) (make_exp e)
-make_alt (DEFAULT,[],e)   = C.Adefault (make_exp e)
+make_alt (LitAlt l,_,e)   = make_exp e >>= (return . (C.Alit (make_lit l)))
+make_alt (DEFAULT,[],e)   = make_exp e >>= (return . C.Adefault)

 -- This should never happen, as the DEFAULT alternative binds no variables,
 -- but we might as well check for it:
 make_alt a@(DEFAULT,_ ,_) = pprPanic ("MkExternalCore: make_alt: DEFAULT "
 -- This should never happen, as the DEFAULT alternative binds no variables,
 -- but we might as well check for it:
 make_alt a@(DEFAULT,_ ,_) = pprPanic ("MkExternalCore: make_alt: DEFAULT "

@@ -180,12 +214,19 @@ make_lit l =
   where 
     t = make_ty (literalType l)
 
   where 
     t = make_ty (literalType l)
 

-make_ty :: Type -> C.Ty
-make_ty (TyVarTy tv)            = C.Tvar (make_var_id (tyVarName tv))
-make_ty (AppTy t1 t2)           = C.Tapp (make_ty t1) (make_ty t2)
-make_ty (FunTy t1 t2)           = make_ty (TyConApp funTyCon [t1,t2])
-make_ty (ForAllTy tv t)         = C.Tforall (make_tbind tv) (make_ty t)
-make_ty (TyConApp tc ts)        = foldl C.Tapp (C.Tcon (qtc tc)) 
+-- Expand type synonyms, then convert.
+make_ty :: Type -> C.Ty                 -- Be sure to expand types recursively!
+                                        -- example: FilePath ~> String ~> [Char]
+make_ty t | Just expanded <- tcView t = make_ty expanded
+make_ty t = make_ty' t
+ 
+-- note calls to make_ty so as to expand types recursively
+make_ty' :: Type -> C.Ty
+make_ty' (TyVarTy tv)           = C.Tvar (make_var_id (tyVarName tv))
+make_ty' (AppTy t1 t2)                  = C.Tapp (make_ty t1) (make_ty t2)
+make_ty' (FunTy t1 t2)                  = make_ty (TyConApp funTyCon [t1,t2])
+make_ty' (ForAllTy tv t)        = C.Tforall (make_tbind tv) (make_ty t)
+make_ty' (TyConApp tc ts)       = foldl C.Tapp (C.Tcon (qtc tc)) 

                                         (map make_ty ts)
 -- Newtypes are treated just like any other type constructor; not expanded
 -- Reason: predTypeRep does substitution and, while substitution deals
                                         (map make_ty ts)
 -- Newtypes are treated just like any other type constructor; not expanded
 -- Reason: predTypeRep does substitution and, while substitution deals

@@ -199,7 +240,7 @@ make_ty (TyConApp tc ts)     = foldl C.Tapp (C.Tcon (qtc tc))
 -- expose the representation in interface files, which definitely isn't right.
 -- Maybe CoreTidy should know whether to expand newtypes or not?
 
 -- expose the representation in interface files, which definitely isn't right.
 -- Maybe CoreTidy should know whether to expand newtypes or not?
 

-make_ty (PredTy p)     = make_ty (predTypeRep p)
+make_ty' (PredTy p)    = make_ty (predTypeRep p)

 
 
 
 
 
 

@@ -238,19 +279,28 @@ make_mid m = showSDoc $
               <> (pprEncoded $ pprModuleName $ moduleName m)
      where pprEncoded = pprCode CStyle
                
               <> (pprEncoded $ pprModuleName $ moduleName m)
      where pprEncoded = pprCode CStyle
                

-make_qid :: Bool -> Name -> C.Qual C.Id
-make_qid is_var n = (mname,make_id is_var n)
+make_qid :: Bool -> Bool -> Name -> C.Qual C.Id
+make_qid force_unqual is_var n = (mname,make_id is_var n)

     where mname = 
            case nameModule_maybe n of
     where mname = 
            case nameModule_maybe n of

-            Just m -> make_mid m
-            Nothing -> "" 
+            Just m | not force_unqual -> make_mid m
+            _ -> "" 

 
 

-make_var_qid :: Name -> C.Qual C.Id
-make_var_qid = make_qid True
+make_var_qid :: Bool -> Name -> C.Qual C.Id
+make_var_qid force_unqual = make_qid force_unqual True

 
 make_con_qid :: Name -> C.Qual C.Id
 
 make_con_qid :: Name -> C.Qual C.Id

-make_con_qid = make_qid False
-
+make_con_qid = make_qid False False
+
+-------
+isALocal :: Name -> CoreM Bool
+isALocal vName = do
+  modName <- ask
+  return $ case nameModule_maybe vName of
+             -- Not sure whether isInternalName corresponds to "local"ness
+             -- in the External Core sense; need to re-read the spec.
+             Just m | m == modName -> isInternalName vName
+             _                     -> False

 \end{code}
 
 
 \end{code}
 
 

diff --git a/compiler/coreSyn/PprExternalCore.lhs b/compiler/coreSyn/PprExternalCore.lhs
index cb9b0e7..e46a871 100644 (file)
--- a/compiler/coreSyn/PprExternalCore.lhs
+++ b/compiler/coreSyn/PprExternalCore.lhs
@@ -54,7 +54,7 @@ ptdef (Data tcon tbinds cdefs) =
   (text "%data" <+> pqname tcon <+> (hsep (map ptbind tbinds)) <+> char '=')
   $$ indent (braces ((vcat (punctuate (char ';') (map pcdef cdefs)))))
 
   (text "%data" <+> pqname tcon <+> (hsep (map ptbind tbinds)) <+> char '=')
   $$ indent (braces ((vcat (punctuate (char ';') (map pcdef cdefs)))))
 

-ptdef (Newtype tcon tbinds (coercion,k) rep) =
+ptdef (Newtype tcon tbinds (coercion,tbs,k) rep) =

 -- Here we take apart the newtype tycon in order to get the newtype coercion,
 -- which needs to be represented in the External Core file because it's not
 -- straightforward to derive its definition from the newtype declaration alone.
 -- Here we take apart the newtype tycon in order to get the newtype coercion,
 -- which needs to be represented in the External Core file because it's not
 -- straightforward to derive its definition from the newtype declaration alone.

@@ -62,8 +62,10 @@ ptdef (Newtype tcon tbinds (coercion,k) rep) =
 -- Sigh.
   text "%newtype" <+> pqname tcon <+> (hsep (map ptbind tbinds)) 
     $$ indent (axiomclause $$ repclause)
 -- Sigh.
   text "%newtype" <+> pqname tcon <+> (hsep (map ptbind tbinds)) 
     $$ indent (axiomclause $$ repclause)

-       where  axiomclause = char '^' <+> parens (pqname coercion <+> text "::"
-                                     <+> pkind k)
+       where  axiomclause = char '^' 
+                 <+> parens (pqname coercion <+> (hsep (map ptbind tbs))
+                              <+> text "::"
+                              <+> pkind k)

               repclause   = case rep of
                               Just ty -> char '=' <+> pty ty 
                              Nothing -> empty
               repclause   = case rep of
                               Just ty -> char '=' <+> pty ty 
                              Nothing -> empty

@@ -71,9 +73,9 @@ ptdef (Newtype tcon tbinds (coercion,k) rep) =
 
 pcdef :: Cdef -> Doc
 pcdef (Constr dcon tbinds tys)  =
 
 pcdef :: Cdef -> Doc
 pcdef (Constr dcon tbinds tys)  =

-  (pname dcon) <+> (sep [hsep (map pattbind tbinds),sep (map paty tys)])
+  (pqname dcon) <+> (sep [hsep (map pattbind tbinds),sep (map paty tys)])

 pcdef (GadtConstr dcon ty)  =
 pcdef (GadtConstr dcon ty)  =

-  (pname dcon) <+> text "::" <+> pty ty
+  (pqname dcon) <+> text "::" <+> pty ty

 
 pname :: Id -> Doc
 pname id = text (zEncodeString id)
 
 pname :: Id -> Doc
 pname id = text (zEncodeString id)

@@ -128,10 +130,10 @@ pvdefg (Rec vdefs) = text "%rec" $$ braces (indent (vcat (punctuate (char ';') (
 pvdefg (Nonrec vdef) = pvdef vdef
 
 pvdef :: Vdef -> Doc
 pvdefg (Nonrec vdef) = pvdef vdef
 
 pvdef :: Vdef -> Doc

--- note: at one point every vdef was getting printed out as "local".
--- I think that's manifestly wrong. Right now, the "%local" keyword
--- is never used.
-pvdef (_l,v,t,e) = sep [pname v <+> text "::" <+> pty t <+> char '=',
+-- TODO: Think about whether %local annotations are actually needed.
+-- Right now, the local flag is never used, because the Core doc doesn't
+-- explain the meaning of %local.
+pvdef (_l,v,t,e) = sep [(pqname v <+> text "::" <+> pty t <+> char '='),

                    indent (pexp e)]
 
 paexp, pfexp, pexp :: Exp -> Doc
                    indent (pexp e)]
 
 paexp, pfexp, pexp :: Exp -> Doc

diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index 93ce6ad..0b8a5a2 100644 (file)
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -577,7 +577,10 @@ hscNormalIface simpl_result
                <- {-# SCC "MkFinalIface" #-}
                   mkIface hsc_env maybe_old_iface details simpl_result
        -- Emit external core
                <- {-# SCC "MkFinalIface" #-}
                   mkIface hsc_env maybe_old_iface details simpl_result
        -- Emit external core

-       emitExternalCore (hsc_dflags hsc_env) (availsToNameSet (mg_exports simpl_result)) cg_guts -- Move this? --Lemmih 03/07/2006
+       -- This should definitely be here and not after CorePrep,
+       -- because CorePrep produces unqualified constructor wrapper declarations,
+       -- so its output isn't valid External Core (without some preprocessing).
+       emitExternalCore (hsc_dflags hsc_env) cg_guts 

        dumpIfaceStats hsc_env
 
            -------------------
        dumpIfaceStats hsc_env
 
            -------------------

diff --git a/compiler/prelude/TysPrim.lhs b/compiler/prelude/TysPrim.lhs
index 6b02116..e8638d7 100644 (file)
--- a/compiler/prelude/TysPrim.lhs
+++ b/compiler/prelude/TysPrim.lhs
@@ -291,7 +291,7 @@ lifted type, and back.
 
 It's also used to instantiate un-constrained type variables after type
 checking.  For example
 
 It's also used to instantiate un-constrained type variables after type
 checking.  For example

-       lenth Any []
+       length Any []

 Annoyingly, we sometimes need Anys of other kinds, such as (*->*) etc.
 This is a bit like tuples.   We define a couple of useful ones here,
 and make others up on the fly.  If any of these others end up being exported
 Annoyingly, we sometimes need Anys of other kinds, such as (*->*) etc.
 This is a bit like tuples.   We define a couple of useful ones here,
 and make others up on the fly.  If any of these others end up being exported