Commit 4e6d0831 authored by simonm's avatar simonm
Browse files

[project @ 1999-01-15 15:57:33 by simonm]

Haskell 98 updates.
parent a31a5772
......@@ -178,4 +178,14 @@ import qualified FastString
# define _CONCAT_ concat
#endif
#if __HASKELL1__ > 4
#define FMAP fmap
#define ISALPHANUM isAlphaNum
#define IOERROR ioError
#else
#define FMAP map
#define ISALPHANUM isAlphanum
#define IOERROR fail
#endif
#endif
......@@ -37,9 +37,7 @@ import CStrings ( stringToC, charToC, charToEasyHaskell )
import Outputable
import Util ( thenCmp )
#if __HASKELL1__ > 4
import Ratio (numerator, denominator)
#endif
import Ratio ( numerator, denominator )
\end{code}
......
......@@ -38,12 +38,6 @@ module OccName (
#include "HsVersions.h"
#if __HASKELL1__ > 4
#define ISALPHANUM isAlphaNum
#else
#define ISALPHANUM isAlphanum
#endif
import Char ( isAlpha, isUpper, isLower, ISALPHANUM, ord )
import Util ( thenCmp )
import FiniteMap ( FiniteMap, emptyFM, lookupFM, addToFM, elemFM )
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgClosure.lhs,v 1.21 1998/12/18 17:40:49 simonpj Exp $
% $Id: CgClosure.lhs,v 1.22 1999/01/15 15:57:36 simonm Exp $
%
\section[CgClosure]{Code generation for closures}
......@@ -438,9 +438,9 @@ Node is guaranteed to point to it, if profiling and not inherited.
\begin{code}
data IsThunk = IsThunk | IsFunction -- Bool-like, local
--#ifdef DEBUG
-- #ifdef DEBUG
deriving Eq
--#endif
-- #endif
enterCostCentreCode :: ClosureInfo -> CostCentreStack -> IsThunk -> Code
......
......@@ -435,7 +435,7 @@ motherShip :: IO SockAddr
motherShip = do
he <- getHostByName "laysan.dcs.gla.ac.uk"
case (hostAddresses he) of
[] -> fail (userError "No address!")
[] -> IOERROR (userError "No address!")
(x:_) -> return (SockAddrInet motherShipPort x)
--magick
......
......@@ -36,7 +36,7 @@ module MachMisc (
) where
#include "HsVersions.h"
--#include "config.h"
-- #include "config.h"
import AbsCSyn ( MagicId(..) )
import AbsCUtils ( magicIdPrimRep )
......
......@@ -1402,14 +1402,14 @@ catch :: a -> (b -> a) -> a
\begin{code}
primOpInfo CatchOp
= let
a = alphaTy; a_tv = alphaTyVar;
a = alphaTy; a_tv = alphaTyVar
b = betaTy; b_tv = betaTyVar;
in
mkGenPrimOp SLIT("catch#") [a_tv, b_tv] [a, mkFunTy b a] a
primOpInfo RaiseOp
= let
a = alphaTy; a_tv = alphaTyVar;
a = alphaTy; a_tv = alphaTyVar
b = betaTy; b_tv = betaTyVar;
in
mkGenPrimOp SLIT("raise#") [a_tv, b_tv] [a] b
......
......@@ -33,6 +33,10 @@ import Maybes
import Outputable
import GlaExts
#if __HASKELL1__ > 4
import Ratio ( (%) )
#endif
}
%name parseIface
......
......@@ -38,7 +38,6 @@ import SrcLoc ( SrcLoc, noSrcLoc )
import Outputable
import Util ( removeDups )
import List ( nub )
import Char ( isAlphanum )
\end{code}
......
......@@ -436,13 +436,13 @@ getAllFilesMatching dirs hims (dir_path, suffix) = ( do
hi_boot_xiffus = "toob-ih." -- .hi-boot reversed.
addModules his@(hi_env, hib_env) nm = fromMaybe his $
map (\ (mod_nm,v) -> (addToFM_C addNewOne hi_env mod_nm v, hib_env))
FMAP (\ (mod_nm,v) -> (addToFM_C addNewOne hi_env mod_nm v, hib_env))
(go xiffus rev_nm) `seqMaybe`
map (\ (mod_nm,v) -> (hi_env, addToFM_C overrideNew hib_env mod_nm v))
FMAP (\ (mod_nm,v) -> (hi_env, addToFM_C overrideNew hib_env mod_nm v))
(go hi_boot_version_xiffus rev_nm) `seqMaybe`
map (\ (mod_nm,v) -> (hi_env, addToFM_C addNewOne hib_env mod_nm v))
FMAP (\ (mod_nm,v) -> (hi_env, addToFM_C addNewOne hib_env mod_nm v))
(go hi_boot_xiffus rev_nm)
where
rev_nm = reverse nm
......
......@@ -72,6 +72,8 @@ import Bag
import Maybes
import IO ( hPutStr, stderr )
import Outputable
import Ratio ( numerator, denominator )
\end{code}
\begin{code}
......
......@@ -965,10 +965,10 @@ mkCallUDs f args
plusUDs :: UsageDetails -> UsageDetails -> UsageDetails
plusUDs (MkUD {dict_binds = db1, calls = calls1})
(MkUD {dict_binds = db2, calls = calls2})
= MkUD {dict_binds, calls}
= MkUD {dict_binds = d, calls = c}
where
dict_binds = db1 `unionBags` db2
calls = calls1 `unionCalls` calls2
d = db1 `unionBags` db2
c = calls1 `unionCalls` calls2
plusUDList = foldr plusUDs emptyUDs
......
......@@ -281,7 +281,7 @@ failTc :: TcM s a
failTc down env = give_up
give_up :: IO a
give_up = fail (userError "Typecheck failed")
give_up = IOERROR (userError "Typecheck failed")
failWithTc :: Message -> TcM s a -- Add an error message and fail
failWithTc err_msg = failWithTcM (emptyTidyEnv, err_msg)
......
Supports Markdown
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