(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)
(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 ()
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)
(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)
))
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 )
-- 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
deSugar \
printing \
ccall \
- deriving \
- bugs
+ deriving
module Test where
-import PreludeGlaIO
+import PreludeGlaST
-- simple functions
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
--!!! cc003 -- ccall with unresolved polymorphism (should fail)
module Test where
-import PreludeGlaIO
+import PreludeGlaST
fubar :: PrimIO Int
fubar = ccall f `seqPrimIO` ccall b
--!!! 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
-- do all the right types get stuck on all the
-- Nils and Conses?
+module ShouldSucceed where
+
+
f x = [[], []]
g x = ([], [], [])
--!!! ds026 -- classes -- incl. polymorphic method
+module ShouldSucceed where
+
class Foo a where
op :: a -> a
--!!! ds028: failable pats in top row
+module ShouldSucceed where
+
+
-- when the first row of pats doesn't have convenient
-- variables to grab...
+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)
--!!! recursive funs tangled in an AbsBind
+module ShouldSucceed where
+
+
flatten :: Int -- Indentation
-> Bool -- True => just had a newline
-> Float -- Current seq to flatten
--!!! 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))
--!!! make sure correct type applications get put in
--!!! when (:) is saturated.
+module ShouldSucceed where
+
+
f = (:)
--!!! 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"
+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"
--!!! This is the example given in TcDeriv
--
+module ShouldSucceed where
+
data T a b
= C1 (Foo a) (Bar b)
| C2 Int (T b a)
--!!! simple example of deriving Ord (and, implicitly, Eq)
--
+module ShouldSucceed where
+
data Foo a b
= C1 a Int
| C2 b Double
--!!! simple example of deriving Enum
--
+module ShouldSucceed where
+
data Foo = Foo1 | Foo2 | Foo3 | Foo4 | Foo5 | Foo6 | Foo7 | Foo8
deriving Enum
--!!! simple examples of deriving Ix
--
+module ShouldSucceed where
+import Ix
+
data Foo = Foo1 | Foo2 | Foo3 | Foo4 | Foo5 | Foo6 | Foo7 | Foo8
deriving Ix
--!!! buggy deriving with function type, reported by Sigbjorn Finne
+module ShouldSucceed where
data Foo = Foo (Int -> Int) deriving Eq
@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)
SUBDIRS = /* TEMPORARILY OUT: check_mess */ \
should_fail \
/* TEMPORARILY OUT: test_exps */ \
- should_succeed \
- bugs
+ should_succeed
+module ShouldFail where
f x x = 2
--!!! tests for InstOpErr
+module ShouldFail where
data Foo = Bar | Baz
+module ShouldFail where
f x = if 'a' then 1 else 2
-- from Jon Hill
+module ShouldFail where
buglet = [ x | (x,y) <- buglet ]
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
instance Num NUM
instance Num NUM
instance Eq NUM
-instance Text NUM
+instance Show NUM
-- Lennart
- ------- End of forwarded message -------
-}
+module ShouldFail where
sort :: Ord a => [a] -> [a]
sort xs = s xs (length xs)
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
{-
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]
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)))
--!!! 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
--!! 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)
+module ShouldFail where
class (B a) => C a where
op1 :: a -> a
+module ShouldFail where
f x = g x
+module ShouldFail where
f x = B x
+module ShouldFail where
instance B Bool where
op1 a = a
+module ShouldFail where
data C a = B a c
+module ShouldFail where
f (B a) = True
+module ShouldFail where
f x = (x + 1 :: Int) :: Float
+module ShouldFail where
data Foo = MkFoo Bool
module ShouldFail where
+import Array
--!!! inadvertently using => instead of ->
--!! signature bugs exposed by Sigbjorne Finne
--
+module ShouldFail where
type Flarp a = (b,b)
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
= 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
Message-Id: <9412081138.AA16652@rdf009.cs.man.ac.uk>
To: partain@dcs.gla.ac.uk
-}
+module ShouldFail where
type IMonad a
= IMonadState -> IMonadReturn a
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 ++
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 ++ ")"
--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`
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) ->
+module ShouldSucceed where
+
b = if True then 1 else 2
-
+module ShouldSucceed where
x = 'a'
(y:ys) = ['a','b','c'] where p = x
+module ShouldSucceed where
+
data Boolean = FF | TT
--!!! an example Simon made up
--
+module ShouldSucceed where
f x = (x+1, x<3, g True, g 'c')
where
\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
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)
$TopPwd = '$(TOP_PWD)';
$InstLibDirGhc = '$(INSTLIBDIR_GHC)';
$InstDataDirGhc = '$(INSTDATADIR_GHC)';
-# $InstSysLibDir = '$(INSTLIBDIR_HSLIBS)'; ToDo ToDo
- $InstSysLibDir = '$(TOP_PWD)/hslibs';
} else {
$TopPwd = $ENV{'GLASGOW_HASKELL_ROOT'};
}
}
+if ( $(INSTALLING) ) {
+ $InstSysLibDir = $InstDataDirGhc;
+ $InstSysLibDir =~ s/\/ghc\//\/hslibs\//;
+} else {
+ $InstSysLibDir = "$TopPwd/hslibs";
+}
+
$Status = 0; # just used for exit() status
$Verbose = '';
? "$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; };
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,^\./,,;
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}
-import LibSystem (getEnv)
+import System (getEnv)
main =
getEnv "TERM" >>= \ term ->
-import LibSystem (getProgName, getArgs)
+import System (getProgName, getArgs)
main =
getProgName >>= \ argv0 ->
-import LibSystem (exitWith, ExitCode(..))
+import System (exitWith, ExitCode(..))
main = exitWith (ExitFailure 42)
-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")
+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"
+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"
-import LibDirectory (removeFile)
+import IO -- 1.3
+import GHCio
+
+import Directory (removeFile)
main =
openFile "io008.in" ReadMode >>= \ hIn ->
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)
-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)
dot :: String -> Bool
dot "." = True
dot ".." = True
-dot _ = False
\ No newline at end of file
+dot _ = False
-import LibDirectory
+import IO -- 1.3
+
+import Directory
main =
createDirectory "foo" >>
-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
+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") >>
openFile "/dev/null" ReadMode >>= \ h ->
hIsSeekable h >>= \ False ->
hClose h
-
\ No newline at end of file
+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 }
+import IO -- 1.3
+
main =
isEOF >>= \ eof ->
if eof then
-import LibSystem (getArgs)
+import IO -- 1.3
+
+import System (getArgs)
+import Char (toUpper)
main = getArgs >>= \ [f1,f2] ->
openFile f1 ReadMode >>= \ h1 ->
+import IO -- 1.3
+
main =
hSetBuffering stdout NoBuffering >>
putStr "Enter an integer: " >>
-import LibSystem(getArgs)
+import IO -- 1.3
+
+import System(getArgs)
main = getArgs >>= \ [user,host] ->
let username = (user ++ "@" ++ host) in
-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
shows2 x = showString (pad2 x)
pad2 x = case show x of
c@[_] -> '0' : c
- cs -> cs
\ No newline at end of file
+ cs -> cs
-import LibTime
+import Time
main =
getClockTime >>= \ time ->
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'
+import IO -- 1.3
+
main =
hSetBuffering stdin NoBuffering >>
hSetBuffering stdout NoBuffering >>
-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
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
-import LibPosix
+import Posix
main =
executeFile "printenv" True [] (Just [("ONE","1"),("TWO","2")])
-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
-import LibPosix
-import LibSystem(ExitCode(..), exitWith)
+import Posix
+import System(ExitCode(..), exitWith)
main =
forkProcess >>= \ maybe_pid ->
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 ->
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 ->
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 ->
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)")
-import LibPosix
+import Posix
main =
getEnvVar "TERM" >>= \ term ->
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'
-import LibPosix
+import Posix
main =
epochTime >>= \ start ->
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'
-import LibPosix
+import Posix
main =
installHandler keyboardSignal (Catch doCtrlC) Nothing >>
ccStr '\DEL' = "^?"
ccStr x
| x >= ' ' = [x]
- | otherwise = ['^', (chr (ord x + ord '@'))]
+ | otherwise = ['^', (toEnum (fromEnum x + fromEnum '@'))]
-import LibPosix
+import Posix
main =
installHandler realTimeAlarm (Catch alarmclock) Nothing >>
-import LibPosix
+import Posix
main =
putStr "Blocking real time alarms.\n" >>
sleep 5 >>
getPendingSignals >>= \ ints ->
putStr "Checking pending interrupts for RealTimeAlarm\n" >>
- putText (inSignalSet realTimeAlarm ints) >>
+ print (inSignalSet realTimeAlarm ints) >>
putChar '\n'
-import LibPosix
+import Posix
main =
getUserEntryForName "mattson" >>= \ mattson ->
uid = userID ue
gid = userGroupID ue
home = homeDirectory ue
- shell = userShell ue
\ No newline at end of file
+ shell = userShell ue
-import LibPosix
+import Posix
main =
getGroupEntryForName "grasp" >>= \ grasp ->
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)
-import LibPosix
+import Posix
+import IO -- 1.3
main =
createFile "po012.out" stdFileMode >>= \ fd ->
/* _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}
PROGRAMS = lndir \
runstdtest \
mkdependC \
+ mkdirhier \
fastmake \
ltx
/* === 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,,)
--- /dev/null
+#!/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
+
projects / ghc-hetmet.git / commitdiff