Commit 0190c472 authored by simonm's avatar simonm
Browse files

[project @ 1999-02-10 17:02:56 by simonm]

- remove some unnecessary -H options
- reduce the default -H to 10M for all runs
- enable circsim
- some H98 updates
parent bf9d9e15
TOP = ../..
include $(TOP)/mk/boilerplate.mk
SRC_RUNTEST_OPTS += +RTS -H20m -K10m -RTS
include $(TOP)/mk/target.mk
......@@ -4,7 +4,7 @@ include $(TOP)/mk/boilerplate.mk
# Override default SRCS; the default is all source files, but
# we don't want to include paraffins.c
SRCS=Main.hs
SRC_RUNTEST_OPTS += +RTS -K4m -H20m -RTS
SRC_RUNTEST_OPTS += +RTS -H20m -RTS
include $(TOP)/mk/target.mk
......@@ -4,8 +4,5 @@ include $(TOP)/mk/boilerplate.mk
# Override default SRCS, or we get cseive.c as well.
SRCS = Main.hs
# Need big heap to run
SRC_RUNTEST_OPTS += +RTS -H16m -RTS
include $(TOP)/mk/target.mk
TOP = ../..
include $(TOP)/mk/boilerplate.mk
SRC_RUNTEST_OPTS += +RTS -K600k -H30m -RTS
include $(TOP)/mk/target.mk
......@@ -2,7 +2,7 @@
#
# nofib/mk/opts.mk
#
# $Id: opts.mk,v 1.3 1998/10/21 16:47:47 sof Exp $
# $Id: opts.mk,v 1.4 1999/02/10 17:03:01 simonm Exp $
#
#################################################################################
......@@ -15,7 +15,7 @@
RUNTEST_OPTS = $(SRC_RUNTEST_OPTS) $(WAY$(_way)_RUNTEST_OPTS) \
$($(NOFIB_PROG)_RUNTEST_OPTS) $(EXTRA_RUNTEST_OPTS)
SRC_RUNTEST_OPTS += -ghc-timing +RTS -H20m -K10m -RTS
SRC_RUNTEST_OPTS += -ghc-timing +RTS -H10m -K10m -RTS
#-----------------------------------------------------------------------------
# Setting for Haskell compiler
......
TOP = ../..
include $(TOP)/mk/boilerplate.mk
#
HS_SRCS = Main.hs
SRC_HC_OPTS += -H12m
SRC_RUNTEST_OPTS += -i big_big_test.hs
include $(TOP)/mk/target.mk
......@@ -13,6 +13,7 @@ where
import Maybes
import Char
import Lex
import Monad
import PI
import Ids
......@@ -59,14 +60,14 @@ paOp = llitp "Op" (\ cs -> and [not (isAlphanum' c) && not(isDel c) | c <- cs])
paFnLikeDef :: Bool -> PIS Id
paFnLikeDef def =
do { cs <- paFn; makeidS def cs Fn Fn }
++ do { n <- paNat; makenatS def n }
++ do { cs <- paParen paOp; makeidS def cs Op Fn }
do { cs <- paFn; makeidS def cs Fn Fn }
`mplus` do { n <- paNat; makenatS def n }
`mplus` do { cs <- paParen paOp; makeidS def cs Op Fn }
paOpLikeDef :: Bool -> PIS Id
paOpLikeDef def =
do { cs <- paOp; makeidS def cs Op Op }
++ do { cs <- paBackq paFn; makeidS def cs Fn Op }
do { cs <- paOp; makeidS def cs Op Op }
`mplus` do { cs <- paBackq paFn; makeidS def cs Fn Op }
-- normally, don't create identifiers
......@@ -80,15 +81,15 @@ paOpLike = paOpLikeDef False
paCApp :: PIS Exp
-- a closed (parenthesised) expression
paCApp =
do { xs <- paBrace (paCommas paExp); return (Coll CSet xs) }
++ do { xs <- paBracket (paCommas paExp); return (Coll CList xs) }
++ do { xs <- paParen (paCommas paExp)
; case xs of [x] -> return x; _ -> return (Coll CTuple xs)
}
++ do { x <- paFnLike
; x' <- putarityS (idname x) 0
; return (App x' [])
}
do { xs <- paBrace (paCommas paExp); return (Coll CSet xs) }
`mplus` do { xs <- paBracket (paCommas paExp); return (Coll CList xs) }
`mplus` do { xs <- paParen (paCommas paExp)
; case xs of [x] -> return x; _ -> return (Coll CTuple xs)
}
`mplus` do { x <- paFnLike
; x' <- putarityS (idname x) 0
; return (App x' [])
}
stairway :: Exp -> [Exp] -> PIS Exp
stairway x xs =
......@@ -139,17 +140,17 @@ papp id args =
paExp :: PIS Exp
-- sequence App op App op ... App
paExp =
do { x <- paApp ++ paMCApp
do { x <- paApp `mplus` paMCApp
; xs <- paExpRest
; return (glue (Left x : xs))
}
-- we store Left App, Right op (these are Ids in fact)
paExpRest =
do { op <- paOpLike; arg <- paApp ++ paMCApp; rest <- paExpRest
do { op <- paOpLike; arg <- paApp `mplus` paMCApp; rest <- paExpRest
; return (Right op : Left arg : rest)
}
++ return []
`mplus` return []
------------------------------------------------------------------
......@@ -165,11 +166,11 @@ paCmd =
}
++ do { llit "unlocal"
; poplocals
}
`mplus` do { llit "unlocal"
; poplocals
}
++ do { llit "global"
`mplus` do { llit "global"
-- bit of trickery here: open new local group, read ids
; pushlocals
......@@ -181,30 +182,30 @@ paCmd =
; poplocals
}
++ do { llit "infix"; n <- paNat; ops <- paCommas paOpLike
; sequence [ putprecS (idname op) n Nn | op <- ops ]
}
++ do { llit "infixl"; n <- paNat; ops <- paCommas paOpLike
; sequence [ putprecS (idname op) n Lft | op <- ops ]
}
++ do { llit "infixr"; n <- paNat; ops <- paCommas paOpLike
; sequence [ putprecS (idname op) n Rght | op <- ops ]
}
`mplus` do { llit "infix"; n <- paNat; ops <- paCommas paOpLike
; sequence_ [ putprecS (idname op) n Nn | op <- ops ]
}
`mplus` do { llit "infixl"; n <- paNat; ops <- paCommas paOpLike
; sequence_ [ putprecS (idname op) n Lft | op <- ops ]
}
`mplus` do { llit "infixr"; n <- paNat; ops <- paCommas paOpLike
; sequence_ [ putprecS (idname op) n Rght | op <- ops ]
}
-- obsolete?
++ do { llit "arity"; n <- paNat; fns <- paCommas paFnLike
; sequence [ putarityS (idname fn) n | fn <- fns ]
}
++ do { llit "form"; fn <- paFnLike
; do { llit "="; cs <- paString
; putformS (idname fn) (Passive cs)
}
++ do{ n <- paNat; llit "="; cs <- paString
; putformS (idname fn) (Active n cs)
}
; return ()
}
`mplus` do { llit "arity"; n <- paNat; fns <- paCommas paFnLike
; sequence_ [ putarityS (idname fn) n | fn <- fns ]
}
`mplus` do { llit "form"; fn <- paFnLike
; do { llit "="; cs <- paString
; putformS (idname fn) (Passive cs)
}
`mplus` do{ n <- paNat; llit "="; cs <- paString
; putformS (idname fn) (Active n cs)
}
; return ()
}
......@@ -214,7 +215,7 @@ paCmd =
--paTop :: PIS (Maybe Exp)
paTop =
do { paCmd ; return Nothing }
++ do { x <- paExp ; opt (llit ";"); return (Just x) }
`mplus` do { x <- paExp ; opt (llit ";"); return (Just x) }
-------------------------------------------------------------------
......
......@@ -113,9 +113,9 @@ tnfa2grammar opts name b @ (TNFA consb allb startsb movesb) =
; let h = listToFM n
; let c @ (TNFA consc allc startsc movesc) =
mapTNFA opts (lookupWithDefaultFM h (error "tnfa2grammar.c")) b
; sequence [ push (v, Right t)
; sequence_ [ push (v, Right t)
| (v, ts) <- fmToList movesc, t <- setToList ts ]
; sequence [ push (name, Left s) | s <- setToList startsc ]
; sequence_[ push (name, Left s) | s <- setToList startsc ]
}
--------------------------------------------------------------------------
......@@ -123,7 +123,7 @@ tnfa2grammar opts name b @ (TNFA consb allb startsb movesb) =
mkgs :: Opts -> Env (Auto) (Auto) -> Set String -> Exp -> [(String, Exp)]
-> MK String
mkgs opts env vars x rs =
do { sequence (map (mkg opts env vars) rs)
do { sequence_ (map (mkg opts env vars) rs)
; start <- gensym
; mkg opts env vars (start, x)
; return start
......@@ -142,7 +142,7 @@ mkg opts env vars (name, App id []) =
push (name, Left (idname id))
mkg opts env vars (name, App id xs) | idname id == "++" =
sequence [ do { nx <- gensym
sequence_ [ do { nx <- gensym
; push (name, Left nx)
; mkg opts env vars (nx, x)
}
......
......@@ -34,7 +34,7 @@ recomment (c : cs) = recomment cs
-- treat TeX operators
updown c = c `elem` "_^'"
isAlphanum' c = isAlphanum c || updown c
isAlphanum' c = isAlphaNum c || updown c
-------------------------------------------------------
......
--%
--% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
-- %
-- % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
-- with changes by myself (joe@informatik.uni-jena.de)
--%
--\section[Maybes]{The `Maybe' types and associated utility functions}
-- %
-- \section[Maybes]{The `Maybe' types and associated utility functions}
--
......@@ -49,20 +49,20 @@ the (Just x) = x; the Nothing = error "the"
--
--
--%************************************************************************
--%* *
--\subsection[Maybe type]{The @Maybe@ type}
--%* *
--%************************************************************************
-- %************************************************************************
-- %* *
-- \subsection[Maybe type]{The @Maybe@ type}
-- %* *
-- %************************************************************************
--
maybeToBool :: Maybe a -> Bool
maybeToBool Nothing = False
maybeToBool (Just x) = True
--
--@catMaybes@ takes a list of @Maybe@s and returns a list of
--the contents of all the @Just@s in it. @allMaybes@ collects
--a list of @Justs@ into a single @Just@, returning @Nothing@ if there
--are any @Nothings@.
-- @catMaybes@ takes a list of @Maybe@s and returns a list of
-- the contents of all the @Just@s in it. @allMaybes@ collects
-- a list of @Justs@ into a single @Just@, returning @Nothing@ if there
-- are any @Nothings@.
--
......@@ -73,8 +73,8 @@ allMaybes (Just x : ms) = case (allMaybes ms) of
Nothing -> Nothing
Just xs -> Just (x:xs)
--
--@firstJust@ takes a list of @Maybes@ and returns the
--first @Just@ if there is one, or @Nothing@ otherwise.
-- @firstJust@ takes a list of @Maybes@ and returns the
-- first @Just@ if there is one, or @Nothing@ otherwise.
--
firstJust :: [Maybe a] -> Maybe a
firstJust [] = Nothing
......@@ -92,8 +92,8 @@ expectJust :: String -> Maybe a -> a
expectJust err (Just x) = x
expectJust err Nothing = error ("expectJust " ++ err)
--
--The Maybe monad
--~~~~~~~~~~~~~~~
-- The Maybe monad
-- ~~~~~~~~~~~~~~~
seqMaybe :: Maybe a -> Maybe a -> Maybe a
seqMaybe (Just x) _ = Just x
seqMaybe Nothing my = my
......@@ -104,11 +104,11 @@ returnMaybe = Just
failMaybe :: Maybe a
failMaybe = Nothing
--
--Lookup functions
--~~~~~~~~~~~~~~~~
-- Lookup functions
-- ~~~~~~~~~~~~~~~~
--
--@assocMaybe@ looks up in an assocation list, returning
--@Nothing@ if it fails.
-- @assocMaybe@ looks up in an assocation list, returning
-- @Nothing@ if it fails.
--
assocMaybe :: (Eq a) => [(a,b)] -> a -> Maybe b
......@@ -120,10 +120,10 @@ assocMaybe alist key
--
--@mkLookupFun eq alist@ is a function which looks up
--its argument in the association list @alist@, returning a Maybe type.
--@mkLookupFunDef@ is similar except that it is given a value to return
--on failure.
-- @mkLookupFun eq alist@ is a function which looks up
-- its argument in the association list @alist@, returning a Maybe type.
-- @mkLookupFunDef@ is similar except that it is given a value to return
-- on failure.
--
mkLookupFun :: (key -> key -> Bool) -- Equality predicate
-> [(key,val)] -- The assoc list
......@@ -146,12 +146,12 @@ mkLookupFunDef eq alist deflt s
[] -> deflt
(a:_) -> a
--
--%************************************************************************
--%* *
--\subsection[MaybeErr type]{The @MaybeErr@ type}
--%* *
--%************************************************************************
--
-- %************************************************************************
-- %* *
-- \subsection[MaybeErr type]{The @MaybeErr@ type}
-- %* *
-- %************************************************************************
--
data MaybeErr val err = Succeeded val | Failed err
--
thenMaB :: MaybeErr val1 err -> (val1 -> MaybeErr val2 err) -> MaybeErr val2 err
......@@ -167,9 +167,9 @@ failMaB :: err -> MaybeErr val err
failMaB e = Failed e
--
--
--@listMaybeErrs@ takes a list of @MaybeErrs@ and, if they all succeed, returns
--a @Succeeded@ of a list of their values. If any fail, it returns a
--@Failed@ of the list of all the errors in the list.
-- @listMaybeErrs@ takes a list of @MaybeErrs@ and, if they all succeed, returns
-- a @Succeeded@ of a list of their values. If any fail, it returns a
-- @Failed@ of the list of all the errors in the list.
--
listMaybeErrs :: [MaybeErr val err] -> MaybeErr [val] [err]
listMaybeErrs
......@@ -180,9 +180,9 @@ listMaybeErrs
combine (Succeeded v) (Failed errs) = Failed errs
combine (Failed err) (Failed errs) = Failed (err:errs)
--
--@foldlMaybeErrs@ works along a list, carrying an accumulator; it
--applies the given function to the accumulator and the next list item,
--accumulating any errors that occur.
-- @foldlMaybeErrs@ works along a list, carrying an accumulator; it
-- applies the given function to the accumulator and the next list item,
-- accumulating any errors that occur.
--
foldlMaybeErrs :: (acc -> input -> MaybeErr acc err)
-> acc
......
......@@ -29,6 +29,7 @@ where
import Options
import Ids
import Monad
import IdStack
......@@ -48,7 +49,7 @@ type PIS v = PY (Opts, IdStack) v
------------------------------------------------------------------------
instance Functor (PY a) where
map f (PY p) = PY (\ x ->
fmap f (PY p) = PY (\ x ->
p x `act` (\ (v, x) -> (f v, x)))
instance Monad (PY a) where
......@@ -56,11 +57,9 @@ instance Monad (PY a) where
PY p >>= g = PY (\ x ->
p x `into` (\ (v, x') -> unPY (g v) x'))
instance MonadZero (PY a) where
zero = PY (\ x -> failP "PY.zero")
instance MonadPlus (PY a) where
(PY p) ++ (PY q) = PY ( \ x -> p x ||! q x )
mzero = PY (\ x -> failP "PY.zero")
(PY p) `mplus` (PY q) = PY ( \ x -> p x ||! q x )
--------------------------------------------------------------------------
......@@ -153,7 +152,7 @@ llit x = lift (lit x)
llitp msg p = lift (litp msg p)
lmany1 p = do { x <- p; xs <- lmany p; return (x : xs) }
lmany p = lmany1 p ++ return []
lmany p = lmany1 p `mplus` return []
p `lsepBy1` q =
do { x <- p
......@@ -161,10 +160,10 @@ p `lsepBy1` q =
; return (x : ys)
}
p `lsepBy` q = p `lsepBy1` q ++ return []
p `lsepBy` q = p `lsepBy1` q `mplus` return []
opt p = map Just p ++ return Nothing
opt p = fmap Just p `mplus` return Nothing
----------------------------------------------------------------------
......
......@@ -43,16 +43,16 @@ import FAcon
newtype FIO s = FIO (Either String s); unFIO (FIO n) = n
instance Functor FIO where
map f (FIO (Left l)) = FIO (Left l)
map f (FIO (Right r)) = FIO (Right (f r))
fmap f (FIO (Left l)) = FIO (Left l)
fmap f (FIO (Right r)) = FIO (Right (f r))
instance Monad FIO where
return x = FIO (Right x)
FIO (Left l) >>= f = FIO (Left l)
FIO (Right r) >>= f = f r
instance MonadZero FIO where
zero = FIO (Left "some error")
-- instance MonadPlus FIO where
-- mzero = FIO (Left "some error")
oops :: String -> FIO a
oops cs = FIO (Left cs)
......
......@@ -16,7 +16,7 @@ dosym :: Sym (Int, [s]) a -> (a, [s])
dosym (Sym f) = let ((_, x), r) = f (0, []) in (r, x)
instance Functor (Sym s) where
map f (Sym s) = Sym (\ c ->
fmap f (Sym s) = Sym (\ c ->
let (d, a) = s c in (d, f a) )
instance Monad (Sym s) where
......
TOP = ../..
include $(TOP)/mk/boilerplate.mk
SRC_HC_OPTS += -cpp
EXTRA_RUNTEST_OPTS += +RTS -H60m -RTS
EXTRA_RUNTEST_OPTS += +RTS -M140m -RTS
include $(TOP)/mk/target.mk
......@@ -2,7 +2,7 @@ TOP = ..
include $(TOP)/mk/boilerplate.mk
SUBDIRS = \
ansi awards banner boyer boyer2 calendar cichelli clausify cse \
ansi awards banner boyer boyer2 calendar cichelli circsim clausify cse \
eliza expert fibheaps fish fft2 hartel life knights mandel mandel2 \
minimax multiplier pretty primetest rewrite scc simple sorting treejoin
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment