Commit 4599a07c authored by dterei's avatar dterei

Remove old files.

parent 34e23dcc
# Boring file regexps:
\.o$
\.o\.cmd$
# *.ko files aren't boring by default because they might
# be Korean translations rather than kernel modules.
# \.ko$
\.ko\.cmd$
\.mod\.c$
(^|/)\.tmp_versions($|/)
(^|/)CVS($|/)
(^|/)RCS($|/)
~$
#(^|/)\.[^/]
(^|/)_darcs($|/)
\.bak$
\.BAK$
\.orig$
(^|/)vssver\.scc$
\.swp$
(^|/)MT($|/)
(^|/)\{arch\}($|/)
(^|/).arch-ids($|/)
(^|/),
\.class$
\.prof$
(^|/)\.DS_Store$
(^|/)BitKeeper($|/)
(^|/)ChangeSet($|/)
(^|/)\.svn($|/)
\.py[co]$
\#
\.cvsignore$
(^|/)Thumbs\.db$
^PRIVATE
{- The purpose of this is to test that record update is
sufficiently polymorphic. See comments with
tcExpr (RecordUpd) in TcExpr.lhs
-}
module Main where
data T a b c d = MkT1 { op1 :: a, op2 :: b }
| MkT2 { op1 :: a, op3 :: c }
| MkT3 { op4 :: a, op5 :: d }
update1 :: a2 -> T a b c d -> T a2 b c d2
update1 x t = t { op1 = x }
-- NB: the MkT3.op4 case doesn't constrain the result because
-- it doesn't have an op1 field
update2 :: a2 -> T a b c d -> T a2 b2 c2 d
update2 x t = t { op4 = x }
main = print (op4 $
update2 True $
MkT3 { op4 = op2 $
update1 (1::Int) $
MkT1 { op1 = True }
})
TOP = ../../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
-- This test checks that constructors with strictness annotations
-- at least parse correctly. In GHC 2.02 they didn't!
module Main where
data Foo1 = Crunch1 ! Int ! Int Int deriving( Show )
data Foo2 = Crunch2 ! Int Int Int deriving( Show )
main = do
print (Crunch1 (1+1) (2+2) (3+3))
print (Crunch2 (1+1) (2+2) (3+3))
TOP = ../../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
The NoFib Haskell benchmark suite, version 2.01, patchlevel 0
......@@ -29,3 +29,4 @@ you'll need to get hold of Cachegrind, which is part of Valgrind
There are some options you might want to tweak; search for nofib in
../mk/config.mk, and override settings in ../mk/build.mk as usual.
TOP = ../..
include $(TOP)/mk/boilerplate.mk
SUBDIRS = nfib nfib_overloaded
include $(TARGET_MK)
--!!! the ultra-notorious "nfib 30"
--
module Main (main) where
main = print (nfib 30)
nfib :: Int -> Int
nfib n = if n <= 1 then 1 else nfib (n-1) + nfib (n-2) + 1
TOP = ../..
include $(TOP)/mk/boilerplate.mk
-include opts.mk
include $(TOP)/mk/target.mk
nfib n = 1, n<= 1
= 1 + nfib (n-1) + nfib (n-2), otherwise
--!!! the ultra-notorious "nfib 30" (overloaded arithmetic)
--
module Main (main) where
main = print (nfib 30)
nfib 0 = 1
nfib 1 = 1
nfib n = nfib (n - 2) + nfib (n - 1) + 1
TOP = ../..
include $(TOP)/mk/boilerplate.mk
-include opts.mk
include $(TOP)/mk/target.mk
-- Now you want to recompile Channel,ChannelVar, Merge,SampleVar,Semaphore
-- to use this module rather than the the Concurrent module...
-- I ignore the fact that the file handling stuff needs MVars too, so maybe
-- we should be replacing PrelConc in the longrun! The dependencies will be
-- fun to sort out though.
module Distributed
( PEId -- abstract
, Immobile -- abstract class
, myPEId -- :: IO PEId
, allPEId -- :: IO [PEId]
, owningPE -- :: a -> IO PEId
, revalIO -- :: IO a -> b -> IO a -- (b is PEId, MVar, ThreadId)
, on -- :: a -> PEId -> a
, mainPE -- :: PEId
, ThreadId -- abstract
, killThread -- :: ThreadId -> IO ()
, raiseInThread -- :: ThreadId -> Exception -> IO ()
, yield -- :: IO ()
, threadDelay -- :: Int -> IO ()
, myThreadId -- :: IO ThreadId
, forkIO -- :: IO () -> IO ThreadId
, rforkIO -- :: IO () -> PEId -> IO ThreadId
, MVar -- abstract
, newMVar -- :: a -> IO (MVar a)
, newEmptyMVar -- :: IO (MVar a)
, takeMVar -- :: MVar a -> IO a
, putMVar -- :: MVar a -> a -> IO ()
, readMVar -- :: MVar a -> IO a
, swapMVar -- :: MVar a -> a -> IO a
, isEmptyMVar -- :: MVar a -> IO Bool
, tryPutMVar -- :: MVar a -> a -> IO Bool
, takeMaybeMVar -- :: MVar a -> IO (Maybe a)
) where
import PrelDistributed
import Concurrent (ThreadId, MVar, forkIO, yield, threadDelay, myThreadId, newMVar, newEmptyMVar)
import qualified Concurrent
import qualified PrelConc
import Exception ( Exception(..),ArithException(..), AsyncException(..))
import qualified Exception
import PrelPack (packString)
import qualified PrelIOBase
import PrelAddr (Addr)
---------------------------
-- basic PEId stuff
myPEId :: IO PEId
myPEId = do
p <- _ccall_ cGetMyPEId
return (PEId p)
allPEId :: IO [PEId]
allPEId = do
(cnt :: Int) <- _ccall_ cGetPECount
let getPE (n :: Int) = do
p <- _ccall_ cGetPEId n
return (PEId p)
mapM getPE [1..cnt]
instance Show PEId where
showsPrec _ (PEId p) s = ("PE:"++(show p)) ++ s
---------------------------
-- basic immobile resources stuff
class Immobile a where
owningPE :: a -> IO PEId
revalIO :: IO b -> a -> IO b
revalIO job x = do
p <- owningPE x
doRevalIO job p
owningPE x = primGetCertainOwner x
-- General GpH Problems:
-- 1 - signal handlers not installed... so can't catch div-by-zero yet
data Status a = Okay a | Fail Exception
doRevalIO :: IO a -> PEId -> IO a
doRevalIO job p = do
i <- myPEId
if p==i
then job -- keep it simple if its local
else do
primRevalIO result p
-- block until we know the result is Okay or not.
case result of
Okay r -> return r
Fail e -> Exception.throw e
where
-- we wrap job up to return an 'okay' result.
okayJob = do
r <- job
return (Okay r)
-- if something goes wrong we return a 'Fail' result.
safeJob = Exception.catch okayJob (\e -> return (Fail e))
-- we return the result via a single variable so we can
-- use GpH's synchronisation mechanisms ie FETCHME, BQ, etc. (hackity, hack.)
result = PrelIOBase.unsafePerformIO safeJob
---------------------------
-- utility functions
on :: a -> PEId -> a
on x p = PrelIOBase.unsafePerformIO (revalIO (x `seq` return x) p)
mainPE :: PEId
mainPE = (PEId (PrelIOBase.unsafePerformIO (_ccall_ cGetPEId (1::Int))))
---------------------------
-- immobile PEIds - well it fits in nicely :)
instance Immobile PEId where
owningPE p = return p
---------------------------
-- immobile MVars
instance Immobile (MVar a)
---------------------------
-- immobile ThreadIds
-- The big issue is should the reval thread have the same threadId as its parent?
-- I think we should say NO! If you want to know your parents Id then let the
-- programmer pass it explicitly. Why make my life hard!
-- This opinion could require rethinking later...
instance Immobile ThreadId
---------------------------
-- immobile Host Names (RFP playing around)
instance Immobile ([Char]) where
owningPE h = do
p <- _ccall_ cGetHostOwner (packString h)
case p of
0 -> error "no such host"
_ -> return (PEId p)
---------------------------
-- forking stuff
rforkIO :: IO () -> PEId -> IO ThreadId
rforkIO job p = revalIO (forkIO job) p
---------------------------
-- killing
killThread :: ThreadId -> IO ()
killThread th = revalIO (Concurrent.killThread th) th
raiseInThread :: ThreadId -> Exception -> IO ()
raiseInThread th ex = revalIO (Concurrent.raiseInThread th ex) th
---------------------------
-- MVAR primitives
takeMVar :: MVar a -> IO a
takeMVar mv = revalIO (Concurrent.takeMVar mv) mv
putMVar :: MVar a -> a -> IO ()
putMVar mv r = revalIO (Concurrent.putMVar mv r) mv
readMVar :: MVar a -> IO a
readMVar mv = revalIO (Concurrent.readMVar mv) mv
swapMVar :: MVar a -> a -> IO a
swapMVar mv r = revalIO (Concurrent.swapMVar mv r) mv
isEmptyMVar :: MVar a -> IO Bool
isEmptyMVar mv = revalIO (Concurrent.isEmptyMVar mv) mv
tryPutMVar :: MVar a -> a -> IO Bool
tryPutMVar mv r = Exception.catch (do;putMVar mv r;return True) (\e->return False)
takeMaybeMVar :: MVar a -> IO (Maybe a)
takeMaybeMVar mv = revalIO (PrelConc.takeMaybeMVar mv) mv
Time-stamp: <Tue Apr 03 2001 01:37:07 Stardate: [-30]6425.12 hwloidl>
This directory contains very simple GdH test programs.
GdH, Glasgow distributed Haskell, is an extension of Haskell98 for executing
programs on a network of machines, each running an instance of the
distributed runtime-system (RTS). The RTS ("sticky GUM") is an extension
of the parallel RTS (GUM) adding explicit task placement. GdH uses
a virtual shared heap and implicit communication. For more details see
http://www.cee.hw.ac.uk/~dsg/gdh
At the moment GdH is still in an experimental stage.
The compiler should know about a way "md" for building the distributed
version of the RTS (no modifications in the compiler are necessary).
This whole subdir needs integration into the nofib build machinery.
At the moment they are standalone makefiles.
If you want to play with them:
- Do a make all in the GdH dir for building modified versions of some
libraries.
- Go into one of the other dirs, containing one file test programs, and
do a make (prbly have to add -i../GdH)
module Main(main) where
import Distributed
import System.Environment
import System.IO
data Link a = Link (MVar a) (MVar ())
instance Immobile (Link a) where
owningPE (Link i o) = owningPE i
newLink :: IO (Link a)
newLink = do
i <- newEmptyMVar
o <- newMVar ()
return (Link i o)
readLink :: Link a -> IO a
readLink (Link i o) = do
v <- takeMVar i
putMVar o ()
return v
writeLink :: Link a -> a -> IO ()
writeLink (Link i o) v = do
takeMVar o
putMVar i v
main = do
putStrLn "Chain..."
pes <- allPEId
o <- newLink
let spawn p = do
i <- newLink
let work = do
v <- readLink i
writeLink o ((v*2),p)
work
forkIO work
return i
is <- mapM (\p -> revalIO (spawn p) p) pes
let
work 0 = return True
work n = do
writeLink (is!!(n `mod` (length is))) n
(v,p) <- readLink o
if v==(n*2)
then do
putStrLn "Okay"
work (n-1)
else do
putStrLn ("ERROR: "++show p++" says 2*"++show n++"="++ show v)
return False
rs <- work ((length pes)*6)
if rs
then putStrLn "Test PASSED"
else putStrLn "Test FAILED"
return ()
{-
*Creates a slave thread on each PE which has the job of reading a number and returning
double the result.
*Tests MVar communication, and thread creation.
-}
module Main(main) where
import Distributed
import System
import Exception
main = do
putStrLn "Error test..."
pes <- allPEId
m <- newEmptyMVar
let
work p = catch (revalIO remote p) fails
remote = do
i <- myPEId
mo <- owningPE m
putMVar m (if i==mo then "Owner" else "Other")
return True
fails PutFullMVar = do
name <- takeMVar m
putStrLn ("Writer= "++name)
return True
fails e = do
putStrLn ("Error: "++show e)
return False
rs <- mapM work pes
catch (putMVar m "Main") (\e-> return ())
name <- takeMVar m
putStrLn ("Writer= "++name)
if rs==(replicate (length pes) True)
then putStrLn "Test PASSED"
else putStrLn "Test FAILED"
{-
* tests the handling of remote exceptions.
-}
\ No newline at end of file
module Main(main) where
import Distributed
import System.Environment
import Data.List
import System.IO
import System.Time
import PrelNum
-- we are only interested in ms accuracy < 60 seconds
runTime :: ClockTime -> ClockTime -> Int
runTime t1 t2 =
let
TimeDiff _ _ d h m s p = diffClockTimes t1 t2
(dp,mp) = divModInteger p 1000000000
b = integer2Int dp
(nb,es) = if(b<0) then (b+1000,s-1) else (b,s)
ns = if(es<0) then es+60 else es
in nb+1000*ns
timeit :: IO a -> IO (a, Int)
timeit job = do
start <- getClockTime
res <- job
done <- getClockTime
return (res,(runTime done start))
type PeNames = [(PEId,[String])]
host2pe :: PeNames -> String -> PEId
host2pe pns n =
case (filter (\(p,xs) -> elem n xs) pns) of
[(p,_)] -> p
_ -> error "unknown Host"
pe2host :: PeNames -> PEId -> String
pe2host pns t =
case (filter (\(p,xs) -> p==t) pns) of
[(_,h:_)] -> h
_ -> error "unknown PEId"
peNames :: IO PeNames
peNames = do
pes@(m:_) <- allPEId
let work p = do
n <- revalIO (getEnv "HOST") p
return (p,n)
ws <- mapM work pes
let
us = map (\n -> (n,0)) (nub (map (\(_,n)->n) ws))
reduce = foldl (\acc (t,x) -> if t then (acc++[x]) else acc) []
unique (us,acc) (p,n) = (nus,acc++[(p,nn)])
where
(nus,nn) = loop us
loop ((x,c):t) =
if x==n
then ((x,c+1):t, reduce [(p==m,"MainPE"),(c==0,x),(True,(show c)++"@"++x)])
else let (rt,rn) = (loop t) in ((x,c):rt,rn)
(_,ns) = foldl unique (us,[]) ws
return ns
main = do
pes <- allPEId
putStrLn "PE Names..."
ns <- peNames
mapM (\x -> putStrLn (show x)) ns
putStrLn "\nTiming..."
let
timePing p = do
putStr ("Pinging "++(pe2host ns p)++" ... ")
(_,ms) <- timeit (revalIO (return ()) p)
putStrLn (" time="++show ms++"ms")
mapM timePing pes
return ()
{-
* Generates unique and meaningful names for each PE, then times communication.
* Tests remote host lookup and timing.
-}
import Distributed
import System.Environment
import System.IO
main = do
putStrLn "Place Test..."
pes <- allPEId
let
tot = length pes
check mv = do
i <- myPEId
o <- owningPE mv
return (i,o)
same = map (\(x,y) -> x==y)
test n = (replicate n False)++[True]++(replicate (tot-1-n) False)
loop n = do
let pe = pes!!n
mv <- revalIO (newEmptyMVar) pe
rs <- mapM (\p -> revalIO (check mv) p) pes
if (same rs)==(test n)
then do
putStrLn "Okay"
return True
else do
putStrLn ("ERROR: MVar should be located at "++show pe ++". Results "++show rs)
return False
rs <- mapM loop [0..tot-1]
if rs==(replicate tot True)
then putStrLn "Test PASSED"
else putStrLn "Test FAILED"
return ()
{-
* Creates an MVar on each PE and then checks that it can be correctly
located from all other PEs.
* Tests owningPE on MVars.
-}
#ifndef GhcVersionInUse
# define GhcVersionInUse 27
#endif
#if GhcVersionInUse >= 19
# define if19plus(x) x
#else
# define if19plus(x) /*nothing*/
#endif
#if GhcVersionInUse >= 24
# define if24plus(x) x
#else
# define if24plus(x) /*nothing*/
#endif
#if GhcVersionInUse >= 27
# define if27plus(x) x