[project @ 1996-06-05 06:44:31 by partain]

SLPJ changes through 960604

3 files changed, 30 insertions, 43 deletions

diff --git a/ghc/compiler/main/ErrUtils.lhs b/ghc/compiler/main/ErrUtils.lhs
index edf7a30c82..04ae96f182 100644
--- a/ghc/compiler/main/ErrUtils.lhs
+++ b/ghc/compiler/main/ErrUtils.lhs
@@ -15,7 +15,7 @@ module ErrUtils (
 	ghcExit
     ) where
 
-import Ubiq{-uitous-}
+IMP_Ubiq(){-uitous-}
 
 import Bag		( bagToList )
 import PprStyle		( PprStyle(..) )
diff --git a/ghc/compiler/main/Main.lhs b/ghc/compiler/main/Main.lhs
index 49c9b69992..c0d47913cd 100644
--- a/ghc/compiler/main/Main.lhs
+++ b/ghc/compiler/main/Main.lhs
@@ -8,9 +8,7 @@
 
 module Main ( main ) where
 
-import Ubiq{-uitous-}
-
-import PreludeGlaST	( thenPrimIO, fopen, fclose, _FILE{-instance CCallable-} )
+IMP_Ubiq(){-uitous-}
 
 import HsSyn
 
@@ -37,6 +35,7 @@ import RdrHsSyn		( getRawExportees )
 import Specialise	( SpecialiseData(..) )
 import StgSyn		( pprPlainStgBinding, GenStgBinding )
 import TcInstUtil	( InstInfo )
+import TyCon		( isDataTyCon )
 import UniqSupply	( mkSplitUniqSupply )
 
 import PprAbsC		( dumpRealC, writeRealC )
@@ -65,7 +64,7 @@ main
 doIt :: ([CoreToDo], [StgToDo]) -> String -> IO ()
 
 doIt (core_cmds, stg_cmds) input_pgm
-  = doDump opt_Verbose "Glasgow Haskell Compiler, version 1.01, for Haskell 1.3" "" >>
+  = doDump opt_Verbose "Glasgow Haskell Compiler, version 2.01, for Haskell 1.3" "" >>
 
     -- ******* READER
     show_pass "Reader"	>>
