diff options
68 files changed, 0 insertions, 1946 deletions
diff --git a/ghc/misc/examples/cats/ccat4.c b/ghc/misc/examples/cats/ccat4.c deleted file mode 100644 index a02a7101b0..0000000000 --- a/ghc/misc/examples/cats/ccat4.c +++ /dev/null @@ -1,18 +0,0 @@ -#include <stdio.h> - -main () -{ - char c[4096]; - int n; - - while ((n=fread(c,1,4096,stdin)) > 0) { - fwrite(c,1,n,stdout); - } - exit(0); -} - -/* --- 8,937,757 bytes/sec ( 600KB input) --- 12,146,094 bytes/sec ( 9.3MB input) --- 8,658,233 bytes/sec (25.5MB input) -*/ diff --git a/ghc/misc/examples/cats/ccat5.c b/ghc/misc/examples/cats/ccat5.c deleted file mode 100644 index 6c9e38da50..0000000000 --- a/ghc/misc/examples/cats/ccat5.c +++ /dev/null @@ -1,16 +0,0 @@ -#include <stdio.h> - -main () -{ - int c; - while ((c = getchar()) != EOF) { - putchar(c); - } - exit(0); -} - -/* --- 2,085,477 bytes/sec ( 600KB input) --- 2,320,718 bytes/sec ( 9.3MB input) --- 2,130,143 bytes/sec (25.5MB input) -*/ diff --git a/ghc/misc/examples/cats/hcat1.hs b/ghc/misc/examples/cats/hcat1.hs deleted file mode 100644 index 9a29bf7b46..0000000000 --- a/ghc/misc/examples/cats/hcat1.hs +++ /dev/null @@ -1,4 +0,0 @@ -main :: IO () -main = interact id - --- 46,173 bytes/sec (600KB input) diff --git a/ghc/misc/examples/cats/hcat2.hs b/ghc/misc/examples/cats/hcat2.hs deleted file mode 100644 index 3323ae8301..0000000000 --- a/ghc/misc/examples/cats/hcat2.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Main (main) where - -main :: IO () -main - = try getChar >>= - {-then-}either (\ _ -> return ()) - {-or-} (\ c -> putChar c >> - main) - --- 51,156 bytes/sec (600KB input) diff --git a/ghc/misc/examples/cats/hcat3.hs b/ghc/misc/examples/cats/hcat3.hs deleted file mode 100644 index 82208b9af7..0000000000 --- a/ghc/misc/examples/cats/hcat3.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Main (main) where - -import LibPosix - -main :: IO () -main = copy standardInput standardOutput - where - copy inn out - = try (readFileDescriptor inn 4096) >>= - either - (\ _ -> return ()) - (\ s -> writeFileDescriptor out s >> - copy inn out) - --- 124,879 bytes/sec ( 600KB input) --- 130,694 bytes/sec ( 9.3MB input) --- 127,263 bytes/sec (25.5MB input) diff --git a/ghc/misc/examples/cats/hcat4.hs b/ghc/misc/examples/cats/hcat4.hs deleted file mode 100644 index d4e6ce3611..0000000000 --- a/ghc/misc/examples/cats/hcat4.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Main (mainPrimIO) where - -import PreludePrimIO - -mainPrimIO :: PrimIO () -mainPrimIO - = copy (``stdin'' :: _FILE) - (``stdout'' :: _FILE) - where - copy inn out - = fread 1 4096 inn - `thenPrimIO` \ (n, s) -> - if n <= 0 - then returnPrimIO () - else fwrite s 1 n out `seqPrimIO` - copy inn out - --- 4,170,953 bytes/sec ( 600KB input) --- 7,993,583 bytes/sec ( 9.3MB input) --- 6,917,175 bytes/sec (25.5MB input) diff --git a/ghc/misc/examples/cats/hcat5.hs b/ghc/misc/examples/cats/hcat5.hs deleted file mode 100644 index 0a7a59f6b6..0000000000 --- a/ghc/misc/examples/cats/hcat5.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Main (mainPrimIO) where - -import PreludePrimIO - -mainPrimIO :: PrimIO () -mainPrimIO - = _ccall_ stg_getc (``stdin'' :: _Addr) - `thenPrimIO` \ (I# ch) -> - if ch <# 0# then -- SIGH: ch ==# ``EOF'' - returnPrimIO () - else - _ccall_ stg_putc (C# (chr# ch)) - (``stdout'' :: _Addr) - `seqPrimIO` - mainPrimIO - --- 1,737,897 bytes/sec ( 600KB input) --- 1,808,993 bytes/sec ( 9.3MB input) --- 1,711,850 bytes/sec (25.5MB input) diff --git a/ghc/misc/examples/cats/hcat6.hs b/ghc/misc/examples/cats/hcat6.hs deleted file mode 100644 index ce9b4e68d8..0000000000 --- a/ghc/misc/examples/cats/hcat6.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Main (mainPrimIO) where - -import PreludePrimIO - -mainPrimIO :: PrimIO () -mainPrimIO - = _casm_ - ``do { int c; - while ((c = getchar()) != EOF) { - putchar(c); - }} while (0); - %r = 1;'' -- pretend we have a "result" - `thenPrimIO` \ (I# _) -> - returnPrimIO () - --- 1,955,134 bytes/sec ( 600KB input) --- 1,989,892 bytes/sec ( 9.3MB input) --- 1,871,706 bytes/sec (25.5MB input) diff --git a/ghc/misc/examples/cats/mangle_times b/ghc/misc/examples/cats/mangle_times deleted file mode 100644 index b595a5b467..0000000000 --- a/ghc/misc/examples/cats/mangle_times +++ /dev/null @@ -1,23 +0,0 @@ -#! /usr/local/bin/perl - -$InputSize = 0; - -while (<>) { - chop; - - if ( m,< /users/fp/partain/bib/comp.bib, ) { - $InputSize = 625643; - print "$_\n"; - } elsif ( m,\$bghc/lib/libHS_p.a, ) { - $InputSize = 9352492; - print "$_\n"; - } elsif ( m,\$bghca/lib/libHS_p.a, ) { - $InputSize = 25455204; - print "$_\n"; - - } elsif ( /^\s*(\d+\.\d+)u (\d+\.\d+)s / ) { - $UserSysTime = $1 + $2; - $BytesPerSec = $InputSize / $UserSysTime; - printf "%.0f\t%s\n", $BytesPerSec, $_; - } -} diff --git a/ghc/misc/examples/hsh/Hsh.hs b/ghc/misc/examples/hsh/Hsh.hs deleted file mode 100644 index 2102f7d08c..0000000000 --- a/ghc/misc/examples/hsh/Hsh.hs +++ /dev/null @@ -1,288 +0,0 @@ -module Main (main) where - -import IO -import Posix - -import Directory (setCurrentDirectory) -import System ( getEnv, exitWith, ExitCode(..) ) -import Char (isSpace) - -main :: IO () -main = - do - initialize - commandLoop - -{- - Standard shell practice: move std descriptors out of the way so - it's more convenient to set them up for children. Also set up an - interrupt handler which will put us back in the main loop. --} - -initialize :: IO () -initialize = - dupTo stdInput myStdin >> - dupTo stdOutput myStdout >> - dupTo stdError myStderr >> - fdClose stdInput >> - fdClose stdOutput >> --- fdClose stdError >> - installHandler sigINT (Catch intr) Nothing >> - return () - --- some random fd numbers... -myStdin = intToFd 16 -myStdout = intToFd 17 -myStderr = intToFd 18 - --- For user interrupts - -intr :: IO () -intr = - fdWrite myStdout "\n" >> - commandLoop - -{- - Simple command loop: print a prompt, read a command, process the command. - Repeat as necessary. --} - -commandLoop :: IO () -commandLoop = - fdWrite myStdout "$ " >> - try (readCommand myStdin) >>= - either - (\ err -> - if isEOFError err then - return () - else - dieHorribly) - (\ cmd -> - try (processCommand cmd) >>= either (\ err -> commandLoop) (\ succ -> commandLoop)) - where - dieHorribly :: IO () - dieHorribly = - do - errMsg "read failed" - exitWith (ExitFailure 1) - -{- - Read a command a character at a time (to allow for fancy processing later). - On newline, you're done, unless the newline was escaped by a backslash. --} - -readCommand :: Fd -> IO String -readCommand fd = - accumString "" >>= \ cmd -> - return cmd - where - accumString :: String -> IO String - accumString s = - myGetChar fd >>= \ c -> - case c of - '\\' -> - myGetChar fd >>= \ c' -> - accumString (c':c:s) - '\n' -> return (reverse s) - ch -> accumString (ch:s) - -myGetChar :: Fd -> IO Char -myGetChar chan = - do - (s,len) <- fdRead chan 1 - case len of - 0 -> myGetChar chan - 1 -> return (head s) - -{- - To process a command, first parse it into words, then do the necessary - redirections, and finally perform the desired command. Built-ins are - checked first, and if none match, we execute an external command. --} - -processCommand :: String -> IO () -processCommand "" = return () -processCommand s = - do - words <- parseCommand s - (inFile, outFile, words) <- parseRedirection words - performRedirections inFile outFile - let - cmd = head words - args = tail words - case builtin cmd of - Just f -> - do - f args - fdClose stdInput - fdClose stdOutput - Nothing -> exec cmd args - -{- - Redirections are a bit of a pain, really. If none are specified, we - dup our own file descriptors. Otherwise, we try to open the files - as requested. --} - -performRedirections :: Maybe String -> Maybe String -> IO () -performRedirections inFile outFile = - (case inFile of - Nothing -> dupTo myStdin stdInput - Just x -> - try (openFd x ReadOnly Nothing defaultFileFlags) - >>= - either - (\ err -> - errMsg ("Can't redirect input from " ++ x) >> - fail (userError "redirect")) - (\ succ -> return ())) >> - (case outFile of - Nothing -> - dupTo myStdout stdOutput - Just x -> - try (createFile x stdFileMode) >>= - either - (\ err -> - do - errMsg ("Can't redirect output to " ++ x) - fdClose stdInput - fail (userError "redirect")) - (\ succ -> return ())) - -{- - We parse a command line into words according to the following rules: - 1) Anything inside pairs of "" or '' is parsed literally. - 2) Anything (outside of quotes) escaped by \ is taken literally. - 3) '<' and '>' are words all by themselves, unless escaped or quoted. - 4) Whitespace separates words --} - -parseCommand :: String -> IO [String] -parseCommand = getTokens [] - where - getTokens :: [String] -> String -> IO [String] - getTokens ts "" = return (reverse ts) - getTokens ts (c:cs) | isSpace c = getTokens ts cs - getTokens ts s = - getToken s >>= \ (t, s') -> - getTokens (t:ts) s' - - getToken :: String -> IO (String, String) - getToken (c:cs) - | c == '<' || c == '>' = return ([c], cs) - | c == '"' || c == '\'' = accumQuote c "" cs - | otherwise = accumToken [c] cs - - accumToken :: [Char] -> String -> IO (String, String) - accumToken cs "" = return (reverse cs, "") - accumToken cs ('\\':c:s) = accumToken (c:cs) s - accumToken cs x@(c:s) - | isSpace c || c == '<' || c == '>' = return (reverse cs, x) - | c == '"' || c == '\'' = accumQuote c cs s - | otherwise = accumToken (c:cs) s - - accumQuote :: Char -> [Char] -> String -> IO (String, String) - accumQuote q cs "" = - errMsg ("Unmatched " ++ [q]) >> - fail (userError "unmatched quote") - accumQuote q cs (c:s) - | c == q = accumToken cs s - | otherwise = accumQuote q (c:cs) s - -{- - Here we look for "<" and ">". When we find one, we remove it and the - following word from the word list. The arguments following the redirection - symbols and the remaining words are returned to our caller. However, it's - an error to end a word list with a redirection or for the same redirection - to appear twice. --} - -parseRedirection :: [String] -> IO (Maybe String, Maybe String, [String]) -parseRedirection = redirect Nothing Nothing [] - where - redirect inFile outFile args [] = - return (inFile, outFile, reverse args) - redirect inFile outFile args [arg] - | arg == "<" || arg == ">" = - errMsg "Missing name for redirect" >> - fail (userError "parse redirect") - | otherwise = - return (inFile, outFile, reverse (arg:args)) - redirect inFile outFile args ("<":name:more) - | inFile == Nothing = - redirect (Just name) outFile args more - | otherwise = - errMsg "Ambiguous input redirect" >> - fail (userError "parse redirect") - redirect inFile outFile args (">":name:more) - | outFile == Nothing = - redirect inFile (Just name) args more - | otherwise = - errMsg "Ambiguous output redirect" >> - fail (userError "parse redirect") - redirect inFile outFile args (arg:more) = - redirect inFile outFile (arg:args) more - -{- - Executing an external command is pretty simple, but what if it fails? - Fortunately, we don't have any way to redirect stdError just yet, - so we let it complain and then exit. --} - -exec :: String -> [String] -> IO () -exec cmd args = - forkProcess >>= \ maybe_pid -> - case maybe_pid of - Nothing -> - do - dupTo myStderr stdError - fdClose myStdin - fdClose myStdout - fdClose myStderr - executeFile cmd True args Nothing - `catch` - (\ err -> - fdWrite stdError ("command not found: " ++ cmd ++ ".\n") >> - exitImmediately (ExitFailure 1)) - Just pid -> - do - fdClose stdInput - fdClose stdOutput --- fdClose stdError - getProcessStatus True False pid - return () - -{- - Builtins: - cd [arg] -> change directory (default to HOME) - exit ... -> exit successfully - - Builtins must provide their own error messages, since the main command - loop ignores any errors. --} - -builtin :: String -> Maybe ([String] -> IO ()) -builtin "cd" = Just chdir -builtin "exit" = Just exit -builtin _ = Nothing - -chdir :: [String] -> IO () -chdir [] = - do - home <- getEnv "HOME" - setCurrentDirectory home `catch` \ err -> errMsg "cd: can't go home" - -chdir [dir] = - do - setCurrentDirectory dir `catch` \ err -> errMsg ("cd: can't chdir to " ++ dir) -chdir _ = errMsg "cd: too many arguments" - -exit :: [String] -> IO () -exit _ = exitWith ExitSuccess - --- Print an error message to my std error. - -errMsg :: String -> IO () -errMsg msg = - fdWrite myStderr ("hsh: " ++ msg ++ ".\n") >> - return () diff --git a/ghc/misc/examples/hsh/Makefile b/ghc/misc/examples/hsh/Makefile deleted file mode 100644 index c4a6d8ea7c..0000000000 --- a/ghc/misc/examples/hsh/Makefile +++ /dev/null @@ -1,6 +0,0 @@ -TOP = ../../.. -include $(TOP)/mk/boilerplate.mk -SRC_HC_OPTS += -syslib posix -HS_PROG=hsh -include $(TOP)/mk/target.mk - diff --git a/ghc/misc/examples/io/io001/Main.hs b/ghc/misc/examples/io/io001/Main.hs deleted file mode 100644 index 6620e3c1fe..0000000000 --- a/ghc/misc/examples/io/io001/Main.hs +++ /dev/null @@ -1 +0,0 @@ -main = putStr "Hello, world\n" diff --git a/ghc/misc/examples/io/io002/Main.hs b/ghc/misc/examples/io/io002/Main.hs deleted file mode 100644 index c9a1bcfa82..0000000000 --- a/ghc/misc/examples/io/io002/Main.hs +++ /dev/null @@ -1,12 +0,0 @@ -import System (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 deleted file mode 100644 index 93fff71be5..0000000000 --- a/ghc/misc/examples/io/io003/Main.hs +++ /dev/null @@ -1,9 +0,0 @@ -import System (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 deleted file mode 100644 index 69d2221743..0000000000 --- a/ghc/misc/examples/io/io004/Main.hs +++ /dev/null @@ -1,3 +0,0 @@ -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 deleted file mode 100644 index 3a41560df6..0000000000 --- a/ghc/misc/examples/io/io005/Main.hs +++ /dev/null @@ -1,11 +0,0 @@ -import System (system, ExitCode(..), exitWith) - -main = - system "cat dog 1>/dev/null 2>&1" >>= \ ec -> - case ec of - 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 (userError "cat failed") diff --git a/ghc/misc/examples/io/io006/Main.hs b/ghc/misc/examples/io/io006/Main.hs deleted file mode 100644 index 6eb862c3da..0000000000 --- a/ghc/misc/examples/io/io006/Main.hs +++ /dev/null @@ -1,6 +0,0 @@ -import IO -- 1.3 - -main = - hClose stderr >> - 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 deleted file mode 100644 index 467382ff76..0000000000 --- a/ghc/misc/examples/io/io007/Main.hs +++ /dev/null @@ -1,11 +0,0 @@ -import IO -- 1.3 - -main = - openFile "io007.in" ReadMode >>= \ hIn -> - 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 deleted file mode 100644 index 47f1a6ea97..0000000000 --- a/ghc/misc/examples/io/io008/Main.hs +++ /dev/null @@ -1,21 +0,0 @@ -import IO -- 1.3 -import GHCio - -import Directory (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 = - 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 deleted file mode 100644 index 5f95ce0c42..0000000000 --- a/ghc/misc/examples/io/io009/Main.hs +++ /dev/null @@ -1,6 +0,0 @@ -import Directory (getDirectoryContents) -import QSort (sort) - -main = - getDirectoryContents "." >>= \ names -> - print (sort names) diff --git a/ghc/misc/examples/io/io010/Main.hs b/ghc/misc/examples/io/io010/Main.hs deleted file mode 100644 index 764290c754..0000000000 --- a/ghc/misc/examples/io/io010/Main.hs +++ /dev/null @@ -1,20 +0,0 @@ -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 diff --git a/ghc/misc/examples/io/io011/Main.hs b/ghc/misc/examples/io/io011/Main.hs deleted file mode 100644 index 97f7d90e58..0000000000 --- a/ghc/misc/examples/io/io011/Main.hs +++ /dev/null @@ -1,17 +0,0 @@ -import IO -- 1.3 - -import Directory - -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 deleted file mode 100644 index c5a16b730a..0000000000 --- a/ghc/misc/examples/io/io012/Main.hs +++ /dev/null @@ -1,17 +0,0 @@ -import IO -- 1.3 - -import CPUTime - -main = - openFile "/dev/null" WriteMode >>= \ h -> - hPrint h (nfib 30) >> - getCPUTime >>= \ t -> - print t - -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 deleted file mode 100644 index 9598e04d61..0000000000 --- a/ghc/misc/examples/io/io013/Main.hs +++ /dev/null @@ -1,17 +0,0 @@ -import IO -- 1.3 - -main = - openFile "io013.in" ReadMode >>= \ h -> - hFileSize h >>= \ sz -> - print sz >> - 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 diff --git a/ghc/misc/examples/io/io014/Main.hs b/ghc/misc/examples/io/io014/Main.hs deleted file mode 100644 index fecf4a51d7..0000000000 --- a/ghc/misc/examples/io/io014/Main.hs +++ /dev/null @@ -1,22 +0,0 @@ -import IO -- 1.3 - -main = - accumulate (map hIsOpen [stdin, stdout, stderr]) >>= \ opens -> - print opens >> - accumulate (map hIsClosed [stdin, stdout, stderr]) >>= \ closeds -> - print closeds >> - accumulate (map hIsReadable [stdin, stdout, stderr]) >>= \ readables -> - print readables >> - accumulate (map hIsWritable [stdin, stdout, stderr]) >>= \ writables -> - print writables >> - accumulate (map hIsBlockBuffered [stdin, stdout, stderr]) >>= \ buffereds -> - print buffereds >> - accumulate (map hIsLineBuffered [stdin, stdout, stderr]) >>= \ buffereds -> - print buffereds >> - accumulate (map hIsNotBuffered [stdin, stdout, stderr]) >>= \ buffereds -> - 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 deleted file mode 100644 index 37f0cc134a..0000000000 --- a/ghc/misc/examples/io/io015/Main.hs +++ /dev/null @@ -1,10 +0,0 @@ -import IO -- 1.3 - -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 deleted file mode 100644 index 1ce01b2d45..0000000000 --- a/ghc/misc/examples/io/io016/Main.hs +++ /dev/null @@ -1,21 +0,0 @@ -import IO -- 1.3 - -import System (getArgs) -import Char (toUpper) - -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 deleted file mode 100644 index 2be725480b..0000000000 --- a/ghc/misc/examples/io/io017/Main.hs +++ /dev/null @@ -1,19 +0,0 @@ -import IO -- 1.3 - -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 deleted file mode 100644 index 7318cc7ac9..0000000000 --- a/ghc/misc/examples/io/io018/Main.hs +++ /dev/null @@ -1,25 +0,0 @@ -import IO -- 1.3 - -import System(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 deleted file mode 100644 index bd50838bb5..0000000000 --- a/ghc/misc/examples/io/io019/Main.hs +++ /dev/null @@ -1,22 +0,0 @@ -import Time - -main = - getClockTime >>= \ time -> - print time >> - - 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 diff --git a/ghc/misc/examples/io/io020/Main.hs b/ghc/misc/examples/io/io020/Main.hs deleted file mode 100644 index 1f349ebd32..0000000000 --- a/ghc/misc/examples/io/io020/Main.hs +++ /dev/null @@ -1,13 +0,0 @@ -import Time - -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 - print time >> - putChar '\n' >> - print time' >> - putChar '\n' diff --git a/ghc/misc/examples/io/io021/Main.hs b/ghc/misc/examples/io/io021/Main.hs deleted file mode 100644 index c45a40b9b1..0000000000 --- a/ghc/misc/examples/io/io021/Main.hs +++ /dev/null @@ -1,6 +0,0 @@ -import IO -- 1.3 - -main = - hSetBuffering stdin NoBuffering >> - hSetBuffering stdout NoBuffering >> - interact id diff --git a/ghc/misc/examples/net001/Main.hs b/ghc/misc/examples/net001/Main.hs deleted file mode 100644 index 121e51d664..0000000000 --- a/ghc/misc/examples/net001/Main.hs +++ /dev/null @@ -1,55 +0,0 @@ -{- server - -The purpose of this test driver is to test TCP Stream sockets. -All values have been hard coded since the BSD library is not used to -query the databases for the values. In therory this code is thus not -portable but net007/Main.hs provides a portable version using the BSD -module. - -This creates a stream socket bound to port 5000 and waits for incoming -messages it then reads all available data before closing the -connection to that peer. - -No form of error checking is provided other than that already provided -by module SocketPrim. - - -TESTS: - socket - bindSocket - listen - accept - readSocket - sClose - --} - - -module Main where - -import SocketPrim - - -main = - socket AF_INET Stream 6 >>= \ s -> - bindSocket s (SockAddrInet 5000 iNADDR_ANY) >> - listen s 5 >> - - let - loop = - accept s >>= \ (s',peerAddr) -> - putStr "*** Start of Transfer ***\n" >> - let - read_all = - readSocket s' 4 >>= \ (str, nbytes) -> - if nbytes /= 0 then - putStr str >> - read_all - else - putStr "\n*** End of Transfer ***\n" >> - sClose s' - in - read_all - in - loop - diff --git a/ghc/misc/examples/net002/Main.hs b/ghc/misc/examples/net002/Main.hs deleted file mode 100644 index 7ae6cdc2b6..0000000000 --- a/ghc/misc/examples/net002/Main.hs +++ /dev/null @@ -1,42 +0,0 @@ -{- client - -Client side to net001/Main.hs. - -Note that the machine IP numbers have been hard coded into this -program so it is unlikely that you will be able to run this test if -you are not at dcs.gla.ac.uk :-( - -The reason for this is to aviod using the BSD module at this stage of -testing. - - -TESTS: - socket - connect - writeSocket - shutdown - inet_addr --} - - -module Main where - -import SocketPrim - - -starbuck = "130.209.240.81" -- SunOS 4.1.3 1 sun4c -marcus = "130.209.247.2" -- SunOS 4.1.3 6 sun4m -avon = "130.209.247.4" -- OSF1 V2.0 240 alpha -karkar = "130.209.247.3" -- OSF1 V2.0 240 alpha - -message = "Hello World" - - -main = - socket AF_INET Stream 6 >>= \ s -> - connect s (SockAddrInet 5000 (inet_addr avon)) >> - - writeSocket s message >> - shutdown s 2 >> - sClose s - diff --git a/ghc/misc/examples/net003/Main.hs b/ghc/misc/examples/net003/Main.hs deleted file mode 100644 index 85c00e4eba..0000000000 --- a/ghc/misc/examples/net003/Main.hs +++ /dev/null @@ -1,43 +0,0 @@ -{- server - -As for net001 but gets the system to allocate the next free port -number. It also prints out the IP number of the peer. - -TESTS: - getSocketName - inet_ntoa - --} - -module Main where - -import SocketPrim - - -main = - socket AF_INET Stream 6 >>= \ s -> - bindSocket s (SockAddrInet aNY_PORT iNADDR_ANY) >> - getSocketName s >>= \ (SockAddrInet port _) -> - putStr ("Allocated Port Number: " ++ show port ++ "\n") >> - listen s 5 >> - - - let - loop = - accept s >>= \ (s',(SockAddrInet _ haddr)) -> - putStr ("*** Start of Transfer from: " ++ - (inet_ntoa haddr) ++ "***\n") >> - let - read_all = - readSocket s' 4 >>= \ (str, nbytes) -> - if nbytes /= 0 then - putStr str >> - read_all - else - putStr "\n*** End of Transfer ***\n" >> - sClose s' - in - read_all - in - loop - diff --git a/ghc/misc/examples/net004/Main.hs b/ghc/misc/examples/net004/Main.hs deleted file mode 100644 index 3948707df3..0000000000 --- a/ghc/misc/examples/net004/Main.hs +++ /dev/null @@ -1,33 +0,0 @@ -{- client - -As for net002 but reads port number and message as arguments. -It also prints out the IP number of the peer machine. - - - -TESTS: - getPeerName --} - - -module Main where - -import SocketPrim -import LibSystem - - -starbuck = "130.209.240.81" -marcus = "130.209.247.2" - - -main = - getArgs >>= \ [port, message] -> - socket AF_INET Stream 6 >>= \ s -> - connect s (SockAddrInet (read port) (inet_addr starbuck)) >> - - getPeerName s >>= \ (SockAddrInet p haddr) -> - putStr ("Connected to : " ++ (inet_ntoa haddr) ++ "\n") >> - writeSocket s message >> - shutdown s 2 >> - sClose s - diff --git a/ghc/misc/examples/net005/Main.hs b/ghc/misc/examples/net005/Main.hs deleted file mode 100644 index ec504aa480..0000000000 --- a/ghc/misc/examples/net005/Main.hs +++ /dev/null @@ -1,37 +0,0 @@ -{- server - -Server as net001 but for Unix Domain Datagram sockets. - -TESTS: - socket - bindSocket - readSocket - --} - - -module Main where - -import SocketPrim - - -main = - socket AF_UNIX Datagram 0 >>= \ s -> - bindSocket s (SockAddrUnix "sock") >> - - let - loop = - putStr "*** Start of Transfer ***\n" >> - let - read_all = - readSocket s 1024 >>= \ (str, nbytes) -> - if nbytes /= 0 then - putStr str >> - read_all - else - putStr "\n*** End of Transfer ***\n" - in - read_all - in - loop - diff --git a/ghc/misc/examples/net006/Main.hs b/ghc/misc/examples/net006/Main.hs deleted file mode 100644 index 57be04e330..0000000000 --- a/ghc/misc/examples/net006/Main.hs +++ /dev/null @@ -1,27 +0,0 @@ -{- client - -Client side of net005 - -TESTS: - socket - connect - writeSocket - shutdown - sClose --} - - -module Main where - -import SocketPrim - -message = "Hello World" - - -main = - socket AF_UNIX Datagram 0 >>= \ s -> - connect s (SockAddrUnix "sock") >> - - writeSocket s message >> - shutdown s 2 >> - sClose s diff --git a/ghc/misc/examples/net007/Main.hs b/ghc/misc/examples/net007/Main.hs deleted file mode 100644 index fbc9ff04e0..0000000000 --- a/ghc/misc/examples/net007/Main.hs +++ /dev/null @@ -1,44 +0,0 @@ -{- server - -As net003 but uses the BSD module for portability. Also prints the -common name of the host rather than its IP number. - -TESTS: - getProtocolNumber - getSocketName - getHostByAddr - --} - -module Main where - -import BSD -import SocketPrim - -main = - getProtocolNumber "tcp" >>= \ proto -> - socket AF_INET Stream proto >>= \ s -> - bindSocket s (SockAddrInet aNY_PORT iNADDR_ANY) >> - getSocketName s >>= \ (SockAddrInet port _) -> - putStr ("Allocated Port Number: " ++ show port ++ "\n") >> - listen s 5 >> - - - let - loop = - accept s >>= \ (s',(SockAddrInet _ haddr)) -> - getHostByAddr AF_INET haddr >>= \ (HostEntry hname _ _ _) -> - putStr ("*** Start of Transfer from: " ++ hname ++ "***\n") >> - let - read_all = - readSocket s' 4 >>= \ (str, nbytes) -> - if nbytes /= 0 then - putStr str >> - read_all - else - putStr "\n*** End of Transfer ***\n" >> - sClose s' - in - read_all - in - loop diff --git a/ghc/misc/examples/net008/Main.hs b/ghc/misc/examples/net008/Main.hs deleted file mode 100644 index 8c339297e2..0000000000 --- a/ghc/misc/examples/net008/Main.hs +++ /dev/null @@ -1,22 +0,0 @@ -module Main where - -import SocketPrim -import BSD -import LibSystem - - -main = - getArgs >>= \ [host, port, message] -> - getProtocolNumber "tcp" >>= \ proto -> - socket AF_INET Stream proto >>= \ s -> - getHostByName host >>= \ (HostEntry _ _ _ haddrs) -> - connect s (SockAddrInet (read port) - (head haddrs)) >> - - getPeerName s >>= \ (SockAddrInet _ haddr) -> - getHostByAddr AF_INET haddr >>= \ (HostEntry hname _ _ _) -> - putStr ("Connected to : " ++ hname ++ "\n") >> - writeSocket s message >> - shutdown s 2 >> - sClose s - diff --git a/ghc/misc/examples/nfib/nfib.c b/ghc/misc/examples/nfib/nfib.c deleted file mode 100644 index 04e7d546aa..0000000000 --- a/ghc/misc/examples/nfib/nfib.c +++ /dev/null @@ -1,16 +0,0 @@ -#include <stdio.h> - -main () -{ - int n; - - scanf("%d",&n); - n = nfib(n); - printf("nfibs=%d\n",n); - exit(0); -} - -nfib (n) -{ - return(n <= 1 ? 1 : nfib(n-1) + nfib(n-2) + 1); -} diff --git a/ghc/misc/examples/nfib/nfib.pl b/ghc/misc/examples/nfib/nfib.pl deleted file mode 100644 index 18cc926adb..0000000000 --- a/ghc/misc/examples/nfib/nfib.pl +++ /dev/null @@ -1,19 +0,0 @@ -# WARNING! -# Note: be careful about running this with an argument > (say) 18 ! -# running this script on '27' will chew up ~80 MB of virtual -# ram. and its apetite grows per 1.61803 ** $n. -# -# Your system admin folk would probably be displeased if you trash -# other people's work, or disable systems running this script! -# -# Usage: perl nfib.prl <number> -# -$n = @ARGV[0]; -$f=&fib($n); -print " $n! = $f\n"; -sub fib { - local ($n)=$_[0]; - if ($n==0) {return (0);} - elsif($n==1) {return(1);} - return (&fib ($n-1) + &fib($n-2)); -} diff --git a/ghc/misc/examples/nfib/nfibD.hs b/ghc/misc/examples/nfib/nfibD.hs deleted file mode 100644 index 373bef36b5..0000000000 --- a/ghc/misc/examples/nfib/nfibD.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Main where - -main = print (nfib 28) - -nfib :: Double -> Double - -nfib n | n <= 1 = 1 - | otherwise = (n1 + n2 + 1) - where n1 = nfib (n-1) - n2 = nfib (n-2) diff --git a/ghc/misc/examples/nfib/nfibF.hs b/ghc/misc/examples/nfib/nfibF.hs deleted file mode 100644 index 604bcd195a..0000000000 --- a/ghc/misc/examples/nfib/nfibF.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Main where - -main = print (nfib 28) - -nfib :: Float -> Float - -nfib n | n <= 1 = 1 - | otherwise = (n1 + n2 + 1) - where n1 = nfib (n-1) - n2 = nfib (n-2) diff --git a/ghc/misc/examples/nfib/nfibI.hs b/ghc/misc/examples/nfib/nfibI.hs deleted file mode 100644 index a889a1e948..0000000000 --- a/ghc/misc/examples/nfib/nfibI.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Main where - -main = print (nfib 30) - -nfib :: Int -> Int - -nfib n | n <= 1 = 1 - | otherwise = (n1 + n2 + 1) - where n1 = nfib (n-1) - n2 = nfib (n-2) diff --git a/ghc/misc/examples/nfib/nfibJ.hs b/ghc/misc/examples/nfib/nfibJ.hs deleted file mode 100644 index c622e5c6e1..0000000000 --- a/ghc/misc/examples/nfib/nfibJ.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Main where - -main = print (nfib 28) - -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/nfib/nfibO.hs b/ghc/misc/examples/nfib/nfibO.hs deleted file mode 100644 index a63c33478d..0000000000 --- a/ghc/misc/examples/nfib/nfibO.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Main where - -main = print (nfib 28) - -nfib :: (Num a, Ord a) => a -> a - -nfib n | n <= 1 = 1 - | otherwise = (n1 + n2 + 1) - where n1 = nfib (n-1) - n2 = nfib (n-2) diff --git a/ghc/misc/examples/nfib/nfibR.hs b/ghc/misc/examples/nfib/nfibR.hs deleted file mode 100644 index 793c16497c..0000000000 --- a/ghc/misc/examples/nfib/nfibR.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Main where - -main = print (nfib 20) - -nfib :: Rational -> Rational - -nfib n | n <= 1 = 1 - | otherwise = (n1 + n2 + 1) - where n1 = nfib (n-1) - n2 = nfib (n-2) diff --git a/ghc/misc/examples/posix/po001/Main.hs b/ghc/misc/examples/posix/po001/Main.hs deleted file mode 100644 index 31c32ba94f..0000000000 --- a/ghc/misc/examples/posix/po001/Main.hs +++ /dev/null @@ -1,23 +0,0 @@ -import Posix - -main = - getParentProcessID >>= \ ppid -> - getProcessID >>= \ pid -> - putStr "Parent Process ID: " >> - print ppid >> - putStr "\nProcess ID: " >> - print pid >> - putStr "\nforking ps uxww" >> - print ppid >> - putChar '\n' >> - forkProcess >>= \ child -> - case child of - Nothing -> executeFile "ps" True ["uxww" ++ show ppid] Nothing - Just x -> doParent x pid - -doParent cpid pid = - getProcessStatus True False cpid >> - putStr "\nChild finished. Now exec'ing ps uxww" >> - 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 deleted file mode 100644 index 8d01e8b69f..0000000000 --- a/ghc/misc/examples/posix/po002/Main.hs +++ /dev/null @@ -1,4 +0,0 @@ -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 deleted file mode 100644 index eed6c08456..0000000000 --- a/ghc/misc/examples/posix/po003/Main.hs +++ /dev/null @@ -1,5 +0,0 @@ -import Posix - -main = - openFile "po003.out" WriteMode >>= \ h -> - 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 deleted file mode 100644 index 2423f3f77a..0000000000 --- a/ghc/misc/examples/posix/po004/Main.hs +++ /dev/null @@ -1,58 +0,0 @@ -import Posix -import System(ExitCode(..), exitWith) - -main = - forkProcess >>= \ maybe_pid -> - case maybe_pid of - Nothing -> raiseSignal floatingPointException - _ -> doParent - -doParent = - getAnyProcessStatus True False >>= \ (Just (pid, tc)) -> - case tc of - Terminated sig | sig == floatingPointException -> forkChild2 - _ -> fail (userError "unexpected termination cause") - -forkChild2 = - forkProcess >>= \ maybe_pid -> - case maybe_pid of - Nothing -> exitImmediately (ExitFailure 42) - _ -> doParent2 - -doParent2 = - getAnyProcessStatus True False >>= \ (Just (pid, tc)) -> - case tc of - Exited (ExitFailure 42) -> forkChild3 - _ -> fail (userError "unexpected termination cause (2)") - -forkChild3 = - forkProcess >>= \ maybe_pid -> - case maybe_pid of - Nothing -> exitImmediately (ExitSuccess) - _ -> doParent3 - -doParent3 = - getAnyProcessStatus True False >>= \ (Just (pid, tc)) -> - case tc of - Exited ExitSuccess -> forkChild4 - _ -> fail (userError "unexpected termination cause (3)") - -forkChild4 = - forkProcess >>= \ maybe_pid -> - case maybe_pid of - Nothing -> raiseSignal softwareStop - _ -> doParent4 - -doParent4 = - getAnyProcessStatus True True >>= \ (Just (pid, tc)) -> - case tc of - Stopped sig | sig == softwareStop -> enoughAlready pid - _ -> 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 (userError "unexpected termination cause (5)") - diff --git a/ghc/misc/examples/posix/po005/Main.hs b/ghc/misc/examples/posix/po005/Main.hs deleted file mode 100644 index 81dce3ae02..0000000000 --- a/ghc/misc/examples/posix/po005/Main.hs +++ /dev/null @@ -1,30 +0,0 @@ -import Posix - -main = - getEnvVar "TERM" >>= \ term -> - putStr term >> - putChar '\n' >> - setEnvironment [("one","1"),("two","2")] >> - getEnvironment >>= \ env -> - print env >> - putChar '\n' >> - setEnvVar "foo" "bar" >> - getEnvironment >>= \ env -> - print env >> - putChar '\n' >> - setEnvVar "foo" "baz" >> - getEnvironment >>= \ env -> - print env >> - putChar '\n' >> - setEnvVar "fu" "bar" >> - getEnvironment >>= \ env -> - print env >> - putChar '\n' >> - removeEnvVar "foo" >> - getEnvironment >>= \ env -> - print env >> - putChar '\n' >> - setEnvironment [] >> - getEnvironment >>= \ env -> - print env >> - putChar '\n' diff --git a/ghc/misc/examples/posix/po006/Main.hs b/ghc/misc/examples/posix/po006/Main.hs deleted file mode 100644 index eb6451dd73..0000000000 --- a/ghc/misc/examples/posix/po006/Main.hs +++ /dev/null @@ -1,14 +0,0 @@ -import Posix - -main = - epochTime >>= \ start -> - sleep 5 >> - let timeleft = 0 in - epochTime >>= \ finish -> - putStr "Started: " >> - print start >> - putStr "\nSlept: " >> - print (5 - timeleft) >> - putStr "\nFinished: " >> - print finish >> - putChar '\n' diff --git a/ghc/misc/examples/posix/po007/Main.hs b/ghc/misc/examples/posix/po007/Main.hs deleted file mode 100644 index 3a37dc7545..0000000000 --- a/ghc/misc/examples/posix/po007/Main.hs +++ /dev/null @@ -1,31 +0,0 @@ -import Posix - -main = - installHandler keyboardSignal (Catch doCtrlC) Nothing >> - getTerminalAttributes stdInput >>= \ ta -> - case (controlChar ta Interrupt) of - Nothing -> fixMe ta - Just x -> continue x - -fixMe ta = - putStr "Oops...no interrupt character?\nI can fix that...\n" >> - setTerminalAttributes stdInput (withCC ta (Interrupt, '\ETX')) Immediately >> - getTerminalAttributes stdInput >>= \ ta -> - case (controlChar ta Interrupt) of - Nothing -> putStr "...Then again, maybe I can't\n" - Just x -> continue x - -continue x = - putStr "Press '" >> - putStr (ccStr x) >> - putStr "'.\n" >> - awaitSignal Nothing >> - putStr "How did I get here?\n" - -doCtrlC = - putStr "Caught an interrupt.\n" - -ccStr '\DEL' = "^?" -ccStr x - | x >= ' ' = [x] - | otherwise = ['^', (toEnum (fromEnum x + fromEnum '@'))] diff --git a/ghc/misc/examples/posix/po008/Main.hs b/ghc/misc/examples/posix/po008/Main.hs deleted file mode 100644 index 249e58eedc..0000000000 --- a/ghc/misc/examples/posix/po008/Main.hs +++ /dev/null @@ -1,12 +0,0 @@ -import Posix - -main = - installHandler realTimeAlarm (Catch alarmclock) Nothing >> - putStr "Scheduling an alarm in 5 seconds...\n" >> - scheduleAlarm 5 >> - putStr "Sleeping one minute.\n" >> - sleep 60 >> - putStr "How did I get here?\n" - -alarmclock = - putStr "The alarm went off.\n" diff --git a/ghc/misc/examples/posix/po009/Main.hs b/ghc/misc/examples/posix/po009/Main.hs deleted file mode 100644 index a1f284f78d..0000000000 --- a/ghc/misc/examples/posix/po009/Main.hs +++ /dev/null @@ -1,14 +0,0 @@ -import Posix - -main = - putStr "Blocking real time alarms.\n" >> - blockSignals (addSignal realTimeAlarm emptySignalSet) >> - putStr "Scheduling an alarm in 2 seconds...\n" >> - scheduleAlarm 2 >> - putStr "Sleeping 5 seconds.\n" >> - sleep 5 >> - getPendingSignals >>= \ ints -> - putStr "Checking pending interrupts for RealTimeAlarm\n" >> - print (inSignalSet realTimeAlarm ints) >> - putChar '\n' - diff --git a/ghc/misc/examples/posix/po010/Main.hs b/ghc/misc/examples/posix/po010/Main.hs deleted file mode 100644 index 86ef3e1c24..0000000000 --- a/ghc/misc/examples/posix/po010/Main.hs +++ /dev/null @@ -1,24 +0,0 @@ -import Posix - -main = - getUserEntryForName "mattson" >>= \ mattson -> - getUserEntryForName "partain" >>= \ partain -> - putStr (ue2String mattson) >> - putChar '\n' >> - putStr (ue2String partain) >> - putChar '\n' >> - getUserEntryForID (userID mattson) >>= \ muid -> - getUserEntryForID (userID partain) >>= \ puid -> - putStr (ue2String muid) >> - putChar '\n' >> - putStr (ue2String puid) >> - putChar '\n' - -ue2String ue = - name ++ (':' : (show uid) ++ (':' : (show gid) ++ (':' : home ++ (':' : shell)))) - where - name = userName ue - uid = userID ue - gid = userGroupID ue - home = homeDirectory ue - shell = userShell ue diff --git a/ghc/misc/examples/posix/po011/Main.hs b/ghc/misc/examples/posix/po011/Main.hs deleted file mode 100644 index f8baf1cbc2..0000000000 --- a/ghc/misc/examples/posix/po011/Main.hs +++ /dev/null @@ -1,22 +0,0 @@ -import Posix - -main = - getGroupEntryForName "grasp" >>= \ grasp -> - getGroupEntryForName "staff" >>= \ staff -> - putStr (ge2String grasp) >> - putChar '\n' >> - putStr (ge2String staff) >> - putChar '\n' >> - getGroupEntryForID (groupID grasp) >>= \ guid -> - getGroupEntryForID (groupID staff) >>= \ suid -> - putStr (ge2String guid) >> - putChar '\n' >> - putStr (ge2String suid) >> - putChar '\n' - -ge2String ge = - name ++ (':' : (show gid) ++ (':' : members)) - where - name = groupName ge - gid = groupID ge - 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 deleted file mode 100644 index b84fafabe9..0000000000 --- a/ghc/misc/examples/posix/po012/Main.hs +++ /dev/null @@ -1,53 +0,0 @@ -import Posix -import IO -- 1.3 - -main = - createFile "po012.out" stdFileMode >>= \ fd -> - installHandler processStatusChanged (Catch (reap1 fd)) Nothing >> - ls >> - awaitSignal Nothing - -ls = - runProcess "ls" ["-l","po012.out"] Nothing Nothing Nothing Nothing Nothing - -reap1 fd = - getAnyProcessStatus True False >> - installHandler processStatusChanged (Catch (reap2 fd)) Nothing >> - writeChannel fd (take 666 (repeat 'x')) >> - ls >> - awaitSignal Nothing - -reap2 fd = - getAnyProcessStatus True False >> - installHandler processStatusChanged (Catch (reap3 fd)) Nothing >> - setFileMode "po012.out" - (foldr1 unionFileModes [ownerReadMode,ownerWriteMode,groupReadMode,otherReadMode]) >> - ls >> - awaitSignal Nothing - -reap3 fd = - getAnyProcessStatus True False >> - installHandler processStatusChanged (Catch (reap4 fd)) Nothing >> - setFileTimes "po012.out" 0 0 >> - ls >> - awaitSignal Nothing - -reap4 fd = - getAnyProcessStatus True False >> - installHandler processStatusChanged (Catch (reap5 fd)) Nothing >> - removeLink "po012.out" >> - ls >> - awaitSignal Nothing - -reap5 fd = - getAnyProcessStatus True False >> - seekChannel fd SeekFromEnd 0 >>= \ bytes -> - if bytes == 666 then - seekChannel fd AbsoluteSeek 0 >> - readChannel fd 1024 >>= \ (str, _) -> - if str == (take 666 (repeat 'x')) then - putStr "Okay\n" - else - putStr "Read failed\n" - else - putStr "Seek returned wrong size\n" diff --git a/ghc/misc/test-arch.c b/ghc/misc/test-arch.c deleted file mode 100644 index d0e9666b96..0000000000 --- a/ghc/misc/test-arch.c +++ /dev/null @@ -1,37 +0,0 @@ -/* - Compile this with GCC on a new platform, to learn various - things about argument-passing, return-returning, stack - layout, etc. WDP 95/05 -*/ - -extern long int foo (long int, double, void *, char *, double, long int, char, long int); -extern double bar (char, float, long int, long int, char *, char **); - -long int -foo (long int a, double b, void *c, char *d, double e, long int f, char g, long int h) -{ - __asm__ volatile ("--- BEGIN ---"); - bar(*d, (float) b, a, f, d, (char **) d); - __asm__ volatile ("--- END ---"); -} - -double -bar (char a, float b, long int c, long int d, char *e, char **f) -{ - __asm__ volatile ("--- BEGIN ---"); - foo(c, (double) b, (void *) 0, e, 0.0, d, a, d); - __asm__ volatile ("--- END ---"); -} - -double -baz(w) - int w; -{ - int x[1000]; - int y; - - for(y = 0; y < 1000; y++) - w += x[y]; - - return ((double) w); -} diff --git a/ghc/tests/ghci/prog005/Makefile b/ghc/tests/ghci/prog005/Makefile deleted file mode 100644 index 4bb3c3f2cb..0000000000 --- a/ghc/tests/ghci/prog005/Makefile +++ /dev/null @@ -1,7 +0,0 @@ -#----------------------------------------------------------------------------- -# $Id: Makefile,v 1.1 2002/01/31 13:46:38 simonmar Exp $ - -TOP = ../.. -include $(TOP)/mk/boilerplate.mk - -include $(TOP)/mk/ghci.mk diff --git a/ghc/tests/ghci/prog005/Parser.hs b/ghc/tests/ghci/prog005/Parser.hs deleted file mode 100644 index d7f007c98b..0000000000 --- a/ghc/tests/ghci/prog005/Parser.hs +++ /dev/null @@ -1,359 +0,0 @@ -{-# OPTIONS -fglasgow-exts -cpp #-} --- parser produced by Happy Version 1.11 - -module Parser where - -import Char -import GlaExts -import Array -import IO -import IOExts - -data HappyAbsSyn - = HappyTerminal Token - | HappyErrorToken Int - | HappyAbsSyn4 (Int) - -happyActOffsets :: Addr -happyActOffsets = A# "\x0a\x00\x0a\x00\x00\x00\xff\xff\x0a\x00\x0a\x00\x08\x00\x07\x00\x00\x00"# - -happyGotoOffsets :: Addr -happyGotoOffsets = A# "\x06\x00\x00\x00\x00\x00\x00\x00\x05\x00\x04\x00\x00\x00\x00\x00\x00\x00"# - -happyDefActions :: Addr -happyDefActions = A# "\x00\x00\x00\x00\xfe\xff\x00\x00\x00\x00\x00\x00\xfc\xff\xfd\xff"# - -happyCheck :: Addr -happyCheck = A# "\xff\xff\x02\x00\x03\x00\x04\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\x02\x00\x02\x00\x01\x00\xff\xff\xff\xff\xff\xff"# - -happyTable :: Addr -happyTable = A# "\x00\x00\x05\x00\x06\x00\xff\xff\x06\x00\x07\x00\x03\x00\x00\x00\x00\x00\x00\x00\x05\x00\x03\x00\x00\x00\x00\x00\x00\x00"# - -happyReduceArr = array (1, 3) [ - (1 , happyReduce_1), - (2 , happyReduce_2), - (3 , happyReduce_3) - ] - -happy_n_terms = 5 :: Int -happy_n_nonterms = 1 :: Int - -happyReduce_1 = happySpecReduce_1 0# happyReduction_1 -happyReduction_1 _ - = HappyAbsSyn4 - (1 - ) - -happyReduce_2 = happySpecReduce_3 0# happyReduction_2 -happyReduction_2 _ - _ - _ - = HappyAbsSyn4 - (2 - ) - -happyReduce_3 = happySpecReduce_3 0# happyReduction_3 -happyReduction_3 _ - _ - _ - = HappyAbsSyn4 - (3 - ) - -happyNewToken action sts stk [] = - happyDoAction 4# (error "reading EOF!") action sts stk [] - -happyNewToken action sts stk (tk:tks) = - let cont i = happyDoAction i tk action sts stk tks in - case tk of { - Tid -> cont 1#; - Tgreater -> cont 2#; - Tand -> cont 3#; - } - -happyThen = \m k -> k m -happyReturn = \a -> a -happyThen1 = happyThen -happyReturn1 = \a tks -> a - -parser tks = happyThen (happyParse 0# tks) (\x -> case x of {HappyAbsSyn4 z -> happyReturn z; _other -> notHappyAtAll }) - -data Token = Tid | Tgreater | Tand - deriving Show - -happyError = error "parse error" - -lexer :: String -> [Token] -lexer = l - where l "" = [] - l ('\n':cs) = l cs - l ('a':'n':'d':cs) = Tand : l cs - l (c:cs) - | isSpace c = l cs - | isAlpha c = let (_,rs) = span isAlpha (c:cs) - in Tid : l rs - l ('>':cs) = Tgreater : l cs -{-# LINE 1 "GenericTemplate.hs" #-} -{-# LINE 1 "GenericTemplate.hs" #-} --- $Id: Parser.hs,v 1.1 2002/01/31 13:46:38 simonmar Exp $ - - - - - - - - - - - - - -{-# LINE 27 "GenericTemplate.hs" #-} - - - -data Happy_IntList = HappyCons Int# Happy_IntList - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -happyTrace string expr = unsafePerformIO $ do - hPutStr stderr string - return expr - - - - -infixr 9 `HappyStk` -data HappyStk a = HappyStk a (HappyStk a) - ------------------------------------------------------------------------------ --- starting the parse - -happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll - ------------------------------------------------------------------------------ --- Accepting the parse - -happyAccept j tk st sts (HappyStk ans _) = (happyTcHack j - (happyTcHack st)) - (happyReturn1 ans) - ------------------------------------------------------------------------------ --- Arrays only: do the next action - - - -happyDoAction i tk st - = (happyTrace ("state: " ++ show (I# (st)) ++ - ",\ttoken: " ++ show (I# (i)) ++ - ",\taction: ")) $ - case action of - 0# -> (happyTrace ("fail.\n")) $ - happyFail i tk st - -1# -> (happyTrace ("accept.\n")) $ - happyAccept i tk st - n | (n <# (0# :: Int#)) -> (happyTrace ("reduce (rule " ++ show rule - ++ ")")) $ - (happyReduceArr ! rule) i tk st - where rule = (I# ((negateInt# ((n +# (1# :: Int#)))))) - n -> (happyTrace ("shift, enter state " - ++ show (I# (new_state)) - ++ "\n")) $ - happyShift new_state i tk st - where new_state = (n -# (1# :: Int#)) - where off = indexShortOffAddr happyActOffsets st - off_i = (off +# i) - check = if (off_i >=# (0# :: Int#)) - then (indexShortOffAddr happyCheck off_i ==# i) - else False - action | check = indexShortOffAddr happyTable off_i - | otherwise = indexShortOffAddr happyDefActions st - - - - - - - -indexShortOffAddr (A# arr) off = -#if __GLASGOW_HASKELL__ > 500 - narrow16Int# i -#elif __GLASGOW_HASKELL__ == 500 - intToInt16# i -#else - (i `iShiftL#` 16#) `iShiftRA#` 16# -#endif - where - i = word2Int# ((high `shiftL#` 8#) `or#` low) - high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) - low = int2Word# (ord# (indexCharOffAddr# arr off')) - off' = off *# 2# - - - - - - ------------------------------------------------------------------------------ --- HappyState data type (not arrays) - -{-# LINE 153 "GenericTemplate.hs" #-} - - ------------------------------------------------------------------------------ --- Shifting a token - -happyShift new_state 0# tk st sts stk@(x `HappyStk` _) = - let i = (case x of { HappyErrorToken (I# (i)) -> i }) in --- trace "shifting the error token" $ - happyDoAction i tk new_state (HappyCons (st) (sts)) (stk) - -happyShift new_state i tk st sts stk = - happyNewToken new_state (HappyCons (st) (sts)) ((HappyTerminal (tk))`HappyStk`stk) - --- happyReduce is specialised for the common cases. - -happySpecReduce_0 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_0 nt fn j tk st@((action)) sts stk - = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk) - -happySpecReduce_1 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk') - = happyGoto nt j tk st sts (fn v1 `HappyStk` stk') - -happySpecReduce_2 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk') - = happyGoto nt j tk st sts (fn v1 v2 `HappyStk` stk') - -happySpecReduce_3 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') - = happyGoto nt j tk st sts (fn v1 v2 v3 `HappyStk` stk') - -happyReduce k i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happyReduce k nt fn j tk st sts stk = happyGoto nt j tk st1 sts1 (fn stk) - where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts)) - -happyMonadReduce k nt fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happyMonadReduce k nt fn j tk st sts stk = - happyThen1 (fn stk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) - where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts)) - drop_stk = happyDropStk k stk - -happyDrop 0# l = l -happyDrop n (HappyCons (_) (t)) = happyDrop (n -# (1# :: Int#)) t - -happyDropStk 0# l = l -happyDropStk n (x `HappyStk` xs) = happyDropStk (n -# (1#::Int#)) xs - ------------------------------------------------------------------------------ --- Moving to a new state after a reduction - - -happyGoto nt j tk st = - (happyTrace (", goto state " ++ show (I# (new_state)) ++ "\n")) $ - happyDoAction j tk new_state - where off = indexShortOffAddr happyGotoOffsets st - off_i = (off +# nt) - new_state = indexShortOffAddr happyTable off_i - - - - ------------------------------------------------------------------------------ --- Error recovery (0# is the error token) - --- parse error if we are in recovery and we fail again -happyFail 0# tk old_st _ stk = --- trace "failing" $ - happyError - - -{- We don't need state discarding for our restricted implementation of - "error". In fact, it can cause some bogus parses, so I've disabled it - for now --SDM - --- discard a state -happyFail 0# tk old_st (HappyCons ((action)) (sts)) - (saved_tok `HappyStk` _ `HappyStk` stk) = --- trace ("discarding state, depth " ++ show (length stk)) $ - happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk)) --} - --- Enter error recovery: generate an error token, --- save the old token and carry on. -happyFail i tk (action) sts stk = --- trace "entering error recovery" $ - happyDoAction 0# tk action sts ( (HappyErrorToken (I# (i))) `HappyStk` stk) - --- Internal happy errors: - -notHappyAtAll = error "Internal Happy error\n" - ------------------------------------------------------------------------------ --- Hack to get the typechecker to accept our action functions - - -happyTcHack :: Int# -> a -> a -happyTcHack x y = y -{-# INLINE happyTcHack #-} - - ------------------------------------------------------------------------------ --- Don't inline any functions from the template. GHC has a nasty habit --- of deciding to inline happyGoto everywhere, which increases the size of --- the generated parser quite a bit. - - -{-# NOINLINE happyDoAction #-} -{-# NOINLINE happyTable #-} -{-# NOINLINE happyCheck #-} -{-# NOINLINE happyActOffsets #-} -{-# NOINLINE happyGotoOffsets #-} -{-# NOINLINE happyDefActions #-} - -{-# NOINLINE happyShift #-} -{-# NOINLINE happySpecReduce_0 #-} -{-# NOINLINE happySpecReduce_1 #-} -{-# NOINLINE happySpecReduce_2 #-} -{-# NOINLINE happySpecReduce_3 #-} -{-# NOINLINE happyReduce #-} -{-# NOINLINE happyMonadReduce #-} -{-# NOINLINE happyGoto #-} -{-# NOINLINE happyFail #-} - --- end of Happy Template. diff --git a/ghc/tests/ghci/prog005/prog005.script b/ghc/tests/ghci/prog005/prog005.script deleted file mode 100644 index 06909a3d6a..0000000000 --- a/ghc/tests/ghci/prog005/prog005.script +++ /dev/null @@ -1,5 +0,0 @@ -:unset +s -:unset +t -:set -package lang -fglasgow-exts -:l Parser -parser (lexer "a>b") diff --git a/ghc/tests/ghci/prog005/prog005.stderr b/ghc/tests/ghci/prog005/prog005.stderr deleted file mode 100644 index d049d5bc46..0000000000 --- a/ghc/tests/ghci/prog005/prog005.stderr +++ /dev/null @@ -1,8 +0,0 @@ -Compiling Parser ( Parser.hs, interpreted ) -state: 0, token: 1, action: shift, enter state 2 -state: 2, token: 2, action: reduce (rule 1), goto state 3 -state: 3, token: 2, action: shift, enter state 4 -state: 4, token: 1, action: shift, enter state 2 -state: 2, token: 4, action: reduce (rule 1), goto state 7 -state: 7, token: 4, action: reduce (rule 2), goto state 3 -state: 3, token: 4, action: accept. diff --git a/ghc/tests/ghci/prog005/prog005.stdout b/ghc/tests/ghci/prog005/prog005.stdout deleted file mode 100644 index f3dd03ea94..0000000000 --- a/ghc/tests/ghci/prog005/prog005.stdout +++ /dev/null @@ -1,11 +0,0 @@ - ___ ___ _ - / _ \ /\ /\/ __(_) - / /_\// /_/ / / | | GHC Interactive, version 5.03, for Haskell 98. -/ /_\\/ __ / /___| | http://www.haskell.org/ghc/ -\____/\/ /_/\____/|_| Type :? for help. - -Loading package std ... linking ... done. -Loading package lang ... linking ... done. -Ok, modules loaded: Parser. -2 -Leaving GHCi. diff --git a/ghc/tests/lib/should_run/Makefile b/ghc/tests/lib/should_run/Makefile deleted file mode 100644 index 1e435b01de..0000000000 --- a/ghc/tests/lib/should_run/Makefile +++ /dev/null @@ -1,48 +0,0 @@ -#----------------------------------------------------------------------------- -# $Id: Makefile,v 1.28 2002/02/12 15:17:23 simonmar Exp $ - -TOP = ../.. -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/should_run.mk - -SRC_HC_OPTS += -dcore-lint - -packedstring001_HC_OPTS = -package lang -exceptions001_HC_OPTS = -package lang -fno-warn-missing-methods -stableptr001_HC_OPTS = -package lang -stableptr003_HC_OPTS = -package lang -stableptr004_HC_OPTS = -package lang -list001_HC_OPTS = -package lang -uri001_HC_OPTS = -package net -time001_HC_OPTS = -package lang -io001_HC_OPTS = -package lang -io002_HC_OPTS = -package lang -addr001_HC_OPTS = -package lang - -enum01_HC_OPTS = -cpp -package lang -H12m -enum02_HC_OPTS = -cpp -package lang -H12m -enum03_HC_OPTS = -cpp -package lang -H12m - -stableptr001_RUNTEST_OPTS = +RTS -K4m -stableptr004_RUNTEST_OPTS = +RTS -K4m -dynamic001_HC_OPTS = -package lang -dynamic002_HC_OPTS = -package lang - -ioexts001_HC_OPTS = -package lang -O -ioexts001_RUNTEST_OPTS = +RTS -K16m -ioexts002_HC_OPTS = -package lang - -memo001_HC_OPTS = -package lang -package util -# stress the garbage collector a bit, to make sure weak pointers are being -# finalized properly, and stable names are GC'd etc. -memo001_RUNTEST_OPTS = +RTS -A10k -G1 - -memo002_HC_OPTS = -package lang -package util -memo002_RUNTEST_OPTS = 20 - -weak001_HC_OPTS = -package lang -fglasgow-exts - -SRC_MKDEPENDHS_OPTS += -package lang - -include $(TOP)/mk/target.mk - diff --git a/ghc/tests/lib/should_run/uri001.hs b/ghc/tests/lib/should_run/uri001.hs deleted file mode 100644 index 7515f15d93..0000000000 --- a/ghc/tests/lib/should_run/uri001.hs +++ /dev/null @@ -1,55 +0,0 @@ -module Main where - -import Network.URI -import Data.Maybe - -main = sequence_ (map do_test tests) - -base = fromJust (parseURI "http://a/b/c/d;p?q") - -do_test test = case parseURI test of - Nothing -> error ("no parse: " ++ test) - Just uri -> putStr (show (fromJust (uri `relativeTo` base)) ++ "\n") - -tests = - [ "g:h", - "g", - "./g", - "g/", - "/g", - "//g", - "?y", - "g?y", - "#s", - "g#s", - "g?y#s", - ";x", - "g;x", - "g;x?y#s", - ".", - "./", - "..", - "../", - "../g", - "../..", - "../../", - "../../g", - -- "../../../g" -- should fail - -- "../../../../g" -- should fail - "/./g", - "/../g", - "g.", - ".g", - "g..", - "..g", - "./../g", - "./g/.", - "g/./h", - "g/../h", - "g;x=1/./y", - "g;x=1/../y", - "g?y/./x", - "g?y/../x", - "g#s/./x", - "g#s/../x" - ] |