diff options
| author | partain <unknown> | 1996-07-26 21:29:20 +0000 | 
|---|---|---|
| committer | partain <unknown> | 1996-07-26 21:29:20 +0000 | 
| commit | 216bfb01a138932092eab3076c85648f5eee99b3 (patch) | |
| tree | b045882217811761a5d7b67360748a3e78cc89d5 /ghc | |
| parent | 5eb1c77c795f92ed0f4c8023847e9d4be1a4fd0d (diff) | |
| download | haskell-216bfb01a138932092eab3076c85648f5eee99b3.tar.gz | |
[project @ 1996-07-26 20:58:52 by partain]
Final changes for 2.01
Diffstat (limited to 'ghc')
89 files changed, 246 insertions, 170 deletions
diff --git a/ghc/CONTRIB/haskell-modes/simonm/real/haskell.el b/ghc/CONTRIB/haskell-modes/simonm/real/haskell.el index c1dd5f1eab..6adc7441ed 100644 --- a/ghc/CONTRIB/haskell-modes/simonm/real/haskell.el +++ b/ghc/CONTRIB/haskell-modes/simonm/real/haskell.el @@ -55,8 +55,8 @@      (modify-syntax-entry ?\f "> b"    haskell-mode-syntax-table)      (modify-syntax-entry ?\n "> b"    haskell-mode-syntax-table)      (modify-syntax-entry ?\" "\"" haskell-mode-syntax-table) -    (modify-syntax-entry ?\' "_" haskell-mode-syntax-table) -    (modify-syntax-entry ?_  "_" haskell-mode-syntax-table) +    (modify-syntax-entry ?\' "w" haskell-mode-syntax-table) +    (modify-syntax-entry ?_  "w" haskell-mode-syntax-table)      (modify-syntax-entry ?\\ "." haskell-mode-syntax-table)      (modify-syntax-entry ?\( "()" haskell-mode-syntax-table)      (modify-syntax-entry ?\) ")(" haskell-mode-syntax-table) @@ -81,8 +81,6 @@    (setq comment-column 40)    (make-local-variable 'comment-indent-function)    (setq comment-indent-function 'haskell-comment-indent) -  ;(make-local-variable 'font-lock-keywords) -  ;(setq font-lock-keywords haskell-literate-font-lock-keywords)    )  (defun haskell-mode () @@ -106,6 +104,8 @@ M-TAB toggles the state of the bird track on the current-line.  Entry to this mode calls haskell-mode-hook and haskell-literate-mode-hook."    (interactive)    (haskell-vars) +  (make-local-variable 'font-lock-keywords) +  (setq font-lock-keywords haskell-literate-font-lock-keywords)    (setq major-mode 'haskell-literate-mode)    (setq mode-name "Literate Haskell")    (use-local-map haskell-literate-mode-map) @@ -190,12 +190,13 @@ Entry to this mode calls haskell-mode-hook and haskell-literate-mode-hook."        (list         '("^[^>\n].*$" . font-lock-comment-face)         (concat "\\b\\(" -		    (mapconcat 'identity  -			       '("case" "class" "data" "default" "deriving" "else" "hiding" -				 "if" "import" "in" "infix" "infixl" "infixr" "instance" -				 "interface" "let" "module" "of" "renaming" "then" "to" -				 "type" "where") -			       "\\|") -		    "\\)\\b") +	       (mapconcat 'identity  +			  '("case" "class" "data" "default" "deriving" "else"  +			    "hiding" "if" "import" "in" "infix" "infixl"  +			    "infixr" "instance" "interface" "let" "module"  +			    "of" "renaming" "then" "to" "type" "where") +			  "\\|") +	       "\\)\\b") +;       '("(\\|)\\|\\[\\|\\]\\|,\\|[\\\\!$#^%&*@~?=-+<>.:]+" . font-lock-function-name-face)         )) diff --git a/ghc/compiler/deSugar/Match.lhs b/ghc/compiler/deSugar/Match.lhs index eea766773d..72a4b85edf 100644 --- a/ghc/compiler/deSugar/Match.lhs +++ b/ghc/compiler/deSugar/Match.lhs @@ -25,11 +25,12 @@ import DsUtils  import MatchCon		( matchConFamily )  import MatchLit		( matchLiterals ) -import FieldLabel	( allFieldLabelTags, fieldLabelTag ) -import Id		( idType, mkTupleCon, +import FieldLabel	( FieldLabel {- Eq instance -} ) +import Id		( idType, mkTupleCon, dataConFieldLabels,  			  dataConArgTys, recordSelectorFieldLabel,  			  GenId{-instance-}  			) +import Name		( Name {--O only-} )  import PprStyle		( PprStyle(..) )  import PprType		( GenType{-instance-}, GenTyVar{-ditto-} )  import PrelVals		( pAT_ERROR_ID ) @@ -337,12 +338,12 @@ tidy1 v (RecPat con_id pat_ty rpats) match_result  	-- Boring stuff to find the arg-tys of the constructor      (_, inst_tys, _) = {-trace "Match.getAppDataTyConExpandingDicts" $-} getAppDataTyConExpandingDicts pat_ty      con_arg_tys'     = dataConArgTys con_id inst_tys  -    tagged_arg_tys   = con_arg_tys' `zip` allFieldLabelTags +    tagged_arg_tys   = con_arg_tys' `zip` (dataConFieldLabels con_id)  	-- mk_pat picks a WildPat of the appropriate type for absent fields,  	-- and the specified pattern for present fields -    mk_pat (arg_ty, tag) = case [pat | (sel_id,pat,_) <- rpats, -					fieldLabelTag (recordSelectorFieldLabel sel_id) == tag  +    mk_pat (arg_ty, lbl) = case [pat | (sel_id,pat,_) <- rpats, +					recordSelectorFieldLabel sel_id == lbl  				] of  				(pat:pats) -> ASSERT( null pats )  					      pat diff --git a/ghc/compiler/tests/Jmakefile b/ghc/compiler/tests/Jmakefile index 716cc71966..8450a8258e 100644 --- a/ghc/compiler/tests/Jmakefile +++ b/ghc/compiler/tests/Jmakefile @@ -7,5 +7,4 @@ SUBDIRS = reader \  	  deSugar \  	  printing \  	  ccall \ -	  deriving \ -	  bugs +	  deriving diff --git a/ghc/compiler/tests/ccall/cc001.hs b/ghc/compiler/tests/ccall/cc001.hs index 8c37355ca3..c26a53f29c 100644 --- a/ghc/compiler/tests/ccall/cc001.hs +++ b/ghc/compiler/tests/ccall/cc001.hs @@ -2,7 +2,7 @@  module Test where -import PreludeGlaIO +import PreludeGlaST  -- simple functions diff --git a/ghc/compiler/tests/ccall/cc002.hs b/ghc/compiler/tests/ccall/cc002.hs index 3a4b66d1d7..95a061b971 100644 --- a/ghc/compiler/tests/ccall/cc002.hs +++ b/ghc/compiler/tests/ccall/cc002.hs @@ -2,20 +2,20 @@  module Test where -import PreludeGlaIO +import PreludeGlaST  -- Test returning results -a :: PrimIO _MallocPtr +a :: PrimIO ForeignObj  a = _ccall_ a -b :: PrimIO _StablePtr +b :: PrimIO StablePtr  b = _ccall_ b  -- Test taking arguments -c :: _MallocPtr -> PrimIO Int +c :: ForeignObj -> PrimIO Int  c x = _ccall_ c x -d :: _StablePtr -> PrimIO Int +d :: StablePtr -> PrimIO Int  d x = _ccall_ d x diff --git a/ghc/compiler/tests/ccall/cc003.hs b/ghc/compiler/tests/ccall/cc003.hs index 5b8bd822e2..474a4b3ad3 100644 --- a/ghc/compiler/tests/ccall/cc003.hs +++ b/ghc/compiler/tests/ccall/cc003.hs @@ -1,7 +1,7 @@  --!!! cc003 -- ccall with unresolved polymorphism (should fail)  module Test where -import PreludeGlaIO +import PreludeGlaST  fubar :: PrimIO Int  fubar = ccall f `seqPrimIO` ccall b diff --git a/ghc/compiler/tests/ccall/cc004.hs b/ghc/compiler/tests/ccall/cc004.hs index 7ad0ceda16..6dee39973d 100644 --- a/ghc/compiler/tests/ccall/cc004.hs +++ b/ghc/compiler/tests/ccall/cc004.hs @@ -1,7 +1,7 @@  --!!! cc004 -- ccall with synonyms, polymorphic type variables and user type variables.  module Test where -import PreludeGlaIO +import PreludeGlaST  -- Since I messed up the handling of polymorphism originally, I'll  -- explicitly test code with UserSysTyVar (ie an explicit polymorphic diff --git a/ghc/compiler/tests/deSugar/ds024.hs b/ghc/compiler/tests/deSugar/ds024.hs index 1e5f7ebe07..6f0b27aade 100644 --- a/ghc/compiler/tests/deSugar/ds024.hs +++ b/ghc/compiler/tests/deSugar/ds024.hs @@ -3,6 +3,9 @@  -- do all the right types get stuck on all the  -- Nils and Conses? +module ShouldSucceed where + +  f x = [[], []]  g x = ([], [], []) diff --git a/ghc/compiler/tests/deSugar/ds026.hs b/ghc/compiler/tests/deSugar/ds026.hs index 2f9faa7303..ff1f0bee7e 100644 --- a/ghc/compiler/tests/deSugar/ds026.hs +++ b/ghc/compiler/tests/deSugar/ds026.hs @@ -1,5 +1,7 @@  --!!! ds026 -- classes -- incl. polymorphic method +module ShouldSucceed where +  class Foo a where    op :: a -> a diff --git a/ghc/compiler/tests/deSugar/ds028.hs b/ghc/compiler/tests/deSugar/ds028.hs index 728a0c89bc..18c0b7d622 100644 --- a/ghc/compiler/tests/deSugar/ds028.hs +++ b/ghc/compiler/tests/deSugar/ds028.hs @@ -1,5 +1,8 @@  --!!! ds028: failable pats in top row +module ShouldSucceed where + +  -- when the first row of pats doesn't have convenient  -- variables to grab... diff --git a/ghc/compiler/tests/deSugar/ds031.hs b/ghc/compiler/tests/deSugar/ds031.hs index 6454e08d03..3378800e16 100644 --- a/ghc/compiler/tests/deSugar/ds031.hs +++ b/ghc/compiler/tests/deSugar/ds031.hs @@ -1,3 +1,5 @@ +module ShouldSucceed where +  foldPair :: (a->a->a,b->b->b) -> (a,b) -> [(a,b)] -> (a,b)  foldPair fg       ab [] = ab  foldPair fg@(f,g) ab ((a,b):abs) = (f a u,g b v) diff --git a/ghc/compiler/tests/deSugar/ds032.hs b/ghc/compiler/tests/deSugar/ds032.hs index a1cda8468e..31bc07ebf5 100644 --- a/ghc/compiler/tests/deSugar/ds032.hs +++ b/ghc/compiler/tests/deSugar/ds032.hs @@ -1,5 +1,8 @@  --!!! recursive funs tangled in an AbsBind +module ShouldSucceed where + +  flatten :: Int		-- Indentation          -> Bool		-- True => just had a newline          -> Float	-- Current seq to flatten diff --git a/ghc/compiler/tests/deSugar/ds037.hs b/ghc/compiler/tests/deSugar/ds037.hs index 924df509e0..6485341650 100644 --- a/ghc/compiler/tests/deSugar/ds037.hs +++ b/ghc/compiler/tests/deSugar/ds037.hs @@ -1,4 +1,6 @@  --!!! AbsBinds with tyvars, no dictvars, but some dict binds  -- +module ShouldSucceed where +  f x y = (fst (g y x), x+(1::Int))  g x y = (fst (f x y), y+(1::Int)) diff --git a/ghc/compiler/tests/deSugar/ds039.hs b/ghc/compiler/tests/deSugar/ds039.hs index ad6c1bed07..e153bfa51a 100644 --- a/ghc/compiler/tests/deSugar/ds039.hs +++ b/ghc/compiler/tests/deSugar/ds039.hs @@ -1,4 +1,7 @@  --!!! make sure correct type applications get put in  --!!!   when (:) is saturated. +module ShouldSucceed where + +  f = (:) diff --git a/ghc/compiler/tests/deriving/drv001.hs b/ghc/compiler/tests/deriving/drv001.hs index 707a05d9ba..ffe8196c8f 100644 --- a/ghc/compiler/tests/deriving/drv001.hs +++ b/ghc/compiler/tests/deriving/drv001.hs @@ -1,19 +1,21 @@  --!!! canonical weird example for "deriving" +module ShouldSucceed where  data X a b    = C1 (T a)    | C2 (Y b)    | C3 (X b a) -  deriving Text +  deriving (Read, Show)  data Y b    = D1    | D2 (X Int b) -  deriving Text +  deriving (Read, Show)  data T a    = E1 -instance Eq a => Text (T a) where +instance Eq a => Show (T a) where      showsPrec = error "show" +instance Eq a => Read (T a) where      readsPrec = error "read" diff --git a/ghc/compiler/tests/deriving/drv002.hs b/ghc/compiler/tests/deriving/drv002.hs index e8855f2600..15eb2d9ecc 100644 --- a/ghc/compiler/tests/deriving/drv002.hs +++ b/ghc/compiler/tests/deriving/drv002.hs @@ -1,11 +1,14 @@ +module ShouldSucceed where +  data Z a b    = C1 (T a)    | C2 (Z [a] [b]) -  deriving Text +  deriving (Show, Read)  data T a    = E1 -instance Eq a => Text (T a) where +instance Eq a => Show (T a) where      showsPrec = error "show" +instance Eq a => Read (T a) where      readsPrec = error "read" diff --git a/ghc/compiler/tests/deriving/drv003.hs b/ghc/compiler/tests/deriving/drv003.hs index 3da22bd9d0..f6d678006a 100644 --- a/ghc/compiler/tests/deriving/drv003.hs +++ b/ghc/compiler/tests/deriving/drv003.hs @@ -1,5 +1,7 @@  --!!! This is the example given in TcDeriv  -- +module ShouldSucceed where +  data T a b    = C1 (Foo a) (Bar b)     | C2 Int (T b a)  diff --git a/ghc/compiler/tests/deriving/drv004.hs b/ghc/compiler/tests/deriving/drv004.hs index 9863e3ae3d..82afb6b8f0 100644 --- a/ghc/compiler/tests/deriving/drv004.hs +++ b/ghc/compiler/tests/deriving/drv004.hs @@ -1,5 +1,7 @@  --!!! simple example of deriving Ord (and, implicitly, Eq)  -- +module ShouldSucceed where +  data Foo a b    = C1 a Int    | C2 b Double diff --git a/ghc/compiler/tests/deriving/drv005.hs b/ghc/compiler/tests/deriving/drv005.hs index cef5fe6a5b..93d8b45e0e 100644 --- a/ghc/compiler/tests/deriving/drv005.hs +++ b/ghc/compiler/tests/deriving/drv005.hs @@ -1,4 +1,6 @@  --!!! simple example of deriving Enum  -- +module ShouldSucceed where +  data Foo = Foo1 | Foo2 | Foo3 | Foo4 | Foo5 | Foo6 | Foo7 | Foo8      	 deriving Enum diff --git a/ghc/compiler/tests/deriving/drv006.hs b/ghc/compiler/tests/deriving/drv006.hs index a6d6d1c645..029f67adf4 100644 --- a/ghc/compiler/tests/deriving/drv006.hs +++ b/ghc/compiler/tests/deriving/drv006.hs @@ -1,5 +1,8 @@  --!!! simple examples of deriving Ix  -- +module ShouldSucceed where +import Ix +  data Foo = Foo1 | Foo2 | Foo3 | Foo4 | Foo5 | Foo6 | Foo7 | Foo8      	 deriving Ix diff --git a/ghc/compiler/tests/deriving/drv007.hs b/ghc/compiler/tests/deriving/drv007.hs index c1bbab1bae..ba1a864f30 100644 --- a/ghc/compiler/tests/deriving/drv007.hs +++ b/ghc/compiler/tests/deriving/drv007.hs @@ -1,3 +1,4 @@  --!!! buggy deriving with function type, reported by Sigbjorn Finne +module ShouldSucceed where  data Foo = Foo (Int -> Int) deriving Eq diff --git a/ghc/compiler/tests/rename/Jmakefile b/ghc/compiler/tests/rename/Jmakefile index b018f9ddd6..aff8571ca5 100644 --- a/ghc/compiler/tests/rename/Jmakefile +++ b/ghc/compiler/tests/rename/Jmakefile @@ -7,7 +7,7 @@ runtests::  	@echo '# Validation tests for the renamer (incl dependency analysis) #'  	@echo '###############################################################' -TEST_FLAGS=/*-ddump-rn1 -ddump-rn2 -ddump-rn3*/ -ddump-rn4 +TEST_FLAGS=/*-ddump-rn1 -ddump-rn2 -ddump-rn3*/ -ddump-rn  RunStdTest(rn001,$(GHC), -noC $(TEST_FLAGS) rn001.hs -o2 rn001.stderr -x1)  RunStdTest(rn002,$(GHC), -noC $(TEST_FLAGS) rn002.hs -o2 rn002.stderr -x1) diff --git a/ghc/compiler/tests/typecheck/Jmakefile b/ghc/compiler/tests/typecheck/Jmakefile index a4ca9c760c..7c079c008f 100644 --- a/ghc/compiler/tests/typecheck/Jmakefile +++ b/ghc/compiler/tests/typecheck/Jmakefile @@ -3,5 +3,4 @@  SUBDIRS = /* TEMPORARILY OUT: check_mess */ \  	  should_fail \  	  /* TEMPORARILY OUT: test_exps */ \ -	  should_succeed \ -	  bugs +	  should_succeed diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail021.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail021.hs index 6afdea7920..f6758a1b2b 100644 --- a/ghc/compiler/tests/typecheck/should_fail/tcfail021.hs +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail021.hs @@ -1,2 +1,3 @@ +module ShouldFail where  f x x = 2 diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail029.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail029.hs index 312e6fee47..4b8f2c6c89 100644 --- a/ghc/compiler/tests/typecheck/should_fail/tcfail029.hs +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail029.hs @@ -1,4 +1,5 @@  --!!! tests for InstOpErr +module ShouldFail where  data Foo = Bar | Baz diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail031.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail031.hs index c81ced8229..6b9a0de12b 100644 --- a/ghc/compiler/tests/typecheck/should_fail/tcfail031.hs +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail031.hs @@ -1,2 +1,3 @@ +module ShouldFail where  f x = if 'a' then 1 else 2 diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail033.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail033.hs index 5c8b4d8e7e..fdc0aff8ed 100644 --- a/ghc/compiler/tests/typecheck/should_fail/tcfail033.hs +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail033.hs @@ -1,3 +1,4 @@  -- from Jon Hill +module ShouldFail where  buglet = [ x | (x,y) <- buglet ] diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail034.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail034.hs index e0d0ffeace..82aa18b418 100644 --- a/ghc/compiler/tests/typecheck/should_fail/tcfail034.hs +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail034.hs @@ -10,6 +10,8 @@ I came across a rather nasty error message when I gave a function an  incorrect type signature (the context is wrong). I can remember reading   in the source about this problem - I just thought I'd let you know anyway :-)  -} +module ShouldSucceed where +  test::(Num a, Eq a) => a -> Bool  test x = (x `mod` 3) == 0 diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail035.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail035.hs index a0b9f0ee56..a12908ee5a 100644 --- a/ghc/compiler/tests/typecheck/should_fail/tcfail035.hs +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail035.hs @@ -6,4 +6,4 @@ data NUM = ONE | TWO  instance Num NUM  instance Num NUM  instance Eq NUM -instance Text NUM +instance Show NUM diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail041.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail041.hs index ca92003d70..542c400a86 100644 --- a/ghc/compiler/tests/typecheck/should_fail/tcfail041.hs +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail041.hs @@ -42,6 +42,7 @@ all right.  	-- Lennart  - ------- End of forwarded message -------  -} +module ShouldFail where  sort :: Ord a => [a] -> [a]  sort xs = s xs (length xs) diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail042.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail042.hs index 566bfea991..37c24936a9 100644 --- a/ghc/compiler/tests/typecheck/should_fail/tcfail042.hs +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail042.hs @@ -10,7 +10,7 @@ instance Num a => Foo [a] where      foo (x:xs) = map (x+) xs -instance (Eq a, Text a) => Bar [a] where +instance (Eq a, Show a) => Bar [a] where      bar []     = []      bar (x:xs) = foo xs where u = x==x                                v = show x @@ -20,7 +20,7 @@ instance (Eq a, Text a) => Bar [a] where  {-  class Foo a => Bar2 a where bar2 :: a -> a -instance (Eq a, Text a) => Foo [a] +instance (Eq a, Show a) => Foo [a]  instance Num a => Bar2 [a] diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail044.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail044.hs index 9d056409f1..3f899a6f6b 100644 --- a/ghc/compiler/tests/typecheck/should_fail/tcfail044.hs +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail044.hs @@ -19,4 +19,4 @@ ss = sin * sin  cc = cos * cos  tt = ss + cc -main _ = [AppendChan stdout ((show (tt 0.4))++ "  "++(show (tt 1.652)))] +main = putStr ((show (tt 0.4))++ "  "++(show (tt 1.652))) diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail045.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail045.hs index f13b603508..83a1daf81c 100644 --- a/ghc/compiler/tests/typecheck/should_fail/tcfail045.hs +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail045.hs @@ -1,7 +1,10 @@  --!!! a bad _CCallable thing (from a bug from Satnam)  -- -data Socket = Socket# _Addr -instance _CCallable Socket +module ShouldSucceed where +import PreludeGlaST + +data Socket = Socket# Addr +instance CCallable Socket  f :: Socket -> PrimIO ()  f x = _ccall_ foo x diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail046.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail046.hs index c58988a5e3..40fad6ba7d 100644 --- a/ghc/compiler/tests/typecheck/should_fail/tcfail046.hs +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail046.hs @@ -1,13 +1,13 @@  --!! function types in deriving Eq things  -- From a bug report by Dave Harrison <D.A.Harrison@newcastle.ac.uk> -module Simulation(Process(..), +module Simulation(Process,  		  Status, -		  Pid(..), -		  Time(..), +		  Pid, +		  Time,  		  Continuation,  		  Message, -		  MessList(..) ) where +		  MessList ) where  type 	Process a = Pid -> Time -> Message a -> ( MessList a,   			     		   	  Continuation a) diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail048.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail048.hs index 5b58e204a2..f4400e2fa0 100644 --- a/ghc/compiler/tests/typecheck/should_fail/tcfail048.hs +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail048.hs @@ -1,3 +1,4 @@ +module ShouldFail where  class (B a) => C a where   op1 :: a -> a diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail049.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail049.hs index 3fa7791dff..64dee54a5c 100644 --- a/ghc/compiler/tests/typecheck/should_fail/tcfail049.hs +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail049.hs @@ -1,2 +1,3 @@ +module ShouldFail where  f x = g x diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail050.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail050.hs index a1fa3541d2..c0cee979f7 100644 --- a/ghc/compiler/tests/typecheck/should_fail/tcfail050.hs +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail050.hs @@ -1,2 +1,3 @@ +module ShouldFail where  f x = B x diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail051.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail051.hs index f94aa9d9bf..1b8e251c40 100644 --- a/ghc/compiler/tests/typecheck/should_fail/tcfail051.hs +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail051.hs @@ -1,3 +1,4 @@ +module ShouldFail where  instance B Bool where   op1 a = a diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail052.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail052.hs index 09488054ed..e9be21e6f2 100644 --- a/ghc/compiler/tests/typecheck/should_fail/tcfail052.hs +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail052.hs @@ -1,2 +1,3 @@ +module ShouldFail where  data C a = B a c diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail054.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail054.hs index 69ce2e81b2..a4e724cf18 100644 --- a/ghc/compiler/tests/typecheck/should_fail/tcfail054.hs +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail054.hs @@ -1,2 +1,3 @@ +module ShouldFail where  f (B a) = True diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail055.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail055.hs index fc6efe3bb7..f61c5a81be 100644 --- a/ghc/compiler/tests/typecheck/should_fail/tcfail055.hs +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail055.hs @@ -1,2 +1,3 @@ +module ShouldFail where  f x = (x + 1 :: Int) :: Float diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail056.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail056.hs index 6e15f2bf5d..a8a1315be7 100644 --- a/ghc/compiler/tests/typecheck/should_fail/tcfail056.hs +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail056.hs @@ -1,3 +1,4 @@ +module ShouldFail where  data Foo = MkFoo Bool diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail058.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail058.hs index 191d5644b9..c05c85972f 100644 --- a/ghc/compiler/tests/typecheck/should_fail/tcfail058.hs +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail058.hs @@ -1,4 +1,5 @@  module ShouldFail where +import Array  --!!! inadvertently using => instead of -> diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail061.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail061.hs index 4ed535e9ea..2957e800d5 100644 --- a/ghc/compiler/tests/typecheck/should_fail/tcfail061.hs +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail061.hs @@ -1,5 +1,6 @@  --!! signature bugs exposed by Sigbjorne Finne  -- +module ShouldFail where  type Flarp a = (b,b) diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail062.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail062.hs index 8989d91b20..5c9b0ea215 100644 --- a/ghc/compiler/tests/typecheck/should_fail/tcfail062.hs +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail062.hs @@ -8,10 +8,10 @@ type Module = (String,[Declaration])  data Declaration    = Architecture String StructuralExpression |      Behaviour String Parameter Parameter BehaviouralExpression -    deriving (Eq, Text) +    deriving (Eq, Show)  data Parameter = ParameterVariable String | ParameterList [Parameter] -                 deriving (Eq, Text) +                 deriving (Eq, Show)  nameOfModule :: Module -> String  nameOfModule (name, _) = name @@ -20,14 +20,14 @@ data StructuralExpression    = Variable String |      Serial StructuralExpression StructuralExpression |       Par [StructuralExpression]  -    deriving (Eq, Text) +    deriving (Eq, Show)  data BehaviouralExpression    = BehaviouralVariable String       | AndExpr BehaviouralExpression BehaviouralExpression      | OrExpr BehaviouralExpression BehaviouralExpression      | NotExpr BehaviouralExpression -    deriving (Eq, Text) +    deriving (Eq, Show)  type BehaviouralRelation diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail066.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail066.hs index f146acd759..2d2e9bafd8 100644 --- a/ghc/compiler/tests/typecheck/should_fail/tcfail066.hs +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail066.hs @@ -5,6 +5,7 @@ From: Julian Seward (DRL PhD) <sewardj@computer-science.manchester.ac.uk>  Message-Id: <9412081138.AA16652@rdf009.cs.man.ac.uk>  To: partain@dcs.gla.ac.uk  -} +module ShouldFail where  type IMonad a     = IMonadState -> IMonadReturn a diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail067.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail067.hs index b84328c414..99d4c648c0 100644 --- a/ghc/compiler/tests/typecheck/should_fail/tcfail067.hs +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail067.hs @@ -14,11 +14,11 @@ subRangeValue (SubRange (lower, upper) value) = value  subRange :: SubRange a -> (a, a)  subRange (SubRange r value) = r -newRange :: (Ord a, Text a) => (a, a) -> a -> SubRange a +newRange :: (Ord a, Show a) => (a, a) -> a -> SubRange a  newRange r value = checkRange (SubRange r value) -checkRange :: (Ord a, Text a) => SubRange a -> SubRange a +checkRange :: (Ord a, Show a) => SubRange a -> SubRange a  checkRange (SubRange (lower, upper) value)    = if (value < lower) || (value > upper) then        error ("### sub range error. range = " ++ show lower ++  @@ -39,18 +39,18 @@ instance (Ord a) => Ord (SubRange a) where  relOp :: Ord a => (a->a->Bool) -> SubRange a -> SubRange a -> Bool  relOp op a b = (subRangeValue a) `op` (subRangeValue b) -rangeOf :: (Ord a, Text a) => SubRange a -> SubRange a -> SubRange a +rangeOf :: (Ord a, Show a) => SubRange a -> SubRange a -> SubRange a  rangeOf a b = checkRange (SubRange (subRange b) (subRangeValue a)) -showRange :: Text a => SubRange a -> String +showRange :: Show a => SubRange a -> String  showRange (SubRange (lower, upper) value)    = show value ++ " :" ++ show lower ++ ".." ++ show upper -showRangePair :: (Text a, Text b) => (SubRange a, SubRange b) -> String +showRangePair :: (Show a, Show b) => (SubRange a, SubRange b) -> String  showRangePair (a, b)    = "(" ++ showRange a ++ ", " ++ showRange b ++ ")" -showRangeTriple :: (Text a, Text b, Text c) => +showRangeTriple :: (Show a, Show b, Show c) =>                     (SubRange a, SubRange b, SubRange c) -> String  showRangeTriple (a, b, c)     = "(" ++ showRange a ++ ", " ++ showRange b ++ ", " ++ showRange c ++ ")" diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail068.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail068.hs index 2b17bcebc3..64bf294c08 100644 --- a/ghc/compiler/tests/typecheck/should_fail/tcfail068.hs +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail068.hs @@ -6,22 +6,22 @@ module IndTree(IndTree(..), itgen, itiap, itrap, itrapstate) where  --partain: import Auxiliary  import PreludeGlaST -type IndTree s t = _MutableArray s (Int,Int) t +type IndTree s t = MutableArray s (Int,Int) t  itgen :: Constructed a => (Int,Int) -> a -> IndTree s a  itgen n x =  -	_runST ( +	runST (  	newArray ((1,1),n) x)  itiap :: Constructed a => (Int,Int) -> (a->a) -> IndTree s a -> IndTree s a  itiap i f arr = -	_runST ( +	runST (  	readArray arr i `thenStrictlyST` \val ->  	writeArray arr i (f val) `seqStrictlyST`  	returnStrictlyST arr)  itrap :: Constructed a => ((Int,Int),(Int,Int)) -> (a->a) -> IndTree s a -> IndTree s a -itrap ((i,k),(j,l)) f arr = _runST(itrap' i k) +itrap ((i,k),(j,l)) f arr = runST(itrap' i k)  	where  	itrap' i k = if k > l then returnStrictlyST arr  		     else (itrapsnd i k `seqStrictlyST` @@ -33,7 +33,7 @@ itrap ((i,k),(j,l)) f arr = _runST(itrap' i k)  itrapstate :: Constructed b => ((Int,Int),(Int,Int)) -> (a->b->(a,b)) -> ((Int,Int)->c->a) ->  		(a->c) -> c -> IndTree s b -> (c, IndTree s b) -itrapstate ((i,k),(j,l)) f c d s arr = _runST(itrapstate' i k s) +itrapstate ((i,k),(j,l)) f c d s arr = runST(itrapstate' i k s)  	where  	itrapstate' i k s = if k > l then returnStrictlyST (s,arr)  			    else (itrapstatesnd i k s `thenStrictlyST` \(s,arr) -> diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc002.hs b/ghc/compiler/tests/typecheck/should_succeed/tc002.hs index fbe2cd50bd..85f1a91e1f 100644 --- a/ghc/compiler/tests/typecheck/should_succeed/tc002.hs +++ b/ghc/compiler/tests/typecheck/should_succeed/tc002.hs @@ -1 +1,3 @@ +module ShouldSucceed where +  b = if True then 1 else 2 diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc069.hs b/ghc/compiler/tests/typecheck/should_succeed/tc069.hs index 115af278b3..539b3046da 100644 --- a/ghc/compiler/tests/typecheck/should_succeed/tc069.hs +++ b/ghc/compiler/tests/typecheck/should_succeed/tc069.hs @@ -1,4 +1,4 @@ - +module ShouldSucceed where  x = 'a'  (y:ys) = ['a','b','c'] where p = x diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc070.hs b/ghc/compiler/tests/typecheck/should_succeed/tc070.hs index 3ef920f2af..831195f9f6 100644 --- a/ghc/compiler/tests/typecheck/should_succeed/tc070.hs +++ b/ghc/compiler/tests/typecheck/should_succeed/tc070.hs @@ -1,3 +1,5 @@ +module ShouldSucceed where +  data Boolean = FF | TT diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc081.hs b/ghc/compiler/tests/typecheck/should_succeed/tc081.hs index 27c29329ae..6590550cf6 100644 --- a/ghc/compiler/tests/typecheck/should_succeed/tc081.hs +++ b/ghc/compiler/tests/typecheck/should_succeed/tc081.hs @@ -1,5 +1,6 @@  --!!! an example Simon made up  -- +module ShouldSucceed where  f x = (x+1, x<3, g True, g 'c')  	where diff --git a/ghc/compiler/typecheck/TcTyDecls.lhs b/ghc/compiler/typecheck/TcTyDecls.lhs index 0eff0ad51c..b684d2e81e 100644 --- a/ghc/compiler/typecheck/TcTyDecls.lhs +++ b/ghc/compiler/typecheck/TcTyDecls.lhs @@ -292,6 +292,8 @@ label; it has to be an Id, you see!  \begin{code}  mkRecordSelector tycon fields@((first_con, first_field_label) : other_fields) +		-- These fields all have the same name, but are from +		-- different constructors in the data type    = let  	field_ty   = fieldLabelType first_field_label  	field_name = fieldLabelName first_field_label diff --git a/ghc/compiler/types/PprType.lhs b/ghc/compiler/types/PprType.lhs index 300160053e..1a7cfe35b6 100644 --- a/ghc/compiler/types/PprType.lhs +++ b/ghc/compiler/types/PprType.lhs @@ -191,7 +191,7 @@ ppr_corner sty env ctxt_prec (TyConTy FunTyCon usage) arg_tys  ppr_corner sty env ctxt_prec (TyConTy (TupleTyCon _ _ a) usage) arg_tys    | not (codeStyle sty) -- no magic in that case    = --ASSERT(length arg_tys == a) -    (if (length arg_tys /= a) then pprTrace "ppr_corner:" (ppCat [ppInt a, ppInterleave ppComma (map (pprGenType PprDebug) arg_tys)]) else id) $ +    --(if (length arg_tys /= a) then pprTrace "ppr_corner:" (ppCat [ppInt a, ppInterleave ppComma (map (pprGenType PprDebug) arg_tys)]) else id) $      ppBesides [ppLparen, arg_tys_w_commas, ppRparen]    where      arg_tys_w_commas = ppIntersperse pp'SP (map (ppr_ty sty env tOP_PREC) arg_tys) diff --git a/ghc/driver/ghc.lprl b/ghc/driver/ghc.lprl index 3777be9a5b..a669b22da8 100644 --- a/ghc/driver/ghc.lprl +++ b/ghc/driver/ghc.lprl @@ -108,8 +108,6 @@ if (! $ENV{'GLASGOW_HASKELL_ROOT'}) { # good -- death to environment variables      $TopPwd	    = '$(TOP_PWD)';      $InstLibDirGhc  = '$(INSTLIBDIR_GHC)';      $InstDataDirGhc = '$(INSTDATADIR_GHC)'; -#   $InstSysLibDir  = '$(INSTLIBDIR_HSLIBS)'; ToDo ToDo -    $InstSysLibDir  = '$(TOP_PWD)/hslibs';  } else {      $TopPwd = $ENV{'GLASGOW_HASKELL_ROOT'}; @@ -128,6 +126,13 @@ if (! $ENV{'GLASGOW_HASKELL_ROOT'}) { # good -- death to environment variables      }  } +if ( $(INSTALLING) ) { +    $InstSysLibDir  = $InstDataDirGhc; +    $InstSysLibDir  =~ s/\/ghc\//\/hslibs\//; +} else { +    $InstSysLibDir  = "$TopPwd/hslibs"; +} +  $Status  = 0; # just used for exit() status  $Verbose = ''; @@ -820,14 +825,18 @@ arg: while($_ = $ARGV[0]) {  				? "$InstSysLibDir/$syslib/imports"  				: "$TopPwd/hslibs/$syslib/src"); -			    if (! $(INSTALLING)) { +			    if ( $(INSTALLING) ) { +				push(@SysLibrary_dir, +					("$InstSysLibDir/$TargetPlatform")); +			    } else {  				push(@SysLibrary_dir,  					("$TopPwd/hslibs/$syslib"  					,"$TopPwd/hslibs/$syslib/cbits"));  			    } -			    push(@SysLibrary, ("-lHS$syslib" -						 ,"-lHS${syslib}_cbits")); +			    push(@SysLibrary, "-lHS$syslib"); +			    push(@SysLibrary, "-lHS${syslib}_cbits") +			      unless $syslib eq 'contrib'; #HACK! it has no cbits  			    next arg; }; @@ -2282,7 +2291,7 @@ sub makeHiMap {  	opendir(DIR, $d) || &tidy_up_and_die(1,"$Pgm: error when reading directory: $d\n");  	local(@entry) = readdir(DIR);  	foreach $e ( @entry ) { -	    next unless $e =~ /([A-Z][A-Za-z0-9_]*)\.$HiSuffix$/o; +	    next unless $e =~ /\b([A-Z][A-Za-z0-9_]*)\.$HiSuffix$/o;  	    $mod  = $1;  	    $path = "$d/$e";  	    $path =~ s,^\./,,; diff --git a/ghc/includes/CostCentre.lh b/ghc/includes/CostCentre.lh index a63390751d..3993b29965 100644 --- a/ghc/includes/CostCentre.lh +++ b/ghc/includes/CostCentre.lh @@ -156,7 +156,7 @@ CC_EXTERN(CC_DONTZuCARE);  	/* placeholder only */  CC_EXTERN(CC_CAFs);		/* prelude cost centre (CAFs  only) */  CC_EXTERN(CC_DICTs);		/* prelude cost centre (DICTs only) */ -# define IS_CAF_OR_DICT_OD_SUB_CC(cc) \ +# define IS_CAF_OR_DICT_OR_SUB_CC(cc) \      ((cc)->is_subsumed & ' ') 	/* tests for lower case character */  \end{code} diff --git a/ghc/misc/examples/io/io002/Main.hs b/ghc/misc/examples/io/io002/Main.hs index 346bffb8a1..c9a1bcfa82 100644 --- a/ghc/misc/examples/io/io002/Main.hs +++ b/ghc/misc/examples/io/io002/Main.hs @@ -1,4 +1,4 @@ -import LibSystem (getEnv) +import System (getEnv)  main =       getEnv "TERM" >>= \ term ->  diff --git a/ghc/misc/examples/io/io003/Main.hs b/ghc/misc/examples/io/io003/Main.hs index 535b4716df..93fff71be5 100644 --- a/ghc/misc/examples/io/io003/Main.hs +++ b/ghc/misc/examples/io/io003/Main.hs @@ -1,4 +1,4 @@ -import LibSystem (getProgName, getArgs) +import System (getProgName, getArgs)  main =       getProgName >>= \ argv0 -> diff --git a/ghc/misc/examples/io/io004/Main.hs b/ghc/misc/examples/io/io004/Main.hs index 59c745d4b1..69d2221743 100644 --- a/ghc/misc/examples/io/io004/Main.hs +++ b/ghc/misc/examples/io/io004/Main.hs @@ -1,3 +1,3 @@ -import LibSystem (exitWith, ExitCode(..)) +import System (exitWith, ExitCode(..))  main = exitWith (ExitFailure 42) diff --git a/ghc/misc/examples/io/io005/Main.hs b/ghc/misc/examples/io/io005/Main.hs index a987b9fb27..3a41560df6 100644 --- a/ghc/misc/examples/io/io005/Main.hs +++ b/ghc/misc/examples/io/io005/Main.hs @@ -1,11 +1,11 @@ -import LibSystem (system, ExitCode(..), exitWith) +import System (system, ExitCode(..), exitWith)  main =       system "cat dog 1>/dev/null 2>&1" >>= \ ec ->      case ec of -        ExitSuccess   -> putStr "What?!?\n" >> fail "dog succeeded" +        ExitSuccess   -> putStr "What?!?\n" >> fail (userError "dog succeeded")          ExitFailure _ ->              system "cat Main.hs 2>/dev/null" >>= \ ec ->  	    case ec of  	        ExitSuccess   -> exitWith ExitSuccess -	        ExitFailure _ -> putStr "What?!?\n" >> fail "cat failed" +	        ExitFailure _ -> putStr "What?!?\n" >> fail (userError "cat failed") diff --git a/ghc/misc/examples/io/io006/Main.hs b/ghc/misc/examples/io/io006/Main.hs index c6fc5394e3..6eb862c3da 100644 --- a/ghc/misc/examples/io/io006/Main.hs +++ b/ghc/misc/examples/io/io006/Main.hs @@ -1,4 +1,6 @@ +import IO -- 1.3 +  main =      hClose stderr >> -    hPutStr stderr "junk" `handle` \ (IllegalOperation _) -> putStr "Okay\n" +    hPutStr stderr "junk" `catch` \ err -> if isIllegalOperation err then putStr "Okay\n" else error "Not okay\n" diff --git a/ghc/misc/examples/io/io007/Main.hs b/ghc/misc/examples/io/io007/Main.hs index d6c94d8ef7..467382ff76 100644 --- a/ghc/misc/examples/io/io007/Main.hs +++ b/ghc/misc/examples/io/io007/Main.hs @@ -1,6 +1,11 @@ +import IO -- 1.3 +  main =      openFile "io007.in" ReadMode >>= \ hIn -> -    hPutStr hIn "test" `handle` -    \ (IllegalOperation _) ->  +    hPutStr hIn "test" `catch` +    \ err -> +        if isIllegalOperation err then          hGetContents hIn >>= \ stuff ->          hPutStr stdout stuff +	else +	    error "Oh dear\n" diff --git a/ghc/misc/examples/io/io008/Main.hs b/ghc/misc/examples/io/io008/Main.hs index 51685c9201..47f1a6ea97 100644 --- a/ghc/misc/examples/io/io008/Main.hs +++ b/ghc/misc/examples/io/io008/Main.hs @@ -1,4 +1,7 @@ -import LibDirectory (removeFile) +import IO -- 1.3 +import GHCio + +import Directory (removeFile)  main =      openFile "io008.in" ReadMode >>= \ hIn -> @@ -14,5 +17,5 @@ main =  copy :: Handle -> Handle -> IO ()  copy hIn hOut = -    try (hGetChar hIn) >>= -    either (\ EOF -> return ()) ( \ x -> hPutChar hOut x >> copy hIn hOut) +    tryIO (hGetChar hIn) >>= +    either (\ err -> if isEOFError err then return () else error "copy") ( \ x -> hPutChar hOut x >> copy hIn hOut) diff --git a/ghc/misc/examples/io/io009/Main.hs b/ghc/misc/examples/io/io009/Main.hs index b1bc0f2dc3..5f95ce0c42 100644 --- a/ghc/misc/examples/io/io009/Main.hs +++ b/ghc/misc/examples/io/io009/Main.hs @@ -1,7 +1,6 @@ -import LibDirectory (getDirectoryContents) +import Directory (getDirectoryContents)  import QSort (sort)  main =      getDirectoryContents "." >>= \ names -> -    putText (sort names) >> -    putChar '\n'
\ No newline at end of file +    print (sort names) diff --git a/ghc/misc/examples/io/io010/Main.hs b/ghc/misc/examples/io/io010/Main.hs index 5e5b0c3d16..764290c754 100644 --- a/ghc/misc/examples/io/io010/Main.hs +++ b/ghc/misc/examples/io/io010/Main.hs @@ -17,4 +17,4 @@ main =  dot :: String -> Bool  dot "." = True  dot ".." = True -dot _ = False
\ No newline at end of file +dot _ = False diff --git a/ghc/misc/examples/io/io011/Main.hs b/ghc/misc/examples/io/io011/Main.hs index 2fcbce5cb5..97f7d90e58 100644 --- a/ghc/misc/examples/io/io011/Main.hs +++ b/ghc/misc/examples/io/io011/Main.hs @@ -1,4 +1,6 @@ -import LibDirectory +import IO -- 1.3 + +import Directory  main =      createDirectory "foo" >> diff --git a/ghc/misc/examples/io/io012/Main.hs b/ghc/misc/examples/io/io012/Main.hs index 9b7fba3925..c5a16b730a 100644 --- a/ghc/misc/examples/io/io012/Main.hs +++ b/ghc/misc/examples/io/io012/Main.hs @@ -1,11 +1,12 @@ -import LibCPUTime +import IO -- 1.3 + +import CPUTime  main =       openFile "/dev/null" WriteMode >>= \ h -> -    hPutText h (nfib 30) >> +    hPrint h (nfib 30) >>      getCPUTime >>= \ t -> -    putText t >> -    putChar '\n' +    print t  nfib :: Integer -> Integer  nfib n  diff --git a/ghc/misc/examples/io/io013/Main.hs b/ghc/misc/examples/io/io013/Main.hs index 39c429e13d..9598e04d61 100644 --- a/ghc/misc/examples/io/io013/Main.hs +++ b/ghc/misc/examples/io/io013/Main.hs @@ -1,8 +1,9 @@ +import IO -- 1.3 +  main =       openFile "io013.in" ReadMode >>= \ h ->      hFileSize h >>= \ sz ->  -    putText sz >> -    putChar '\n' >> +    print sz >>      hSeek h SeekFromEnd (-3) >>      hGetChar h >>= \ x ->      putStr (x:"\n") >> @@ -14,4 +15,3 @@ main =      openFile "/dev/null" ReadMode >>= \ h ->      hIsSeekable h >>= \ False ->      hClose h -    
\ No newline at end of file diff --git a/ghc/misc/examples/io/io014/Main.hs b/ghc/misc/examples/io/io014/Main.hs index 23f62ca748..fecf4a51d7 100644 --- a/ghc/misc/examples/io/io014/Main.hs +++ b/ghc/misc/examples/io/io014/Main.hs @@ -1,22 +1,22 @@ +import IO -- 1.3 +  main =       accumulate (map hIsOpen [stdin, stdout, stderr]) >>= \ opens -> -    putText opens >> -    putChar '\n' >> +    print opens >>      accumulate (map hIsClosed [stdin, stdout, stderr]) >>= \ closeds -> -    putText closeds >> -    putChar '\n' >> +    print closeds >>      accumulate (map hIsReadable [stdin, stdout, stderr]) >>= \ readables -> -    putText readables >> -    putChar '\n' >> +    print readables >>      accumulate (map hIsWritable [stdin, stdout, stderr]) >>= \ writables -> -    putText writables >> -    putChar '\n' >> +    print writables >>      accumulate (map hIsBlockBuffered [stdin, stdout, stderr]) >>= \ buffereds -> -    putText buffereds >> -    putChar '\n' >> +    print buffereds >>      accumulate (map hIsLineBuffered [stdin, stdout, stderr]) >>= \ buffereds -> -    putText buffereds >> -    putChar '\n' >> +    print buffereds >>      accumulate (map hIsNotBuffered [stdin, stdout, stderr]) >>= \ buffereds -> -    putText buffereds >> -    putChar '\n' +    print buffereds +  where +    -- these didn't make it into 1.3 +    hIsBlockBuffered h = hGetBuffering h >>= \ b -> return $ case b of { BlockBuffering _ -> True; _ -> False } +    hIsLineBuffered  h = hGetBuffering h >>= \ b -> return $ case b of { LineBuffering -> True; _ -> False } +    hIsNotBuffered   h = hGetBuffering h >>= \ b -> return $ case b of { NoBuffering -> True; _ -> False } diff --git a/ghc/misc/examples/io/io015/Main.hs b/ghc/misc/examples/io/io015/Main.hs index a58450942c..37f0cc134a 100644 --- a/ghc/misc/examples/io/io015/Main.hs +++ b/ghc/misc/examples/io/io015/Main.hs @@ -1,3 +1,5 @@ +import IO -- 1.3 +  main =      isEOF >>= \ eof ->      if eof then  diff --git a/ghc/misc/examples/io/io016/Main.hs b/ghc/misc/examples/io/io016/Main.hs index e8df7a93dd..1ce01b2d45 100644 --- a/ghc/misc/examples/io/io016/Main.hs +++ b/ghc/misc/examples/io/io016/Main.hs @@ -1,4 +1,7 @@ -import LibSystem (getArgs) +import IO -- 1.3 + +import System (getArgs) +import Char   (toUpper)  main   =  getArgs                           >>=        \ [f1,f2] ->            openFile f1 ReadMode              >>=        \ h1      -> diff --git a/ghc/misc/examples/io/io017/Main.hs b/ghc/misc/examples/io/io017/Main.hs index f0a6d3ef3b..2be725480b 100644 --- a/ghc/misc/examples/io/io017/Main.hs +++ b/ghc/misc/examples/io/io017/Main.hs @@ -1,3 +1,5 @@ +import IO -- 1.3 +  main =        hSetBuffering stdout NoBuffering                  >>        putStr   "Enter an integer: "                     >> diff --git a/ghc/misc/examples/io/io018/Main.hs b/ghc/misc/examples/io/io018/Main.hs index f15c1cb5c1..7318cc7ac9 100644 --- a/ghc/misc/examples/io/io018/Main.hs +++ b/ghc/misc/examples/io/io018/Main.hs @@ -1,4 +1,6 @@ -import LibSystem(getArgs) +import IO -- 1.3 + +import System(getArgs)  main =   getArgs                            >>=        \ [user,host] ->           let username = (user ++ "@" ++ host) in diff --git a/ghc/misc/examples/io/io019/Main.hs b/ghc/misc/examples/io/io019/Main.hs index 168a4ac249..bd50838bb5 100644 --- a/ghc/misc/examples/io/io019/Main.hs +++ b/ghc/misc/examples/io/io019/Main.hs @@ -1,9 +1,8 @@ -import LibTime +import Time  main =       getClockTime >>= \ time -> -    putText time >> -    putChar '\n' >> +    print   time >>      let (CalendarTime year month mday hour min sec psec                         wday yday timezone gmtoff isdst) = toUTCTime time @@ -20,4 +19,4 @@ main =      shows2 x = showString (pad2 x)      pad2 x = case show x of                 c@[_] -> '0' : c -               cs -> cs
\ No newline at end of file +               cs -> cs diff --git a/ghc/misc/examples/io/io020/Main.hs b/ghc/misc/examples/io/io020/Main.hs index ff68bd9f35..1f349ebd32 100644 --- a/ghc/misc/examples/io/io020/Main.hs +++ b/ghc/misc/examples/io/io020/Main.hs @@ -1,4 +1,4 @@ -import LibTime +import Time  main =       getClockTime >>= \ time -> @@ -7,7 +7,7 @@ main =          time' = toClockTime (CalendarTime (year - 1) month mday hour min sec psec                               wday yday timezone gmtoff isdst)      in -        putText time >> +        print time >>  	putChar '\n' >> -	putText time' >>  +	print time' >>   	putChar '\n' diff --git a/ghc/misc/examples/io/io021/Main.hs b/ghc/misc/examples/io/io021/Main.hs index 66548f63ee..c45a40b9b1 100644 --- a/ghc/misc/examples/io/io021/Main.hs +++ b/ghc/misc/examples/io/io021/Main.hs @@ -1,3 +1,5 @@ +import IO -- 1.3 +  main =       hSetBuffering stdin NoBuffering	>>      hSetBuffering stdout NoBuffering	>> diff --git a/ghc/misc/examples/posix/po001/Main.hs b/ghc/misc/examples/posix/po001/Main.hs index db10babaa4..31c32ba94f 100644 --- a/ghc/misc/examples/posix/po001/Main.hs +++ b/ghc/misc/examples/posix/po001/Main.hs @@ -1,14 +1,14 @@ -import LibPosix +import Posix  main =      getParentProcessID >>= \ ppid ->      getProcessID >>= \ pid ->      putStr "Parent Process ID: " >> -    putText ppid >> +    print ppid >>      putStr "\nProcess ID: " >> -    putText pid >> +    print pid >>      putStr "\nforking ps uxww" >> -    putText ppid >> +    print ppid >>      putChar '\n' >>      forkProcess >>= \ child ->      case child of @@ -18,6 +18,6 @@ main =  doParent cpid pid =      getProcessStatus True False cpid >>      putStr "\nChild finished.  Now exec'ing ps uxww" >> -    putText pid >> +    print pid >>      putChar '\n' >>      executeFile "ps" True ["uxww" ++ show pid] Nothing diff --git a/ghc/misc/examples/posix/po002/Main.hs b/ghc/misc/examples/posix/po002/Main.hs index e646f02839..8d01e8b69f 100644 --- a/ghc/misc/examples/posix/po002/Main.hs +++ b/ghc/misc/examples/posix/po002/Main.hs @@ -1,4 +1,4 @@ -import LibPosix +import Posix  main =      executeFile "printenv" True [] (Just [("ONE","1"),("TWO","2")]) diff --git a/ghc/misc/examples/posix/po003/Main.hs b/ghc/misc/examples/posix/po003/Main.hs index b05d9cf7f0..eed6c08456 100644 --- a/ghc/misc/examples/posix/po003/Main.hs +++ b/ghc/misc/examples/posix/po003/Main.hs @@ -1,5 +1,5 @@ -import LibPosix +import Posix  main =       openFile "po003.out" WriteMode >>= \ h -> -    runProcess "pwd" [] Nothing (Just "/usr/tmp") Nothing (Just h) Nothing
\ No newline at end of file +    runProcess "pwd" [] Nothing (Just "/usr/tmp") Nothing (Just h) Nothing diff --git a/ghc/misc/examples/posix/po004/Main.hs b/ghc/misc/examples/posix/po004/Main.hs index 1725dd4e2b..2423f3f77a 100644 --- a/ghc/misc/examples/posix/po004/Main.hs +++ b/ghc/misc/examples/posix/po004/Main.hs @@ -1,5 +1,5 @@ -import LibPosix -import LibSystem(ExitCode(..), exitWith) +import Posix +import System(ExitCode(..), exitWith)  main =       forkProcess >>= \ maybe_pid -> @@ -11,7 +11,7 @@ doParent =      getAnyProcessStatus True False >>= \ (Just (pid, tc)) ->      case tc of  	Terminated sig | sig == floatingPointException -> forkChild2 -	_ -> fail "unexpected termination cause" +	_ -> fail (userError "unexpected termination cause")  forkChild2 =      forkProcess >>= \ maybe_pid -> @@ -23,7 +23,7 @@ doParent2 =      getAnyProcessStatus True False >>= \ (Just (pid, tc)) ->      case tc of  	Exited (ExitFailure 42) -> forkChild3 -	_ -> fail "unexpected termination cause (2)" +	_ -> fail (userError "unexpected termination cause (2)")  forkChild3 =      forkProcess >>= \ maybe_pid -> @@ -35,7 +35,7 @@ doParent3 =      getAnyProcessStatus True False >>= \ (Just (pid, tc)) ->      case tc of  	Exited ExitSuccess -> forkChild4 -	_ -> fail "unexpected termination cause (3)" +	_ -> fail (userError "unexpected termination cause (3)")  forkChild4 =      forkProcess >>= \ maybe_pid -> @@ -47,12 +47,12 @@ doParent4 =      getAnyProcessStatus True True >>= \ (Just (pid, tc)) ->      case tc of  	Stopped sig | sig == softwareStop -> enoughAlready pid -	_ -> fail "unexpected termination cause (4)" +	_ -> fail (userError "unexpected termination cause (4)")  enoughAlready pid =      signalProcess killProcess pid >>      getAnyProcessStatus True True >>= \ (Just (pid, tc)) ->      case tc of  	Terminated sig | sig == killProcess -> putStr "I'm happy.\n" -	_ -> fail "unexpected termination cause (5)" +	_ -> fail (userError "unexpected termination cause (5)") diff --git a/ghc/misc/examples/posix/po005/Main.hs b/ghc/misc/examples/posix/po005/Main.hs index 8ea76255e1..81dce3ae02 100644 --- a/ghc/misc/examples/posix/po005/Main.hs +++ b/ghc/misc/examples/posix/po005/Main.hs @@ -1,4 +1,4 @@ -import LibPosix +import Posix  main =      getEnvVar "TERM" >>= \ term -> @@ -6,25 +6,25 @@ main =      putChar '\n' >>      setEnvironment [("one","1"),("two","2")] >>      getEnvironment >>= \ env -> -    putText env >> +    print env >>      putChar '\n' >>      setEnvVar "foo" "bar" >>      getEnvironment >>= \ env -> -    putText env >> +    print env >>      putChar '\n' >>      setEnvVar "foo" "baz" >>      getEnvironment >>= \ env -> -    putText env >> +    print env >>      putChar '\n' >>      setEnvVar "fu" "bar" >>      getEnvironment >>= \ env -> -    putText env >> +    print env >>      putChar '\n' >>      removeEnvVar "foo" >>      getEnvironment >>= \ env -> -    putText env >> +    print env >>      putChar '\n' >>      setEnvironment [] >>      getEnvironment >>= \ env -> -    putText env >> +    print env >>      putChar '\n' diff --git a/ghc/misc/examples/posix/po006/Main.hs b/ghc/misc/examples/posix/po006/Main.hs index 8008a50f2b..eb6451dd73 100644 --- a/ghc/misc/examples/posix/po006/Main.hs +++ b/ghc/misc/examples/posix/po006/Main.hs @@ -1,4 +1,4 @@ -import LibPosix +import Posix  main =       epochTime >>= \ start -> @@ -6,9 +6,9 @@ main =      let timeleft = 0 in      epochTime >>= \ finish ->      putStr "Started: " >> -    putText start >> +    print start >>      putStr "\nSlept: " >> -    putText (5 - timeleft) >> +    print (5 - timeleft) >>      putStr "\nFinished: " >> -    putText finish >> +    print finish >>      putChar '\n' diff --git a/ghc/misc/examples/posix/po007/Main.hs b/ghc/misc/examples/posix/po007/Main.hs index d70e913e6b..3a37dc7545 100644 --- a/ghc/misc/examples/posix/po007/Main.hs +++ b/ghc/misc/examples/posix/po007/Main.hs @@ -1,4 +1,4 @@ -import LibPosix +import Posix  main =       installHandler keyboardSignal (Catch doCtrlC) Nothing >> @@ -28,4 +28,4 @@ doCtrlC =  ccStr '\DEL' = "^?"  ccStr x     | x >= ' ' = [x] -  | otherwise = ['^', (chr (ord x + ord '@'))] +  | otherwise = ['^', (toEnum (fromEnum x + fromEnum '@'))] diff --git a/ghc/misc/examples/posix/po008/Main.hs b/ghc/misc/examples/posix/po008/Main.hs index c775064405..249e58eedc 100644 --- a/ghc/misc/examples/posix/po008/Main.hs +++ b/ghc/misc/examples/posix/po008/Main.hs @@ -1,4 +1,4 @@ -import LibPosix +import Posix  main =      installHandler realTimeAlarm (Catch alarmclock) Nothing >> diff --git a/ghc/misc/examples/posix/po009/Main.hs b/ghc/misc/examples/posix/po009/Main.hs index 9707c58747..a1f284f78d 100644 --- a/ghc/misc/examples/posix/po009/Main.hs +++ b/ghc/misc/examples/posix/po009/Main.hs @@ -1,4 +1,4 @@ -import LibPosix +import Posix  main =      putStr "Blocking real time alarms.\n" >> @@ -9,6 +9,6 @@ main =      sleep 5 >>      getPendingSignals >>= \ ints ->      putStr "Checking pending interrupts for RealTimeAlarm\n" >> -    putText (inSignalSet realTimeAlarm ints) >> +    print (inSignalSet realTimeAlarm ints) >>      putChar '\n' diff --git a/ghc/misc/examples/posix/po010/Main.hs b/ghc/misc/examples/posix/po010/Main.hs index bfc890941f..86ef3e1c24 100644 --- a/ghc/misc/examples/posix/po010/Main.hs +++ b/ghc/misc/examples/posix/po010/Main.hs @@ -1,4 +1,4 @@ -import LibPosix +import Posix  main =      getUserEntryForName "mattson" >>= \ mattson -> @@ -21,4 +21,4 @@ ue2String ue =      uid = userID ue      gid = userGroupID ue      home = homeDirectory ue -    shell = userShell ue
\ No newline at end of file +    shell = userShell ue diff --git a/ghc/misc/examples/posix/po011/Main.hs b/ghc/misc/examples/posix/po011/Main.hs index 3d78924157..f8baf1cbc2 100644 --- a/ghc/misc/examples/posix/po011/Main.hs +++ b/ghc/misc/examples/posix/po011/Main.hs @@ -1,4 +1,4 @@ -import LibPosix +import Posix  main =      getGroupEntryForName "grasp" >>= \ grasp -> @@ -19,4 +19,4 @@ ge2String ge =    where      name = groupName ge      gid = groupID ge -    members = foldr (\x y -> x ++ (',' : y)) "" (groupMembers ge)
\ No newline at end of file +    members = foldr (\x y -> x ++ (',' : y)) "" (groupMembers ge) diff --git a/ghc/misc/examples/posix/po012/Main.hs b/ghc/misc/examples/posix/po012/Main.hs index d4eb3841bf..b84fafabe9 100644 --- a/ghc/misc/examples/posix/po012/Main.hs +++ b/ghc/misc/examples/posix/po012/Main.hs @@ -1,4 +1,5 @@ -import LibPosix +import Posix +import IO -- 1.3  main =      createFile "po012.out" stdFileMode >>= \ fd -> diff --git a/ghc/runtime/main/StgStartup.lhc b/ghc/runtime/main/StgStartup.lhc index bc2c352d26..086f755a08 100644 --- a/ghc/runtime/main/StgStartup.lhc +++ b/ghc/runtime/main/StgStartup.lhc @@ -625,31 +625,14 @@ END_REGISTER_CCS()  /* _regPrelude is above */ -START_REGISTER_PRELUDE(_regPreludeArray); +START_REGISTER_PRELUDE(_regGHCbase);  END_REGISTER_CCS() -START_REGISTER_PRELUDE(_regPreludeCore); -END_REGISTER_CCS() - -START_REGISTER_PRELUDE(_regPreludeDialogueIO); -END_REGISTER_CCS() - -START_REGISTER_PRELUDE(_regPreludeGlaMisc); +START_REGISTER_PRELUDE(_regGHCerr);  END_REGISTER_CCS()  START_REGISTER_PRELUDE(_regPreludeGlaST);  END_REGISTER_CCS() -START_REGISTER_PRELUDE(_regPreludeIOError); -END_REGISTER_CCS() - -START_REGISTER_PRELUDE(_regPreludePS); -END_REGISTER_CCS() - -START_REGISTER_PRELUDE(_regPreludePrimIO); -END_REGISTER_CCS() - -START_REGISTER_PRELUDE(_regPreludeStdIO); -END_REGISTER_CCS()  #endif  \end{code}  | 
