Commit 47bd4098 authored by Simon Marlow's avatar Simon Marlow

rempve some unused files

parent 71130e69
#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)
*/
#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)
*/
main :: IO ()
main = interact id
-- 46,173 bytes/sec (600KB input)
module Main (main) where
main :: IO ()
main
= try getChar >>=
{-then-}either (\ _ -> return ())
{-or-} (\ c -> putChar c >>
main)
-- 51,156 bytes/sec (600KB input)
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)
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)
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)
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)
#! /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, $_;
}
}
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 ()
TOP = ../../..
include $(TOP)/mk/boilerplate.mk
SRC_HC_OPTS += -syslib posix
HS_PROG=hsh
include $(TOP)/mk/target.mk
main = putStr "Hello, world\n"
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'
import System (getProgName, getArgs)
main =
getProgName >>= \ argv0 ->
putStr argv0 >>
getArgs >>= \ argv ->
sequence (map (\ x -> putChar ' ' >> putStr x) argv) >>
putChar '\n'
import System (exitWith, ExitCode(..))
main = exitWith (ExitFailure 42)
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")
import IO -- 1.3
main =
hClose stderr >>
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" `catch`
\ err ->
if isIllegalOperation err then
hGetContents hIn >>= \ stuff ->
hPutStr stdout stuff
else
error "Oh dear\n"
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)
import Directory (getDirectoryContents)
import QSort (sort)
main =
getDirectoryContents "." >>= \ names ->
print (sort names)
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
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"
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)
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
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 }
import IO -- 1.3
main =
isEOF >>= \ eof ->
if eof then
return ()
else
getChar >>= \ c ->
putChar c >>
main
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
import IO -- 1.3
main =
hSetBuffering stdout NoBuffering >>
putStr "Enter an integer: " >>
readLine >>= \ x1 ->
putStr "Enter another integer: " >>
readLine >>= \ x2 ->