diff --git a/ghc/CONTRIB/haskell-modes/simonm/real/haskell.el b/ghc/CONTRIB/haskell-modes/simonm/real/haskell.el index c1dd5f1eab01085603c09519cd6205abb72a2c3a..6adc7441eda9175b2cdea6d32b4c1e33066d7f04 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 eea766773db945c8e9e5af900ec335c9ee92cee5..72a4b85edf680771a08a3c389e88312faf407045 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 716cc71966eabd26b697674b7ebe03c620221dfc..8450a8258ec7037ea3a6fd1e9d0f18a598174a5f 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 8c37355ca398bc7b8552e0f9ec9f62c9a8952ac5..c26a53f29c888d53b849901ab9e1bf07927fd2f0 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 3a4b66d1d72b7702c80458b575842c5a96e75e6d..95a061b9715d9422df017a38dced2268c668b4fb 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 5b8bd822e28547f65a247a77186d0d58afdd15b7..474a4b3ad3c80700009e0ba1d82f668b1282d738 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 7ad0ceda1682ae0b7711aa12b44a71e46d8364ba..6dee39973db07e9315ef415365b355680e9b3a2b 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 1e5f7ebe0742178f4921be88c8853fe8f01640d1..6f0b27aadec89597d7682f287ae3c7accd50cb1d 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 2f9faa730343cd7771e445297a330d2ec71e2758..ff1f0bee7ee54e40526c2c57fdf61ace09b91f02 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 728a0c89bc264fc8c6cc273eeb44ee6ca20e9ff1..18c0b7d622958b5aff3b97a7e885f25cc77d2b67 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 6454e08d036f19ab3d0ebbad037acba645d0d729..3378800e169d02da98052ae62635a688e8dd86ed 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 a1cda8468e104c51de8ff03db87943852cb6db14..31bc07ebf557ab7bcc1285c05c6b2006e7386762 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 924df509e05b3873049030d0c8a88bbd5f725a14..648534165021609b42d0701b03794a7078098cf3 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 ad6c1bed071a1111dca2d05080e181cc884433a9..e153bfa51a2cb6ad4676e16be4cf4e1df2841405 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 707a05d9ba427f08b045d0210825b8309966deb4..ffe8196c8f7162c946ffd2967503acbc7e123356 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 e8855f2600df6b9d152d689d7d67267ccc5cc3e8..15eb2d9ecc01f3e305c61383e2108d1a4c385534 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 3da22bd9d0a42bc7ba27a321db7844b79143b1ff..f6d678006a63b3cec9eab06901f137cd4e6af2aa 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 9863e3ae3d78450256c39b048627cdfca47a95ab..82afb6b8f0ea3e0264a60d106cd3138b0fadbedf 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 cef5fe6a5b2087db04fabf09045c61743733a2ee..93d8b45e0e00864faca96f003e845448737a07ab 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 a6d6d1c64574874cf5f05c62f7fbf7056e211275..029f67adf41a9ea338c91fbce8df3a8e3178f70f 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 c1bbab1bae1da63baa82e1c3e769730384639df2..ba1a864f30e43ab3b5fca40e8a08472a902b06cb 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 b018f9ddd6a21eda07924caa856be7f4362d9868..aff8571ca5483f5e2ec150dd1114c554d51b5336 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 a4ca9c760c221fac1dfae198991e415e1bc6eb6e..7c079c008f164a1a3589a1404d6250f6c7ffb61e 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 6afdea7920e201cfb5ff7b720b538707a6799817..f6758a1b2beba4443be009acd8eb95e7dcc4e008 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 312e6fee47bdbef62535dc06e972632d39e0e4f8..4b8f2c6c891bad4a96f06daf0b51249218ce595c 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 c81ced82299f01e446b974cbac1b6e38d3afdedd..6b9a0de12b89ec8db84514e11875502f81b3cfcc 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 5c8b4d8e7e21131b554f588b1660e682f8b5c62f..fdc0aff8ed5a1ce0d349e6dfdaa51148149a8bf1 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 e0d0ffeacec616aca87a0c5ea532db5f6adfb131..82aa18b41872cc2446c25314d973d24f73f7daef 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 a0b9f0ee566c879d9ee120b2bb1834641d4c4c7f..a12908ee5a246ed9f0ede3b95b7a6baa2aba0d6f 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 ca92003d70424842c6305637353442e2136dfe37..542c400a865356e696d51f2c74c1e4eabfc5c909 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 566bfea991c2eae2533a3e13a9f639e4b4676f5f..37c24936a99607b27e61485cfbffe02d840e60e8 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 9d056409f16788de523277a371bef3f81df71889..3f899a6f6b883b0c1394ee243cb73a404aa779b2 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 f13b603508c16b883300efbe9b19f3e7cb11eef1..83a1daf81cce86b2ea48e1dc6bea56596a1e8452 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 c58988a5e3c3e762ec714fb54ec3f39c276bfb6f..40fad6ba7d4a99bfeb125f921e0e2aafe0bfa70b 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 5b58e204a24c7a8529233ca85f9eab77337c2c95..f4400e2fa01cd72211ee78262ecefd9f9f218186 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 3fa7791dffe81d5fa13e27c63fb206738e2558d9..64dee54a5c9623bbaa97b3666e1ae46ce04e8d77 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 a1fa3541d23e021194970786f6157ee3731b7068..c0cee979f7e4ec1f3399d1b9c131c7bf9f84561a 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 f94aa9d9bf4a3d004bc855bd51f8302059b0836d..1b8e251c4083de3e28b34c7b7c0eaf6a25b57788 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 09488054edde2d22cf94209f64d2e4fa70a18ac6..e9be21e6f2b2ad99d5e27c830e9c238b12ca6ed9 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 69ce2e81b2251e9a4a4637e39c268b61f667d4c9..a4e724cf18a2f7ccc9f913ba1733caa87f854eda 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 fc6efe3bb7f74dc0453c772ba03cae2e0d5d337d..f61c5a81be72f69d0ac0e99fa2fc63ff1d7d1602 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 6e15f2bf5d0d4ba7dfbc465af4f8bb37376b4096..a8a1315be781a33d07815c866d7c4cc831415a90 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 191d5644b9111492500e041f3e70bae8b5a12544..c05c85972f9671d6820a652ece52a62dadb84675 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 4ed535e9ea27ce21916b291775a7296cd0fa9e86..2957e800d5d3aaa776e7f0a16cafafcf43e69082 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 8989d91b205caafb2dc85772ba0bfec361c4f657..5c9b0ea2156b7d765f3d90ecd167d42341222829 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 f146acd759cd8377d2ca6d19ad20af6b49a2f87a..2d2e9bafd8b33365cd4b7efb0660551e72aa21dc 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 b84328c4144978d14f412b4f8319c61cd91068bf..99d4c648c06a8f15ffae96d889d82cafff89ac40 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 2b17bcebc30f6e3d5fbc4b1e674c9822ab8c9e22..64bf294c08ce1efc63ffe0cb305a5bc55d212d9a 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 fbe2cd50bd3473a8d346ccee3d53c32da74525b9..85f1a91e1fc5b10eadb03ed3c01cd7bdbfa7929e 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 115af278b3eb402c55c4645387f57ec3642a70d8..539b3046da70e5a483ca1cc7a0bc157ef7edd81d 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 3ef920f2af212bd2f903f0c9d14d1667b9f92f4e..831195f9f6269fb3634cab100d0880d1fa68cf20 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 27c29329ae5ffaf26ad23683bb8b44f1a7e84c4c..6590550cf670ae95778a5c35457645eb7473e89e 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 0eff0ad51c5bf9ba73d099aaeaa86ed5b200df60..b684d2e81ea02c787d192e9599fa3982d0304fd9 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 300160053e9d5d56733693a18fb0bf4216d7dc92..1a7cfe35b66fd3ce55f12bcbef51f764cb278a1a 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 3777be9a5b4e6ca6a7fcbb94206af8349afb3159..a669b22da8dee2e0652d5bd864c08d9ed302db28 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 a63390751d74a26e172958259974c708b1e1a31a..3993b29965ba89a91c917aebdd7dcd0f5b0eb656 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 346bffb8a1c1b2cacd3727401c9a259334248146..c9a1bcfa8264f18874d7e51359891beee04b2f77 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 535b4716df562dbf3e75bc166bdd92cb05ea45a4..93fff71be517a0d09a4b8f91f9c43b153d158307 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 59c745d4b1c75073b4f6c6077fdba4b879d39a0b..69d2221743b04b33832a3276e48a4bafb3f20dc9 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 a987b9fb27174aa98c454ca83b6adbc3de5f559d..3a41560df67505607093062111d3781189a6fe47 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 c6fc5394e30a4c25dee1c34110192e10881053f6..6eb862c3da06f443f212459c00e70beb052e248a 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 d6c94d8ef7ee1d135b3eb58d570129f1301ebc64..467382ff76c3467e4c7d40a008e1a66336c66466 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 51685c9201aa7acf95971a9849ac8e54b7750b24..47f1a6ea97a32799e9be7a9edc4af85b6372042d 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 b1bc0f2dc3ca65be336e5dfd0161ff132eb5b322..5f95ce0c42a953cabd037c2b03e96a44db71c737 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 5e5b0c3d16582b144e76f0d0545f63f9040e2196..764290c7549639777d3662376ad8313b64c3aa3a 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 2fcbce5cb57381cf418b3aa151e4b93f667f5075..97f7d90e58b68eefce3f1da41115619217d422e1 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 9b7fba3925b0b298a8d09067c12a40ff2fc3c4e2..c5a16b730a85535b43ad3d7b1276c8aea6b2b34f 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 39c429e13d1b4ab30a9ec65c5366f25443f7fc73..9598e04d611cd5c8ec6dac0f357a23c9a5cece5f 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 23f62ca748a6ce8198a5585d801202b461111b9c..fecf4a51d778a9afef4ba8c0465787499931c4a6 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 a58450942c16d31c8f46e06cfe54d502fb432b24..37f0cc134ab0b36de3edc3017fa23e6be4142bc4 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 e8df7a93dd0801d6a714de2ae2a174ce6edc38e1..1ce01b2d45874798dab8a421da222cf4c0f95d2b 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 f0a6d3ef3bc1d4194274a58ae28e274bac6c5484..2be725480b62fc079850c0e19aa6d46aeed8a979 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 f15c1cb5c198483c02170f287ffe8f84586fcc6e..7318cc7ac91f6b48bf77e89128fc427f7447ed4d 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 168a4ac2492572f7fab74368c8242c49943faaa0..bd50838bb519eba42d049e80740ec498307fc43e 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 ff68bd9f35a947d1b28fff9677529ff9bbad522c..1f349ebd327edfb3b33c3a9cf445102d78e0c407 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 66548f63ee136186a1eded5316c8aef3a3ea0832..c45a40b9b1e4c707174f02fc5a2d619b7ec3e3ce 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 db10babaa4f54ee40175f654d1f91aade3f5fbc6..31c32ba94f394989d19e5722ce128ba56e55c454 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 e646f02839d3d4b782f69d0d6dd0f4c2eb2decc0..8d01e8b69f1234717a0c8ad2f33175b48925b7d2 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 b05d9cf7f086b297b0369c296d78aba4b4e36bc9..eed6c084569e79a5af728bf99171ed96bfa28c6f 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 1725dd4e2b14418ce8c65c1c8793d8fc6b0c6a39..2423f3f77a990bf781c7d3a2ceddf24fadd63be2 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 8ea76255e1ff5191211e9d0205bccf0e9de4baa0..81dce3ae02555af47061277db833b8872ae00dca 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 8008a50f2b6763caa7aefb93f6165d0071091eeb..eb6451dd734512c3e58ee75132ba675cd69fa2af 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 d70e913e6b85b0a8e87ddb809a73909c024c968a..3a37dc7545df078d85fd88ea1650441a991deb4e 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 c775064405d856864fe46b54433353ac85f59955..249e58eedc1f8a58bec58362acf271e2ad9670bd 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 9707c58747d7aa804ad5d9647a2f150521d77248..a1f284f78d0ffa8937852e99b9cd2df478002522 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 bfc890941f2478a8f78d6b93945e413bb72fccb3..86ef3e1c24880498951bbab7377ca2e0d8d54ece 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 3d789241570fe2e7a30e7f0b4123f252e547b0d5..f8baf1cbc235a6bc7d567705fc0a3afc6f742a43 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 d4eb3841bf67bb94e5d15e3f503b1e28789f38ef..b84fafabe9dbfa0be850af359dfeed01615e8569 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 bc2c352d26cedbbde22f2c59e06f0c9cca123874..086f755a08c9cb3df208c670b93dd0c6fcb6d581 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 4157b548f01b33eceb034036e8cf3a60ade9e308..b3589a3fb07788aedd460d2599d5997d44afb111 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 0000000000000000000000000000000000000000..739535e1189b000b73def2073c5daed05ac687d1 --- /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 +