21 files changed, 267 insertions, 0 deletions

diff --git a/ghc/misc/examples/io/io001/Main.hs b/ghc/misc/examples/io/io001/Main.hs
new file mode 100644
index 0000000000..6620e3c1fe
--- /dev/null
+++ b/ghc/misc/examples/io/io001/Main.hs
@@ -0,0 +1 @@
+main = putStr "Hello, world\n"
diff --git a/ghc/misc/examples/io/io002/Main.hs b/ghc/misc/examples/io/io002/Main.hs
new file mode 100644
index 0000000000..346bffb8a1
--- /dev/null
+++ b/ghc/misc/examples/io/io002/Main.hs
@@ -0,0 +1,12 @@
+import LibSystem (getEnv)
+
+main = 
+    getEnv "TERM" >>= \ term -> 
+    putStr term >>
+    putChar '\n' >>
+    getEnv "One fish, two fish, red fish, blue fish" >>= \ fish -> 
+    putStr fish >>
+    putChar '\n'
+
+
+
diff --git a/ghc/misc/examples/io/io003/Main.hs b/ghc/misc/examples/io/io003/Main.hs
new file mode 100644
index 0000000000..535b4716df
--- /dev/null
+++ b/ghc/misc/examples/io/io003/Main.hs
@@ -0,0 +1,9 @@
+import LibSystem (getProgName, getArgs)
+
+main = 
+    getProgName >>= \ argv0 ->
+    putStr argv0 >>
+    getArgs >>= \ argv ->
+    sequence (map (\ x -> putChar ' ' >> putStr x) argv) >>
+    putChar '\n'
+
diff --git a/ghc/misc/examples/io/io004/Main.hs b/ghc/misc/examples/io/io004/Main.hs
new file mode 100644
index 0000000000..59c745d4b1
--- /dev/null
+++ b/ghc/misc/examples/io/io004/Main.hs
@@ -0,0 +1,3 @@
+import LibSystem (exitWith, ExitCode(..))
+
+main = exitWith (ExitFailure 42)
diff --git a/ghc/misc/examples/io/io005/Main.hs b/ghc/misc/examples/io/io005/Main.hs
new file mode 100644
index 0000000000..a987b9fb27
--- /dev/null
+++ b/ghc/misc/examples/io/io005/Main.hs
@@ -0,0 +1,11 @@
+import LibSystem (system, ExitCode(..), exitWith)
+
+main = 
+    system "cat dog 1>/dev/null 2>&1" >>= \ ec ->
+    case ec of
+        ExitSuccess   -> putStr "What?!?\n" >> fail "dog succeeded"
+        ExitFailure _ ->
+            system "cat Main.hs 2>/dev/null" >>= \ ec ->
+	    case ec of
+	        ExitSuccess   -> exitWith ExitSuccess
+	        ExitFailure _ -> putStr "What?!?\n" >> fail "cat failed"
diff --git a/ghc/misc/examples/io/io006/Main.hs b/ghc/misc/examples/io/io006/Main.hs
new file mode 100644
index 0000000000..c6fc5394e3
--- /dev/null
+++ b/ghc/misc/examples/io/io006/Main.hs
@@ -0,0 +1,4 @@
+main =
+    hClose stderr >>
+    hPutStr stderr "junk" `handle` \ (IllegalOperation _) -> putStr "Okay\n"
+
diff --git a/ghc/misc/examples/io/io007/Main.hs b/ghc/misc/examples/io/io007/Main.hs
new file mode 100644
index 0000000000..d6c94d8ef7
--- /dev/null
+++ b/ghc/misc/examples/io/io007/Main.hs
@@ -0,0 +1,6 @@
+main =
+    openFile "io007.in" ReadMode >>= \ hIn ->
+    hPutStr hIn "test" `handle`
+    \ (IllegalOperation _) -> 
+        hGetContents hIn >>= \ stuff ->
+        hPutStr stdout stuff
diff --git a/ghc/misc/examples/io/io008/Main.hs b/ghc/misc/examples/io/io008/Main.hs
new file mode 100644
index 0000000000..51685c9201
--- /dev/null
+++ b/ghc/misc/examples/io/io008/Main.hs
@@ -0,0 +1,18 @@
+import LibDirectory (removeFile)
+
+main =
+    openFile "io008.in" ReadMode >>= \ hIn ->
+    openFile "io008.out" ReadWriteMode >>= \ hOut ->
+    removeFile "io008.out" >>
+    hGetPosn hIn >>= \ bof ->
+    copy hIn hOut >>
+    hSetPosn bof >>
+    copy hIn hOut >>
+    hSeek hOut AbsoluteSeek 0 >>
+    hGetContents hOut >>= \ stuff ->
+    putStr stuff
+
+copy :: Handle -> Handle -> IO ()
+copy hIn hOut =
+    try (hGetChar hIn) >>=
+    either (\ EOF -> return ()) ( \ 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
new file mode 100644
index 0000000000..b1bc0f2dc3
--- /dev/null
+++ b/ghc/misc/examples/io/io009/Main.hs
@@ -0,0 +1,7 @@
+import LibDirectory (getDirectoryContents)
+import QSort (sort)
+
+main =
+    getDirectoryContents "." >>= \ names ->
+    putText (sort names) >>
+    putChar '\n'
\ No newline at end of file
diff --git a/ghc/misc/examples/io/io010/Main.hs b/ghc/misc/examples/io/io010/Main.hs
new file mode 100644
index 0000000000..5e5b0c3d16
--- /dev/null
+++ b/ghc/misc/examples/io/io010/Main.hs
@@ -0,0 +1,20 @@
+import LibDirectory (getCurrentDirectory, setCurrentDirectory, 
+                     createDirectory, removeDirectory, getDirectoryContents)
+
+main =
+    getCurrentDirectory >>= \ oldpwd ->
+    createDirectory "foo" >>
+    setCurrentDirectory "foo" >> 
+    getDirectoryContents "." >>= \ [n1, n2] ->
+    if dot n1 && dot n2 then
+        setCurrentDirectory oldpwd >>
+        removeDirectory "foo" >>
+        putStr "Okay\n"
+    else
+        fail "Oops"
+
+
+dot :: String -> Bool
+dot "." = True
+dot ".." = True
+dot _ = False
\ No newline at end of file
diff --git a/ghc/misc/examples/io/io011/Main.hs b/ghc/misc/examples/io/io011/Main.hs
new file mode 100644
index 0000000000..2fcbce5cb5
--- /dev/null
+++ b/ghc/misc/examples/io/io011/Main.hs
@@ -0,0 +1,15 @@
+import LibDirectory
+
+main =
+    createDirectory "foo" >>
+    openFile "foo/bar" WriteMode >>= \ h ->
+    hPutStr h "Okay\n" >>
+    hClose h >>
+    renameFile "foo/bar" "foo/baz" >>
+    renameDirectory "foo" "bar" >>
+    openFile "bar/baz" ReadMode >>= \ h ->
+    hGetContents h >>= \ stuff ->
+    putStr stuff >>
+    hClose h >>
+    removeFile "bar/baz" >>
+    removeDirectory "bar"
diff --git a/ghc/misc/examples/io/io012/Main.hs b/ghc/misc/examples/io/io012/Main.hs
new file mode 100644
index 0000000000..9b7fba3925
--- /dev/null
+++ b/ghc/misc/examples/io/io012/Main.hs
@@ -0,0 +1,16 @@
+import LibCPUTime
+
+main = 
+    openFile "/dev/null" WriteMode >>= \ h ->
+    hPutText h (nfib 30) >>
+    getCPUTime >>= \ t ->
+    putText t >>
+    putChar '\n'
+
+nfib :: Integer -> Integer
+nfib n 
+  | n <= 1 = 1
+  | otherwise = (n1 + n2 + 1)
+  where 
+    n1 = nfib (n-1) 
+    n2 = nfib (n-2)
diff --git a/ghc/misc/examples/io/io013/Main.hs b/ghc/misc/examples/io/io013/Main.hs
new file mode 100644
index 0000000000..39c429e13d
--- /dev/null
+++ b/ghc/misc/examples/io/io013/Main.hs
@@ -0,0 +1,17 @@
+main = 
+    openFile "io013.in" ReadMode >>= \ h ->
+    hFileSize h >>= \ sz -> 
+    putText sz >>
+    putChar '\n' >>
+    hSeek h SeekFromEnd (-3) >>
+    hGetChar h >>= \ x ->
+    putStr (x:"\n") >>
+    hSeek h RelativeSeek (-2) >>
+    hGetChar h >>= \ w ->
+    putStr (w:"\n") >>
+    hIsSeekable h >>= \ True ->
+    hClose h >>
+    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
new file mode 100644
index 0000000000..23f62ca748
--- /dev/null
+++ b/ghc/misc/examples/io/io014/Main.hs
@@ -0,0 +1,22 @@
+main = 
+    accumulate (map hIsOpen [stdin, stdout, stderr]) >>= \ opens ->
+    putText opens >>
+    putChar '\n' >>
+    accumulate (map hIsClosed [stdin, stdout, stderr]) >>= \ closeds ->
+    putText closeds >>
+    putChar '\n' >>
+    accumulate (map hIsReadable [stdin, stdout, stderr]) >>= \ readables ->
+    putText readables >>
+    putChar '\n' >>
+    accumulate (map hIsWritable [stdin, stdout, stderr]) >>= \ writables ->
+    putText writables >>
+    putChar '\n' >>
+    accumulate (map hIsBlockBuffered [stdin, stdout, stderr]) >>= \ buffereds ->
+    putText buffereds >>
+    putChar '\n' >>
+    accumulate (map hIsLineBuffered [stdin, stdout, stderr]) >>= \ buffereds ->
+    putText buffereds >>
+    putChar '\n' >>
+    accumulate (map hIsNotBuffered [stdin, stdout, stderr]) >>= \ buffereds ->
+    putText buffereds >>
+    putChar '\n'
diff --git a/ghc/misc/examples/io/io015/Main.hs b/ghc/misc/examples/io/io015/Main.hs
new file mode 100644
index 0000000000..a58450942c
--- /dev/null
+++ b/ghc/misc/examples/io/io015/Main.hs
@@ -0,0 +1,8 @@
+main =
+    isEOF >>= \ eof ->
+    if eof then 
+	return ()
+    else
+	getChar >>= \ c ->
+        putChar c >>
+        main
diff --git a/ghc/misc/examples/io/io016/Main.hs b/ghc/misc/examples/io/io016/Main.hs
new file mode 100644
index 0000000000..e8df7a93dd
--- /dev/null
+++ b/ghc/misc/examples/io/io016/Main.hs
@@ -0,0 +1,18 @@
+import LibSystem (getArgs)
+
+main   =  getArgs                           >>=        \ [f1,f2] ->
+          openFile f1 ReadMode              >>=        \ h1      ->
+          openFile f2 WriteMode             >>=        \ h2      ->
+          copyFile h1 h2                    >>
+          hClose h1                         >>
+          hClose h2
+
+copyFile h1 h2 =
+          hIsEOF h1                         >>=        \ eof ->
+          if eof then
+            return ()
+          else
+            hGetChar h1                     >>=        \ c       ->
+            hPutChar h2 (toUpper c)         >>
+            copyFile h1 h2
+
diff --git a/ghc/misc/examples/io/io017/Main.hs b/ghc/misc/examples/io/io017/Main.hs
new file mode 100644
index 0000000000..f0a6d3ef3b
--- /dev/null
+++ b/ghc/misc/examples/io/io017/Main.hs
@@ -0,0 +1,17 @@
+main =
+      hSetBuffering stdout NoBuffering                  >>
+      putStr   "Enter an integer: "                     >>
+      readLine                                          >>= \ x1 -> 
+      putStr   "Enter another integer: "                >>
+      readLine                                          >>= \ x2 -> 
+      putStr  ("Their sum is " ++ show (read x1+ read x2) ++ "\n")
+
+ where readLine = isEOF                                 >>= \ eof ->
+                  if eof then return []
+                  else getChar                          >>= \ c ->
+                       if c `elem` ['\n','\r'] then
+                          return []
+                       else
+                          readLine                      >>= \ cs ->
+                          return (c:cs)
+
diff --git a/ghc/misc/examples/io/io018/Main.hs b/ghc/misc/examples/io/io018/Main.hs
new file mode 100644
index 0000000000..f15c1cb5c1
--- /dev/null
+++ b/ghc/misc/examples/io/io018/Main.hs
@@ -0,0 +1,23 @@
+import LibSystem(getArgs)
+
+main =   getArgs                            >>=        \ [user,host] ->
+         let username = (user ++ "@" ++ host) in
+         openFile username ReadWriteMode    >>=        \ cd          ->
+         hSetBuffering stdin NoBuffering    >>
+         hSetBuffering stdout NoBuffering   >>
+         hSetBuffering cd NoBuffering       >>
+         hPutStr cd speakString             >>
+         speak cd
+
+speakString = "Someone wants to speak with you\n"
+
+speak cd =
+         (hReady cd                         >>=        \ ready       ->
+         if ready then (hGetChar cd >>= putChar)
+         else return ()                     >>
+
+         hReady stdin                       >>=        \ ready       ->
+         if ready then (getChar >>= hPutChar cd)
+         else return ())                    >>
+
+         speak cd
diff --git a/ghc/misc/examples/io/io019/Main.hs b/ghc/misc/examples/io/io019/Main.hs
new file mode 100644
index 0000000000..168a4ac249
--- /dev/null
+++ b/ghc/misc/examples/io/io019/Main.hs
@@ -0,0 +1,23 @@
+import LibTime
+
+main = 
+    getClockTime >>= \ time ->
+    putText time >>
+    putChar '\n' >>
+
+    let (CalendarTime year month mday hour min sec psec 
+                      wday yday timezone gmtoff isdst) = toUTCTime time
+    in
+      putStr (wdays !! wday) >>
+      putStr (' ' : months !! month) >>
+      putStr (' ' : shows2 mday (' ' : shows2 hour (':' : shows2 min (':' : shows2 sec
+             (' ' : timezone ++ ' ' : shows year "\n")))))
+
+  where
+    wdays = ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"]
+    months = ["Jan", "Feb", "Mar", "Apr", "May", "Jun", 
+	      "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"]
+    shows2 x = showString (pad2 x)
+    pad2 x = case show x of
+               c@[_] -> '0' : c
+               cs -> cs
\ No newline at end of file
diff --git a/ghc/misc/examples/io/io020/Main.hs b/ghc/misc/examples/io/io020/Main.hs
new file mode 100644
index 0000000000..ff68bd9f35
--- /dev/null
+++ b/ghc/misc/examples/io/io020/Main.hs
@@ -0,0 +1,13 @@
+import LibTime
+
+main = 
+    getClockTime >>= \ time ->
+    let (CalendarTime year month mday hour min sec psec 
+                      wday yday timezone gmtoff isdst) = toUTCTime time
+        time' = toClockTime (CalendarTime (year - 1) month mday hour min sec psec
+                             wday yday timezone gmtoff isdst)
+    in
+        putText time >>
+	putChar '\n' >>
+	putText time' >> 
+	putChar '\n'
diff --git a/ghc/misc/examples/io/io021/Main.hs b/ghc/misc/examples/io/io021/Main.hs
new file mode 100644
index 0000000000..66548f63ee
--- /dev/null
+++ b/ghc/misc/examples/io/io021/Main.hs
@@ -0,0 +1,4 @@
+main = 
+    hSetBuffering stdin NoBuffering	>>
+    hSetBuffering stdout NoBuffering	>>
+    interact id