From 216bfb01a138932092eab3076c85648f5eee99b3 Mon Sep 17 00:00:00 2001 From: partain <unknown> Date: Fri, 26 Jul 1996 21:29:20 +0000 Subject: [PATCH] [project @ 1996-07-26 20:58:52 by partain] Final changes for 2.01 --- .../haskell-modes/simonm/real/haskell.el | 23 +++++++-------- ghc/compiler/deSugar/Match.lhs | 11 ++++---- ghc/compiler/tests/Jmakefile | 3 +- ghc/compiler/tests/ccall/cc001.hs | 2 +- ghc/compiler/tests/ccall/cc002.hs | 10 +++---- ghc/compiler/tests/ccall/cc003.hs | 2 +- ghc/compiler/tests/ccall/cc004.hs | 2 +- ghc/compiler/tests/deSugar/ds024.hs | 3 ++ ghc/compiler/tests/deSugar/ds026.hs | 2 ++ ghc/compiler/tests/deSugar/ds028.hs | 3 ++ ghc/compiler/tests/deSugar/ds031.hs | 2 ++ ghc/compiler/tests/deSugar/ds032.hs | 3 ++ ghc/compiler/tests/deSugar/ds037.hs | 2 ++ ghc/compiler/tests/deSugar/ds039.hs | 3 ++ ghc/compiler/tests/deriving/drv001.hs | 8 ++++-- ghc/compiler/tests/deriving/drv002.hs | 7 +++-- ghc/compiler/tests/deriving/drv003.hs | 2 ++ ghc/compiler/tests/deriving/drv004.hs | 2 ++ ghc/compiler/tests/deriving/drv005.hs | 2 ++ ghc/compiler/tests/deriving/drv006.hs | 3 ++ ghc/compiler/tests/deriving/drv007.hs | 1 + ghc/compiler/tests/rename/Jmakefile | 2 +- ghc/compiler/tests/typecheck/Jmakefile | 3 +- .../tests/typecheck/should_fail/tcfail021.hs | 1 + .../tests/typecheck/should_fail/tcfail029.hs | 1 + .../tests/typecheck/should_fail/tcfail031.hs | 1 + .../tests/typecheck/should_fail/tcfail033.hs | 1 + .../tests/typecheck/should_fail/tcfail034.hs | 2 ++ .../tests/typecheck/should_fail/tcfail035.hs | 2 +- .../tests/typecheck/should_fail/tcfail041.hs | 1 + .../tests/typecheck/should_fail/tcfail042.hs | 4 +-- .../tests/typecheck/should_fail/tcfail044.hs | 2 +- .../tests/typecheck/should_fail/tcfail045.hs | 7 +++-- .../tests/typecheck/should_fail/tcfail046.hs | 8 +++--- .../tests/typecheck/should_fail/tcfail048.hs | 1 + .../tests/typecheck/should_fail/tcfail049.hs | 1 + .../tests/typecheck/should_fail/tcfail050.hs | 1 + .../tests/typecheck/should_fail/tcfail051.hs | 1 + .../tests/typecheck/should_fail/tcfail052.hs | 1 + .../tests/typecheck/should_fail/tcfail054.hs | 1 + .../tests/typecheck/should_fail/tcfail055.hs | 1 + .../tests/typecheck/should_fail/tcfail056.hs | 1 + .../tests/typecheck/should_fail/tcfail058.hs | 1 + .../tests/typecheck/should_fail/tcfail061.hs | 1 + .../tests/typecheck/should_fail/tcfail062.hs | 8 +++--- .../tests/typecheck/should_fail/tcfail066.hs | 1 + .../tests/typecheck/should_fail/tcfail067.hs | 12 ++++---- .../tests/typecheck/should_fail/tcfail068.hs | 10 +++---- .../tests/typecheck/should_succeed/tc002.hs | 2 ++ .../tests/typecheck/should_succeed/tc069.hs | 2 +- .../tests/typecheck/should_succeed/tc070.hs | 2 ++ .../tests/typecheck/should_succeed/tc081.hs | 1 + ghc/compiler/typecheck/TcTyDecls.lhs | 2 ++ ghc/compiler/types/PprType.lhs | 2 +- ghc/driver/ghc.lprl | 21 ++++++++++---- ghc/includes/CostCentre.lh | 2 +- ghc/misc/examples/io/io002/Main.hs | 2 +- ghc/misc/examples/io/io003/Main.hs | 2 +- ghc/misc/examples/io/io004/Main.hs | 2 +- ghc/misc/examples/io/io005/Main.hs | 6 ++-- ghc/misc/examples/io/io006/Main.hs | 4 ++- ghc/misc/examples/io/io007/Main.hs | 9 ++++-- ghc/misc/examples/io/io008/Main.hs | 9 ++++-- ghc/misc/examples/io/io009/Main.hs | 5 ++-- ghc/misc/examples/io/io010/Main.hs | 2 +- ghc/misc/examples/io/io011/Main.hs | 4 ++- ghc/misc/examples/io/io012/Main.hs | 9 +++--- ghc/misc/examples/io/io013/Main.hs | 6 ++-- ghc/misc/examples/io/io014/Main.hs | 28 +++++++++---------- ghc/misc/examples/io/io015/Main.hs | 2 ++ ghc/misc/examples/io/io016/Main.hs | 5 +++- ghc/misc/examples/io/io017/Main.hs | 2 ++ ghc/misc/examples/io/io018/Main.hs | 4 ++- ghc/misc/examples/io/io019/Main.hs | 7 ++--- ghc/misc/examples/io/io020/Main.hs | 6 ++-- ghc/misc/examples/io/io021/Main.hs | 2 ++ ghc/misc/examples/posix/po001/Main.hs | 10 +++---- ghc/misc/examples/posix/po002/Main.hs | 2 +- ghc/misc/examples/posix/po003/Main.hs | 4 +-- ghc/misc/examples/posix/po004/Main.hs | 14 +++++----- ghc/misc/examples/posix/po005/Main.hs | 14 +++++----- ghc/misc/examples/posix/po006/Main.hs | 8 +++--- ghc/misc/examples/posix/po007/Main.hs | 4 +-- ghc/misc/examples/posix/po008/Main.hs | 2 +- ghc/misc/examples/posix/po009/Main.hs | 4 +-- ghc/misc/examples/posix/po010/Main.hs | 4 +-- ghc/misc/examples/posix/po011/Main.hs | 4 +-- ghc/misc/examples/posix/po012/Main.hs | 3 +- ghc/runtime/main/StgStartup.lhc | 21 ++------------ glafp-utils/scripts/Jmakefile | 4 +++ glafp-utils/scripts/mkdirhier.sh | 24 ++++++++++++++++ 91 files changed, 274 insertions(+), 170 deletions(-) create mode 100644 glafp-utils/scripts/mkdirhier.sh diff --git a/ghc/CONTRIB/haskell-modes/simonm/real/haskell.el b/ghc/CONTRIB/haskell-modes/simonm/real/haskell.el index c1dd5f1eab01..6adc7441eda9 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 eea766773db9..72a4b85edf68 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 716cc71966ea..8450a8258ec7 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 8c37355ca398..c26a53f29c88 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 3a4b66d1d72b..95a061b9715d 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 5b8bd822e285..474a4b3ad3c8 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 7ad0ceda1682..6dee39973db0 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 1e5f7ebe0742..6f0b27aadec8 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 2f9faa730343..ff1f0bee7ee5 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 728a0c89bc26..18c0b7d62295 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 6454e08d036f..3378800e169d 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 a1cda8468e10..31bc07ebf557 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 924df509e05b..648534165021 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 ad6c1bed071a..e153bfa51a2c 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 707a05d9ba42..ffe8196c8f71 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 e8855f2600df..15eb2d9ecc01 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 3da22bd9d0a4..f6d678006a63 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 9863e3ae3d78..82afb6b8f0ea 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 cef5fe6a5b20..93d8b45e0e00 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 a6d6d1c64574..029f67adf41a 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 c1bbab1bae1d..ba1a864f30e4 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 b018f9ddd6a2..aff8571ca548 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 a4ca9c760c22..7c079c008f16 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 6afdea7920e2..f6758a1b2beb 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 312e6fee47bd..4b8f2c6c891b 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 c81ced82299f..6b9a0de12b89 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 5c8b4d8e7e21..fdc0aff8ed5a 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 e0d0ffeacec6..82aa18b41872 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 a0b9f0ee566c..a12908ee5a24 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 ca92003d7042..542c400a8653 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 566bfea991c2..37c24936a996 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 9d056409f167..3f899a6f6b88 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 f13b603508c1..83a1daf81cce 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 c58988a5e3c3..40fad6ba7d4a 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 5b58e204a24c..f4400e2fa01c 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 3fa7791dffe8..64dee54a5c96 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 a1fa3541d23e..c0cee979f7e4 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 f94aa9d9bf4a..1b8e251c4083 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 09488054edde..e9be21e6f2b2 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 69ce2e81b225..a4e724cf18a2 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 fc6efe3bb7f7..f61c5a81be72 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 6e15f2bf5d0d..a8a1315be781 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 191d5644b911..c05c85972f96 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 4ed535e9ea27..2957e800d5d3 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 8989d91b205c..5c9b0ea2156b 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 f146acd759cd..2d2e9bafd8b3 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 b84328c41449..99d4c648c06a 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 2b17bcebc30f..64bf294c08ce 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 fbe2cd50bd34..85f1a91e1fc5 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 115af278b3eb..539b3046da70 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 3ef920f2af21..831195f9f626 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 27c29329ae5f..6590550cf670 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 0eff0ad51c5b..b684d2e81ea0 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 300160053e9d..1a7cfe35b66f 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 3777be9a5b4e..a669b22da8de 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 a63390751d74..3993b29965ba 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 346bffb8a1c1..c9a1bcfa8264 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 535b4716df56..93fff71be517 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 59c745d4b1c7..69d2221743b0 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 a987b9fb2717..3a41560df675 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 c6fc5394e30a..6eb862c3da06 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 d6c94d8ef7ee..467382ff76c3 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 51685c9201aa..47f1a6ea97a3 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 b1bc0f2dc3ca..5f95ce0c42a9 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 5e5b0c3d1658..764290c75496 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 2fcbce5cb573..97f7d90e58b6 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 9b7fba3925b0..c5a16b730a85 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 39c429e13d1b..9598e04d611c 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 23f62ca748a6..fecf4a51d778 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 a58450942c16..37f0cc134ab0 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 e8df7a93dd08..1ce01b2d4587 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 f0a6d3ef3bc1..2be725480b62 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 f15c1cb5c198..7318cc7ac91f 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 168a4ac24925..bd50838bb519 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 ff68bd9f35a9..1f349ebd327e 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 66548f63ee13..c45a40b9b1e4 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 db10babaa4f5..31c32ba94f39 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 e646f02839d3..8d01e8b69f12 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 b05d9cf7f086..eed6c084569e 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 1725dd4e2b14..2423f3f77a99 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 8ea76255e1ff..81dce3ae0255 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 8008a50f2b67..eb6451dd7345 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 d70e913e6b85..3a37dc7545df 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 c775064405d8..249e58eedc1f 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 9707c58747d7..a1f284f78d0f 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 bfc890941f24..86ef3e1c2488 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 3d789241570f..f8baf1cbc235 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 d4eb3841bf67..b84fafabe9db 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 bc2c352d26ce..086f755a08c9 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} diff --git a/glafp-utils/scripts/Jmakefile b/glafp-utils/scripts/Jmakefile index 4157b548f01b..b3589a3fb077 100644 --- a/glafp-utils/scripts/Jmakefile +++ b/glafp-utils/scripts/Jmakefile @@ -1,6 +1,7 @@ PROGRAMS = lndir \ runstdtest \ mkdependC \ + mkdirhier \ fastmake \ ltx @@ -10,6 +11,9 @@ MsubNeededHere($(PROGRAMS)) /* === BUILD STUFF (installation, etc., below) ========== */ +/* std X11 stuff: used in installing ghc/hslibs */ +MsubProgramScriptTarget(BourneShell,mkdirhier,mkdirhier.sh,,) + BuildPgmFromOneCFile(lndir) MsubMakefileDependentProgramScriptTarget(PerlCmd,runstdtest,runstdtest.prl,,) diff --git a/glafp-utils/scripts/mkdirhier.sh b/glafp-utils/scripts/mkdirhier.sh new file mode 100644 index 000000000000..739535e1189b --- /dev/null +++ b/glafp-utils/scripts/mkdirhier.sh @@ -0,0 +1,24 @@ +#!/bin/sh + +# +# create a heirarchy of directories +# + +for f in $*; do + parts=`echo $f | sed 's,\(.\)/\(.\),\1 \2,g' | sed 's,/$,,'`; + path=""; + for p in $parts; do + if [ x"$path" = x ]; then + dir=$p; + else + dir=$path/$p; + fi; + if [ ! -d $dir ]; then + echo mkdir $dir; + mkdir $dir; + chmod a+rx $dir; + fi; + path=$dir; + done; +done + -- GitLab