Commit 5d95275e authored by sof's avatar sof

[project @ 1999-01-18 19:38:27 by sof]

Misc (backward compatible) changes to make srcs acceptable
to a Haskell 98 compiler.
parent 8441d28d
--!!! Wentworth's version of a program to generate -- !!! Wentworth's version of a program to generate
--!!! all the expansions of a generalised regular expression -- !!! all the expansions of a generalised regular expression
--!!! -- !!!
-- --
module Main (main) where module Main (main) where
......
--!!! count the number of solutions to the "n queens" problem. -- !!! count the number of solutions to the "n queens" problem.
-- (grabbed from LML dist) -- (grabbed from LML dist)
main = print (nsoln 10) main = print (nsoln 10)
......
--!!! the ultra-notorious "nfib 30" does w/ Floats -- !!! the ultra-notorious "nfib 30" does w/ Floats
-- --
module Main (main) where module Main (main) where
......
...@@ -51,6 +51,13 @@ They were documented in earlier chapters (Part~\ref{part:modules}). ...@@ -51,6 +51,13 @@ They were documented in earlier chapters (Part~\ref{part:modules}).
> (=:) a b = (a,b) > (=:) a b = (a,b)
>#endif >#endif
#if __HASKELL1__ < 5
#define amap map
#else
#define amap fmap
#endif
\end{verbatim} \end{verbatim}
...@@ -288,7 +295,7 @@ definition stands for ``tied-mixture continuation.'' ...@@ -288,7 +295,7 @@ definition stands for ``tied-mixture continuation.''
> can't_read :: String -> String > can't_read :: String -> String
> can't_read file = " can't read the file " ++ file > can't_read file = " can't read the file " ++ file
> make_tm_table = map (\as -> array (1, length as) as) . > make_tm_table = amap (\as -> array (1, length as) as) .
> accumArray (flip (:)) [] phone_bounds > accumArray (flip (:)) [] phone_bounds
\end{haskell} \end{haskell}
......
...@@ -22,6 +22,13 @@ vectors. ...@@ -22,6 +22,13 @@ vectors.
> import HmmConstants > import HmmConstants
> import Array--1.3 > import Array--1.3
#if __HASKELL1__ < 5
#define amap map
#else
#define amap fmap
#endif
\end{haskell} \end{haskell}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
...@@ -343,7 +350,7 @@ for efficient retrieval. ...@@ -343,7 +350,7 @@ for efficient retrieval.
> eval_log_densities :: TmTable -> Vector -> LogDensityTable > eval_log_densities :: TmTable -> Vector -> LogDensityTable
> eval_log_densities tmt x = ldt > eval_log_densities tmt x = ldt
> where ldt = map (map eval_tied_mixture) tmt > where ldt = amap (amap eval_tied_mixture) tmt
> eval_tied_mixture (Gm gm) = eval_log_mixture x gm > eval_tied_mixture (Gm gm) = eval_log_mixture x gm
> eval_tied_mixture (Tie p k) = ldt!p!k > eval_tied_mixture (Tie p k) = ldt!p!k
......
...@@ -37,6 +37,12 @@ described in later chapters in Part~\ref{part:library}. ...@@ -37,6 +37,12 @@ described in later chapters in Part~\ref{part:library}.
> import Array--1.3 > import Array--1.3
> import Ix--1.3 > import Ix--1.3
#if __HASKELL1__ < 5
#define amap map
#else
#define amap fmap
#endif
\end{verbatim} \end{verbatim}
...@@ -655,7 +661,7 @@ the probabilities for all HMMs in an array. ...@@ -655,7 +661,7 @@ the probabilities for all HMMs in an array.
\begin{haskell}{get_log_probs} \begin{haskell}{get_log_probs}
> get_log_probs :: (Ix a) => Array a (HmmTsL b) -> Array a (HmmTsL b) > get_log_probs :: (Ix a) => Array a (HmmTsL b) -> Array a (HmmTsL b)
> get_log_probs = map convert_to_log_probs > get_log_probs = amap convert_to_log_probs
\end{haskell} \end{haskell}
......
...@@ -55,7 +55,7 @@ HS_OBJS = Alignments.o \ ...@@ -55,7 +55,7 @@ HS_OBJS = Alignments.o \
SRC_MKDEPENDHS_OPTS += -syslib misc SRC_MKDEPENDHS_OPTS += -syslib misc
SRC_RUNTEST_OPTS += -o2 HMMS.stderr hmms/h9 hmms/h9.ties hmms/h9.dgs sentences SRC_RUNTEST_OPTS += -o2 HMMS.stderr hmms/h9 hmms/h9.ties hmms/h9.dgs sentences
SRC_HC_OPTS += -fglasgow-exts -syslib misc SRC_HC_OPTS += -fglasgow-exts -syslib misc -cpp
MaybeStateT_HC_OPTS += -cpp MaybeStateT_HC_OPTS += -cpp
BatchAlign_HC_OPTS += -cpp BatchAlign_HC_OPTS += -cpp
......
--==========================================================-- -- ==========================================================--
--=== Concretisation of function points. ===-- -- === Concretisation of function points. ===--
--=== AbsConc3.hs ===-- -- === AbsConc3.hs ===--
--==========================================================-- -- ==========================================================--
module AbsConc3 where module AbsConc3 where
import BaseDefs import BaseDefs
...@@ -14,7 +14,7 @@ import AbstractMisc ...@@ -14,7 +14,7 @@ import AbstractMisc
import DomainExpr import DomainExpr
--==========================================================-- -- ==========================================================--
-- --
acUncurryWRT :: Domain -> Domain -> Domain acUncurryWRT :: Domain -> Domain -> Domain
-- small big -- small big
...@@ -48,7 +48,7 @@ acUncurryWRT (Func ds_s dt_s) (Func ds_b dt_b) ...@@ -48,7 +48,7 @@ acUncurryWRT (Func ds_s dt_s) (Func ds_b dt_b)
totally_fixed totally_fixed
--==========================================================-- -- ==========================================================--
-- --
acNormAndCurried :: Domain -> Domain -> (Domain, Domain) acNormAndCurried :: Domain -> Domain -> (Domain, Domain)
...@@ -57,7 +57,7 @@ acNormAndCurried small_d big_d ...@@ -57,7 +57,7 @@ acNormAndCurried small_d big_d
in (big_d_u, acUncurryWRT small_d big_d_u) in (big_d_u, acUncurryWRT small_d big_d_u)
--==========================================================-- -- ==========================================================--
-- big domain smaller domain -- big domain smaller domain
acCompatible :: Domain -> Domain -> Bool acCompatible :: Domain -> Domain -> Bool
-- --
...@@ -83,7 +83,7 @@ acCompatible _ _ ...@@ -83,7 +83,7 @@ acCompatible _ _
= False = False
--==========================================================-- -- ==========================================================--
-- --
acConc :: ACMode -> Domain -> Domain -> Route -> Route acConc :: ACMode -> Domain -> Domain -> Route -> Route
...@@ -105,7 +105,7 @@ acConc s_or_l big_d small_d small_r ...@@ -105,7 +105,7 @@ acConc s_or_l big_d small_d small_r
else acConcData s_or_l big_d_u small_d small_r else acConcData s_or_l big_d_u small_d small_r
--==========================================================-- -- ==========================================================--
-- big small -- big small
-- --
acConcData :: ACMode -> Domain -> Domain -> Route -> Route acConcData :: ACMode -> Domain -> Domain -> Route -> Route
...@@ -128,7 +128,7 @@ acConcData s_or_l (Lift2 dbs) (Lift2 dss) (UpUp2 rs) ...@@ -128,7 +128,7 @@ acConcData s_or_l (Lift2 dbs) (Lift2 dss) (UpUp2 rs)
= UpUp2 (myZipWith3 (acConc s_or_l) dbs dss rs) = UpUp2 (myZipWith3 (acConc s_or_l) dbs dss rs)
--==========================================================-- -- ==========================================================--
-- big_c big_u small -- big_c big_u small
acConcRep :: ACMode -> Domain -> Domain -> Domain -> Rep -> Rep acConcRep :: ACMode -> Domain -> Domain -> Domain -> Rep -> Rep
...@@ -146,7 +146,7 @@ acConcRep s_or_l big_d_c@(Func dss_b_c dt_b_c) ...@@ -146,7 +146,7 @@ acConcRep s_or_l big_d_c@(Func dss_b_c dt_b_c)
concd_all concd_all
--==========================================================-- -- ==========================================================--
-- Concretise target domain of a function. -- Concretise target domain of a function.
-- target_big rep_current -- target_big rep_current
acConcTarget :: ACMode -> Domain -> Domain -> Rep -> Rep acConcTarget :: ACMode -> Domain -> Domain -> Rep -> Rep
...@@ -235,7 +235,7 @@ acConcTarget ...@@ -235,7 +235,7 @@ acConcTarget
--==========================================================-- -- ==========================================================--
-- --
ac_increase_arity_safe :: Int -> -- arity increase ac_increase_arity_safe :: Int -> -- arity increase
[Domain] -> -- existing arg domains [Domain] -> -- existing arg domains
...@@ -255,7 +255,7 @@ ac_increase_arity_safe arity_increase argds new_argds fr ...@@ -255,7 +255,7 @@ ac_increase_arity_safe arity_increase argds new_argds fr
--==========================================================-- -- ==========================================================--
-- --
ac_increase_arity_live :: Int -> -- arity increase ac_increase_arity_live :: Int -> -- arity increase
[Domain] -> -- existing arg domains [Domain] -> -- existing arg domains
...@@ -275,7 +275,7 @@ ac_increase_arity_live arity_increase argds new_argds fr ...@@ -275,7 +275,7 @@ ac_increase_arity_live arity_increase argds new_argds fr
--==========================================================-- -- ==========================================================--
-- --
ac_ia_aux :: ACMode -> -- mode ac_ia_aux :: ACMode -> -- mode
Int -> -- arity increase Int -> -- arity increase
...@@ -296,7 +296,7 @@ ac_ia_aux ...@@ -296,7 +296,7 @@ ac_ia_aux
--==========================================================-- -- ==========================================================--
-- --
ac_extend_fr :: ACMode -> ac_extend_fr :: ACMode ->
[Domain] -> [Domain] ->
...@@ -316,7 +316,7 @@ ac_extend_fr s_or_l final_argds f1 f0 new_points ...@@ -316,7 +316,7 @@ ac_extend_fr s_or_l final_argds f1 f0 new_points
Live -> (new_f1_live, new_f0_live) Live -> (new_f1_live, new_f0_live)
--==========================================================-- -- ==========================================================--
-- big_args small_args -- big_args small_args
acConcSource_aux :: ACMode -> [Domain] -> [Domain] -> Frontier -> Frontier acConcSource_aux :: ACMode -> [Domain] -> [Domain] -> Frontier -> Frontier
...@@ -337,7 +337,7 @@ acConcSource_aux Live dbs dss (Min1Max0 ar f1 f0) ...@@ -337,7 +337,7 @@ acConcSource_aux Live dbs dss (Min1Max0 ar f1 f0)
Min1Max0 ar new_f1 new_f0 Min1Max0 ar new_f1 new_f0
--==========================================================-- -- ==========================================================--
-- Concretise source domain of a function -- Concretise source domain of a function
-- big small -- big small
acConcSource :: ACMode -> Domain -> Domain -> Rep -> Rep acConcSource :: ACMode -> Domain -> Domain -> Rep -> Rep
...@@ -382,7 +382,7 @@ acConcSource s_or_l (Func dss_b (Lift2 dts_b)) ...@@ -382,7 +382,7 @@ acConcSource s_or_l (Func dss_b (Lift2 dts_b))
Rep2 new_lf new_mf new_hfs Rep2 new_lf new_mf new_hfs
--==========================================================-- -- ==========================================================--
-- Figure out the domain of the thing created by acConcSource. -- Figure out the domain of the thing created by acConcSource.
-- big small -- big small
acConcSourceD :: Domain -> Domain -> Domain acConcSourceD :: Domain -> Domain -> Domain
...@@ -411,7 +411,7 @@ acConcSourceD (Func dss_b (Lift2 dts_b)) (Func dss_s (Lift2 dts_s)) ...@@ -411,7 +411,7 @@ acConcSourceD (Func dss_b (Lift2 dts_b)) (Func dss_s (Lift2 dts_s))
Func dss_res (Lift1 dts_res) -> Func dss_res (Lift2 dts_res) Func dss_res (Lift1 dts_res) -> Func dss_res (Lift2 dts_res)
--==========================================================-- -- ==========================================================--
-- --
acMakeInstance :: ACMode -> -- should be Safe for real applications acMakeInstance :: ACMode -> -- should be Safe for real applications
DExpr -> -- simplest instance domain of point (DXFunc _ _) DExpr -> -- simplest instance domain of point (DXFunc _ _)
...@@ -437,6 +437,6 @@ acMakeInstance s_or_l ...@@ -437,6 +437,6 @@ acMakeInstance s_or_l
acConc s_or_l finalDomain basicDomain f_simplest acConc s_or_l finalDomain basicDomain f_simplest
--==========================================================-- -- ==========================================================--
--=== end AbsConc3.hs ===-- -- === end AbsConc3.hs ===--
--==========================================================-- -- ==========================================================--
--==========================================================-- -- ==========================================================--
--=== Reduction of abstract expressions ===-- -- === Reduction of abstract expressions ===--
--=== AbstractEval2.hs ===-- -- === AbstractEval2.hs ===--
--==========================================================-- -- ==========================================================--
module AbstractEval2 where module AbstractEval2 where
import BaseDefs import BaseDefs
...@@ -11,7 +11,7 @@ import MyUtils ...@@ -11,7 +11,7 @@ import MyUtils
import AbstractVals2 import AbstractVals2
import Apply import Apply
--==========================================================-- -- ==========================================================--
-- --
aeEval :: HExpr Naam -> HExpr Naam aeEval :: HExpr Naam -> HExpr Naam
...@@ -38,7 +38,7 @@ aeEval (HApp f@(HPoint _) e) ...@@ -38,7 +38,7 @@ aeEval (HApp f@(HPoint _) e)
aeEval x = panic "aeEval(4)" aeEval x = panic "aeEval(4)"
--==========================================================-- -- ==========================================================--
-- --
aeEvalConst :: HExpr Naam -> Route aeEvalConst :: HExpr Naam -> Route
...@@ -46,7 +46,7 @@ aeEvalConst e ...@@ -46,7 +46,7 @@ aeEvalConst e
= case aeEval e of {HPoint p -> p; _ -> panic "aeEvalConst"} = case aeEval e of {HPoint p -> p; _ -> panic "aeEvalConst"}
--==========================================================-- -- ==========================================================--
-- --
aeEvalExact :: HExpr Naam -> [HExpr Naam] -> Route aeEvalExact :: HExpr Naam -> [HExpr Naam] -> Route
...@@ -55,7 +55,7 @@ aeEvalExact (HLam vs e) args ...@@ -55,7 +55,7 @@ aeEvalExact (HLam vs e) args
{HPoint p -> p; _ -> panic "aeEvalExact"} {HPoint p -> p; _ -> panic "aeEvalExact"}
--==========================================================-- -- ==========================================================--
-- --
aeSubst :: AList Naam (HExpr Naam) -> HExpr Naam -> HExpr Naam aeSubst :: AList Naam (HExpr Naam) -> HExpr Naam -> HExpr Naam
...@@ -68,7 +68,7 @@ aeSubst rho (HApp e1 e2) = HApp (aeSubst rho e1) (aeSubst rho e2) ...@@ -68,7 +68,7 @@ aeSubst rho (HApp e1 e2) = HApp (aeSubst rho e1) (aeSubst rho e2)
aeSubst rho (HVAp f es) = HVAp (aeSubst rho f) (map (aeSubst rho) es) aeSubst rho (HVAp f es) = HVAp (aeSubst rho f) (map (aeSubst rho) es)
--==========================================================-- -- ==========================================================--
-- --
aeMkMeet :: HExpr Naam -> [HExpr Naam] -> HExpr Naam aeMkMeet :: HExpr Naam -> [HExpr Naam] -> HExpr Naam
...@@ -77,6 +77,6 @@ aeMkMeet bottom [x] = x ...@@ -77,6 +77,6 @@ aeMkMeet bottom [x] = x
aeMkMeet bottom xs = HMeet xs aeMkMeet bottom xs = HMeet xs
--==========================================================-- -- ==========================================================--
--=== end AbstractEval2.hs ===-- -- === end AbstractEval2.hs ===--
--==========================================================-- -- ==========================================================--
--==========================================================-- -- ==========================================================--
--=== Miscellaneous operations in the Abstract value ===-- -- === Miscellaneous operations in the Abstract value ===--
--=== world. AbstractMisc.hs ===-- -- === world. AbstractMisc.hs ===--
--==========================================================-- -- ==========================================================--
module AbstractMisc where module AbstractMisc where
import BaseDefs import BaseDefs
...@@ -13,21 +13,21 @@ import SuccsAndPreds2 ...@@ -13,21 +13,21 @@ import SuccsAndPreds2
import List(nub) -- 1.3 import List(nub) -- 1.3
--==========================================================-- -- ==========================================================--
-- --
amIAboves :: Domain -> Route -> [Route] amIAboves :: Domain -> Route -> [Route]
amIAboves d r = map (r \/) (spSuccsR d r) amIAboves d r = map (r \/) (spSuccsR d r)
--==========================================================-- -- ==========================================================--
-- --
amIBelows :: Domain -> Route -> [Route] amIBelows :: Domain -> Route -> [Route]
amIBelows d r = map (r /\) (spPredsR d r) amIBelows d r = map (r /\) (spPredsR d r)
--==========================================================-- -- ==========================================================--
-- --
amPushUpFF :: Domain -> [Route] -> [Route] amPushUpFF :: Domain -> [Route] -> [Route]
...@@ -35,7 +35,7 @@ amPushUpFF d [] = [] ...@@ -35,7 +35,7 @@ amPushUpFF d [] = []
amPushUpFF d xs = nub (concat (map (amIAboves d) xs)) amPushUpFF d xs = nub (concat (map (amIAboves d) xs))
--==========================================================-- -- ==========================================================--
-- --
amPushDownFF :: Domain -> [Route] -> [Route] amPushDownFF :: Domain -> [Route] -> [Route]
...@@ -43,7 +43,7 @@ amPushDownFF d [] = [] ...@@ -43,7 +43,7 @@ amPushDownFF d [] = []
amPushDownFF d xs = nub (concat (map (amIBelows d) xs)) amPushDownFF d xs = nub (concat (map (amIBelows d) xs))
--==========================================================-- -- ==========================================================--
-- --
amAllUpSlices :: Domain -> [[Route]] amAllUpSlices :: Domain -> [[Route]]
...@@ -51,7 +51,7 @@ amAllUpSlices d ...@@ -51,7 +51,7 @@ amAllUpSlices d
= takeWhile (not.null) (iterate (amPushUpFF d) [avBottomR d]) = takeWhile (not.null) (iterate (amPushUpFF d) [avBottomR d])
--==========================================================-- -- ==========================================================--
-- --
amAllDownSlices :: Domain -> [[Route]] amAllDownSlices :: Domain -> [[Route]]
...@@ -59,7 +59,7 @@ amAllDownSlices d ...@@ -59,7 +59,7 @@ amAllDownSlices d
= takeWhile (not.null) (iterate (amPushDownFF d) [avTopR d]) = takeWhile (not.null) (iterate (amPushDownFF d) [avTopR d])
--==========================================================-- -- ==========================================================--
-- --
amAllRoutes :: Domain -> [Route] amAllRoutes :: Domain -> [Route]
...@@ -76,7 +76,7 @@ amAllRoutes (Func dss dt) ...@@ -76,7 +76,7 @@ amAllRoutes (Func dss dt)
= concat (amAllUpSlices (Func dss dt)) = concat (amAllUpSlices (Func dss dt))
--==========================================================-- -- ==========================================================--
-- --
amUpCloseOfMinf :: Domain -> [Route] -> [Route] amUpCloseOfMinf :: Domain -> [Route] -> [Route]
...@@ -87,7 +87,7 @@ amUpCloseOfMinf d q@(x:_) ...@@ -87,7 +87,7 @@ amUpCloseOfMinf d q@(x:_)
(avMinR [ y \/ z | y <- q, z <- spSuccsR d x ])) (avMinR [ y \/ z | y <- q, z <- spSuccsR d x ]))
--==========================================================-- -- ==========================================================--
-- --
amDownCloseOfMaxf :: Domain -> [Route] -> [Route] amDownCloseOfMaxf :: Domain -> [Route] -> [Route]
...@@ -98,7 +98,7 @@ amDownCloseOfMaxf d q@(x:_) ...@@ -98,7 +98,7 @@ amDownCloseOfMaxf d q@(x:_)
(avMaxR [ y /\ z | y <- q, z <- spPredsR d x ])) (avMaxR [ y /\ z | y <- q, z <- spPredsR d x ]))
--==========================================================-- -- ==========================================================--
-- --
amAllRoutesMinusTopJONES :: Domain -> [Route] amAllRoutesMinusTopJONES :: Domain -> [Route]
...@@ -106,7 +106,7 @@ amAllRoutesMinusTopJONES d ...@@ -106,7 +106,7 @@ amAllRoutesMinusTopJONES d
= amDownCloseOfMaxf d (spPredsR d (avTopR d)) = amDownCloseOfMaxf d (spPredsR d (avTopR d))
--==========================================================-- -- ==========================================================--
-- --
--amAllRoutesMinusTopMINE :: Domain -> [Route] --amAllRoutesMinusTopMINE :: Domain -> [Route]
-- --
...@@ -120,7 +120,7 @@ amAllRoutesMinusTopJONES d ...@@ -120,7 +120,7 @@ amAllRoutesMinusTopJONES d
-- concat allSlices -- concat allSlices
--==========================================================-- -- ==========================================================--
-- --
amEqualPoints :: Point -> Point -> Bool amEqualPoints :: Point -> Point -> Bool
...@@ -130,7 +130,7 @@ amEqualPoints (d1, r1) (d2, r2) ...@@ -130,7 +130,7 @@ amEqualPoints (d1, r1) (d2, r2)
else panic "Comparing points in different domains." else panic "Comparing points in different domains."
--==========================================================-- -- ==========================================================--
-- --
amIsaHOF :: Domain -> Bool