@@ -159,8 +158,8 @@ doIt (core_cmds, stg_cmds) input_pgm
 
     case tc_results
     of {  (typechecked_quint@(recsel_binds, class_binds, inst_binds, val_binds, const_binds),
-	   interface_stuff,
-	   (local_tycons,local_classes), pragma_tycon_specs, ddump_deriv) ->
+	   interface_stuff@(_,local_tycons,_,_),
+	   pragma_tycon_specs, ddump_deriv) ->
 
     doDump opt_D_dump_tc "Typechecked:"
 	(pp_show (ppAboves [
@@ -198,8 +197,11 @@ doIt (core_cmds, stg_cmds) input_pgm
     -- ******* CORE-TO-CORE SIMPLIFICATION (NB: I/O op)
     show_pass "Core2Core" 			>>
     _scc_     "Core2Core"
+    let
+	local_data_tycons = filter isDataTyCon local_tycons
+    in
     core2core core_cmds mod_name pprStyle
-	      sm_uniqs local_tycons pragma_tycon_specs desugared
+	      sm_uniqs local_data_tycons pragma_tycon_specs desugared
 						>>=
 
 	 \ (simplified, inlinings_env,
@@ -312,15 +314,9 @@ doIt (core_cmds, stg_cmds) input_pgm
       = case switch of
 	  Nothing -> return ()
 	  Just fname ->
-	    fopen fname "a+"	`thenPrimIO` \ file ->
-	    if (file == ``NULL'') then
-		error ("doOutput: failed to open:"++fname)
-	    else
-		io_action file		>>=     \ () ->
-		fclose file		`thenPrimIO` \ status ->
-		if status == 0
-		then return ()
-		else error ("doOutput: closed failed: "{-++show status++" "-}++fname)
+	    openFile fname WriteMode	>>= \ handle ->
+	    io_action handle		>>
+	    hClose handle
 
     doDump switch hdr string
       = if switch
diff --git a/ghc/compiler/main/MkIface.lhs b/ghc/compiler/main/MkIface.lhs
index ce876cb1b2..8083b8d891 100644
--- a/ghc/compiler/main/MkIface.lhs
+++ b/ghc/compiler/main/MkIface.lhs
@@ -18,7 +18,7 @@ module MkIface (
 	ifacePragmas
     ) where
 
-import Ubiq{-uitous-}
+IMP_Ubiq(){-uitous-}
 
 import Bag		( emptyBag, snocBag, bagToList )
 import Class		( GenClass(..){-instance NamedThing-}, GenClassOp(..) )
@@ -26,7 +26,7 @@ import CmdLineOpts	( opt_ProduceHi )
 import FieldLabel	( FieldLabel{-instance NamedThing-} )
 import FiniteMap	( fmToList )
 import HsSyn
-import Id		( idType, dataConSig, dataConFieldLabels,
+import Id		( idType, dataConRawArgTys, dataConFieldLabels,
 			  dataConStrictMarks, StrictnessMark(..),
 			  GenId{-instance NamedThing/Outputable-}
 			)
@@ -60,6 +60,7 @@ ppr_name   n
 	pp = prettyToUn (ppr PprInterface on)
     in
     (if isLexSym s then uppParens else id) pp
+{-OLD:
 ppr_unq_name n
   = let
 	on = origName n
@@ -67,6 +68,7 @@ ppr_unq_name n
 	pp = uppPStr  s
     in
     (if isLexSym s then uppParens else id) pp
+-}
 \end{code}
 
 We have a function @startIface@ to open the output file and put
@@ -144,7 +146,7 @@ ifaceUsages (Just if_hdl) usages
 	       upp_versions (fmToList versions), uppSemi]
 
     upp_versions nvs
-      = uppIntersperse upp'SP{-'-} [ uppCat [(if isLexSym n then uppParens else id) (uppPStr n), uppInt v] | (n,v) <- nvs ]
+      = uppIntersperse uppSP [ uppCat [(if isLexSym n then uppParens else id) (uppPStr n), uppInt v] | (n,v) <- nvs ]
 \end{code}
 
 \begin{code}
@@ -256,14 +258,13 @@ ifaceFixities (Just if_hdl) (HsModule _ _ _ _ fixities _ _ _ _ _ _ _ _ _)
 ifaceDecls Nothing{-no iface handle-} _ = return ()
 
 ifaceDecls (Just if_hdl) (vals, tycons, classes, _)
-  = let
-	togo_classes = [ c | c <- classes, isLocallyDefined c ]
-	togo_tycons  = [ t | t <- tycons,  isLocallyDefined t ]
-	togo_vals    = [ v | v <- vals,    isLocallyDefined v ]
-
-	sorted_classes   = sortLt ltLexical togo_classes
-	sorted_tycons	 = sortLt ltLexical togo_tycons
-	sorted_vals	 = sortLt ltLexical togo_vals
+  = ASSERT(all isLocallyDefined vals)
+    ASSERT(all isLocallyDefined tycons)
+    ASSERT(all isLocallyDefined classes)
+    let
+	sorted_classes   = sortLt ltLexical classes
+	sorted_tycons	 = sortLt ltLexical tycons
+	sorted_vals	 = sortLt ltLexical vals
     in
     if (null sorted_classes && null sorted_tycons && null sorted_vals) then
 	--  You could have a module with just instances in it
@@ -365,7 +366,7 @@ ppr_tycon tycon
     ppr_tc (initNmbr (nmbrTyCon tycon))
 
 ------------------------
-ppr_tc (PrimTyCon _ n _)
+ppr_tc (PrimTyCon _ n _ _)
   = uppCat [ uppStr "{- data", ppr_name n, uppStr " *built-in* -}" ]
 
 ppr_tc FunTyCon
@@ -386,7 +387,7 @@ ppr_tc this_tycon@(DataTyCon u n k tvs ctxt cons derivings data_or_new)
 	   ppr_context ctxt,
 	   ppr_name n,
 	   uppIntersperse uppSP (map ppr_tyvar tvs),
-	   pp_unabstract_condecls,
+	   uppEquals, pp_condecls,
 	   uppSemi]
 	   -- NB: we do not print deriving info in interfaces
   where
@@ -401,16 +402,6 @@ ppr_tc this_tycon@(DataTyCon u n k tvs ctxt cons derivings data_or_new)
 		   uppInterleave uppComma [uppCat [ppr_name c, ppr_ty t] | (c,t) <- cs],
 		   uppRparen, uppPStr SLIT(" =>")]
 
-    yes_we_print_condecls
-      = case (getExportFlag n) of
-	  ExportAbs -> False
-	  other	    -> True
-
-    pp_unabstract_condecls
-      = if yes_we_print_condecls
-	then uppCat [uppEquals, pp_condecls]
-	else uppNil
-
     pp_condecls
       = let
 	    (c:cs) = cons
@@ -421,11 +412,11 @@ ppr_tc this_tycon@(DataTyCon u n k tvs ctxt cons derivings data_or_new)
 
     ppr_con con
       = let
-	    (_, _, con_arg_tys, _) = dataConSig con
+	    con_arg_tys  = dataConRawArgTys   con
 	    labels       = dataConFieldLabels con -- none if not a record
 	    strict_marks = dataConStrictMarks con
 	in
-	uppCat [ppr_unq_name con, ppr_fields labels strict_marks con_arg_tys]
+	uppCat [ppr_name con, ppr_fields labels strict_marks con_arg_tys]
 
     ppr_fields labels strict_marks con_arg_tys
       = if null labels then -- not a record thingy
@@ -440,7 +431,7 @@ ppr_tc this_tycon@(DataTyCon u n k tvs ctxt cons derivings data_or_new)
 		  (prettyToUn (pprParendType PprInterface t))
 
     ppr_field l b t
-      = uppBesides [ppr_unq_name l, uppPStr SLIT(" :: "),
+      = uppBesides [ppr_name l, uppPStr SLIT(" :: "),
 		   case b of { MarkedStrict -> uppChar '!'; _ -> uppNil },
 		   ppr_ty t]
 \end{code}