[project @ 1999-01-18 19:38:27 by sof]
authorsof <unknown>
Mon, 18 Jan 1999 19:38:58 +0000 (19:38 +0000)
committersof <unknown>
Mon, 18 Jan 1999 19:38:58 +0000 (19:38 +0000)
Misc (backward compatible) changes to make srcs acceptable
to a Haskell 98 compiler.

63 files changed:
imaginary/gen_regexps/Main.hs
imaginary/queens/Main.hs
imaginary/rfib/Main.hs
real/HMMS/BatchAlign.lhs
real/HMMS/HmmDensities.lhs
real/HMMS/HmmDigraphs.lhs
real/HMMS/Makefile
real/anna/AbsConc3.hs
real/anna/AbstractEval2.hs
real/anna/AbstractMisc.hs
real/anna/AbstractVals2.hs
real/anna/Apply.hs
real/anna/BarakiConc3.hs
real/anna/BarakiMeet.hs
real/anna/BaseDefs.hs
real/anna/Constructors.hs
real/anna/Dependancy.hs
real/anna/DomainExpr.hs
real/anna/EtaAbstract.hs
real/anna/FrontierDATAFN2.hs
real/anna/FrontierGENERIC2.hs
real/anna/FrontierMisc2.hs
real/anna/Inverse.hs
real/anna/LambdaLift5.hs
real/anna/Main.hs
real/anna/MakeDomains.hs
real/anna/Monster.hs
real/anna/MyUtils.hs
real/anna/Parser2.hs
real/anna/PrettyPrint.hs
real/anna/PrintResults.hs
real/anna/ReadTable.hs
real/anna/Simplify.hs
real/anna/SmallerLattice.hs
real/anna/StrictAn6.hs
real/anna/SuccsAndPreds2.hs
real/anna/TExpr2DExpr.hs
real/anna/TypeCheck5.hs
real/anna/Utils.hs
real/ebnf2ps/Color.hs
real/ebnf2ps/IOSupplement.hs
real/ebnf2ps/Makefile
real/ebnf2ps/PsOutput.hs
real/fulsom/Csg.hs
real/fulsom/Makefile
real/fulsom/Matrix.hs
real/infer/Makefile
real/infer/Parse.hs
real/parser/Main.hs
real/pic/Main.hs
real/pic/pic.stdout
real/pic/pic.stdout-linux
real/symalg/Lexer.hs
real/symalg/Main.hs
real/symalg/Makefile
spectral/calendar/Main.hs
spectral/calendar/Makefile
spectral/cichelli/Main.hs
spectral/cichelli/Prog.hs
spectral/knights/ChessSetArray.lhs
spectral/knights/Main.lhs
spectral/knights/Makefile
spectral/scc/Main.hs

index d490508..4fb6b08 100644 (file)
@@ -1,6 +1,6 @@
---!!! Wentworth's version of a program to generate
---!!! all the expansions of a generalised regular expression
---!!!
+-- !!! Wentworth's version of a program to generate
+-- !!! all the expansions of a generalised regular expression
+-- !!!
 --
 module Main (main) where
 
index 291be10..0155572 100644 (file)
@@ -1,4 +1,4 @@
---!!! count the number of solutions to the "n queens" problem.
+-- !!! count the number of solutions to the "n queens" problem.
 -- (grabbed from LML dist)
 
 main = print (nsoln 10)
index a8ecd4c..1acbfe5 100644 (file)
@@ -1,4 +1,4 @@
---!!! the ultra-notorious "nfib 30" does w/ Floats
+-- !!! the ultra-notorious "nfib 30" does w/ Floats
 --
 module Main (main) where
 
index e3143a9..878f5fc 100644 (file)
@@ -51,6 +51,13 @@ They were documented in earlier chapters (Part~\ref{part:modules}).
 > (=:) a b = (a,b)
 >#endif
 
+#if __HASKELL1__ < 5
+#define amap map
+#else
+#define amap fmap
+#endif
+
+
 \end{verbatim}
 
 
@@ -288,7 +295,7 @@ definition stands for ``tied-mixture continuation.''
 > can't_read :: String -> String
 > 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
 
 \end{haskell}
index dd5f90b..63cb884 100644 (file)
@@ -22,6 +22,13 @@ vectors.
 > import HmmConstants
 > import Array--1.3
 
+#if __HASKELL1__ < 5
+#define amap map
+#else
+#define amap fmap
+#endif
+
+
 \end{haskell}
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -343,7 +350,7 @@ for efficient retrieval.
 > eval_log_densities :: TmTable -> Vector -> LogDensityTable
 
 > 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 (Tie p k) = ldt!p!k
 
index f74f169..098a14f 100644 (file)
@@ -37,6 +37,12 @@ described in later chapters in Part~\ref{part:library}.
 > import Array--1.3
 > import Ix--1.3
 
+#if __HASKELL1__ < 5
+#define amap map
+#else
+#define amap fmap
+#endif
+
 \end{verbatim}
 
 
@@ -655,7 +661,7 @@ the probabilities for all HMMs in an array.
         \begin{haskell}{get_log_probs}
 
 > 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}
 
index aabe5ff..b7d5225 100644 (file)
@@ -55,7 +55,7 @@ HS_OBJS =   Alignments.o      \
 
 SRC_MKDEPENDHS_OPTS += -syslib misc
 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
 BatchAlign_HC_OPTS += -cpp
 
index a5fa9cf..4906858 100644 (file)
@@ -1,8 +1,8 @@
 
---==========================================================--
---=== Concretisation of function points.                 ===--
---===                                        AbsConc3.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Concretisation of function points.                 ===--
+-- ===                                        AbsConc3.hs ===--
+-- ==========================================================--
 
 module AbsConc3 where
 import BaseDefs
@@ -14,7 +14,7 @@ import AbstractMisc
 import DomainExpr
 
 
---==========================================================--
+-- ==========================================================--
 -- 
 acUncurryWRT :: Domain -> Domain -> Domain
 --              small     big
@@ -48,7 +48,7 @@ acUncurryWRT (Func ds_s dt_s) (Func ds_b dt_b)
         totally_fixed
 
 
---==========================================================--
+-- ==========================================================--
 -- 
 acNormAndCurried :: Domain -> Domain -> (Domain, Domain)
 
@@ -57,7 +57,7 @@ acNormAndCurried small_d big_d
      in (big_d_u, acUncurryWRT small_d big_d_u)
 
 
---==========================================================--
+-- ==========================================================--
 --              big domain   smaller domain
 acCompatible :: Domain ->    Domain      -> Bool
 --
@@ -83,7 +83,7 @@ acCompatible _ _
    = False
 
 
---==========================================================--
+-- ==========================================================--
 -- 
 acConc :: ACMode -> Domain -> Domain -> Route -> Route
 
@@ -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
 
 
---==========================================================--
+-- ==========================================================--
 --                      big       small
 --
 acConcData :: ACMode -> Domain -> Domain -> Route -> Route
@@ -128,7 +128,7 @@ acConcData s_or_l (Lift2 dbs) (Lift2 dss) (UpUp2 rs)
    = UpUp2 (myZipWith3 (acConc s_or_l) dbs dss rs)
 
 
---==========================================================--
+-- ==========================================================--
 --                     big_c     big_u     small
 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)
            concd_all
 
 
---==========================================================--
+-- ==========================================================--
 -- Concretise target domain of a function.  
 --                    target_big    rep_current
 acConcTarget :: ACMode -> Domain -> Domain -> Rep -> Rep
@@ -235,7 +235,7 @@ acConcTarget
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 ac_increase_arity_safe :: Int ->        -- arity increase
                           [Domain] ->   -- existing arg domains
@@ -255,7 +255,7 @@ ac_increase_arity_safe arity_increase argds new_argds fr
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 ac_increase_arity_live :: Int ->        -- arity increase
                           [Domain] ->   -- existing arg domains
@@ -275,7 +275,7 @@ ac_increase_arity_live arity_increase argds new_argds fr
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 ac_ia_aux :: ACMode ->     -- mode
              Int ->        -- arity increase
@@ -296,7 +296,7 @@ ac_ia_aux
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 ac_extend_fr :: ACMode -> 
                 [Domain] -> 
@@ -316,7 +316,7 @@ ac_extend_fr s_or_l final_argds f1 f0 new_points
             Live -> (new_f1_live, new_f0_live)
 
 
---==========================================================--
+-- ==========================================================--
 --                            big_args    small_args
 acConcSource_aux :: ACMode -> [Domain] -> [Domain] -> Frontier -> Frontier
 
@@ -337,7 +337,7 @@ acConcSource_aux Live dbs dss (Min1Max0 ar f1 f0)
          Min1Max0 ar new_f1 new_f0
 
 
---==========================================================--
+-- ==========================================================--
 -- Concretise source domain of a function
 --                        big       small
 acConcSource :: ACMode -> Domain -> Domain -> Rep -> Rep
@@ -382,7 +382,7 @@ acConcSource s_or_l (Func dss_b (Lift2 dts_b))
          Rep2 new_lf new_mf new_hfs
 
 
---==========================================================--
+-- ==========================================================--
 -- Figure out the domain of the thing created by acConcSource.
 --               big       small
 acConcSourceD :: Domain -> Domain -> Domain
@@ -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)
 
 
---==========================================================--
+-- ==========================================================--
 --
 acMakeInstance :: ACMode ->  -- should be Safe for real applications
                   DExpr ->   -- simplest instance domain of point (DXFunc _ _)
@@ -437,6 +437,6 @@ acMakeInstance s_or_l
        acConc s_or_l finalDomain basicDomain f_simplest
 
 
---==========================================================--
---=== end                                    AbsConc3.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                                    AbsConc3.hs ===--
+-- ==========================================================--
index a49d4d5..14b055c 100644 (file)
@@ -1,8 +1,8 @@
  
---==========================================================--
---=== Reduction of abstract expressions                  ===--
---===                                   AbstractEval2.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Reduction of abstract expressions                  ===--
+-- ===                                   AbstractEval2.hs ===--
+-- ==========================================================--
 
 module AbstractEval2 where
 import BaseDefs
@@ -11,7 +11,7 @@ import MyUtils
 import AbstractVals2
 import Apply
 
---==========================================================--
+-- ==========================================================--
 --
 aeEval :: HExpr Naam -> HExpr Naam
 
@@ -38,7 +38,7 @@ aeEval   (HApp f@(HPoint _) e)
 aeEval x = panic "aeEval(4)"
 
 
---==========================================================--
+-- ==========================================================--
 --
 aeEvalConst :: HExpr Naam -> Route
 
@@ -46,7 +46,7 @@ aeEvalConst e
    = case aeEval e of {HPoint p -> p; _ -> panic "aeEvalConst"}
 
 
---==========================================================--
+-- ==========================================================--
 --
 aeEvalExact :: HExpr Naam -> [HExpr Naam] -> Route
 
@@ -55,7 +55,7 @@ aeEvalExact (HLam vs e) args
        {HPoint p -> p; _ -> panic "aeEvalExact"}
 
 
---==========================================================--
+-- ==========================================================--
 --
 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)
 aeSubst rho (HVAp f es)   = HVAp (aeSubst rho f) (map (aeSubst rho) es)
 
 
---==========================================================--
+-- ==========================================================--
 --
 aeMkMeet :: HExpr Naam -> [HExpr Naam] -> HExpr Naam
 
@@ -77,6 +77,6 @@ aeMkMeet bottom [x]   = x
 aeMkMeet bottom xs    = HMeet xs
 
 
---==========================================================--
---=== end                               AbstractEval2.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                               AbstractEval2.hs ===--
+-- ==========================================================--
index ca979e9..9522363 100644 (file)
@@ -1,8 +1,8 @@
  
---==========================================================--
---=== Miscellaneous operations in the Abstract value     ===--
---=== world.                             AbstractMisc.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Miscellaneous operations in the Abstract value     ===--
+-- === world.                             AbstractMisc.hs ===--
+-- ==========================================================--
 
 module AbstractMisc where
 import BaseDefs
@@ -13,21 +13,21 @@ import SuccsAndPreds2
 
 import List(nub) -- 1.3
 
---==========================================================--
+-- ==========================================================--
 --
 amIAboves :: Domain -> Route -> [Route]
 
 amIAboves d r = map (r \/) (spSuccsR d r)
 
 
---==========================================================--
+-- ==========================================================--
 --
 amIBelows :: Domain -> Route -> [Route]
 
 amIBelows d r = map (r /\) (spPredsR d r)
 
 
---==========================================================--
+-- ==========================================================--
 --
 amPushUpFF :: Domain -> [Route] -> [Route]
 
@@ -35,7 +35,7 @@ amPushUpFF d [] = []
 amPushUpFF d xs = nub (concat (map (amIAboves d) xs))
 
 
---==========================================================--
+-- ==========================================================--
 --
 amPushDownFF :: Domain -> [Route] -> [Route]
 
@@ -43,7 +43,7 @@ amPushDownFF d [] = []
 amPushDownFF d xs = nub (concat (map (amIBelows d) xs))
 
 
---==========================================================--
+-- ==========================================================--
 --
 amAllUpSlices :: Domain -> [[Route]]
 
@@ -51,7 +51,7 @@ amAllUpSlices d
    = takeWhile (not.null) (iterate (amPushUpFF d) [avBottomR d])
 
 
---==========================================================--
+-- ==========================================================--
 --
 amAllDownSlices :: Domain -> [[Route]]
 
@@ -59,7 +59,7 @@ amAllDownSlices d
    = takeWhile (not.null) (iterate (amPushDownFF d) [avTopR d])
 
 
---==========================================================--
+-- ==========================================================--
 --
 amAllRoutes :: Domain -> [Route]
 
@@ -76,7 +76,7 @@ amAllRoutes (Func dss dt)
    = concat (amAllUpSlices (Func dss dt))
 
 
---==========================================================--
+-- ==========================================================--
 --
 amUpCloseOfMinf :: Domain -> [Route] -> [Route]
 
@@ -87,7 +87,7 @@ amUpCloseOfMinf d q@(x:_)
             (avMinR [ y \/ z | y <- q, z <- spSuccsR d x ]))
 
 
---==========================================================--
+-- ==========================================================--
 --
 amDownCloseOfMaxf :: Domain -> [Route] -> [Route]
 
@@ -98,7 +98,7 @@ amDownCloseOfMaxf d q@(x:_)
             (avMaxR [ y /\ z | y <- q, z <- spPredsR d x ]))
 
 
---==========================================================--
+-- ==========================================================--
 --
 amAllRoutesMinusTopJONES :: Domain -> [Route]
 
@@ -106,7 +106,7 @@ amAllRoutesMinusTopJONES d
    = amDownCloseOfMaxf d (spPredsR d (avTopR d))
 
 
---==========================================================--
+-- ==========================================================--
 --
 --amAllRoutesMinusTopMINE :: Domain -> [Route]
 --
@@ -120,7 +120,7 @@ amAllRoutesMinusTopJONES d
 --         concat allSlices
 
 
---==========================================================--
+-- ==========================================================--
 --
 amEqualPoints :: Point -> Point -> Bool
 
@@ -130,7 +130,7 @@ amEqualPoints (d1, r1) (d2, r2)
      else   panic "Comparing points in different domains."
 
 
---==========================================================--
+-- ==========================================================--
 --
 amIsaHOF :: Domain -> Bool
 
@@ -139,7 +139,7 @@ amIsaHOF (Func dss dt)
      myAny amContainsFunctionSpace dss
 
 
---==========================================================--
+-- ==========================================================--
 --
 amContainsFunctionSpace :: Domain -> Bool
 
@@ -149,14 +149,14 @@ amContainsFunctionSpace (Lift2 dss)   = myAny amContainsFunctionSpace dss
 amContainsFunctionSpace (Func _ _)    = True
 
 
---==========================================================--
+-- ==========================================================--
 --
 amIsDataFn :: Domain -> Bool
 
 amIsDataFn (Func _ dt) = not (amContainsFunctionSpace dt)
 
 
---==========================================================--
+-- ==========================================================--
 --
 amRepArity :: Rep -> Int
 
@@ -165,7 +165,7 @@ amRepArity (Rep1 (Min1Max0 lf_ar lf_f1 lf_f0) hfs)      = lf_ar
 amRepArity (Rep2 (Min1Max0 lf_ar lf_f1 lf_f0) mf hfs)   = lf_ar
 
 
---==========================================================--
+-- ==========================================================--
 --
 amStrongNormalise :: Domain -> Domain
 
@@ -185,7 +185,7 @@ amStrongNormalise (Func dss non_func_res)
    = Func (map amStrongNormalise dss) (amStrongNormalise non_func_res)
 
 
---==========================================================--
+-- ==========================================================--
 --
 amMeetIRoutes :: Domain -> [Route]
 
@@ -200,7 +200,7 @@ amMeetIRoutes (Lift2 ds)
      map UpUp2 (myListVariants (map avTopR ds) (map amMeetIRoutes ds))
 
 
---==========================================================--
---=== end                                AbstractMisc.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                                AbstractMisc.hs ===--
+-- ==========================================================--
 
index 6a2bebc..811f214 100644 (file)
@@ -1,8 +1,8 @@
  
---==========================================================--
---=== Revised domain operations for HO analysis          ===--
---===                                   AbstractVals2.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Revised domain operations for HO analysis          ===--
+-- ===                                   AbstractVals2.hs ===--
+-- ==========================================================--
 
 module AbstractVals2 where
 import BaseDefs
@@ -15,13 +15,13 @@ infix 9 /\   -- Binary GLB for routes
 infix 9 \/   -- Binary LUB for routes
 
 
---==========================================================--
---===                                                    ===--
---=== Top and bottom points of domains.                  ===--
---===                                                    ===--
---==========================================================--
+-- ==========================================================--
+-- ===                                                    ===--
+-- === Top and bottom points of domains.                  ===--
+-- ===                                                    ===--
+-- ==========================================================--
 
---==========================================================--
+-- ==========================================================--
 --
 avUncurry :: [Domain] -> Domain -> Domain
 
@@ -29,7 +29,7 @@ avUncurry dss (Func dss2 dt) = Func (dss++dss2) dt
 avUncurry dss non_func_dom   = Func dss non_func_dom
 
 
---==========================================================--
+-- ==========================================================--
 --
 avTopR :: Domain -> Route
 
@@ -39,7 +39,7 @@ avTopR (Lift2 ds)        = UpUp2 (map avTopR ds)
 avTopR d@(Func dss dt)   = Rep (avTopR_aux d)
 
 
---==========================================================--
+-- ==========================================================--
 --
 avTopR_aux_2 :: [Domain] -> Frontier
 
@@ -47,7 +47,7 @@ avTopR_aux_2 dss
    = Min1Max0 (length dss) [MkFrel (map avBottomR dss)] []
 
 
---==========================================================--
+-- ==========================================================--
 --
 avTopR_aux :: Domain -> Rep
 
@@ -69,7 +69,7 @@ avTopR_aux (Func dss (Lift2 dts))
          Rep2 lf lf hfs
 
 
---==========================================================--
+-- ==========================================================--
 --
 avBottomR :: Domain -> Route
 
@@ -79,7 +79,7 @@ avBottomR (Lift2 ds)        = Stop2
 avBottomR d@(Func dss dt)   = Rep (avBottomR_aux d)
 
 
---==========================================================--
+-- ==========================================================--
 --
 avBottomR_aux_2 :: [Domain] -> Frontier
 
@@ -87,7 +87,7 @@ avBottomR_aux_2 dss
    = Min1Max0 (length dss) [] [MkFrel (map avTopR dss)]
 
 
---==========================================================--
+-- ==========================================================--
 --
 avBottomR_aux :: Domain -> Rep
 
@@ -109,7 +109,7 @@ avBottomR_aux (Func dss (Lift2 dts))
          Rep2 lf lf hfs
 
 
---==========================================================--
+-- ==========================================================--
 --
 avIsBottomR :: Route -> Bool
 
@@ -123,7 +123,7 @@ avIsBottomR (UpUp2 _)   = False
 avIsBottomR (Rep r)     = avIsBottomRep r
 
 
---==========================================================--
+-- ==========================================================--
 --
 avIsBottomRep :: Rep -> Bool
 
@@ -135,7 +135,7 @@ avIsBottomRep (Rep2 (Min1Max0 lf_ar lf_f1 lf_f0) mf hfs)
    = null lf_f1
 
 
---==========================================================--
+-- ==========================================================--
 -- Is this correct?  I think so.
 --
 avIsTopR :: Route -> Bool
@@ -150,7 +150,7 @@ avIsTopR (UpUp2 rs)   = myAll avIsTopR rs
 avIsTopR (Rep r)      = avIsTopRep r
 
 
---==========================================================--
+-- ==========================================================--
 --
 avIsTopRep :: Rep -> Bool
 
@@ -162,13 +162,13 @@ avIsTopRep (Rep2 lf mf hfs)
    = myAll avIsTopRep hfs
 
 
---==========================================================--
---===                                                    ===--
---=== Partial ordering predicates for points in domains. ===--
---===                                                    ===--
---==========================================================--
+-- ==========================================================--
+-- ===                                                    ===--
+-- === Partial ordering predicates for points in domains. ===--
+-- ===                                                    ===--
+-- ==========================================================--
 
---==========================================================--
+-- ==========================================================--
 --
 (<<) :: Route -> Route -> Bool
 
@@ -189,7 +189,7 @@ UpUp2 rs1    <<   _           = False
 Rep rep1     <<   Rep rep2    = avBelowEQrep rep1 rep2
 
 
---==========================================================--
+-- ==========================================================--
 -- A little bit of Cordy-style loop unrolling
 -- although not actually tail-strict :-)
 --
@@ -239,7 +239,7 @@ avLEQR_list (a1:a2:a3:a4:as@(_:_)) (b1:b2:b3:b4:bs@(_:_))
 avLEQR_list _ _            = panic "avLEQR_list: unequal lists"
 
 
---==========================================================--
+-- ==========================================================--
 --
 avBelowEQfrel :: FrontierElem -> FrontierElem -> Bool
 
@@ -247,7 +247,7 @@ avBelowEQfrel (MkFrel rs1) (MkFrel rs2)
    = avLEQR_list rs1 rs2
 
 
---==========================================================--
+-- ==========================================================--
 --
 avBelowEQfrontier :: Frontier -> Frontier -> Bool
 
@@ -268,7 +268,7 @@ avBelowEQfrontier (Min1Max0 ar1 f1a f0a) (Min1Max0 ar2 f1b f0b)
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 avBelowEQrep :: Rep -> Rep -> Bool
 
@@ -285,13 +285,13 @@ avBelowEQrep (Rep2 lf1 mf1 hfs1) (Rep2 lf2 mf2 hfs2)
      myAndWith2 avBelowEQrep hfs1 hfs2
 
 
---==========================================================--
---===                                                    ===--
---=== LUB and GLB operations for Points.                 ===--
---===                                                    ===--
---==========================================================--
+-- ==========================================================--
+-- ===                                                    ===--
+-- === LUB and GLB operations for Points.                 ===--
+-- ===                                                    ===--
+-- ==========================================================--
 
---==========================================================--
+-- ==========================================================--
 --
 (\/) :: Route -> Route -> Route
 
@@ -311,7 +311,7 @@ p@(UpUp2 rs1)  \/  q              = p
 p@(Rep rep1)   \/  q@(Rep rep2)   = Rep (avLUBrep rep1 rep2)
 
 
---==========================================================--
+-- ==========================================================--
 --
 avLUBfrel :: FrontierElem -> FrontierElem -> FrontierElem
 
@@ -319,7 +319,7 @@ avLUBfrel (MkFrel rs1) (MkFrel rs2)
    = MkFrel (myZipWith2 (\/) rs1 rs2)
 
 
---==========================================================--
+-- ==========================================================--
 --
 avLUBfrontier :: Frontier -> Frontier -> Frontier
 
@@ -328,7 +328,7 @@ avLUBfrontier (Min1Max0 ar1 f1a f0a) (Min1Max0 ar2 f1b f0b)
    = Min1Max0 ar1 (avLUBmin1frontier f1a f1b) (avLUBmax0frontier f0a f0b)
 
 
---==========================================================--
+-- ==========================================================--
 --
 avLUBrep :: Rep -> Rep -> Rep
 
@@ -341,7 +341,7 @@ avLUBrep (Rep2 lf1 mf1 hfs1) (Rep2 lf2 mf2 hfs2)
           (myZipWith2 avLUBrep hfs1 hfs2)
 
 
---==========================================================--
+-- ==========================================================--
 --
 avLUBmin1frontier :: [FrontierElem] -> [FrontierElem] -> [FrontierElem]
 
@@ -349,7 +349,7 @@ avLUBmin1frontier f1a f1b
    = sort (foldr avMinAddPtfrel f1a f1b)  {-OPTIMISE-}
 
 
---==========================================================--
+-- ==========================================================--
 --
 avLUBmax0frontier :: [FrontierElem] -> [FrontierElem] -> [FrontierElem]
 
@@ -357,7 +357,7 @@ avLUBmax0frontier f0a f0b
    = sort (avMaxfrel [ x `avGLBfrel` y | x <- f0a, y <- f0b ])
 
 
---==========================================================--
+-- ==========================================================--
 --
 (/\) :: Route -> Route -> Route
 
@@ -377,7 +377,7 @@ p@(UpUp2 rs1)  /\  q                = q
 p@(Rep rep1)   /\  q@(Rep rep2)     = Rep (avGLBrep rep1 rep2)
 
 
---==========================================================--
+-- ==========================================================--
 --
 avGLBfrel :: FrontierElem -> FrontierElem -> FrontierElem
 
@@ -385,7 +385,7 @@ avGLBfrel (MkFrel rs1) (MkFrel rs2)
    = MkFrel (myZipWith2 (/\) rs1 rs2)
 
 
---==========================================================--
+-- ==========================================================--
 --
 avGLBfrontier :: Frontier -> Frontier -> Frontier
 
@@ -394,7 +394,7 @@ avGLBfrontier (Min1Max0 ar1 f1a f0a) (Min1Max0 ar2 f1b f0b)
    = Min1Max0 ar1 (avGLBmin1frontier f1a f1b) (avGLBmax0frontier f0a f0b)
 
 
---==========================================================--
+-- ==========================================================--
 --
 avGLBrep :: Rep -> Rep -> Rep
 
@@ -407,7 +407,7 @@ avGLBrep (Rep2 lf1 mf1 hfs1) (Rep2 lf2 mf2 hfs2)
           (myZipWith2 avGLBrep hfs1 hfs2)
 
 
---==========================================================--
+-- ==========================================================--
 --
 avGLBmax0frontier :: [FrontierElem] -> [FrontierElem] -> [FrontierElem]
 
@@ -415,7 +415,7 @@ avGLBmax0frontier f0a f0b
    = sort (foldr avMaxAddPtfrel f0a f0b)  {-OPTIMISE-}
 
 
---==========================================================--
+-- ==========================================================--
 --
 avGLBmin1frontier :: [FrontierElem] -> [FrontierElem] -> [FrontierElem]
 
@@ -423,13 +423,13 @@ avGLBmin1frontier f1a f1b
    = sort (avMinfrel [ x `avLUBfrel` y | x <- f1a, y <- f1b ])
 
 
---==========================================================--
---===                                                    ===--
---=== Min and Max operations for frontiers.              ===--
---=== Note avBelowMax0/avAboveMin1 expect Frel's to be   ===--
---=== of the same length.                                ===--
---===                                                    ===--
---==========================================================--
+-- ==========================================================--
+-- ===                                                    ===--
+-- === Min and Max operations for frontiers.              ===--
+-- === Note avBelowMax0/avAboveMin1 expect Frel's to be   ===--
+-- === of the same length.                                ===--
+-- ===                                                    ===--
+-- ==========================================================--
 
 pt `avBelowMax0frel` f = myAny (pt `avBelowEQfrel`) f
 
@@ -448,11 +448,11 @@ avMinfrel = foldr avMinAddPtfrel []
 avMaxfrel = foldr avMaxAddPtfrel []
 
 
---==========================================================--
---===                                                    ===--
---=== Min and Max operations for Routes                  ===--
---===                                                    ===--
---==========================================================--
+-- ==========================================================--
+-- ===                                                    ===--
+-- === Min and Max operations for Routes                  ===--
+-- ===                                                    ===--
+-- ==========================================================--
 
 pt `avBelowMax0R` f = myAny (pt <<) f
 
@@ -471,11 +471,11 @@ avMinR = foldr avMinAddPtR []
 avMaxR = foldr avMaxAddPtR []
 
 
---==========================================================--
---===                                                    ===--
---=== Min and Max operations for Reps                    ===--
---===                                                    ===--
---==========================================================--
+-- ==========================================================--
+-- ===                                                    ===--
+-- === Min and Max operations for Reps                    ===--
+-- ===                                                    ===--
+-- ==========================================================--
 
 pt `avBelowMax0rep` f = myAny (pt `avBelowEQrep`) f
 
@@ -494,6 +494,6 @@ avMinrep = foldr avMinAddPtrep []
 avMaxrep = foldr avMaxAddPtrep []
 
 
---==========================================================--
---=== end                               AbstractVals2.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                               AbstractVals2.hs ===--
+-- ==========================================================--
index ee0b233..7653fa1 100644 (file)
@@ -1,8 +1,8 @@
 
---==========================================================--
---=== Application of function points to                  ===--
---=== argument points.                          Apply.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Application of function points to                  ===--
+-- === argument points.                          Apply.hs ===--
+-- ==========================================================--
 
 module Apply where
 import BaseDefs
@@ -10,14 +10,14 @@ import Utils
 import MyUtils
 import AbstractVals2
 
---==========================================================--
+-- ==========================================================--
 --
 apApply :: Route -> [Route] -> Route
 
 apApply (Rep func) args = apPapConst (apPap func args)
 
 
---==========================================================--
+-- ==========================================================--
 --
 apPap_2 :: Int -> Frontier -> [Route] -> Frontier
 
@@ -39,7 +39,7 @@ apPap_2 argCount (Min1Max0 ar f1 f0) args
          if argCount <= ar then result else panic "apPap_2"
 
 
---==========================================================--
+-- ==========================================================--
 --
 apPap :: Rep -> [Route] -> Rep
 
@@ -64,7 +64,7 @@ apPap (Rep2 lf mf hfs) args
          Rep2 new_lf new_mf new_hfs
 
 
---==========================================================--
+-- ==========================================================--
 --
 apPapConst :: Rep -> Route
 
@@ -88,6 +88,6 @@ apPapConst rep@(Rep2 (Min1Max0 lf_ar lf_f1 lf_f0) (Min1Max0 mf_ar mf_f1 mf_f0) h
    | otherwise                        = panic "apPapConst(3)"
 
 
---==========================================================--
---=== end                                       Apply.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                                       Apply.hs ===--
+-- ==========================================================--
index 02f8f06..10a0fc2 100644 (file)
@@ -1,8 +1,8 @@
        
---==========================================================--
---=== Implementation of Gebreselassie Baraki's           ===--
---=== polymorphism stuff                   BarakiConc.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Implementation of Gebreselassie Baraki's           ===--
+-- === polymorphism stuff                   BarakiConc.hs ===--
+-- ==========================================================--
 
 module BarakiConc3 where
 import BaseDefs
@@ -16,12 +16,12 @@ import AbsConc3
 import BarakiMeet
 
 
---==================================================--
---=== Application of a embedding functor (e-app) ===--
---=== to a point.                                ===--
---==================================================--
+-- ==================================================--
+-- === Application of a embedding functor (e-app) ===--
+-- === to a point.                                ===--
+-- ==================================================--
 
---==========================================================--
+-- ==========================================================--
 --
 bcEApp_d :: DRRSubst -> DExpr -> Domain
 
@@ -37,7 +37,7 @@ bcEApp_d rho (DXVar alpha)
    = bcGetD (utSureLookup rho "bcEApp_d" alpha)
 
 
---==========================================================--
+-- ==========================================================--
 --
 bcEApp :: DRRSubst -> DExpr -> Route -> Route
 
@@ -69,12 +69,12 @@ bcEApp rho (DXFunc dxss dxt) (Rep rep)
          bcEdotFdotC rho dxt repDomain rep dxss
 
 
---=============================================--
---=== Composition of an embedding functor e ===--
---=== with a function f, hence: e.f         ===--
---=============================================--
+-- =============================================--
+-- === Composition of an embedding functor e ===--
+-- === with a function f, hence: e.f         ===--
+-- =============================================--
 
---==========================================================--
+-- ==========================================================--
 --
 bcEdotF :: DRRSubst ->   -- binds domain variables to Points
            DExpr ->      -- the embedding functor "e"
@@ -143,13 +143,13 @@ bcEdotF
 
 
 
---=============================================--
---=== Composition of a function f with a    ===--
---=== list of closure functors [c1 ... cn], ===--
---=== hence: "f.[c1 ... cn]"                ===--
---=============================================--
+-- =============================================--
+-- === Composition of a function f with a    ===--
+-- === list of closure functors [c1 ... cn], ===--
+-- === hence: "f.[c1 ... cn]"                ===--
+-- =============================================--
 
---==========================================================--
+-- ==========================================================--
 --
 bcFdotC :: DRRSubst ->   -- binds domain variables to Points
            [DExpr] ->    -- the closure functor "[c1 ... cn]"
@@ -166,7 +166,7 @@ bcFdotC rho dxs newDs (Func dss dt) rep
          new_rep
           
 
---==========================================================--
+-- ==========================================================--
 -- apply some function to the max0 frontiers of a function
 -- and recalculate the corresponding min1 frontiers.
 --
@@ -193,7 +193,7 @@ bcApplyF0 f dss (Rep2 lf mf hfs)
          Rep2 new_lf new_mf new_hfs
 
 
---==========================================================--
+-- ==========================================================--
 --
 bcApplyF0_2 :: (FrontierElem -> FrontierElem) -> 
                [Domain] -> 
@@ -207,14 +207,14 @@ bcApplyF0_2 f dss fr@(Min1Max0 ar f1 f0)
          Min1Max0 ar new_f1 new_f0
 
 
---=================================================--
---=== Given embedding functor "e", function "f" ===--
---=== and closure functor "c", computes         ===--
---=== "e.f.c" (ie "Ge.f2.Fc", in accordance     ===--
---=== with Baraki's theory).                    ===--
---=================================================--
+-- =================================================--
+-- === Given embedding functor "e", function "f" ===--
+-- === and closure functor "c", computes         ===--
+-- === "e.f.c" (ie "Ge.f2.Fc", in accordance     ===--
+-- === with Baraki's theory).                    ===--
+-- =================================================--
 
---==========================================================--
+-- ==========================================================--
 --
 bcEdotFdotC :: DRRSubst ->  -- binds domain variables to Points
                DExpr ->     -- target domain functor, "Ge"
@@ -232,18 +232,18 @@ bcEdotFdotC rho g_e fDomain@(Func fds fdt) f f_cs
          Rep e_dot_f_dot_c
 
 
---==========================================================--
+-- ==========================================================--
 --
 bcGetR (d, r, t) = r
 bcGetD (d, r, t) = d
 bcGetT (d, r, t) = t
 
 
---=========================================================--
---=== Do Baraki-style concretisation of function points ===--
---=========================================================--
+-- =========================================================--
+-- === Do Baraki-style concretisation of function points ===--
+-- =========================================================--
 
---==========================================================--
+-- ==========================================================--
 --
 bcMakeInstance :: 
          Bool ->    -- True if use Baraki, False if use Conc
@@ -403,7 +403,7 @@ bcMakeInstance
    = acMakeInstance s_or_l simplest rho_d f
 
 
---==========================================================--
+-- ==========================================================--
 --
 bcClean :: DExpr -> DExpr
 
@@ -415,6 +415,6 @@ bcClean (DXLift2 dxs)       = DXLift2 (map bcClean dxs)
 bcClean (DXVar v)           = DXVar v
 bcClean (DXFunc dxss dxt)   = DXFunc (map bcClean dxss) (bcClean dxt)
 
---==========================================================--
---=== end                                  BarakiConc.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                                  BarakiConc.hs ===--
+-- ==========================================================--
index b4cfac1..33a5af2 100644 (file)
@@ -1,10 +1,10 @@
 
---==========================================================--
---=== Specialised meet to speed up calculation of meets  ===--
---=== in Gebre's polymorphic generalisation system       ===--
---===                                                    ===--
---===                                      BarakiMeet.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Specialised meet to speed up calculation of meets  ===--
+-- === in Gebre's polymorphic generalisation system       ===--
+-- ===                                                    ===--
+-- ===                                      BarakiMeet.hs ===--
+-- ==========================================================--
 
 
 module BarakiMeet where
@@ -18,7 +18,7 @@ import SuccsAndPreds2
 infix 9 %%
 
 
---==========================================================--
+-- ==========================================================--
 --
 bmNorm :: Domain -> Route -> Route
 
@@ -57,14 +57,14 @@ bmNorm_frel dss (MkFrel fels)
    = MkFrel (myZipWith2 bmNorm dss fels)
 
 
---==========================================================--
+-- ==========================================================--
 --
 bmGLB :: Route -> Route -> Route
 
 bmGLB (Rep rep1) (Rep rep2) = Rep (bmGLBrep rep1 rep2)
 
 
---==========================================================--
+-- ==========================================================--
 --
 bmGLBrep :: Rep -> Rep -> Rep
 
@@ -77,7 +77,7 @@ bmGLBrep (Rep2 lf1 mf1 hfs1) (Rep2 lf2 mf2 hfs2)
           (myZipWith2 bmGLBrep hfs1 hfs2)
 
 
---==========================================================--
+-- ==========================================================--
 --
 bmGLBfrontier :: Frontier -> Frontier -> Frontier
 
@@ -88,7 +88,7 @@ bmGLBfrontier (Min1Max0 ar1 _ f0a) (Min1Max0 ar2 _ f0b)
    = Min1Max0 ar1 [] (bmGLBmax0frontier f0a f0b)
 
 
---==========================================================--
+-- ==========================================================--
 --
 bmGLBmax0frontier :: [FrontierElem] -> [FrontierElem] -> [FrontierElem]
 
@@ -102,7 +102,7 @@ bmMaxAddPtfrel x ys
 pt `bmBelowMax0frel` f = myAny (pt `bmBelowEQfrel`) f
 
 
---==========================================================--
+-- ==========================================================--
 --
 bmBelowEQfrel :: FrontierElem -> FrontierElem -> Bool
 
@@ -110,7 +110,7 @@ bmBelowEQfrel (MkFrel rs1) (MkFrel rs2)
    = myAndWith2 (%%) rs1 rs2
 
 
---==========================================================--
+-- ==========================================================--
 --
 (%%) :: Route -> Route -> Bool
 
@@ -131,7 +131,7 @@ UpUp2 rs1    %%   _           = False
 Rep rep1     %%   Rep rep2    = bmBelowEQrep rep1 rep2
 
 
---==========================================================--
+-- ==========================================================--
 --
 bmBelowEQrep :: Rep -> Rep -> Bool
 
@@ -148,7 +148,7 @@ bmBelowEQrep (Rep2 lf1 mf1 hfs1) (Rep2 lf2 mf2 hfs2)
      myAndWith2 bmBelowEQrep hfs1 hfs2
 
 
---==========================================================--
+-- ==========================================================--
 --
 bmBelowEQfrontier :: Frontier -> Frontier -> Bool
 
@@ -166,6 +166,6 @@ bmBelowEQfrontier (Min1Max0 ar1 _ f0a) (Min1Max0 ar2 _ f0b)
      in
          outer f0b
 
---==========================================================--
---=== end                                  BarakiMeet.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                                  BarakiMeet.hs ===--
+-- ==========================================================--
index 73600eb..90a8ae8 100644 (file)
@@ -1,7 +1,7 @@
 
---==========================================================--
---=== Base declarations                      BaseDefs.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Base declarations                      BaseDefs.hs ===--
+-- ==========================================================--
 
 module BaseDefs where
 
@@ -365,14 +365,14 @@ data PartialExpr = NoOp
                    deriving (Eq)
 
 
---===============================================================--
---=== Definition of the static component                      ===--
---===---------------------------------------------------------===--
---=== The static component carries around all information     ===--
---=== which remains unchanged throughout strictness analysis. ===--
---=== This avoids having to pass around vast hordes of        ===--
---=== parameters containing static information.               ===--
---===============================================================--
+-- ===============================================================--
+-- === Definition of the static component                      ===--
+-- ===---------------------------------------------------------===--
+-- === The static component carries around all information     ===--
+-- === which remains unchanged throughout strictness analysis. ===--
+-- === This avoids having to pass around vast hordes of        ===--
+-- === parameters containing static information.               ===--
+-- ===============================================================--
      
 type StaticComponent 
     =  ( 
@@ -401,6 +401,6 @@ type StaticComponent
         )
 
 
---==========================================================--
---=== end                                    BaseDefs.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                                    BaseDefs.hs ===--
+-- ==========================================================--
index 7d7cd80..ee8fe8b 100644 (file)
@@ -1,8 +1,8 @@
 
---==========================================================--
---=== Constructor functions                              ===--
---===                                    Constructors.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Constructor functions                              ===--
+-- ===                                    Constructors.hs ===--
+-- ==========================================================--
 
 module Constructors where
 import BaseDefs
@@ -15,7 +15,7 @@ import AbstractMisc
 import Inverse
 import Apply
 
---==========================================================--
+-- ==========================================================--
 --
 coMakeConstructorInstance :: Bool ->         -- True == use mindless inverse
                              [ConstrElem] -> -- tells about constructor args
@@ -102,7 +102,7 @@ coMakeConstructorInstance mi cargs simplest_init usage
         else  Rep        (coCGen_aux mi tagTable actual)
 
 
---==========================================================--
+-- ==========================================================--
 --
 coCGen_aux :: Bool ->
               AList Route [FrontierElem] -> -- the tag/value table
@@ -148,7 +148,7 @@ coCGen_aux mi tt (Func dss gDomain@(Func dss2 dt))
      in  coCGen_aux mi newtt (Func (dss++dss2) dt)
 
 
---==========================================================--
+-- ==========================================================--
 --
 coCGen_aux_cross :: Bool -> 
                     AList [Route] [FrontierElem] -> 
@@ -193,6 +193,6 @@ coCGen_aux_cross mi tt dss dts
 
 
 
---==========================================================--
---=== end                                Constructors.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                                Constructors.hs ===--
+-- ==========================================================--
index 1d5ec71..6523d56 100644 (file)
@@ -1,27 +1,27 @@
 
---==========================================================--
---=== Dependancy analyser               dependancy.m (1) ===--
---==========================================================--
+-- ==========================================================--
+-- === Dependancy analyser               dependancy.m (1) ===--
+-- ==========================================================--
 
 module Dependancy where
 import BaseDefs
 import Utils
 
---==========================================================--
+-- ==========================================================--
 --
 deBindersOf       :: [(a,b)] -> [a]
 
 deBindersOf defns =  [name | (name, rhs) <- defns]
 
 
---==========================================================--
+-- ==========================================================--
 --
 deValuesOf        :: [(a,b)] -> [b]
 
 deValuesOf defns  =  [rhs  | (name, rhs) <- defns]
 
 
---==========================================================--
+-- ==========================================================--
 --
 deFreeVars :: CExpr -> AnnExpr Naam (Set Naam)
 
@@ -58,7 +58,7 @@ deFreeVars (ELet isRec defns body)
           bodyFree       = utSetSubtraction (deFreeVarsOf body') binderSet
 
 
---==========================================================--
+-- ==========================================================--
 --
 deFreeVarsOf :: AnnExpr Naam (Set Naam) -> Set Naam
 
@@ -66,7 +66,7 @@ deFreeVarsOf (free_vars, expr) = free_vars
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 deDepthFirstSearch :: (Ord a) =>
                       (a -> [a])   -> -- The map,
@@ -89,7 +89,7 @@ deDepthFirstSearch
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 deSpanningSearch   :: (Ord a) =>
                       (a -> [a])       -> -- The map
@@ -112,7 +112,7 @@ deSpanningSearch
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 deScc :: (Ord a) =>
          (a -> [a]) -> -- The "ins"  map
@@ -127,7 +127,7 @@ deScc ins outs
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 deDependancy :: CExprP Naam -> CExprP Naam
 
@@ -135,7 +135,7 @@ deDependancy = deDepends . deFreeVars
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 deDepends (free, ANum n)          = ENum n
 deDepends (free, AConstr n)       = EConstr n
@@ -164,7 +164,7 @@ deDepends (free, ALet isRec defns body)
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 deElet isRec dfs e 
    = if not isRec || nonRec dfs
@@ -174,6 +174,6 @@ deElet isRec dfs e
            nonRec [(n, (free, e))] = not (utSetElementOf n free)
            nonRec dfs              = False
 
---==========================================================--
---=== End                               dependancy.m (1) ===--
---==========================================================--
+-- ==========================================================--
+-- === End                               dependancy.m (1) ===--
+-- ==========================================================--
index abb37be..459ba84 100644 (file)
@@ -1,15 +1,15 @@
        
---==========================================================--
---=== Domain expressions.                                ===--
---===                                      DomainExpr.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Domain expressions.                                ===--
+-- ===                                      DomainExpr.hs ===--
+-- ==========================================================--
 
 module DomainExpr where
 import BaseDefs
 import Utils
 import MyUtils
 
---==========================================================--
+-- ==========================================================--
 --
 dxApplyDSubst_2 :: DExpr -> Domain
 
@@ -25,7 +25,7 @@ dxApplyDSubst_2 (DXFunc dxs dxt)    = Func (map dxApplyDSubst_2 dxs)
                                            (dxApplyDSubst_2 dxt)
 
 
---==========================================================--
+-- ==========================================================--
 --
 dxApplyDSubst :: DSubst -> DExpr -> Domain
 
@@ -41,7 +41,7 @@ dxApplyDSubst rho (DXFunc dxs dxt)   = Func (map (dxApplyDSubst rho) dxs)
                                             (dxApplyDSubst rho dxt)
 
 
---==========================================================--
+-- ==========================================================--
 --
 dxNormaliseDExpr :: DExpr -> DExpr
 
@@ -56,7 +56,7 @@ dxNormaliseDExpr (DXLift2 dxs)   = DXLift2 (map dxNormaliseDExpr dxs)
 dxNormaliseDExpr (DXVar v)       = DXVar v
 
 
---==========================================================--
+-- ==========================================================--
 --
 dxContainsFnSpace :: DExpr -> Bool
 
@@ -67,7 +67,7 @@ dxContainsFnSpace (DXFunc _ _)    = True
 dxContainsFnSpace (DXVar _)       = False
 
 
---==========================================================--
+-- ==========================================================--
 --
 dxContainsSubsidiaryFnSpace :: DExpr -> Bool
 
@@ -87,7 +87,7 @@ dxContainsSubsidiaryFnSpace (DXVar _)
    = False
 
 
---==========================================================--
+-- ==========================================================--
 --        big       small
 dxDiff :: Domain -> Domain -> (DExpr, DSubst)
 
@@ -140,6 +140,6 @@ dxDiff_list other1 other2
    = panic "dxDiff_list: unequal lists"
 
 
---==========================================================--
---=== end                                  DomainExpr.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                                  DomainExpr.hs ===--
+-- ==========================================================--
index d3866af..f4f823f 100644 (file)
@@ -1,8 +1,8 @@
 
---==========================================================--
---=== Add parameters to supercombinators which           ===--
---=== otherwise return functions          EtaAbstract.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Add parameters to supercombinators which           ===--
+-- === otherwise return functions          EtaAbstract.hs ===--
+-- ==========================================================--
 
 module EtaAbstract where
 import BaseDefs
@@ -10,7 +10,7 @@ import Utils
 import MyUtils
 
 
---==========================================================--
+-- ==========================================================--
 -- Doesn't assume that the tree has been lambda-lifted.
 -- It does however assume that all lambda-terms are 
 -- directly attached to a let-binding.
@@ -46,7 +46,7 @@ eaEtaAbstract ae@(tau, ALet rf defs body)
      in (tau, ALet rf fixedDefs (eaEtaAbstract body))
         
 
---==========================================================--
+-- ==========================================================--
 --
 eaMain :: (Naam, AnnExpr Naam TExpr) ->
           [TExpr] ->
@@ -66,7 +66,7 @@ eaMain (scname, (tau, ALam vs (tau2, rhs))) argTs resT
      in (scname, (tau, ALam (vs++newArgs) newBody))
 
 
---==========================================================--
+-- ==========================================================--
 --
 eaMakeApChain :: [((Naam, TExpr), TExpr)] ->
                  AnnExpr Naam TExpr ->
@@ -77,7 +77,7 @@ eaMakeApChain (((v, vtype), vaptype):rest) app
    = eaMakeApChain rest (vaptype, AAp app (vtype, AVar v))
 
 
---==========================================================--
+-- ==========================================================--
 --
 eaMakeNewArgs :: Int -> [Naam] -> [Naam]
 
@@ -89,7 +89,7 @@ eaMakeNewArgs n vs
      in newNames
 
 
---==========================================================--
+-- ==========================================================--
 --
 eaCurry :: TExpr -> [TExpr] -> TExpr
 
@@ -97,7 +97,7 @@ eaCurry resT []           = resT
 eaCurry resT (argT:argTs) = TArr argT (eaCurry resT argTs)
 
 
---==========================================================--
+-- ==========================================================--
 --
 eaUncurry :: TExpr -> ([TExpr], TExpr)
 
@@ -111,8 +111,8 @@ eaUncurry (TCons tcon targs)
    = ([], TCons tcon targs)
 
 
---==========================================================--
---=== end                                 EtaAbstract.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                                 EtaAbstract.hs ===--
+-- ==========================================================--
 
 
index b07556d..671b438 100644 (file)
@@ -1,12 +1,12 @@
 
---==========================================================--
---=== Find frontiers using Hunt's algorithm.             ===--
---=== Only works for functions whose result lattice      ===--
---=== does not contain any function spaces               ===--
---=== ("data functions").                                ===--
---===                                                    ===--
---===                                  FrontierDATAFN.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Find frontiers using Hunt's algorithm.             ===--
+-- === Only works for functions whose result lattice      ===--
+-- === does not contain any function spaces               ===--
+-- === ("data functions").                                ===--
+-- ===                                                    ===--
+-- ===                                  FrontierDATAFN.hs ===--
+-- ==========================================================--
 
 module FrontierDATAFN2 where
 import BaseDefs
@@ -21,7 +21,7 @@ import FrontierMisc2
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 fdImprove :: (Route -> Route) ->    -- coercion function
              MemoList ->            -- possibly useful info
@@ -51,7 +51,7 @@ fdImprove coerce memo dss naive max0_super min1_super
          (new_max0, new_min1)
 
 
---==========================================================--
+-- ==========================================================--
 --
 fdFind :: ACMode ->
           HExpr Naam ->        -- tree of abstract function
@@ -148,7 +148,7 @@ fdFind s_or_l hexpr (Func dss (Lift2 dts)) small_argds big_argds
           midfact_memo_additions ++ hifact_memo_additions)
 
 
---==========================================================--
+-- ==========================================================--
 --
 fdFind_aux :: ACMode ->
               [Domain] ->          -- small argument domains
@@ -190,7 +190,7 @@ fdFind_aux s_or_l small_argds big_argds dts hexpr prev_hfs coerce
          (hifacts, hf_memo_additions)
 
 
---==========================================================--
+-- ==========================================================--
 --
 fdIdent :: Route -> Route
 fdIdent p  = p
@@ -222,7 +222,7 @@ fdIsZero :: Route -> Bool
 fdIsZero x = case x of {Zero -> True; One -> False}
 
 
---==========================================================--
+-- ==========================================================--
 --
 fdFs2 :: ACMode -> 
          HExpr Naam ->         -- the tree
@@ -254,7 +254,7 @@ fdFs2 s_or_l hexpr small_argds big_argds min1_prev max0_prev coerce
 --     f0 == spMax0FromMin1 dss f1
 
 
---==========================================================--
+-- ==========================================================--
 --
 fdFs_aux :: ACMode ->
             HExpr Naam ->        -- the tree
@@ -303,6 +303,6 @@ fdFs_aux s_or_l hexpr small_argds big_argds
        
 
 
---==========================================================--
---=== end                              FrontierDATAFN.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                              FrontierDATAFN.hs ===--
+-- ==========================================================--
index 7fafd93..3bff77d 100644 (file)
@@ -1,8 +1,8 @@
 
---==========================================================--
---=== Find frontiers using Hunt's algorithm.             ===--
---===                                 FrontierSearch5.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Find frontiers using Hunt's algorithm.             ===--
+-- ===                                 FrontierSearch5.hs ===--
+-- ==========================================================--
 
 module FrontierGENERIC2 where
 import BaseDefs
@@ -18,7 +18,7 @@ import AbstractMisc
 import Apply
 
 
---==========================================================--
+-- ==========================================================--
 --
 fsMakeFrontierRep :: ACMode ->      -- safe or live
                      Bool ->        -- True == naive initialisation
@@ -73,7 +73,7 @@ fsMakeFrontierRep s_or_l naive hexpr func_domain big_arg_ds
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 fsFind :: ACMode ->
           HExpr Naam ->       -- tree
@@ -193,7 +193,7 @@ fsFind
          Rep2 lofact midfact hifacts
 
 
---==========================================================--
+-- ==========================================================--
 --
 fsApp :: [AppInfo] ->
          [HExpr Naam] ->
@@ -238,7 +238,7 @@ fsApp ((AHi2 n x d):as) xs h
          fsApp as (drop n xs) (HPoint nth_upp_obj)
 
 
---==========================================================--
+-- ==========================================================--
 --
 fsEvalConst :: HExpr Naam ->
                [HExpr Naam] ->
@@ -249,7 +249,7 @@ fsEvalConst h@(HPoint p) [] = p
 fsEvalConst h@(HPoint _) xs = aeEvalConst (HVAp h xs)
 
 
---==========================================================--
+-- ==========================================================--
 --
 fsFs2 :: ACMode ->
          HExpr Naam ->
@@ -294,7 +294,7 @@ fsFs2
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 fsFs_aux :: ACMode ->
             HExpr Naam ->
@@ -365,6 +365,6 @@ fsFs_aux
        
 
 
---==========================================================--
---=== end                             FrontierSearch5.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                             FrontierSearch5.hs ===--
+-- ==========================================================--
index 4064ee0..e075880 100644 (file)
@@ -1,8 +1,8 @@
 
---==========================================================--
---=== Miscellaneous stuff for the frontiers algorithm.   ===--
---===                                    FrontierMisc.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Miscellaneous stuff for the frontiers algorithm.   ===--
+-- ===                                    FrontierMisc.hs ===--
+-- ==========================================================--
 
 module FrontierMisc2 where
 import BaseDefs
@@ -14,7 +14,7 @@ import AbstractMisc
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 fsZULB :: Rep -> Rep -> Rep
 
@@ -31,7 +31,7 @@ fsZULB_2 (Min1Max0 aru f1u f0u) (Min1Max0 arl f1l f0l)
    = Min1Max0 aru f1l f0u
 
 
---==========================================================--
+-- ==========================================================--
 --
 fmSelect :: Int ->
             [FrontierElem] ->
@@ -55,7 +55,7 @@ fmSelect a_rand up_space down_space fromTop
          else Just (first  selected_pair)
 
 
---==========================================================--
+-- ==========================================================--
 --
 fmIsNothing :: Maybe a -> Bool
 
@@ -63,7 +63,7 @@ fmIsNothing Nothing   = True
 fmIsNothing (Just _)  = False
 
 
---==========================================================--
+-- ==========================================================--
 --
 fmMaxIntersection :: [FrontierElem] -> [FrontierElem] -> [FrontierElem]
 
@@ -71,7 +71,7 @@ fmMaxIntersection xx yy
    = avMaxfrel [ x `avGLBfrel` y | x <- xx, y <- yy ]
 
 
---==========================================================--
+-- ==========================================================--
 --
 fmMinIntersection :: [FrontierElem] -> [FrontierElem] -> [FrontierElem]
 
@@ -79,7 +79,7 @@ fmMinIntersection xx yy
    = avMinfrel [ x `avLUBfrel` y | x <- xx, y <- yy ]
 
 
---==========================================================--
+-- ==========================================================--
 --
 fmReviseMinXX :: [Domain] ->
                  [FrontierElem] -> 
@@ -101,7 +101,7 @@ fmReviseMinXX ds trial_min_xx args
          optimised_result
 
 
---==========================================================--
+-- ==========================================================--
 --
 fmReviseMaxYY :: [Domain] -> 
                  [FrontierElem] -> 
@@ -123,6 +123,6 @@ fmReviseMaxYY ds trial_max_yy args
          optimised_result
 
 
---==========================================================--
---=== end                                FrontierMisc.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                                FrontierMisc.hs ===--
+-- ==========================================================--
index bcdcab5..36292bd 100644 (file)
@@ -1,8 +1,8 @@
 
---==========================================================--
---=== Computes inverses of function applications.        ===--
---===                                         Inverse.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Computes inverses of function applications.        ===--
+-- ===                                         Inverse.hs ===--
+-- ==========================================================--
 
 module Inverse where
 import BaseDefs
@@ -14,7 +14,7 @@ import AbstractMisc
 import Apply
 
 
---==========================================================--
+-- ==========================================================--
 --
 inMinInverse :: Bool -> Domain -> Route -> Route -> [FrontierElem]
 
@@ -23,7 +23,7 @@ inMinInverse mindless fDomain (Rep f) res
    | otherwise  = second (inMMI fDomain f res)
 
 
---==========================================================--
+-- ==========================================================--
 --
 inMaxInverse :: Bool -> Domain -> Route -> Route -> [FrontierElem]
 
@@ -32,7 +32,7 @@ inMaxInverse mindless fDomain (Rep f) res
    | otherwise  = first (inMMI fDomain f res)
 
 
---==========================================================--
+-- ==========================================================--
 --
 inMMI_mindless :: Domain -> Rep -> Route -> ([FrontierElem], [FrontierElem])
 
@@ -41,7 +41,7 @@ inMMI_mindless (Func dss dt) f a
      in (avMaxfrel totalInverseImage, avMinfrel totalInverseImage)
 
 
---==========================================================--
+-- ==========================================================--
 --
 inNormalise :: [FrontierElem] -> 
                [FrontierElem] -> 
@@ -54,7 +54,7 @@ inNormalise max min
          (new_max, new_min)
 
 
---==========================================================--
+-- ==========================================================--
 --
 inIntersect :: ([FrontierElem], [FrontierElem]) ->
                ([FrontierElem], [FrontierElem]) ->
@@ -66,7 +66,7 @@ inIntersect (max1, min1) (max2, min2)
      in  inNormalise new_max new_min
 
 
---==========================================================--
+-- ==========================================================--
 --
 inMMI :: Domain -> Rep -> Route -> ([FrontierElem], [FrontierElem])
 
@@ -148,7 +148,7 @@ inMMI dss f a
    = inMMI_mindless dss f a
 
 
-----==========================================================--
+-- ==========================================================--
 ----
 --inPapL :: Point -> [Point] -> Point
 --
@@ -169,7 +169,7 @@ inMMI dss f a
 --         RFunc (RepTwo (Min1Max0 (ar-argCount) newf1 newf0)))
 --
 
---==========================================================--
+-- ==========================================================--
 --
 inInverse_mindless :: [Domain] -> Rep -> Route -> [FrontierElem]
 
@@ -190,7 +190,7 @@ inInverse_mindless argDomains f a
 --inTrace :: Bool -> Bool
 --inTrace x = x
 
---==========================================================--
---=== end                                     Inverse.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                                     Inverse.hs ===--
+-- ==========================================================--
 
index 8118614..045886f 100644 (file)
@@ -1,8 +1,8 @@
 
---==========================================================--
---=== The Lambda-lifter                                  ===--
---===                                     LambdaLift5.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === The Lambda-lifter                                  ===--
+-- ===                                     LambdaLift5.hs ===--
+-- ==========================================================--
 
 module LambdaLift5 where
 import BaseDefs
@@ -12,7 +12,7 @@ import Dependancy
 
 import List(nub) -- 1.3
 
---==========================================================--
+-- ==========================================================--
 -- First, put "split" lambda abstractions back together.
 -- Largely decorative, but it seems like a sensible thing to do.
 --
@@ -34,7 +34,7 @@ llMergeLams (ELet rf defs e)
    = ELet rf (map2nd llMergeLams defs) (llMergeLams e)
 
 
---==========================================================--
+-- ==========================================================--
 -- Now give a name to all anonymous lambda abstractions.
 -- As it happens, they all get the same name, but that's not
 -- a problem: they get different names later on.
@@ -58,7 +58,7 @@ llName (ELet rf defs e)
         fix (n, non_lam_e) = (n, llName non_lam_e)
 
 
---==========================================================--
+-- ==========================================================--
 -- Next, travel over the tree and attach a number to each
 -- name, making them all unique.  This implicitly defines the
 -- scope bindings used.
@@ -109,7 +109,7 @@ llUnique ns dict (ELet rf defs e)
      in (final_ns, ELet rf new_defs new_e)
 
 
---==========================================================--
+-- ==========================================================--
 -- Makes sure a set of names is unique.
 --
 llCheckUnique :: [Naam] -> 
@@ -126,7 +126,7 @@ llCheckUnique names
            else myFail ("Duplicate identifiers in the same scope:\n\t" ++ show dups)
 
 
---==========================================================--
+-- ==========================================================--
 -- By now each variable is uniquely named, let bound vars have
 -- been given a leading underscore, and, importantly, each lambda term
 -- has an associated let-binding.  Now do a free variables pass.
@@ -173,7 +173,7 @@ llFreeVars (ECase e alts)
      in (utSetUnion eFree free, ACase e' alts')
 
 
---==========================================================--
+-- ==========================================================--
 -- Extract the set equations.
 --
 llEqns :: AnnExpr Naam (Set Naam) ->
@@ -197,7 +197,7 @@ llEqns (_, ALet rf defs body)
      in  eqnsHere ++ innerEqns ++ nextEqns
 
 
---==========================================================--
+-- ==========================================================--
 -- Now we use the information from the previous pass to
 -- fix up usages of functions.
 --
@@ -239,7 +239,7 @@ llAddParams env (_, ALet rFlag defs body)
              in (n, ELam new_params (llAddParams env (df, non_lambda_rhs)))
 
 
---==========================================================--
+-- ==========================================================--
 -- The only thing that remains to be done is to flatten
 -- out the program, by lifting out all the let (and hence lambda)
 -- bindings to the top level.
@@ -293,7 +293,7 @@ llFlatten (ELet rf dl rhs)
         inside (name, (inDs, frhs)) = inDs
 
 
---==========================================================--
+-- ==========================================================--
 -- The transformed program is now correct, but hard to read
 -- because all variables have a number on.  This function
 -- detects non-contentious variable names and deletes 
@@ -355,7 +355,7 @@ llPretty (scDefs, scFrees)
         (scDefs2, scFrees2)
 
 
---==========================================================--
+-- ==========================================================--
 --
 llSplitSet :: Set Naam -> (Set Naam, Set Naam)
 
@@ -366,7 +366,7 @@ llSplitSet list
             (fs, vs) -> (utSetFromList fs, utSetFromList vs)
 
 
---==========================================================--
+-- ==========================================================--
 --
 llZapBuiltins :: [Naam] -> Eqn -> Eqn
 
@@ -374,7 +374,7 @@ llZapBuiltins builtins (EqnNVC n v c)
    = EqnNVC n v (utSetFromList (filter (`notElem` builtins) (utSetToList c)))
 
 
---==========================================================--
+-- ==========================================================--
 --
 llSolveIteratively :: [Eqn] -> AList Naam (Set Naam)
 
@@ -392,7 +392,7 @@ llSolveIteratively eqns
              in  case llSplitSet allSub of (facc, vacc) -> (n, vacc)
 
 
---==========================================================--
+-- ==========================================================--
 -- Map a function over a core tree.
 -- *** Haskell-B 9972 insists on restricted signature, why? ***
 --
@@ -412,7 +412,7 @@ llMapCoreTree f (ECase sw alts)
         [(cn, (map f ps, llMapCoreTree f rhs)) | (cn, (ps, rhs)) <- alts]
 
 
---==========================================================--
+-- ==========================================================--
 --
 llMain :: [Naam] ->
           CExprP Naam ->
@@ -444,6 +444,6 @@ llMain builtInNames expr doPretty =
    in  (exprDepended, prettyNewParams)
 
 
---==========================================================--
---=== end                                 LambdaLift5.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                                 LambdaLift5.hs ===--
+-- ==========================================================--
index f331f32..74fe9fd 100644 (file)
@@ -1,7 +1,7 @@
  
---==========================================================--
---=== Main module                                Main.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Main module                                Main.hs ===--
+-- ==========================================================--
 
 module Main where
 import BaseDefs
@@ -18,7 +18,7 @@ import ReadTable
 import System -- partain: for 1.3
 import Char(isDigit)
 
---==========================================================--
+-- ==========================================================--
 --
 maBaseTypes :: TcTypeEnv
 
@@ -45,7 +45,7 @@ maBaseTypes
      ] 
 
 
---==========================================================--
+-- ==========================================================--
 --
 maBaseAnns :: AList Naam (HExpr Naam)
 
@@ -84,7 +84,7 @@ maBaseAnns
                                   [MkFrel [Zero, Zero]])))
 
 
---==========================================================--
+-- ==========================================================--
 --
 maKludgeFlags :: [Flag] -> [Flag]
 
@@ -94,7 +94,7 @@ maKludgeFlags flags
      else                       flags ++ bdDefaultSettings
      
 
---==========================================================--
+-- ==========================================================--
 --
 maStrictAn :: AList Domain Int -> [Flag] -> [Char] -> [Char]
 
@@ -149,7 +149,7 @@ maStrictAn table flagsInit fileName
          fullEnvAug = fullEnv ++ map2nd deScheme maBaseTypes
          deScheme (Scheme _ texpr) = texpr
 
---==========================================================--
+-- ==========================================================--
 --
 --main :: [Response] -> [Request]
 
@@ -165,7 +165,7 @@ main = do
     putStr (maStrictAn table cmd_line_args file_contents)
 
 
---==========================================================--
+-- ==========================================================--
 --
 maGetFlags :: [String] -> [Flag]
 
@@ -200,7 +200,7 @@ maGetFlags
 maGetFlags (other:_) = myFail ("Unknown flag: " ++ other ++ maUsage )
 
 
---==========================================================--
+-- ==========================================================--
 --
 maUsage :: String
 
@@ -228,6 +228,6 @@ maUsage
      ]
 
 
---==========================================================--
---=== end                                        Main.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                                        Main.hs ===--
+-- ==========================================================--
index 2f7455e..deef141 100644 (file)
@@ -1,7 +1,7 @@
 
---==========================================================--
---=== Build abstract domains     File: MakeDomains.m (1) ===--
---==========================================================--
+-- ==========================================================--
+-- === Build abstract domains     File: MakeDomains.m (1) ===--
+-- ==========================================================--
 
 module MakeDomains where
 import BaseDefs
@@ -10,7 +10,7 @@ import Dependancy
 
 import List(nub) -- 1.3
 
---==========================================================--
+-- ==========================================================--
 --
 mdFreeTVarsIn :: TypeDef ->  -- a type definition
                  [Naam]      -- variables free in it
@@ -27,7 +27,7 @@ mdFreeTVarsIn (tn, tvl, cal)
         allTVs (TDefCons n tel) = n:concat (map allTVs tel)
 
 
---==========================================================--
+-- ==========================================================--
 --
 mdMakeEdges :: [TypeDef] ->    -- all type definitions
                [(Naam, Naam)]  -- all edges resulting (from, to)
@@ -41,7 +41,7 @@ mdMakeEdges tdl
         mergeFromTo (f, tol) = [(f, t) | t <- tol]
 
 
---==========================================================--
+-- ==========================================================--
 --
 mdTypeDependancy :: [TypeDef] ->    -- all type definitions
                     TypeDependancy  -- list of groups & rec flag
@@ -63,7 +63,7 @@ mdTypeDependancy tdl
                                               | otherwise  = findAIn rest
 
 
---==========================================================--
+-- ==========================================================--
 --
 mdIsRecursiveType :: TypeDependancy -> 
                      Naam ->
@@ -77,6 +77,6 @@ mdIsRecursiveType typedependancy typeName
            | otherwise               = search rest
 
      
---==========================================================--
---=== end                              MakeDomains.m (1) ===--
---==========================================================--
+-- ==========================================================--
+-- === end                              MakeDomains.m (1) ===--
+-- ==========================================================--
index b020195..f2dd789 100644 (file)
@@ -1,9 +1,9 @@
 
---==========================================================--
---=== Monster -- Enumerates the points in a lattice.     ===--
---=== Not part of the strictness analyser proper.        ===--
---===                                         Monster.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Monster -- Enumerates the points in a lattice.     ===--
+-- === Not part of the strictness analyser proper.        ===--
+-- ===                                         Monster.hs ===--
+-- ==========================================================--
 
 module Monster where
 import BaseDefs
@@ -36,6 +36,6 @@ main
                      "\n\nEnter the domain: " ]
 
 
---==========================================================--
---=== end                                     Monster.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                                     Monster.hs ===--
+-- ==========================================================--
index c4f8971..11bd203 100644 (file)
@@ -1,15 +1,15 @@
 
---==========================================================--
---=== Various useful bits & pieces                       ===--
---===                                         MyUtils.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Various useful bits & pieces                       ===--
+-- ===                                         MyUtils.hs ===--
+-- ==========================================================--
 
 module MyUtils where
 import BaseDefs
 
 infixl 9 ##
 
---==========================================================--
+-- ==========================================================--
 --
 myFail msg
    = error ("\n" ++ msg ++ "\n")
@@ -18,14 +18,14 @@ panic msg
    = error ("\nPanic! (the `impossible' happened):\n" ++ msg ++ "\n")
 
 
---==========================================================--
+-- ==========================================================--
 --
 mySubtract :: Int -> Int -> Int
 
 mySubtract x y = y - x
 
 
---==========================================================--
+-- ==========================================================--
 --
 myZipWith2 :: (a -> b -> c) -> [a] -> [b] -> [c]
 
@@ -36,7 +36,7 @@ myZipWith2 _ _      _      = panic "myZipWith2: unequal lists"
 myZip2 = myZipWith2 (\a b -> (a, b))
 
 
---==========================================================--
+-- ==========================================================--
 --
 myZipWith3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
 
@@ -47,7 +47,7 @@ myZipWith3 _ _      _      _      = panic "myZipWith3: unequal lists"
 myZip3 = myZipWith3 (\a b c -> (a, b, c))
 
 
---==========================================================--
+-- ==========================================================--
 --
 myZipWith4 :: (a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
 
@@ -58,7 +58,7 @@ myZipWith4 _ _      _      _      _      = panic "myZipWith4: unequal lists"
 myZip4 = myZipWith4 (\a b c d -> (a, b, c, d))
 
 
---==========================================================--
+-- ==========================================================--
 --
 myZipWith5 :: (a -> b -> c -> d -> e -> f) -> 
               [a] -> [b] -> [c] -> [d] -> [e] -> [f]
@@ -72,7 +72,7 @@ myZipWith5 _ _      _      _      _      _
 myZip5 = myZipWith5 (\a b c d e -> (a, b, c, d, e))
 
 
---==========================================================--
+-- ==========================================================--
 --
 myAndWith2 :: (a -> b -> Bool) -> [a] -> [b] -> Bool
 
@@ -88,7 +88,7 @@ myAndWith2 _ _      _
    = panic "myAndWith2: unequal lists"
 
 
---==========================================================--
+-- ==========================================================--
 --
 myAny, myAll :: (a -> Bool) -> [a] -> Bool
 
@@ -99,7 +99,7 @@ myAll p []       = True
 myAll p (x:xs)   = if p x then myAll p xs else False
 
 
---==========================================================--
+-- ==========================================================--
 --
 myAnd, myOr :: [Bool] -> Bool
 
@@ -110,7 +110,7 @@ myOr  []        = False
 myOr  (x:xs)    = if x then True else myOr xs
 
 
---==========================================================--
+-- ==========================================================--
 --
 myListVariants :: [a] -> [[a]] -> [[a]]
 
@@ -122,7 +122,7 @@ myListVariants (x:xs) (rs:rss)
 myListVariants _ _ = panic "myListVariants: unequal lists"
 
 
---==========================================================--
+-- ==========================================================--
 --
 myCartesianProduct :: [[a]] -> [[a]]
 
@@ -135,14 +135,14 @@ myCartesianProduct (xs:xss)
          concat (map (g xs) (myCartesianProduct xss))
 
 
---==========================================================--
+-- ==========================================================--
 --
 mySeq :: (Eq a) => a -> b -> b
 
 mySeq x y | x == x = y
 
 
---==========================================================--
+-- ==========================================================--
 --
 myIntsFromTo :: Int -> Int -> [Int]
 
@@ -152,14 +152,14 @@ myIntsFromTo n m
      else   n : myIntsFromTo (n + (1 :: Int)) m
 
 
---==========================================================--
+-- ==========================================================--
 --
 myIntsFrom :: Int -> [Int]
 
 myIntsFrom n = n : myIntsFrom (n + (1 :: Int))
 
 
---==========================================================--
+-- ==========================================================--
 --
 (##) :: [b] -> Int -> b
 
@@ -169,6 +169,6 @@ myIntsFrom n = n : myIntsFrom (n + (1 :: Int))
    = if n == (0 :: Int) then x else xs ## (n - (1 :: Int))
 
 
---==========================================================--
---=== end                                     MyUtils.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                                     MyUtils.hs ===--
+-- ==========================================================--
index 4dd06e8..3d29234 100644 (file)
@@ -1,7 +1,7 @@
 
---==========================================================--
---=== Parser of Core programs          File: parse.m (1) ===--
---==========================================================--
+-- ==========================================================--
+-- === Parser of Core programs          File: parse.m (1) ===--
+-- ==========================================================--
 
 module Parser2 where
 import BaseDefs
@@ -12,11 +12,11 @@ import MakeDomains
 import List(nub) -- 1.3
 import Char(isAlpha,isDigit) -- 1.3
 
---====================================--
---=== Lexical analyser             ===--
---====================================--
+-- ====================================--
+-- === Lexical analyser             ===--
+-- ====================================--
 
---==========================================================--
+-- ==========================================================--
 --
 paLex :: Int -> 
          [Char] -> 
@@ -60,12 +60,12 @@ paLex n (c:cs)
 
 paLex n [] = [(999999, "$$$")]
 
---====================================--
---=== Generic parsing functions    ===--
---====================================--
+-- ====================================--
+-- === Generic parsing functions    ===--
+-- ====================================--
 
 
---==========================================================--
+-- ==========================================================--
 --
 paFailed (PFail _) = True
 paFailed (POk _ _) = False
@@ -78,7 +78,7 @@ paGetRest (POk _ rest) = rest
 paGetRest (PFail rest) = rest
 
 
---==========================================================--
+-- ==========================================================--
 --
 paLit :: [Char] -> 
          Parser [Char]
@@ -88,7 +88,7 @@ paLit lit ((n, t):ts)  | lit == t     = POk lit ts
                        | otherwise    = PFail ((n, t):ts)
 
 
---==========================================================--
+-- ==========================================================--
 --
 paAlts :: [([Char] -> Bool, Parser a)] -> Parser a
 
@@ -100,7 +100,7 @@ paAlts ((pred, par):pps) toks@((n,t):_)
    | otherwise = paAlts pps toks
 
 
---==========================================================--
+-- ==========================================================--
 --
 paThen2 :: (a -> b -> c) ->
            Parser a ->
@@ -117,7 +117,7 @@ paThen2 combine p1 p2 toks
                  (paGetRest p2parse)
 
 
---==========================================================--
+-- ==========================================================--
 --
 paThen3 :: (a -> b -> c -> d) ->
            Parser a ->
@@ -138,7 +138,7 @@ paThen3 combine p1 p2 p3 toks
                 (paGetRest p3parse)
 
 
---==========================================================--
+-- ==========================================================--
 --
 paThen4 :: (a -> b -> c -> d -> e) ->
            Parser a ->
@@ -162,7 +162,7 @@ paThen4 combine p1 p2 p3 p4 toks
                 (paGetRest p4parse)
 
 
---==========================================================--
+-- ==========================================================--
 --
 paZeroOrMore :: Parser a -> Parser [a]
 
@@ -177,7 +177,7 @@ paZeroOrMore p toks
         else POk ((paGetItem pParse):paGetItem zmParse) zmUnused
 
 
---==========================================================--
+-- ==========================================================--
 --
 paOneOrMore :: Parser a -> Parser [a]
 
@@ -185,7 +185,7 @@ paOneOrMore p
    = paThen2 (:) p (paZeroOrMore p)
 
 
---==========================================================--
+-- ==========================================================--
 --
 paOneOrMoreWithSep :: Parser a -> 
                       Parser b -> 
@@ -205,7 +205,7 @@ paOneOrMoreWithSep p psep toks
         else POk ((paGetItem pParse):paGetItem mParse) mRest
 
 
---==========================================================--
+-- ==========================================================--
 --
 paApply :: Parser a -> 
            (a -> b) -> 
@@ -219,7 +219,7 @@ paApply p f toks
         else    POk (f (paGetItem pParse)) (paGetRest pParse)
 
 
---==========================================================--
+-- ==========================================================--
 --
 paSat :: (String -> Bool) ->
          Parser String
@@ -230,18 +230,18 @@ paSat pred ((n,t):toks)
    | otherwise  = PFail toks
 
 
---==========================================================--
+-- ==========================================================--
 --
 paEmpty :: a -> Parser a
 
 paEmpty v toks = POk v toks
 
 
---====================================--
---=== Specific parsing functions   ===--
---====================================--
+-- ====================================--
+-- === Specific parsing functions   ===--
+-- ====================================--
 
---================================================--
+-- ================================================--
 paSyntax 
    = get_parse . paProgram
      where
@@ -258,40 +258,40 @@ paSyntax
 
         get_parse (POk prog [(999999, "$$$")]) = prog
 
---================================================--
+-- ================================================--
 paProgram = paThen3 f paTypeDefList (paLit ";;") paScdefs
             where f a b c = (a,c)
 
---================================================--
+-- ================================================--
 paName = paSat paIsName
 
---================================================--
+-- ================================================--
 paIsName s = isAlpha (head s) &&  not (s `elem` paKeywords)
 
---================================================--
+-- ================================================--
 paCname = paSat paIsCname
 
---================================================--
+-- ================================================--
 paIsCname s = ('A'<=(head s)) && 
               ((head s)<='Z') && 
               not (s `elem` paKeywords)
 
---================================================--
+-- ================================================--
 paKeywords = ["let", "letrec", "case", "in", "of", "end"]
 
---================================================--
+-- ================================================--
 paRelops = ["<=", "<", ">=", ">", "==", "~="]
 
---================================================--
+-- ================================================--
 paIsRelop op = op `elem` paRelops
 
---================================================--
+-- ================================================--
 paRelop = paSat paIsRelop
 
---================================================--
+-- ================================================--
 paNum = paSat paIsNum `paApply` paNumval
 
---================================================--
+-- ================================================--
 paNumval :: [Char] -> Int
 paNumval cs 
    = sum (powers 1 (map (\d -> fromEnum d - 48) (reverse cs)))
@@ -299,33 +299,33 @@ paNumval cs
         powers n [] = []
         powers n (h:t) = n*h : powers ((10 :: Int) *n) t
 
---================================================--
+-- ================================================--
 paIsNum = isDigit.head
 
---================================================--
+-- ================================================--
 paWithTrailingSemi p = paThen2 const p (paLit ";")
 
---==================================--
---=== Parsing type definitions   ===--
---==================================--
+-- ==================================--
+-- === Parsing type definitions   ===--
+-- ==================================--
 
---================================================--
+-- ================================================--
 paTypeDefList = paZeroOrMore (paThen2 f paTypeDef (paLit ";"))
                 where f a b = a
 
---================================================--
+-- ================================================--
 paTypeDef 
    = paThen4 f paName (paZeroOrMore paName) (paLit "::=") paConstrAlts
      where f a b c d = (a,b,d)
 
---================================================--
+-- ================================================--
 paConstrAlts = paOneOrMoreWithSep paConstrAlt (paLit "|")
 
---================================================--
+-- ================================================--
 paConstrAlt = paThen2 f paCname (paZeroOrMore paTDefExpr)
               where f a b = (a,b)
 
---================================================--
+-- ================================================--
 paTDefExpr
     = paAlts [ (  (== "("),   paTDefExpr2  ),
                (  paIsName,   paApply paName TDefVar) ]
@@ -336,19 +336,19 @@ paTDefExpr
          h a b = TDefCons a b
 
 
---===========================================--
---=== Parsing supercombinator definitions ===--
---===========================================--
+-- ===========================================--
+-- === Parsing supercombinator definitions ===--
+-- ===========================================--
 
---================================================--
+-- ================================================--
 paScdefs = paOneOrMore (paWithTrailingSemi paSc)
 
---================================================--
+-- ================================================--
 paSc = paThen4 mk_sc paName (paZeroOrMore paName) (paLit "=") paExpr
        where
           mk_sc sc args eq rhs = (sc, (args, rhs))
 
---================================================--
+-- ================================================--
 paExpr
    = paAlts [  (  (== "let"),  paLet    ),
                (  (== "letrec"), paLetrec ),
@@ -357,7 +357,7 @@ paExpr
                (  (const True),  paExpr1 ) ]
 
 
---================================================--
+-- ================================================--
 paLet = paThen4 mk_let
               (paLit "let")
               paDefns
@@ -366,7 +366,7 @@ paLet = paThen4 mk_let
         mk_let lett defns inn expr = ELet False defns expr
 
 
---================================================--
+-- ================================================--
 paLetrec = paThen4 mk_letrec
               (paLit "letrec")
               paDefns
@@ -375,102 +375,102 @@ paLetrec = paThen4 mk_letrec
            mk_letrec letrecc defns inn expr = ELet True defns expr
 
 
---================================================--
+-- ================================================--
 paDefns = paOneOrMoreWithSep paDefn (paLit ";")
 
---================================================--
+-- ================================================--
 paDefn = paThen3 mk_defn paName (paLit "=") paExpr
          where
          mk_defn var equals rhs = (var,rhs)
 
---================================================--
+-- ================================================--
 paCase = paThen4 mk_case (paLit "case") paExpr (paLit "of") paAlters
          where
          mk_case kase e ov alts = ECase e alts
 
---================================================--
+-- ================================================--
 paAlters = paThen2 const (paOneOrMoreWithSep paAlter (paLit ";")) (paLit "end")
 
---================================================--
+-- ================================================--
 paAlter = paThen4 mk_alt paCname (paZeroOrMore paName) (paLit "->") paExpr
           where
           mk_alt tag args arrow rhs = (tag, (args, rhs))
 
---================================================--
+-- ================================================--
 paLambda = paThen4 mk_lam
              (paLit "\\") (paOneOrMore paName) (paLit "->") paExpr
            where
            mk_lam lam vars dot expr = ELam vars expr
 
---================================================--
+-- ================================================--
 paExpr1 = paThen2 paAssembleOp paExpr2 paExpr1c
 
---================================================--
+-- ================================================--
 paExpr1c = paAlts [((== "|"),   paThen2 FoundOp (paLit "|") paExpr1),
                    ((== "#"),   paThen2 FoundOp (paLit "#") paExpr1),
                    (const True, paEmpty NoOp)]
 
---================================================--
+-- ================================================--
 paExpr2 = paThen2 paAssembleOp paExpr3 paExpr2c
 
---================================================--
+-- ================================================--
 paExpr2c = paAlts [((== "&"),   paThen2 FoundOp (paLit "&") paExpr2),
                    (const True, paEmpty NoOp)]
 
---================================================--
+-- ================================================--
 paExpr3 = paThen2 paAssembleOp paExpr4 paExpr3c
 
---================================================--
+-- ================================================--
 paExpr3c = paAlts [(paIsRelop,  paThen2 FoundOp paRelop paExpr4),
                    (const True, paEmpty NoOp)]
 
---================================================--
+-- ================================================--
 paExpr4 = paThen2 paAssembleOp paExpr5 paExpr4c
 
---================================================--
+-- ================================================--
 paExpr4c = paAlts [((== "+"),   paThen2 FoundOp (paLit "+") paExpr4),
                    ((== "-"),   paThen2 FoundOp (paLit "-") paExpr5),
                    (const True, paEmpty NoOp)]
 
---================================================--
+-- ================================================--
 paExpr5 = paThen2 paAssembleOp paExpr6 paExpr5c
 
---================================================--
+-- ================================================--
 paExpr5c = paAlts [((== "*"),   paThen2 FoundOp (paLit "*") paExpr5),
                    ((== "/"),   paThen2 FoundOp (paLit "/") paExpr6),
                    (const True, paEmpty NoOp)]
 
---================================================--
+-- ================================================--
 paExpr6 = (paOneOrMore paAtomic) `paApply` mk_ap_chain
             where
               mk_ap_chain (fn:args) = foldl EAp fn args
 
---================================================--
+-- ================================================--
 paAtomic = paAlts [(paIsCname, paConstr),
                    ((== "("), paBracExpr),
                    (paIsName, paName `paApply` EVar),
                    (paIsNum,  paNum `paApply` ENum)]
 
---================================================--
+-- ================================================--
 paBracExpr = paThen3 mk_brack (paLit "(") paExpr (paLit ")")
              where
              mk_brack open expr close = expr
 
---================================================--
+-- ================================================--
 paConstr = paApply paCname EConstr
 
 
---================================================--
+-- ================================================--
 paAssembleOp e1 NoOp = e1
 paAssembleOp e1 (FoundOp op e2) = EAp (EAp (EVar op) e1) e2
 
 
 
---===================================================--
---=== Validation & transformation of parsed trees ===--
---===================================================--
+-- ===================================================--
+-- === Validation & transformation of parsed trees ===--
+-- ===================================================--
 
---==========================================================--
+-- ==========================================================--
 --
 paProgramToAtomic :: CoreProgram -> 
                      AtomicProgram
@@ -482,7 +482,7 @@ paProgramToAtomic (tds, scdefs)
                 [(name, ELam ns b) | (name, (ns, b)) <- scdefs]
                 (ENum 42)
 
---==========================================================--
+-- ==========================================================--
 --
 paValidTypeDefs :: [TypeDef] ->       -- all type definitions
                    TypeDependancy ->  -- type dependancy info
@@ -546,7 +546,7 @@ paValidTypeDefs tds rda
                            | otherwise                    = groupOf tname rest
 
             
---==========================================================--
+-- ==========================================================--
 --
 paParse :: [Char] -> (TypeDependancy, AtomicProgram)
 
@@ -562,6 +562,6 @@ paParse fileContents
         parsedProgram = paSyntax tokens
 
 
---==========================================================--
---=== End                                    parse.m (1) ===--
---==========================================================--
+-- ==========================================================--
+-- === End                                    parse.m (1) ===--
+-- ==========================================================--
index 6725e41..8c51909 100644 (file)
@@ -1,21 +1,21 @@
 
---==========================================================--
---=== Pretty-printer                   prettyprint.m (1) ===--
---==========================================================--
+-- ==========================================================--
+-- === Pretty-printer                   prettyprint.m (1) ===--
+-- ==========================================================--
 
 module PrettyPrint where
 import BaseDefs
 import Utils
 import MyUtils
 
---==========================================================--
+-- ==========================================================--
 --
 ppPrintCExpr :: CExpr -> [Char]
 
 ppPrintCExpr = utiMkStr . ppPrintCExprMain
 
 
---==========================================================--
+-- ==========================================================--
 --
 ppPrintCExprMain (EVar v) = utiStr v
 ppPrintCExprMain (ENum n) = utiNum n
@@ -55,7 +55,7 @@ ppPrintCExprMain (ECase sw al)
      `utiAppend` (utiStr "\nend"))))
 
 
---==========================================================--
+-- ==========================================================--
 --
 ppPrintAlter (cn, (cal, cexp)) 
    = (utiStr "  ") `utiAppend` ((utiStr cn) 
@@ -66,7 +66,7 @@ ppPrintAlter (cn, (cal, cexp))
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 ppPrintRAp    (EVar v)      = utiStr v
 ppPrintRAp    (ENum n)      = utiNum n
@@ -75,7 +75,7 @@ ppPrintRAp    e             = (utiStr "(") `utiAppend` ((ppPrintCExprMain e)
                                `utiAppend` (utiStr ")"))
 
 
---==========================================================--
+-- ==========================================================--
 --
 ppPrintLAp    (EVar v)      = utiStr v
 ppPrintLAp    (ENum n)      = utiNum n
@@ -87,7 +87,7 @@ ppPrintLAp    e             = (utiStr "(") `utiAppend` ((ppPrintCExprMain e)
                               `utiAppend` (utiStr ")"))
 
 
---==========================================================--
+-- ==========================================================--
 --
 ppPrintTypeDef :: TypeDef -> [Char]
 
@@ -103,14 +103,14 @@ ppPrintTypeDefMain (tn, tal, tcl)
          (map ppPrintConstrAlt tcl) ) )))))
 
 
---==========================================================--
+-- ==========================================================--
 --
 ppPrintConstrAlt (cn, ctes) 
    = (utiStr cn) `utiAppend` ((utiStr " ") `utiAppend`
      ((utiInterleave (utiStr " ") (map ppPrintTDefExpr ctes) )))
 
 
---==========================================================--
+-- ==========================================================--
 --
 ppPrintTDefExpr (TDefVar n) = utiStr n
 
@@ -121,7 +121,7 @@ ppPrintTDefExpr (TDefCons n te)
      ((utiStr ")" )))))
 
 
---==========================================================--
+-- ==========================================================--
 --
 ppPrintParsed :: AtomicProgram -> [Char]
 
@@ -132,7 +132,7 @@ ppPrintParsed (tds, ce)
         tdsChars (t:ts) = "\n" ++ (ppPrintTypeDef t) ++ ";\n\n" 
                           ++ (tdsChars ts)
 
---==========================================================--
---=== End                              prettyprint.m (1) ===--
---==========================================================--
+-- ==========================================================--
+-- === End                              prettyprint.m (1) ===--
+-- ==========================================================--
 
index 4ba6c47..4a24368 100644 (file)
@@ -1,8 +1,8 @@
 
---==========================================================--
---=== Printer of abstract functions                      ===--
---===                               File: PrintResults.m ===--
---==========================================================--
+-- ==========================================================--
+-- === Printer of abstract functions                      ===--
+-- ===                               File: PrintResults.m ===--
+-- ==========================================================--
 
 module PrintResults where
 import BaseDefs
@@ -11,7 +11,7 @@ import MyUtils
 import Inverse
 import AbstractMisc
 
---==========================================================--
+-- ==========================================================--
 --
 prLift :: PrDomain -> PrDomain
 
@@ -22,14 +22,14 @@ prLift d = newBottom:d
               newBottom = copy dElemLen dBottomElem
 
 
---==========================================================--
+-- ==========================================================--
 --
 prCross :: PrDomain -> PrDomain -> PrDomain
 
 prCross d1 d2 = [e1++e2 | e1 <- d1,  e2 <- d2]
 
 
---==========================================================--
+-- ==========================================================--
 --
 prCrossList :: [PrDomain] -> PrDomain
 
@@ -38,7 +38,7 @@ prCrossList [d]       = d
 prCrossList (a:b:abs) = prCross a (prCrossList (b:abs))
 
 
---==========================================================--
+-- ==========================================================--
 --
 prAllPoints :: Domain -> [Char]
 
@@ -61,7 +61,7 @@ prAllPoints d
         k n = toEnum (n+48)
 
 
---==========================================================--
+-- ==========================================================--
 --
 prWidth :: Domain -> Int
 
@@ -70,7 +70,7 @@ prWidth (Lift1 ds)  = sum (map prWidth ds)
 prWidth (Lift2 ds)  = sum (map prWidth ds)
 
 
---==========================================================--
+-- ==========================================================--
 --
 prLiftsIn :: Domain -> Int
 
@@ -79,14 +79,14 @@ prLiftsIn (Lift1 ds)  = 1 + maximum (map prLiftsIn ds)
 prLiftsIn (Lift2 ds)  = 2 + maximum (map prLiftsIn ds)
 
 
---==========================================================--
+-- ==========================================================--
 --
 prSucc :: Int -> Int -> Int
 
 prSucc n c = n + c
 
 
---==========================================================--
+-- ==========================================================--
 --
 prRoute :: Domain -> Route -> [Char]
 
@@ -97,7 +97,7 @@ prRoute d r
          map k (prRouteMain d r)
 
 
---==========================================================--
+-- ==========================================================--
 --
 prRouteMain :: Domain -> Route -> [Int]
 
@@ -139,7 +139,7 @@ prRouteMain_cross ds rs
            = compFactMax - nn
 
 
---==========================================================--
+-- ==========================================================--
 --
 prPrintFunction :: Bool -> StaticComponent -> Naam -> Point -> [Char]
 
@@ -198,6 +198,6 @@ prPrintFunction mi statics fName (ds, rs)
      prAllPoints ds ++ "\n\n"
 
 
---==========================================================--
---=== end                                 PrintResults.m ===--
---==========================================================--
+-- ==========================================================--
+-- === end                                 PrintResults.m ===--
+-- ==========================================================--
index d37be92..3b5ab94 100644 (file)
@@ -1,7 +1,7 @@
 
---==========================================================--
---=== Read the lattice table.               ReadTable.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Read the lattice table.               ReadTable.hs ===--
+-- ==========================================================--
 
 module ReadTable where
 import BaseDefs
@@ -11,7 +11,7 @@ import Parser2
 
 import Char(isDigit) -- 1.3
 
---==========================================================--
+-- ==========================================================--
 --
 rtReadTable :: String -> [(Domain, Int)]
 
@@ -27,7 +27,7 @@ rtReadTable s
            -> myFail ("Syntax error in lattice table, line " ++ show n ++ ".")
 
 
---==========================================================--
+-- ==========================================================--
 --
 rtLex :: Int -> String -> [Token]
 
@@ -56,11 +56,11 @@ rtLex n (c:cs)
            " in lattice table, line " ++ show n ++ "." )
 
 
---==========================================================--
+-- ==========================================================--
 --
 rtPWithComma p = paThen2 (\a b -> a) p (paLit ",")
 
---==========================================================--
+-- ==========================================================--
 --
 rtListMain p
   = paAlts 
@@ -71,15 +71,15 @@ rtListMain p
         paThen3 (\a b c -> a ++ [b]) 
                (paZeroOrMore (rtPWithComma p)) p (paLit "]") ) ]
 
---==========================================================--
+-- ==========================================================--
 --
 rtList p = paThen2 (\a b -> b) (paLit "[") (rtListMain p)
 
---==========================================================--
+-- ==========================================================--
 --
 rtListDomain = rtList rtDomain
 
---==========================================================--
+-- ==========================================================--
 --
 rtDomain
   = paAlts
@@ -92,18 +92,18 @@ rtDomain
                           (paLit "F") rtListDomain rtDomain )
     ]
 
---==========================================================--
+-- ==========================================================--
 --
 rtPair pa pb
    = paThen4 (\a b c d -> (b,d)) (paLit "(") pa (paLit ",") (
      paThen2 (\a b -> a)         pb (paLit ")") )
 
---==========================================================--
+-- ==========================================================--
 --
 rtTable 
   = rtList (rtPair rtDomain paNum)
 
 
---==========================================================--
---=== end                                   ReadTable.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                                   ReadTable.hs ===--
+-- ==========================================================--
index 7e97a16..dbe929d 100644 (file)
@@ -1,8 +1,8 @@
 
---==========================================================--
---=== Simplification of abstract expressions ...         ===--
---===                                        Simplify.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Simplification of abstract expressions ...         ===--
+-- ===                                        Simplify.hs ===--
+-- ==========================================================--
 
 module Simplify where
 import BaseDefs
@@ -12,7 +12,7 @@ import AbstractVals2
 import AbstractEval2
 import Apply
 
---==========================================================--
+-- ==========================================================--
 --
 siVectorise :: HExpr Naam -> HExpr Naam
 
@@ -33,7 +33,7 @@ siVectorise h@(HPoint _) = h
 siVectorise (HMeet es) = HMeet (map siVectorise es)
 
 
---==========================================================--
+-- ==========================================================--
 --
 siSimplify :: HExpr Naam -> HExpr Naam
 
@@ -46,7 +46,7 @@ siSimplify hexpr
         else  siSimplify hexpr_after_one_cycle
 
 
---==========================================================--
+-- ==========================================================--
 --
 siHOpt :: HExpr Naam -> HExpr Naam
 
@@ -58,7 +58,7 @@ siHOpt (HLam vs e)    = HLam vs (siHOpt e)
 siHOpt (HTable t)     = HTable (map2nd siHOpt t)
 
 
---==========================================================--
+-- ==========================================================--
 -- meet-literal simplification
 --
 siHOpt_meet :: [HExpr Naam] -> HExpr Naam
@@ -79,7 +79,7 @@ siHOpt_meet es
      else        aeMkMeet (HPoint onelit) ((HPoint onelit):nonlits)
 
 
---==========================================================--
+-- ==========================================================--
 -- case-of-case simplification
 -- literal-function-applied-to-literal simplification
 --
@@ -94,6 +94,6 @@ siHOpt_app (HPoint p1) (HPoint p2)
 siHOpt_app h1_other h2_other = HApp h1_other h2_other
 
 
---==========================================================--
---=== end                                    Simplify.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                                    Simplify.hs ===--
+-- ==========================================================--
index 127de3a..b8c1f9e 100644 (file)
@@ -1,10 +1,10 @@
 
---==========================================================--
---=== Find a smaller versions of big lattices when  we   ===--
---=== we reckon that the big lattice is too expensive    ===--
---=== to work in.                                        ===--
---===                                  SmallerLattice.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Find a smaller versions of big lattices when  we   ===--
+-- === we reckon that the big lattice is too expensive    ===--
+-- === to work in.                                        ===--
+-- ===                                  SmallerLattice.hs ===--
+-- ==========================================================--
 
 
 module SmallerLattice where
@@ -15,7 +15,7 @@ import AbsConc3
 
 import List(nub,transpose) -- 1.3
 
---==========================================================--
+-- ==========================================================--
 --
 {- partain: moved to BaseDefs.hs:
 
@@ -28,13 +28,13 @@ instance (Text a, Ord a) => Num (ExceptionInt a) where
       = MkExInt (i1 * i2) (xs1 ++ xs2)
 -}
 
---==========================================================--
+-- ==========================================================--
 --
 sl_1 = MkExInt 1 []
 sl_2 = MkExInt 2 []
 
 
---==========================================================--
+-- ==========================================================--
 --
 slCard :: AList Domain Int -> Domain -> DomainInt
 
@@ -59,7 +59,7 @@ slCard rho (Func dss dt)
             non_fn_d -> slCard rho norm_func_domain
 
 
---==========================================================--
+-- ==========================================================--
 --
 slNorm :: Domain -> Domain
 
@@ -81,7 +81,7 @@ slNorm (Func dss dt)
    = Func (sort (map slNorm dss)) (slNorm dt)
 
 
---==========================================================--
+-- ==========================================================--
 --
 slReduce :: Domain -> [Domain]
 
@@ -117,7 +117,7 @@ slReduce (Func dss dt)
          [Two]
 
 
---==========================================================--
+-- ==========================================================--
 --
 slMakeSequence :: AList Domain Int -> -- lattice size table
                   Int ->              -- scaleup ratio
@@ -177,7 +177,7 @@ slMakeSequence table scaleup_ratio dss lowlimit highlimit
          (usePart, notUsePart)
 
 
---==========================================================--
+-- ==========================================================--
 --
 slMakeOneSequence :: AList Domain Int -> Int -> [Domain] -> [(DInt, Int)]
 
@@ -246,7 +246,7 @@ slMakeOneSequence table scaleup_ratio ds
 
          
 
---==========================================================--
+-- ==========================================================--
 --
 slRecover :: Eq a => [a] -> (a -> a -> Bool) -> AList a [a]
 
@@ -264,7 +264,7 @@ slRecover latt leq
         [(s, iaboves s) | s <- latt]
 
 
---==========================================================--
+-- ==========================================================--
 --
 slDijkstra :: Eq a => [(a, a, Int)] -> a -> a -> [(a, Int)]
 
@@ -276,7 +276,7 @@ slDijkstra roads start end
         route
 
 
---==========================================================--
+-- ==========================================================--
 --
 slDijkstra_aux :: Eq a => [(a, a, Int)] -> 
                           a -> 
@@ -307,7 +307,7 @@ slDijkstra_aux roads end considered
         (best, bestcost, bestback) : slDijkstra_aux roads end considered2
 
 
---==========================================================--
+-- ==========================================================--
 --
 slDijkstra_unlink :: Eq a => a -> a -> [(a, Int, a)] -> [(a, Int)]
 
@@ -318,6 +318,6 @@ slDijkstra_unlink start here costs
           (cell, cost) : slDijkstra_unlink start back costs
 
 
---==========================================================--
---=== end                              SmallerLattice.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                              SmallerLattice.hs ===--
+-- ==========================================================--
index 1a9970c..f105240 100644 (file)
@@ -1,7 +1,7 @@
 
---==========================================================--
---=== Strictness analyser -- v6             StrictAn6.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Strictness analyser -- v6             StrictAn6.hs ===--
+-- ==========================================================--
 
 module StrictAn6 where
 import BaseDefs
@@ -24,7 +24,7 @@ import AbsConc3
 import List(transpose) -- 1.3
 import Char(isLower,isUpper)
 
---==========================================================--
+-- ==========================================================--
 -- Call analyser and format results
 --
 saMain :: AnnExpr Naam TExpr ->
@@ -98,7 +98,7 @@ saMain typedTree typeDAR simplestTEnv freeVars builtins dataDefs flags table
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 saSettingInfo :: Int -> Int -> Int -> Int -> Int -> Bool -> Bool -> String
 
@@ -123,7 +123,7 @@ saSettingInfo pLim mLim lLim uLim sRat mindless_inv use_baraki
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 saGroups :: StaticComponent -> 
             AList Naam (HExpr Naam) -> 
@@ -226,7 +226,7 @@ saGroups statics beta ((True, defs):rest)
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 saFixStartup :: StaticComponent ->
                 [Naam] ->             -- names of fns in groups
@@ -277,7 +277,7 @@ saFixStartup
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 saNonRecStartup :: StaticComponent ->
                    Naam ->             -- name of fn
@@ -329,7 +329,7 @@ saNonRecStartup
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 saNonRecSearch :: StaticComponent ->
                   Naam ->               -- name of fn
@@ -413,7 +413,7 @@ saNonRecSearch
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 saFixMain :: StaticComponent ->
              [Naam] ->               -- names of fns in group
@@ -510,7 +510,7 @@ saFixMain
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 saFixAtSizeLive :: StaticComponent ->
                    [Route] ->            -- live abstractions
@@ -593,7 +593,7 @@ saFixAtSizeLive
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 saFixAtSizeSafe :: StaticComponent ->
                    [Route] ->            -- safe abstractions
@@ -668,7 +668,7 @@ saFixAtSizeSafe
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 saFinalExpansion :: StaticComponent -> 
                     [Domain] ->
@@ -695,7 +695,7 @@ saFinalExpansion
         result
 
 
---==========================================================--
+-- ==========================================================--
 --
 saIsResult :: SAInfo -> Bool
 
@@ -705,7 +705,7 @@ saIsResult anyElse           = False
 saGetResult (SAResult name domain route) = route
 
 
---==========================================================--
+-- ==========================================================--
 --
 saPrinter :: StaticComponent -> Bool -> SAInfo -> [Char]
 
@@ -742,7 +742,7 @@ saPrinter_aux use ((s,ds):sds)
      ++ show ds ++ "\n" ++ saPrinter_aux use sds
 
 
---==========================================================--
+-- ==========================================================--
 --
 saUndoCAFkludge :: [SAInfo] -> [SAInfo]
 
@@ -769,7 +769,7 @@ saUndoCAFkludge (saInfo:saInfos)
          this ++ rest
 
 
---==========================================================--
+-- ==========================================================--
 --
 saCAFkludge, saCAFkludgeInverse :: Domain -> Domain
 
@@ -781,7 +781,7 @@ saCAFkludgeInverse (Func dss dt) = Func dss dt
 saCAFkludgeInverse non_fn_dom    = non_fn_dom
 
 
---==========================================================--
+-- ==========================================================--
 --
 saMkFunc :: [Domain] -> Domain -> Domain
 
@@ -789,7 +789,7 @@ saMkFunc []  dt = dt
 saMkFunc dss dt = Func dss dt
 
 
---==========================================================--
+-- ==========================================================--
 --
 saSequenceIsEmpty (use, noUse)       = null use
 saGetNextRec      ((u:us), noUse)    = u
@@ -798,13 +798,13 @@ saGetSeqTail      (u:us, noUse)      = (us, noUse)
 saGivenUpEarly    (use, noUse)       = not (null noUse)
 
 
---==========================================================--
+-- ==========================================================--
 --
 saGetArgs (Func dss dt) = dss
 saGetRes  (Func dss dt) = dt
 
 
---==========================================================--
+-- ==========================================================--
 --
 saMakeSizeInfo :: Sequence -> [Naam] -> [SAInfo]
 
@@ -817,7 +817,7 @@ saMakeSizeInfo (use, noUse) names
          myZipWith3 SASizes names useT noUseT2
 
 
---==========================================================--
+-- ==========================================================--
 --
 saHSubst :: RSubst ->
             HExpr Naam ->
@@ -833,7 +833,7 @@ saHSubst fenv (HTable t)        = HTable (map2nd (saHSubst fenv) t)
 saHSubst fenv (HVAp f es)       = HVAp (saHSubst fenv f) (map (saHSubst fenv) es)
 
 
---==========================================================--
+-- ==========================================================--
 --
 saMkGroups :: AnnExpr Naam DExpr -> 
             DefnGroup (AnnDefn Naam DExpr)
@@ -842,7 +842,7 @@ saMkGroups (_, ALet rf subdefs rest) = (rf, subdefs):saMkGroups rest
 saMkGroups (_, anyThingElse        ) = []
 
 
---==========================================================--
+-- ==========================================================--
 -- The strictness analyser proper: the magic function "S"
 -- Now rather heavily modified (in version 0.300 and above)
 -- and no longer bearing much relationship to the original
@@ -1058,7 +1058,7 @@ sa statics beta (dtau, ACase (dtau_sw, expr_sw) alts)
          result
 
 
---==========================================================--
+-- ==========================================================--
 --
 saMkCargs :: [TypeDef] -> AList Naam [ConstrElem]
 
@@ -1072,6 +1072,6 @@ saMkCargs ((typename, tvars, calts):rest)
         find v (v2:vs) = if v == v2 then 0 else 1 + find v vs
 
 
---==========================================================--
---=== End                                   StrictAn6.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === End                                   StrictAn6.hs ===--
+-- ==========================================================--
index 2d663be..4d37f9b 100644 (file)
@@ -1,8 +1,8 @@
  
---==========================================================--
---=== Successors and predecessors of a point in a        ===--
---=== finite lattice.                  SuccsAndPreds2.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Successors and predecessors of a point in a        ===--
+-- === finite lattice.                  SuccsAndPreds2.hs ===--
+-- ==========================================================--
 
 module SuccsAndPreds2 where
 import BaseDefs
@@ -11,23 +11,23 @@ import MyUtils
 import AbstractVals2
 
 
---==========================================================--
---===                                                    ===--
---=== "succs" and "preds" of a point, where:             ===--
---===                                                    ===--
---===    succs(x) = Min (complement (downclose (x)))     ===--
---===    preds(x) = Max (complement (upclose (x)))       ===--
---===                                                    ===--
---==========================================================--
+-- ==========================================================--
+-- ===                                                    ===--
+-- === "succs" and "preds" of a point, where:             ===--
+-- ===                                                    ===--
+-- ===    succs(x) = Min (complement (downclose (x)))     ===--
+-- ===    preds(x) = Max (complement (upclose (x)))       ===--
+-- ===                                                    ===--
+-- ==========================================================--
 
---==========================================================--
+-- ==========================================================--
 --
 spSuccs :: Point -> [Point]
 
 spSuccs (d1, r1) = [(d1, r) | r <- spSuccsR d1 r1]
 
 
---==========================================================--
+-- ==========================================================--
 --
 spSuccsR :: Domain -> Route -> [Route]
 
@@ -54,7 +54,7 @@ spSuccsR d@(Func _ _) (Rep r)
    = map Rep (spSuccsRep d r)
 
 
---==========================================================--
+-- ==========================================================--
 --
 spSuccsRep :: Domain -> Rep -> [Rep]
 
@@ -83,7 +83,7 @@ spSuccsRep (Func dss (Lift2 dts)) (Rep2 lf mf hfs)
          map isoRouteInv isoSuccs
 
 
---==========================================================--
+-- ==========================================================--
 --
 spSuccsFrel :: [Domain] -> FrontierElem -> [FrontierElem]
 
@@ -94,7 +94,7 @@ spSuccsFrel ds (MkFrel rs)
    = map MkFrel (myListVariants (map avBottomR ds) (myZipWith2 spSuccsR ds rs))
 
 
---==========================================================--
+-- ==========================================================--
 --
 spLEmb :: [Rep] -> Frontier -> Rep
 
@@ -102,7 +102,7 @@ spLEmb hfBottoms h
    = Rep1 h hfBottoms
 
 
---==========================================================--
+-- ==========================================================--
 --
 spLLift :: [Route] -> [Domain] -> [Domain] -> [Rep] -> Rep
 
@@ -116,7 +116,7 @@ spLLift initTops initDss hfDomains hfs_reps
          Rep1 new_lf hfs_reps
 
 
---==========================================================--
+-- ==========================================================--
 --
 spLLift_aux :: Int -> [Route] -> [Domain] -> Domain -> Rep -> Rep
 
@@ -128,7 +128,7 @@ spLLift_aux des_arity initTops initDss (Func dss (Lift2 dts)) (Rep2 lf mf hfs)
    = spLLift_reduce_arity_as_top des_arity initTops initDss (RepTwo lf)
 
 
---==========================================================--
+-- ==========================================================--
 --
 spLLift_reduce_arity_as_top :: Int -> [Route] -> [Domain] -> Rep -> Rep
 
@@ -144,14 +144,14 @@ spLLift_reduce_arity_as_top des_arity initTops initDss
          RepTwo (Min1Max0 des_arity new_f1 new_f0)
 
 
---==========================================================--
+-- ==========================================================--
 --
 spPreds :: Point -> [Point]
 
 spPreds (d1, r1) = [(d1, r) | r <- spPredsR d1 r1]
 
 
---==========================================================--
+-- ==========================================================--
 --
 spPredsR :: Domain -> Route -> [Route]
 
@@ -186,7 +186,7 @@ spPredsR d@(Func _ _) (Rep r)
    = map Rep (spPredsRep d r)
 
 
---==========================================================--
+-- ==========================================================--
 --
 spPredsRep :: Domain -> Rep -> [Rep]
 
@@ -216,7 +216,7 @@ spPredsRep (Func dss (Lift2 dts)) (Rep2 lf mf hfs)
          map isoRouteInv isoPreds
 
 
---==========================================================--
+-- ==========================================================--
 --
 spPredsFrel :: [Domain] -> FrontierElem -> [FrontierElem]
 
@@ -227,21 +227,21 @@ spPredsFrel ds (MkFrel rs)
    = map MkFrel (myListVariants (map avTopR ds) (myZipWith2 spPredsR ds rs))
 
 
---==========================================================--
+-- ==========================================================--
 --
 spGLift :: Frontier -> [Rep] -> Rep
 
 spGLift lfTop hfs2 = Rep1 lfTop hfs2
 
 
---==========================================================--
+-- ==========================================================--
 --
 spGEmb :: Frontier -> [Domain] -> Rep
 
 spGEmb lf hfTargDs = Rep1 lf (map (spGEmb_aux lf) hfTargDs)
 
 
---==========================================================--
+-- ==========================================================--
 --
 spGEmb_aux :: Frontier -> Domain -> Rep
 
@@ -261,7 +261,7 @@ spGEmb_aux lf (Func dss dt)
         dt
 
 
---==========================================================--
+-- ==========================================================--
 --
 spGEmb_increase_arity_ignore :: Frontier -> [Domain] -> Rep
 
@@ -279,7 +279,7 @@ spGEmb_increase_arity_ignore (Min1Max0 ar f1 f0) dss
          RepTwo (Min1Max0 (ar + length dss) new_f1 new_f0)
 
 
---==========================================================--
+-- ==========================================================--
 --
 spMax0FromMin1 :: [Domain] -> [FrontierElem] -> [FrontierElem]
 
@@ -291,7 +291,7 @@ spMax0FromMin1_aux tops dss f1
                  (map (spPredsFrel dss) f1))
 
 
---==========================================================--
+-- ==========================================================--
 --
 spMin1FromMax0 :: [Domain] -> [FrontierElem] -> [FrontierElem]
 
@@ -303,6 +303,6 @@ spMin1FromMax0_aux bottoms dss f0
                  (map (spSuccsFrel dss) f0))
 
 
---==========================================================--
---=== end                              SuccsAndPreds2.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                              SuccsAndPreds2.hs ===--
+-- ==========================================================--
index 841867d..753fd92 100644 (file)
@@ -1,8 +1,8 @@
 
---==========================================================--
---=== Turn type expressions into domain expressions.     ===--
---===                                     TExpr2DExpr.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Turn type expressions into domain expressions.     ===--
+-- ===                                     TExpr2DExpr.hs ===--
+-- ==========================================================--
 
 module TExpr2DExpr where
 import BaseDefs
@@ -14,7 +14,7 @@ import TypeCheck5
 
 import List(nub) -- 1.3
 
---==========================================================--
+-- ==========================================================--
 -- This may need fixing up if we start instantiating domain
 -- variables to expressions which contain other domain
 -- variables within them.
@@ -52,7 +52,7 @@ txGetInstantiations simplest usage
                            else panic "txGetInstantiations"
 
 
---==========================================================--
+-- ==========================================================--
 --
 tx2dxAnnTree :: TypeDependancy ->
                 AnnExpr Naam TExpr ->
@@ -61,7 +61,7 @@ tx2dxAnnTree :: TypeDependancy ->
 tx2dxAnnTree td tree = tcMapAnnExpr (tx2dx td) tree
 
 
---==========================================================--
+-- ==========================================================--
 --
 tx2dx :: TypeDependancy -> TExpr -> DExpr
 
@@ -85,6 +85,6 @@ tx2dx_aux td env (TCons tname targs)
      then DXLift2 (map (tx2dx_aux td env) targs)
      else DXLift1 (map (tx2dx_aux td env) targs)
 
---==========================================================--
---=== end                                 TExpr2DExpr.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                                 TExpr2DExpr.hs ===--
+-- ==========================================================--
index a64df1b..eef9449 100644 (file)
@@ -1,8 +1,8 @@
  
---==========================================================--
---=== A type-checker -- v5        File: TypeCheck5.m (1) ===--
---=== Corrected version for 0.210a                       ===--
---==========================================================--
+-- ==========================================================--
+-- === A type-checker -- v5        File: TypeCheck5.m (1) ===--
+-- === Corrected version for 0.210a                       ===--
+-- ==========================================================--
 
 module TypeCheck5 where
 import BaseDefs
@@ -11,9 +11,9 @@ import MyUtils
 
 import List(nub) -- 1.3
 
---==========================================================--
---=== Formatting of results                              ===--
---==========================================================--
+-- ==========================================================--
+-- === Formatting of results                              ===--
+-- ==========================================================--
 
 tcMapAnnExpr :: (a -> b) ->
                 AnnExpr c a ->
@@ -40,7 +40,7 @@ tcMapAnnExpr f (ann, node)
            = (naam, (pars, tcMapAnnExpr f resExpr))
 
 
---======================================================--
+-- ======================================================--
 --
 tcSubstAnnTree :: Subst -> 
                   AnnExpr Naam TExpr -> 
@@ -49,7 +49,7 @@ tcSubstAnnTree :: Subst ->
 tcSubstAnnTree phi tree = tcMapAnnExpr (tcSub_type phi) tree
 
 
---======================================================--
+-- ======================================================--
 --
 tcTreeToEnv :: AnnExpr Naam TExpr ->
                TypeEnv
@@ -74,7 +74,7 @@ tcTreeToEnv tree
 
 
 
---======================================================--
+-- ======================================================--
 --
 tcShowtExpr :: TExpr ->
                [Char]
@@ -105,7 +105,7 @@ tcShowtExpr t
        tvdict' (TArr t1 t2) = tvdict' t1 ++ tvdict' t2
 
 
---======================================================--
+-- ======================================================--
 --
 tcPretty :: (Naam, TExpr) -> 
             [Char]
@@ -115,7 +115,7 @@ tcPretty (naam, tipe)
             (tcShowtExpr tipe)
 
 
---======================================================--
+-- ======================================================--
 tcCheck :: TcTypeEnv -> 
            TypeNameSupply ->
            AtomicProgram -> 
@@ -153,11 +153,11 @@ tcCheck baseTypes ns (tdefs, expr)
         
 
 
---==========================================================--
---=== 9.2 Representation of type expressions             ===--
---==========================================================--
+-- ==========================================================--
+-- === 9.2 Representation of type expressions             ===--
+-- ==========================================================--
 
-----======================================================--
+-- ======================================================--
 --tcArrow :: TExpr -> 
 --           TExpr -> 
 --           TExpr
@@ -166,21 +166,21 @@ tcCheck baseTypes ns (tdefs, expr)
 
 
 
---======================================================--
+-- ======================================================--
 tcInt :: TExpr
 
 tcInt = TCons "int" []
 
 
 
---======================================================--
+-- ======================================================--
 tcBool :: TExpr
 
 tcBool = TCons "bool" []
 
 
 
---======================================================--
+-- ======================================================--
 tcTvars_in :: TExpr -> 
               [TVName]
 
@@ -191,11 +191,11 @@ tcTvars_in t = tvars_in' t []
                   tvars_in' (TArr t1 t2) l = tvars_in' t1 (tvars_in' t2 l)
 
 
---==========================================================--
---=== 9.41 Substitutions                                 ===--
---==========================================================--
+-- ==========================================================--
+-- === 9.41 Substitutions                                 ===--
+-- ==========================================================--
 
---======================================================--
+-- ======================================================--
 tcApply_sub :: Subst ->
                TVName ->
                TExpr
@@ -208,7 +208,7 @@ tcApply_sub phi tvn
         lookUpResult = utLookupDef phi tvn (TVar tvn)
 
 
---======================================================--
+-- ======================================================--
 tcSub_type :: Subst -> 
               TExpr -> 
               TExpr
@@ -220,7 +220,7 @@ tcSub_type phi (TCons tcn ts) = TCons tcn (map (tcSub_type phi) ts)
 tcSub_type phi (TArr t1 t2) = TArr (tcSub_type phi t1) (tcSub_type phi t2)
 
 
---======================================================--
+-- ======================================================--
 tcScomp :: Subst -> 
            Subst -> 
            Subst
@@ -229,14 +229,14 @@ tcScomp sub2 sub1 = sub1 ++ sub2
 
 
 
---======================================================--
+-- ======================================================--
 tcId_subst :: Subst
 
 tcId_subst = []
 
 
 
---======================================================--
+-- ======================================================--
 tcDelta :: TVName -> 
            TExpr -> 
            Subst
@@ -249,11 +249,11 @@ tcDelta tvn (TVar tvn2)
 tcDelta tvn non_var_texpr = [(tvn, non_var_texpr)]
 
 
---==========================================================--
---=== 9.42 Unification                                   ===--
---==========================================================--
+-- ==========================================================--
+-- === 9.42 Unification                                   ===--
+-- ==========================================================--
 
---======================================================--
+-- ======================================================--
 tcExtend :: Subst -> 
             TVName -> 
             TExpr -> 
@@ -276,7 +276,7 @@ tcExtend phi tvn t
 
 
 
---======================================================--
+-- ======================================================--
 tcUnify :: Subst -> 
            (TExpr, TExpr) -> 
            Reply Subst Message
@@ -314,7 +314,7 @@ tcUnify phi (t1, t2)
 
 
 
---======================================================--
+-- ======================================================--
 tcUnifyl :: Subst ->  
             [(TExpr, TExpr)] -> 
             Reply Subst Message
@@ -327,11 +327,11 @@ tcUnifyl phi eqns
 
 
 
---==========================================================--
---=== 9.42.2 Merging of substitutions                    ===--
---==========================================================--
+-- ==========================================================--
+-- === 9.42.2 Merging of substitutions                    ===--
+-- ==========================================================--
 
---======================================================--
+-- ======================================================--
 tcMergeSubs :: Subst ->
                Subst
 
@@ -344,7 +344,7 @@ tcMergeSubs phi
 
 
 
---======================================================--
+-- ======================================================--
 tcMergeSubsMain :: Subst -> 
                    (Subst, Subst)   -- pair of new binds, unified olds
 
@@ -359,7 +359,7 @@ tcMergeSubsMain phi
 
 
 
---======================================================--
+-- ======================================================--
 tcCheckUnifier :: Reply Subst Message -> Subst
 
 tcCheckUnifier (Ok r) = r
@@ -368,7 +368,7 @@ tcCheckUnifier (Fail m)
 
 
 
---======================================================--
+-- ======================================================--
 tcOldUnified :: [Subst] -> [[TExpr]] -> [TExpr]
 
 tcOldUnified [] [] = []
@@ -376,11 +376,11 @@ tcOldUnified (u:us) (og:ogs)
       = (tcSub_type u (head og)): tcOldUnified us ogs
 
 
---==========================================================--
---=== 9.5 Keeping track of types                         ===--
---==========================================================--
+-- ==========================================================--
+-- === 9.5 Keeping track of types                         ===--
+-- ==========================================================--
 
---======================================================--
+-- ======================================================--
 tcUnknowns_scheme :: TypeScheme -> 
                      [TVName]
 
@@ -388,7 +388,7 @@ tcUnknowns_scheme (Scheme scvs t) = tcTvars_in t `tcBar` scvs
 
 
 
---======================================================--
+-- ======================================================--
 tcBar :: (Eq a) => [a] -> 
                    [a] -> 
                    [a]
@@ -397,7 +397,7 @@ tcBar xs ys = [ x | x <- xs,  not (x `elem` ys)]
 
 
 
---======================================================--
+-- ======================================================--
 tcSub_scheme :: Subst -> 
                 TypeScheme -> 
                 TypeScheme
@@ -409,18 +409,18 @@ tcSub_scheme phi (Scheme scvs t)
 
 
 
---==========================================================--
---=== 9.53 Association lists                             ===--
---==========================================================--
+-- ==========================================================--
+-- === 9.53 Association lists                             ===--
+-- ==========================================================--
 
---======================================================--
+-- ======================================================--
 tcCharVal :: AList Naam b -> Naam -> b
 
 tcCharVal al k
    = utLookupDef al k (panic ("tcCharVal: no such variable: " ++ k))
 
 
---======================================================--
+-- ======================================================--
 tcUnknowns_te :: TcTypeEnv -> 
                  [TVName]
 
@@ -428,7 +428,7 @@ tcUnknowns_te gamma = concat (map tcUnknowns_scheme (utRange gamma))
 
 
 
---======================================================--
+-- ======================================================--
 tcSub_te :: Subst -> 
             TcTypeEnv -> 
             TcTypeEnv
@@ -436,11 +436,11 @@ tcSub_te :: Subst ->
 tcSub_te phi gamma = [(x, tcSub_scheme phi st) | (x, st) <- gamma]
 
 
---==========================================================--
---=== 9.6 New variables                                  ===--
---==========================================================--
+-- ==========================================================--
+-- === 9.6 New variables                                  ===--
+-- ==========================================================--
 
---======================================================--
+-- ======================================================--
 tcNext_name :: TypeNameSupply -> 
                TVName
 
@@ -448,7 +448,7 @@ tcNext_name ns@(f, s) = ns
 
 
 
---======================================================--
+-- ======================================================--
 tcDeplete :: TypeNameSupply -> 
              TypeNameSupply
 
@@ -456,7 +456,7 @@ tcDeplete (f, s) = (f, tcNSSucc s)
 
 
 
---======================================================--
+-- ======================================================--
 tcSplit :: TypeNameSupply -> 
            (TypeNameSupply, TypeNameSupply)
 
@@ -465,14 +465,14 @@ tcSplit (f, s) = ((f2, [0]), (tcNSSucc f2, [0]))
 
 
 
---======================================================--
+-- ======================================================--
 tcName_sequence :: TypeNameSupply -> 
                    [TVName]
 
 tcName_sequence ns = tcNext_name ns: tcName_sequence (tcDeplete ns)
 
 
---======================================================--
+-- ======================================================--
 tcNSSucc :: [Int] ->
             [Int]
 
@@ -481,7 +481,7 @@ tcNSSucc (n:ns) | n < tcNSslimit  = n+1: ns
                 | otherwise       = 0: tcNSSucc ns
 
 
---======================================================--
+-- ======================================================--
 tcNSDouble :: [Int] ->
               [Int]
 
@@ -501,12 +501,12 @@ tcNSslimit :: Int
 tcNSslimit = tcNSdlimit + (tcNSdlimit - 1)
 
 
---==========================================================--
---=== 9.7 The type-checker                               ===--
---==========================================================--
+-- ==========================================================--
+-- === 9.7 The type-checker                               ===--
+-- ==========================================================--
 
 
---======================================================--
+-- ======================================================--
 tc :: [TypeDef] ->
       TcTypeEnv -> 
       TypeNameSupply -> 
@@ -546,9 +546,9 @@ tc tds gamma ns (ECase switch alts)
         (arglists, exprs) = unzip2 alters
  
 
---==========================================================--
---=== 0.00 Type-checking case-expressions                ===--
---==========================================================--
+-- ==========================================================--
+-- === 0.00 Type-checking case-expressions                ===--
+-- ==========================================================--
 
 tcConstrTypeSchemes :: TypeNameSupply ->
                        TypeDef ->
@@ -580,7 +580,7 @@ tcConstrTypeSchemes ns (tn, stvs, cal)
                     
 
 
---======================================================--
+-- ======================================================--
 --
 tccase :: [TypeDef] ->         -- constructor type definitions
           TcTypeEnv ->         -- current type bindings
@@ -612,7 +612,7 @@ tccase tds gamma ns sw cs als res
 
 
 
---======================================================--
+-- ======================================================--
 --
 tcReorder :: [Naam] -> [(Naam,b)] -> [b]
 
@@ -625,7 +625,7 @@ tcReorder (k:ks) uol
         : tcReorder ks uol 
 
 
---======================================================--
+-- ======================================================--
 -- Projection functions and similar rubbish.
 tcDeOksel (Ok x) = x
 tcDeOksel (Fail m) = panic ("tcDeOkSel: " ++ m)
@@ -640,7 +640,7 @@ tcK33 (a,b,c) = c
 
 
 
---======================================================--
+-- ======================================================--
 --
 tccase1 :: [TypeDef] ->
            TcTypeEnv -> 
@@ -667,7 +667,7 @@ tccase1 tds gamma ns sw reOals reOres newTVs tdInUse
         (ns1, ns2) = tcSplit ns  
         
 
---======================================================--
+-- ======================================================--
 --
 tccase2 :: [TypeDef] ->
            TcTypeEnv -> 
@@ -692,7 +692,7 @@ tccase2 tds gamma ns sw reOals newTVs tdInUse rhsTcs
 
  
 
---======================================================--
+-- ======================================================--
 --
 tccase3 :: [TypeDef] ->                    -- tds
            TcTypeEnv ->                    -- gamma
@@ -742,7 +742,7 @@ tccase3 tds gamma ns sw reOals newTVs tdInUse rhsTcs
         tdCNames = map first (tcK33 tdInUse)
 
 
---======================================================--
+-- ======================================================--
 --
 tcUnifySet :: Subst -> 
               [TExpr] -> 
@@ -757,7 +757,7 @@ tcUnifySet sub (e1:e2:e3:es)
         newSub = tcDeOksel (tcUnify sub (e1, e2))
 
 
---======================================================--
+-- ======================================================--
 --
 tcNewTypeVars :: TypeDef -> 
                  TypeNameSupply ->
@@ -767,7 +767,7 @@ tcNewTypeVars (t, vl, c) ns = zip vl (tcName_sequence ns)
 
 
 
---======================================================--
+-- ======================================================--
 --
 tcGetGammaN :: AList Naam TVName ->
                ConstrAlt -> 
@@ -779,7 +779,7 @@ tcGetGammaN tvl (cname, cal) cparams
 
 
 
---======================================================--
+-- ======================================================--
 --
 tcTDefSubst :: AList Naam TVName ->
                TDefExpr ->
@@ -796,7 +796,7 @@ tcTDefSubst nameMap (TDefCons c al)
    = TCons c (map (tcTDefSubst nameMap) al)
 
 
---======================================================--
+-- ======================================================--
 --
 tcGetAllGammas :: AList Naam TVName ->
                   [ConstrAlt] ->
@@ -811,7 +811,7 @@ tcGetAllGammas tvl (calt:calts) (cparams:cparamss) =
          tcGetAllGammas tvl calts cparamss
 
 
---======================================================--
+-- ======================================================--
 --
 tcGetTypeDef :: [TypeDef] ->    -- type definitions
                 [Naam] ->       -- list of constructors used here
@@ -831,11 +831,11 @@ tcGetTypeDef tds cs
                     usedc `elem` (map first cl) ]
 
 
---==========================================================--
---=== 9.71 Type-checking lists of expressions            ===--
---==========================================================--
+-- ==========================================================--
+-- === 9.71 Type-checking lists of expressions            ===--
+-- ==========================================================--
 
---======================================================--
+-- ======================================================--
 --
 tcl :: [TypeDef] ->
        TcTypeEnv     -> 
@@ -851,14 +851,14 @@ tcl tds gamma ns (e:es)
         (ns0, ns1) = tcSplit ns
 
 
---======================================================--
+-- ======================================================--
 --
 tcl1 tds gamma ns es (Fail m) = Fail m
 tcl1 tds gamma ns es (Ok (phi, t, annotatedE)) 
    = tcl2 phi t (tcl tds (tcSub_te phi gamma) ns es) annotatedE
 
 
---======================================================--
+-- ======================================================--
 --
 tcl2 phi t (Fail m) annotatedE = Fail m
 tcl2 phi t (Ok (psi, ts, annotatedEs)) annotatedE 
@@ -866,11 +866,11 @@ tcl2 phi t (Ok (psi, ts, annotatedEs)) annotatedE
          annotatedE:annotatedEs)
 
 
---==========================================================--
---=== 9.72 Type-checking variables                       ===--
---==========================================================--
+-- ==========================================================--
+-- === 9.72 Type-checking variables                       ===--
+-- ==========================================================--
 
---======================================================--
+-- ======================================================--
 --
 tcvar :: [TypeDef] ->
          TcTypeEnv     -> 
@@ -884,7 +884,7 @@ tcvar tds gamma ns x = Ok (tcId_subst, finalType, (finalType, AVar x))
                           finalType = tcNewinstance ns scheme
 
 
---======================================================--
+-- ======================================================--
 --
 tcNewinstance :: TypeNameSupply -> 
                  TypeScheme -> 
@@ -896,7 +896,7 @@ tcNewinstance ns (Scheme scvs t) = tcSub_type phi t
                                       phi = tcAl_to_subst al
 
 
---======================================================--
+-- ======================================================--
 --
 tcAl_to_subst :: AList TVName TVName -> 
                  Subst
@@ -904,11 +904,11 @@ tcAl_to_subst :: AList TVName TVName ->
 tcAl_to_subst al = map2nd TVar al
 
 
---==========================================================--
---=== 9.73 Type-checking applications                    ===--
---==========================================================--
+-- ==========================================================--
+-- === 9.73 Type-checking applications                    ===--
+-- ==========================================================--
 
---======================================================--
+-- ======================================================--
 --
 tcap :: [TypeDef] ->
         TcTypeEnv     -> 
@@ -923,7 +923,7 @@ tcap tds gamma ns e1 e2 = tcap1 tvn (tcl tds gamma ns' [e1, e2])
                              ns' = tcDeplete ns
 
 
---======================================================--
+-- ======================================================--
 --
 tcap1 tvn (Fail m)
    = Fail m
@@ -931,7 +931,7 @@ tcap1 tvn (Ok (phi, [t1, t2], [ae1, ae2]))
    = tcap2 tvn (tcUnify phi (t1, t2 `TArr` (TVar tvn))) [ae1, ae2]
 
 
---======================================================--
+-- ======================================================--
 --
 tcap2 tvn (Fail m) [ae1, ae2]
    = Fail m
@@ -941,11 +941,11 @@ tcap2 tvn (Ok phi) [ae1, ae2]
         finalType = tcApply_sub phi tvn
 
 
---==========================================================--
---=== 9.74 Type-checking lambda abstractions             ===--
---==========================================================--
+-- ==========================================================--
+-- === 9.74 Type-checking lambda abstractions             ===--
+-- ==========================================================--
 
---======================================================--
+-- ======================================================--
 --
 tclambda :: [TypeDef] ->
             TcTypeEnv     -> 
@@ -961,7 +961,7 @@ tclambda tds gamma ns x e = tclambda1 tvn x (tc tds gamma' ns' e)
                                tvn = tcNext_name ns
 
 
---======================================================--
+-- ======================================================--
 --
 tclambda1 tvn x (Fail m) = Fail m
 
@@ -971,16 +971,16 @@ tclambda1 tvn x (Ok (phi, t, annotatedE)) =
       finalType = (tcApply_sub phi tvn) `TArr` t
 
 
---======================================================--
+-- ======================================================--
 --
 tcNew_bvar (x, tvn) = (x, Scheme [] (TVar tvn))
 
 
---==========================================================--
---=== 9.75 Type-checking let-expressions                 ===--
---==========================================================--
+-- ==========================================================--
+-- === 9.75 Type-checking let-expressions                 ===--
+-- ==========================================================--
 
---======================================================--
+-- ======================================================--
 --
 tclet :: [TypeDef] ->
          TcTypeEnv     -> 
@@ -997,7 +997,7 @@ tclet tds gamma ns xs es e
         rhsTypes = tcl tds gamma ns1 es
         
 
---======================================================--
+-- ======================================================--
 --
 tclet1 tds gamma ns xs e (Fail m) = Fail m
 
@@ -1009,7 +1009,7 @@ tclet1 tds gamma ns xs e (Ok (phi, ts, rhsAnnExprs))
         (ns0, ns1) = tcSplit ns
 
 
---======================================================--
+-- ======================================================--
 --
 tclet2 phi xs recFlag (Fail m) rhsAnnExprs = Fail m
 
@@ -1017,7 +1017,7 @@ tclet2 phi xs recFlag (Ok (phi', t, annotatedE)) rhsAnnExprs
    = Ok (phi' `tcScomp` phi, t, (t, ALet recFlag (zip xs rhsAnnExprs) annotatedE))
 
 
---======================================================--
+-- ======================================================--
 --
 tcAdd_decls :: TcTypeEnv     ->
                TypeNameSupply  -> 
@@ -1031,7 +1031,7 @@ tcAdd_decls gamma ns xs ts = (xs `zip` schemes) ++ gamma
                                 unknowns = tcUnknowns_te gamma
 
 
---======================================================--
+-- ======================================================--
 --
 tcGenbar unknowns ns t = Scheme (map second al) t'
                          where
@@ -1041,11 +1041,11 @@ tcGenbar unknowns ns t = Scheme (map second al) t'
 
 
 
---==========================================================--
---=== 9.76 Type-checking letrec-expressions              ===--
---==========================================================--
+-- ==========================================================--
+-- === 9.76 Type-checking letrec-expressions              ===--
+-- ==========================================================--
 
---======================================================--
+-- ======================================================--
 --
 tcletrec :: [TypeDef] ->
             TcTypeEnv     -> 
@@ -1064,13 +1064,13 @@ tcletrec tds gamma ns xs es e
         nbvs = tcNew_bvars xs ns2
 
 
---======================================================--
+-- ======================================================--
 --
 tcNew_bvars xs ns = map tcNew_bvar (xs `zip` (tcName_sequence ns))
 
 
 
---======================================================--
+-- ======================================================--
 --
 tcletrec1 tds gamma ns xs nbvs e (Fail m) = (Fail m)
 
@@ -1082,12 +1082,12 @@ tcletrec1 tds gamma ns xs nbvs e (Ok (phi, ts, rhsAnnExprs))
         gamma' = tcSub_te phi gamma
 
 
---======================================================--
+-- ======================================================--
 --
 tcOld_bvar (x, Scheme [] t) = t
 
 
---======================================================--
+-- ======================================================--
 --
 tcletrec2 tds gamma ns xs nbvs e (Fail m) rhsAnnExprs = (Fail m)
 
@@ -1102,6 +1102,6 @@ tcletrec2 tds gamma ns xs nbvs e (Ok phi) rhsAnnExprs
         subnames = map first nbvs
 
 
---==========================================================--
---=== End                               TypeCheck5.m (1) ===--
---==========================================================--
+-- ==========================================================--
+-- === End                               TypeCheck5.m (1) ===--
+-- ==========================================================--
index 7f84466..2d5511d 100644 (file)
@@ -1,24 +1,24 @@
---==========================================================--
---=== Utilities                        File: utils.m (1) ===--
---==========================================================--
+-- ==========================================================--
+-- === Utilities                        File: utils.m (1) ===--
+-- ==========================================================--
 
 module Utils where
 import MyUtils
 import BaseDefs
 
---====================================--
---=== Haskell compatability        ===--
---====================================--
+-- ====================================--
+-- === Haskell compatability        ===--
+-- ====================================--
 
 
---==========================================================--
+-- ==========================================================--
 --
 copy :: Int -> a -> [a]
 
 copy n x = take (max 0 n) xs where xs = x:xs
 
 
---==========================================================--
+-- ==========================================================--
 --
 sort :: (Ord a) =>  [a] -> [a]
 
@@ -31,7 +31,7 @@ sort (a:x) = insert a (sort x)
                             | otherwise   = b:insert a x
 
 
---==========================================================--
+-- ==========================================================--
 --
 layn :: [[Char]] -> [Char]
 
@@ -43,7 +43,7 @@ layn x =   f 1 x
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 rjustify :: Int -> [Char] -> [Char]
 rjustify n s = spaces (n - length s)++s
@@ -52,7 +52,7 @@ rjustify n s = spaces (n - length s)++s
                   spaces m = copy m ' '
 
 
---==========================================================--
+-- ==========================================================--
 --
 ljustify :: Int -> [Char] -> [Char]
 ljustify n s = s ++ spaces (n - length s)
@@ -61,7 +61,7 @@ ljustify n s = s ++ spaces (n - length s)
                   spaces m = copy m ' '
 
 
---==========================================================--
+-- ==========================================================--
 --
 utRandomInts :: Int -> Int -> [Int]
 
@@ -89,10 +89,10 @@ utRandomInts s1 s2
 
 
 
---====================================--
---=== Projection functions for     ===--
---=== the static component         ===--
---====================================--
+-- ====================================--
+-- === Projection functions for     ===--
+-- === the static component         ===--
+-- ====================================--
 
 utSCdexprs :: StaticComponent -> DExprEnv
 utSCdexprs (dexprs, domains, constrelems, freevars, flags, lims, sizes) 
@@ -123,18 +123,18 @@ utSCsizes (dexprs, domains, constrelems, freevars, flags, lims, sizes)
    = sizes
 
 
---====================================--
---=== Association lists            ===--
---====================================--
+-- ====================================--
+-- === Association lists            ===--
+-- ====================================--
 
---==========================================================--
+-- ==========================================================--
 --
 utLookup []         k' = Nothing
 utLookup ((k,v):bs) k' | k == k'   = Just v
                        | otherwise = utLookup bs k'
 
 
---==========================================================--
+-- ==========================================================--
 --
 utSureLookup []         msg k' 
    = panic ( "utSureLookup: key not found in " ++ msg )
@@ -143,47 +143,47 @@ utSureLookup ((k,v):bs) msg k'
    | otherwise   = utSureLookup bs msg k'
 
 
---==========================================================--
+-- ==========================================================--
 --
 utLookupDef []         k' defawlt = defawlt
 utLookupDef ((k,v):bs) k' defawlt | k == k'     = v
                                   | otherwise   = utLookupDef bs k' defawlt
 
 
---==========================================================--
+-- ==========================================================--
 --
 utEmpty = []
 
 
---==========================================================--
+-- ==========================================================--
 --
 utDomain al = map first al
 
 
---==========================================================--
+-- ==========================================================--
 --
 utRange al = map second al
 
 
---==========================================================--
+-- ==========================================================--
 --
 utLookupAll []         k' = []
 utLookupAll ((k,v):bs) k' | k == k'     = v: utLookupAll bs k'
                           | otherwise   =    utLookupAll bs k'
 
 
---====================================--
---=== nameSupply                   ===--
---====================================--
+-- ====================================--
+-- === nameSupply                   ===--
+-- ====================================--
 
---==========================================================--
+-- ==========================================================--
 --
 utInitialNameSupply :: NameSupply
 
 utInitialNameSupply = 0
 
 
---==========================================================--
+-- ==========================================================--
 --
 utGetName :: NameSupply -> [Char] -> (NameSupply, [Char])
 
@@ -192,7 +192,7 @@ utGetName name_supply prefix
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 utGetNames :: NameSupply -> [[Char]] -> (NameSupply, [[Char]])
 
@@ -202,17 +202,17 @@ utGetNames name_supply prefixes
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 utMakeName prefix ns = prefix ++ ")" ++ show ns
 
 
 
---====================================--
---=== iseq                         ===--
---====================================--
+-- ====================================--
+-- === iseq                         ===--
+-- ====================================--
 
---==========================================================--
+-- ==========================================================--
 --
 utiConcat :: [Iseq] -> Iseq
 
@@ -220,7 +220,7 @@ utiConcat = foldr utiAppend utiNil
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 utiInterleave :: Iseq -> [Iseq] -> Iseq
 
@@ -230,7 +230,7 @@ utiInterleave is iss = foldl1 glue iss
                              foldl1 f (x:xs) = foldl f x xs
 
 
---==========================================================--
+-- ==========================================================--
 --
 utiLayn :: [Iseq] -> Iseq
 
@@ -245,7 +245,7 @@ utiLayn iss = utiLaynN 1 iss
                             ]
 
 
---==========================================================--
+-- ==========================================================--
 --
 utiLjustify :: Int -> Iseq -> Iseq
 
@@ -254,7 +254,7 @@ utiLjustify n s
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 utiNum :: Int -> Iseq
 
@@ -262,7 +262,7 @@ utiNum = utiStr . show
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 utiFWNum :: Int -> Int -> Iseq
 
@@ -274,46 +274,46 @@ utiFWNum width n
                | otherwise                = width - length digits
 
 
---====================================--
---=== oseq                         ===--
---====================================--
+-- ====================================--
+-- === oseq                         ===--
+-- ====================================--
 
---==========================================================--
+-- ==========================================================--
 --
 utoEmpty :: Oseq              -- An empty oseq
 
 utoEmpty indent col = []
 
 
---==========================================================--
+-- ==========================================================--
 --
 utoMkstr :: Oseq -> [Char]
 
 utoMkstr oseq = oseq 0 0
 
 
---==========================================================--
+-- ==========================================================--
 --
 utiNil = id
 
 
---==========================================================--
+-- ==========================================================--
 --
 utiAppend = (.)
 
 
---==========================================================--
+-- ==========================================================--
 --
 utiStr = foldr (utiAppend . utiChar) utiNil
 
 
---==========================================================--
+-- ==========================================================--
 --
 utiMkStr iseq = utoMkstr (iseq utoEmpty)
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 utiChar :: Char -> Iseq
 
@@ -323,7 +323,7 @@ utiChar c    rest indent col
    | otherwise    = utpspaces (indent - col) (c : rest indent (indent+1))
 
 
---==========================================================--
+-- ==========================================================--
 --
 utiIndent iseq oseq indent col 
  = iseq oseq' (max col indent) col
@@ -334,46 +334,46 @@ utiIndent iseq oseq indent col
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 utpspaces :: Int -> [Char] -> [Char]
 utpspaces n cs | n <= 0     = cs
                | otherwise  = ' ' : utpspaces (n-1) cs
 
 
---====================================--
---=== set                          ===--
---====================================--
+-- ====================================--
+-- === set                          ===--
+-- ====================================--
 
---==========================================================--
+-- ==========================================================--
 --
 --unMkSet :: (Ord a) => Set a -> [a]
 
 unMkSet (MkSet s) = s
 
 
---==========================================================--
+-- ==========================================================--
 --
 --utSetEmpty :: (Ord a) => Set a
 
 utSetEmpty = MkSet []
 
 
---==========================================================--
+-- ==========================================================--
 --
 --utSetIsEmpty :: (Ord a) => Set a -> Bool
 
 utSetIsEmpty (MkSet s) = s == []
 
 
---==========================================================--
+-- ==========================================================--
 --
 --utSetSingleton :: (Ord a) => a -> Set a
 
 utSetSingleton x = MkSet [x]
 
 
---==========================================================--
+-- ==========================================================--
 --
 --utSetFromList :: (Ord a) => [a] -> Set a
 
@@ -384,14 +384,14 @@ utSetFromList x = (MkSet . rmdup . sort) x
                                        | otherwise  = x: rmdup (y:xs)
 
 
---==========================================================--
+-- ==========================================================--
 --
 --utSetToList :: (Ord a) => Set a -> [a]
 
 utSetToList (MkSet xs) = xs
 
 
---==========================================================--
+-- ==========================================================--
 --
 --utSetUnion :: (Ord a) => Set a -> Set a -> Set a
 
@@ -404,7 +404,7 @@ utSetUnion (MkSet (a:as)) (MkSet (b:bs))
     | a > b   = MkSet (b: (unMkSet (utSetUnion (MkSet (a:as)) (MkSet bs))))
 
 
---==========================================================--
+-- ==========================================================--
 --
 --utSetIntersection :: (Ord a) => Set a -> Set a -> Set a
 
@@ -417,7 +417,7 @@ utSetIntersection (MkSet (a:as)) (MkSet (b:bs))
     | a > b   = utSetIntersection (MkSet (a:as)) (MkSet bs)
 
 
---==========================================================--
+-- ==========================================================--
 --
 --utSetSubtraction :: (Ord a) => Set a -> Set a -> Set a
 
@@ -430,7 +430,7 @@ utSetSubtraction (MkSet (a:as)) (MkSet (b:bs))
     | a > b   = utSetSubtraction (MkSet (a:as)) (MkSet bs)
 
 
---==========================================================--
+-- ==========================================================--
 --
 --utSetElementOf :: (Ord a) => a -> Set a -> Bool
 
@@ -438,7 +438,7 @@ utSetElementOf x (MkSet [])       = False
 utSetElementOf x (MkSet (y:ys))   = x==y || (x>y && utSetElementOf x (MkSet ys))
 
 
---==========================================================--
+-- ==========================================================--
 --
 --utSetSubsetOf :: (Ord a) => Set a -> Set a -> Bool
 
@@ -447,64 +447,64 @@ utSetSubsetOf (MkSet (a:as))    (MkSet bs)
     = utSetElementOf a (MkSet bs) && utSetSubsetOf (MkSet as) (MkSet bs)
 
 
---==========================================================--
+-- ==========================================================--
 --
 --utSetUnionList :: (Ord a) => [Set a] -> Set a
 
 utSetUnionList setList = foldl utSetUnion utSetEmpty setList
 
 
---====================================--
---=== bag                          ===--
---====================================--
+-- ====================================--
+-- === bag                          ===--
+-- ====================================--
 
---==========================================================--
+-- ==========================================================--
 --
 utBagUnion :: Bag a -> Bag a -> Bag a
 
 utBagUnion as bs = as ++ bs
 
 
---==========================================================--
+-- ==========================================================--
 --
 utBagInsert :: a -> Bag a -> Bag a
 
 utBagInsert a as = a:as
 
 
---==========================================================--
+-- ==========================================================--
 --
 utBagToList :: Bag a -> [a]
 
 utBagToList xs   = xs
 
 
---==========================================================--
+-- ==========================================================--
 --
 utBagFromList :: [a] -> Bag a
 
 utBagFromList xs = xs
 
 
---==========================================================--
+-- ==========================================================--
 --
 utBagSingleton :: a -> Bag a
 
 utBagSingleton x = [x]
 
 
---==========================================================--
+-- ==========================================================--
 --
 utBagEmpty :: Bag a
 
 utBagEmpty = []
 
 
---====================================--
---=== Useful stuff                 ===--
---====================================--
+-- ====================================--
+-- === Useful stuff                 ===--
+-- ====================================--
 
---================================================--
+-- ================================================--
 --
 splitList :: (a -> Bool) -> [a] -> ([a], [a])
 
@@ -515,17 +515,17 @@ splitList p (x:xs)  = case splitList p xs of
 
 
 
---================================================--
+-- ================================================--
 --
 first (a,b) = a
 
 
---================================================--
+-- ================================================--
 --
 second (a,b) = b
 
 
---================================================--
+-- ================================================--
 --
 mapAccuml :: (a -> b -> (a, c)) -- Function of accumulator and element 
                                    --   input list, returning new
@@ -540,7 +540,7 @@ mapAccuml f acc (x:xs) = (acc2, x':xs')
                                (acc2, xs') = mapAccuml f acc1 xs
 
 
---================================================--
+-- ================================================--
 --
 unzip2 :: [(a,b)] -> ([a], [b])
 unzip2 [] = ([],[])
@@ -548,21 +548,21 @@ unzip2 ((a,b):abs) = ( (a:as), (b:bs) )
                      where (as,bs) = unzip2 abs
 
 
---================================================--
+-- ================================================--
 --
 map1st :: (a -> b) -> [(a,c)] -> [(b,c)]
 map1st f [] = []
 map1st f ((a,b):abs) = (f a,b): map1st f abs
 
 
---================================================--
+-- ================================================--
 --
 map2nd :: (a -> b) -> [(c,a)] -> [(c,b)]
 map2nd f [] = []
 map2nd f ((a,b):abs) = (a,f b): map2nd f abs
 
 
---================================================--
+-- ================================================--
 --
 interleave :: [a] -> [[a]] -> [a]
 
@@ -571,9 +571,9 @@ interleave e [xs] = xs
 interleave e (xs:xs2:xss) = xs ++ e ++ (interleave e (xs2:xss))
 
 
---====================================--
---=== State monad generics         ===--
---====================================--
+-- ====================================--
+-- === State monad generics         ===--
+-- ====================================--
 
 returnS :: a -> ST a b
 returnS a s0 = (a, s0)
@@ -596,6 +596,6 @@ doStatefulOp2 f initState initValue1 initValue2
    = f initValue1 initValue2 initState
 
 
---==========================================================--
---=== End                                    utils.m (1) ===--
---==========================================================--
+-- ==========================================================--
+-- === End                                    utils.m (1) ===--
+-- ==========================================================--
index 59aa4b7..f9d22e8 100644 (file)
 -- 
 -- $Locker:  $
 -- $Log: Color.hs,v $
+-- Revision 1.3  1999/01/18 19:38:46  sof
+-- Misc (backward compatible) changes to make srcs acceptable
+-- to a Haskell 98 compiler.
+--
 -- Revision 1.2  1996/07/25 21:23:51  partain
 -- Bulk of final changes for 2.01
 --
@@ -29,6 +33,7 @@ import List ((\\)) -- 1.3
 
 type Color = (Int, Int, Int)
 
+noColor :: Color
 noColor = (-1, -1, -1)
 
 {-
index 99dc555..9f6ce9c 100644 (file)
@@ -9,6 +9,10 @@
 -- Status          : Unknown, Use with caution!
 -- 
 -- $Log: IOSupplement.hs,v $
+-- Revision 1.6  1999/01/18 19:38:46  sof
+-- Misc (backward compatible) changes to make srcs acceptable
+-- to a Haskell 98 compiler.
+--
 -- Revision 1.5  1998/02/19 17:02:22  simonm
 -- updates for library re-organisation in GHC 3.01.
 --
@@ -40,6 +44,10 @@ module IOSupplement (
 import System -- 1.3
 import IO
 
+#if __HASKELL1__ >= 5
+#define fail ioError
+#endif
+
 --------------------------------------------------------------------------------
 
 
index 94ce5d0..6e1e4ce 100644 (file)
@@ -2,6 +2,7 @@ TOP = ../..
 include $(TOP)/mk/boilerplate.mk
 
 SRC_HC_OPTS += -fglasgow-exts
+IOSupplement_HC_OPTS += -cpp
 SRC_RUNTEST_OPTS += ebnf2ps.stdin apat -o1 ebnf2ps.stdout
 
 # the default HS_SRCS doesn't include .ly files...
index fd3aff7..f2bbd15 100644 (file)
@@ -1,6 +1,10 @@
 --------------------------------------------------
 -- Copyright 1994 by Peter Thiemann
 -- $Log: PsOutput.hs,v $
+-- Revision 1.2  1999/01/18 19:38:47  sof
+-- Misc (backward compatible) changes to make srcs acceptable
+-- to a Haskell 98 compiler.
+--
 -- Revision 1.1  1996/01/08 20:02:34  partain
 -- Initial revision
 --
@@ -30,6 +34,7 @@ import Info (Container (..), GObject (..), TDirection (..), WrapperType (..), IN
 type PsState = (Color, FONT, Int, ShowS)
 type PsTrafo = PsState -> PsState
 
+initialState :: PsState
 initialState = (noColor, noFont, -1, id)
 
 setColor :: Color -> PsTrafo
index 189a824..c0d76f9 100644 (file)
@@ -23,6 +23,10 @@ import Matrix
 import Types
 import Interval
 
+#if __HASKELL1__ < 5
+#define realToFrac fromRealFrac
+#endif
+
 -- no is returned when there is "no" change to the csg.
 no = error ("Evaluated dead csg.")
 
@@ -55,8 +59,8 @@ calc (Object (Sphere a b c r)) rgb xyz
        f rgb zyx = (sphere zyx,no,rgb,False)
        sphere :: (R3 BI) -> BI
        sphere (x,y,z) = sqr (x-a') + sqr (y-b') + sqr (z-c') - sqr r'
-       a' = fromRealFrac a ; b' = fromRealFrac b ; c' = fromRealFrac c
-       r' = fromRealFrac r
+       a' = realToFrac a ; b' = realToFrac b ; c' = realToFrac c
+       r' = realToFrac r
 
 calc (Object (Cube a b c r)) rgb xyz
     = (ans,newc',rgb,bool)
index 030d759..66beba6 100644 (file)
@@ -1,6 +1,8 @@
 TOP = ../..
 include $(TOP)/mk/boilerplate.mk
 
+SRC_HC_OPTS += -cpp
+
 # Bah.hs is a test file, which we don't want in SRCS,
 # so we list the ones we do want explicitly
 SRCS =  Csg.hs Fulsom.hs Interval.hs Kolor.hs Matrix.hs Oct.hs Patchlevel.hs \
index c9b228a..69ec768 100644 (file)
@@ -22,6 +22,10 @@ module Matrix where
 import Types
 import Interval -- not used.
 
+#if __HASKELL1__ < 5
+#define realToFrac fromRealFrac
+#endif
+
 mat4x1 :: (Fractional a) => Arr -> R3 a -> R3 a
 mat4x1 (r1,r2,r3) xyz = (x,y,z)
                           where
@@ -33,10 +37,10 @@ dorow :: (Fractional a) => Row -> R3 a -> a
 dorow (m11,m12,m13,m14) (x,y,z) 
     = case  (m1 * x) + (m2 * y) + (m3 * z) + m4 of n -> n
        where
-        m1 = fromRealFrac m11
-        m2 = fromRealFrac m12
-        m3 = fromRealFrac m13
-        m4 = fromRealFrac m14
+        m1 = realToFrac m11
+        m2 = realToFrac m12
+        m3 = realToFrac m13
+        m4 = realToFrac m14
 
 mat4x1' :: (Fractional a) => Arr -> R3 a -> R3 a
 mat4x1' (r1,r2,r3) xyz = (x,y,z)
@@ -49,9 +53,9 @@ dorow' :: (Fractional a) => Row -> R3 a -> a
 dorow' (m11,m12,m13,m14) (x,y,z) 
     = case (m1 * x) + (m2 * y) + (m3 * z) of n -> n
        where
-        m1 = fromRealFrac m11
-        m2 = fromRealFrac m12
-        m3 = fromRealFrac m13
+        m1 = realToFrac m11
+        m2 = realToFrac m12
+        m3 = realToFrac m13
 
 mat1x4 :: Row -> Arr -> Row
 mat1x4 a (b1,b2,b3) = (c1,c2,c3,c4)
index b3b9c15..6e64ed6 100644 (file)
@@ -1,5 +1,6 @@
 TOP = ../..
 include $(TOP)/mk/boilerplate.mk
+SRC_HC_OPTS += -cpp
 HS_SRCS := $(filter-out Test%,$(HS_SRCS))
 include $(TOP)/mk/target.mk
 
index a2d3f69..094995b 100644 (file)
@@ -13,6 +13,10 @@ module Parse
 
 import Char -- 1.3
 
+#if __HASKELL1__ < 5
+#define isAlphaNum isAlphanum
+#endif
+
 infixr 1      `elseP`
 infix  2      `thenP`
 infix  2      `eachP`
@@ -74,7 +78,7 @@ upperP        =  isUpper    `filterP` itemP
 lowerP        =  isLower    `filterP` itemP
 alphaP        =  isAlpha    `filterP` itemP
 digitP        =  isDigit    `filterP` itemP
-alphanumP     =  isAlphanum `filterP` itemP
+alphanumP     =  isAlphaNum `filterP` itemP
 surroundP             :: String -> Parses x -> String -> Parses x
 surroundP l xP r      =  lexP l       `thenP` (\_ ->
                          xP           `thenP` (\x ->
index 1eab8a7..e559141 100644 (file)
@@ -1,8 +1,8 @@
 
---==========================================================--
---=== Raw lexical analysis (tokenisation) of source      ===--
---===                                           Lexer.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Raw lexical analysis (tokenisation) of source      ===--
+-- ===                                           Lexer.hs ===--
+-- ==========================================================--
 
 module Main where
 import Char -- 1.3
@@ -28,10 +28,10 @@ data Lex = Lcon             -- constructor used as prefix:
                             -- normal prefix variable in backquotes,
                             -- or infix variable (operator)
 
-         --| Ltycon           -- constructor starting with A-Z
+         -- | Ltycon          -- constructor starting with A-Z
                               -- subcase of Lcon
 
-         --| Ltyvar           -- variable starting with a-z
+         -- | Ltyvar          -- variable starting with a-z
                               -- subcase of Lvar
 
          | Lintlit          -- integer literal
@@ -132,7 +132,7 @@ data Lex = Lcon             -- constructor used as prefix:
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 leLex :: Int -> Int -> String -> [Token]
 
@@ -269,7 +269,7 @@ leLex l n (c:cs)
      leFail l n ("Illegal character  " ++ [c])
 
 
---==========================================================--
+-- ==========================================================--
 --
 leChunk :: Int -> (Char -> Bool) -> String -> (String, Int, String)
 
@@ -284,7 +284,7 @@ leChunk n proper (c:cs)
   = ([], n, c:cs)
 
 
---==========================================================--
+-- ==========================================================--
 --
 leTakeLitChars :: Bool -> Int -> Int -> String -> (String, Int, String)
 
@@ -332,7 +332,7 @@ leTakeLitChars d l n (c:cs)
        (rest, col, left) -> (c:rest, col, left)
 
 
---==========================================================--
+-- ==========================================================--
 --
 leLexLComment :: Int -> Int -> String -> [Token]
 
@@ -340,7 +340,7 @@ leLexLComment l n cs
    = leLex (l+1) 1 (drop 1 (dropWhile ((/=) '\n') cs))
 
 
---==========================================================--
+-- ==========================================================--
 --
 leLexRComment :: Int -> Int -> String -> [Token]
 
@@ -360,7 +360,7 @@ leLexRComment l n (c:cs)
    = leLexRComment l (n+1) cs
 
 
---==========================================================--
+-- ==========================================================--
 --
 leIsSymbol :: Char -> Bool
 
@@ -369,7 +369,7 @@ leIsSymbol c = c `elem` leSymbols
 leSymbols = ":!#$%&*+./<=>?\\@^|~"
 
 
---==========================================================--
+-- ==========================================================--
 --
 leIsTailChar :: Char -> Bool
 
@@ -382,7 +382,7 @@ leIsTailChar c
      c == '\''
 
 
---==========================================================--
+-- ==========================================================--
 --
 leIsLitChar :: Char -> Bool
 
@@ -393,7 +393,7 @@ leIsLitChar c
      c /= '"'
 
 
---==========================================================--
+-- ==========================================================--
 --
 leStringToInt :: String -> Int
 
@@ -403,7 +403,7 @@ leStringToInt
      in s2i . reverse
 
 
---==========================================================--
+-- ==========================================================--
 --
 leFail l n m
   = faiL ("Lexical error, line " ++ show l ++ ", col " ++ show n ++ 
@@ -411,18 +411,18 @@ leFail l n m
 
 faiL m = error ( "\n\n" ++ m ++ "\n" )
 
---==========================================================--
---=== end                                       Lexer.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                                       Lexer.hs ===--
+-- ==========================================================--
 
---==========================================================--
---=== Keyword spotting, and offside rule implementation  ===--
---===                                          Layout.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Keyword spotting, and offside rule implementation  ===--
+-- ===                                          Layout.hs ===--
+-- ==========================================================--
 
 --module Layout
 
---==========================================================--
+-- ==========================================================--
 --
 laKeyword :: Token -> Token
 
@@ -453,7 +453,7 @@ laKeyword (l, n, what, text)
          (l, n, f what text, text)
 
 
---==========================================================--
+-- ==========================================================--
 --
 laLayout :: Int -> [Int] -> [Token] -> [Token]
 
@@ -490,12 +490,12 @@ laLayout l (s:ss) (t1@(l1, n1, w1, c1) :
      laLayout l ss (t1:t2:ts)
 
 
---==========================================================--
+-- ==========================================================--
 --
 laRbrace c l n 
    = take c (repeat (l, n, Lrbrace, "}"))
 
---==========================================================--
+-- ==========================================================--
 --
 laMain :: String -> [Token]
 
@@ -503,14 +503,14 @@ laMain
    = laLayout 1 [0] . map laKeyword . leLex 1 1
 
 
---==========================================================--
---=== end                                      Layout.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                                      Layout.hs ===--
+-- ==========================================================--
 
---==========================================================--
---=== Abstract syntax for modules                        ===--
---===                                       AbsSyntax.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Abstract syntax for modules                        ===--
+-- ===                                       AbsSyntax.hs ===--
+-- ==========================================================--
 
 --module AbsSyntax where
 
@@ -599,14 +599,14 @@ data Literal
    | LiteralString  String
              deriving (Show{-was:Text-})
 
---==========================================================--
---=== end                                   AbsSyntax.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                                   AbsSyntax.hs ===--
+-- ==========================================================--
 
---==========================================================--
---=== Parser generics                                    ===--
---===                                   ParserGeneric.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === Parser generics                                    ===--
+-- ===                                   ParserGeneric.hs ===--
+-- ==========================================================--
 
 --module ParserGeneric
 
@@ -619,7 +619,7 @@ type Parser a = PEnv -> [Token] -> PResult a
 
 type PEntry = (Bool, Expr, Id)
 
---==========================================================--
+-- ==========================================================--
 --
 pgItem :: Lex -> Parser String
 
@@ -630,7 +630,7 @@ pgItem x env ((l, n, w, t):toks)
    | otherwise  = PFail (l, n, w, t)
 
 
---==========================================================--
+-- ==========================================================--
 --
 pgAlts :: [Parser a] -> Parser a
 
@@ -651,7 +651,7 @@ pgAlts ps env toks
         useAlts ps (head (toks ++ [pgEOF])) 
 
 
---==========================================================--
+-- ==========================================================--
 --
 pgThen2 :: (a -> b -> c) -> 
            Parser a -> 
@@ -674,7 +674,7 @@ pgThen2 combine p1 p2 env toks
      }
 
 
---==========================================================--
+-- ==========================================================--
 --
 pgThen3 :: (a -> b -> c -> d) -> 
            Parser a -> 
@@ -704,7 +704,7 @@ pgThen3 combine p1 p2 p3 env toks
      }
 
 
---==========================================================--
+-- ==========================================================--
 --
 pgThen4 :: (a -> b -> c -> d -> e) -> 
            Parser a -> 
@@ -741,7 +741,7 @@ pgThen4 combine p1 p2 p3 p4 env toks
      }
 
 
---==========================================================--
+-- ==========================================================--
 --
 pgZeroOrMore :: Parser a -> Parser [a]
 
@@ -761,7 +761,7 @@ pgZeroOrMore p env toks
      }
          
 
---==========================================================--
+-- ==========================================================--
 --
 pgOneOrMore :: Parser a -> Parser [a]
 
@@ -769,7 +769,7 @@ pgOneOrMore p
    = pgThen2 (:) p (pgZeroOrMore p)
 
 
---==========================================================--
+-- ==========================================================--
 --
 pgApply :: (a -> b) -> Parser a -> Parser b
 
@@ -783,7 +783,7 @@ pgApply f p env toks
      }
 
 
---==========================================================--
+-- ==========================================================--
 --
 pgTwoOrMoreWithSep :: Parser a -> Parser b -> Parser [a]
 
@@ -796,7 +796,7 @@ pgTwoOrMoreWithSep p psep
         (pgZeroOrMore (pgThen2 (\sep x -> x) psep p))
 
 
---==========================================================--
+-- ==========================================================--
 --
 pgOneOrMoreWithSep :: Parser a -> Parser b -> Parser [a]
 
@@ -804,7 +804,7 @@ pgOneOrMoreWithSep p psep
    = pgThen2 (:) p (pgZeroOrMore (pgThen2 (\sep x -> x) psep p))
 
 
---==========================================================--
+-- ==========================================================--
 --
 pgZeroOrMoreWithSep :: Parser a -> Parser b -> Parser [a]
 
@@ -817,7 +817,7 @@ pgZeroOrMoreWithSep p psep
      ]
 
 
---==========================================================--
+-- ==========================================================--
 --
 pgOptional :: Parser a -> Parser (Maybe a)
 
@@ -831,7 +831,7 @@ pgOptional p env toks
      }
 
 
---==========================================================--
+-- ==========================================================--
 --
 pgGetLineNumber :: Parser a -> Parser (Int, a)
 
@@ -848,7 +848,7 @@ pgGetLineNumber p env toks
          }
 
 
---==========================================================--
+-- ==========================================================--
 --
 pgEmpty :: a -> Parser a
 
@@ -856,18 +856,18 @@ pgEmpty item env toks
    = POk env toks item
 
 
---==========================================================--
+-- ==========================================================--
 --
 pgEOF :: Token
 
 pgEOF = (88888, 88888, Lvar, "*** Unexpected end of source! ***")
 
 
---============================================================--
---=== Some kludgey stuff for implementing the offside rule ===--
---============================================================--
+-- ============================================================--
+-- === Some kludgey stuff for implementing the offside rule ===--
+-- ============================================================--
 
---==========================================================--
+-- ==========================================================--
 --
 pgEatEnd :: Parser ()
 
@@ -879,7 +879,7 @@ pgEatEnd env (tok@(l, n, w, t):toks)
    | otherwise                    = POk env (tok:toks) ()
 
 
---==========================================================--
+-- ==========================================================--
 --
 pgDeclList :: Parser a -> Parser [a]
 
@@ -889,14 +889,14 @@ pgDeclList p
                            pgEatEnd
 
 
---==========================================================--
---=== end                               ParserGeneric.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                               ParserGeneric.hs ===--
+-- ==========================================================--
 
---==========================================================--
---=== The parser.                                        ===--
---===                                          Parser.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === The parser.                                        ===--
+-- ===                                          Parser.hs ===--
+-- ==========================================================--
 
 --module Parser where
 
@@ -1237,12 +1237,12 @@ parser_test toks
      in
          parser_to_test hsPrecTable toks
 
---==============================================--
---=== The Operator-Precedence parser (yuck!) ===--
---==============================================--
+-- ==============================================--
+-- === The Operator-Precedence parser (yuck!) ===--
+-- ==============================================--
 
 --
---==========================================================--
+-- ==========================================================--
 --
 hsAExprOrOp 
  = pgAlts [paAExpr, paOp]
@@ -1307,9 +1307,9 @@ hsDoExpr stack env toks =
            | validIn -> shift
            | otherwise -> PFail err
 
---==========================================================--
---=== end                                      Parser.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                                      Parser.hs ===--
+-- ==========================================================--
 
 hsPrecTable :: PEnv
 hsPrecTable = [
@@ -1353,7 +1353,7 @@ showx (POk env toks result)
    "\n   Next token = " ++ show (head toks) ++
    "\n\n   Result = " ++ show result ++ "\n\n"
 
---==========================================================--
+-- ==========================================================--
 --
 layn :: [[Char]] -> [Char]
 
@@ -1365,7 +1365,7 @@ layn x =   f 1 x
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 rjustify :: Int -> [Char] -> [Char]
 rjustify n s = spaces (n - length s)++s
index 7385bc3..5635c24 100644 (file)
@@ -11,4 +11,5 @@ main = do
     hPutStr stderr "Enter the number of particles: "
     s <- getContents
     let (nPart, rest) = (head (reads s)) :: (Int, String)
-    putStr (takeWhile ((/=) '\n') s ++ (pic nPart))
+    putStrLn (takeWhile ((/=) '\n') s ++ (pic nPart))
+
index 0faf7e3..07a605c 100644 (file)
@@ -1 +1 @@
-920.5370742369054264
\ No newline at end of file
+920.5370742369054264
index e5d539a..4beb3f5 100644 (file)
@@ -1 +1 @@
-920.5370742369055023
\ No newline at end of file
+920.5370742369055023
index 729df7e..3eb1ef0 100644 (file)
@@ -2,6 +2,10 @@ module Lexer (Lexeme(..), lexer) where
 
 import Char -- 1.3
 
+#if __HASKELL1__ < 5
+#define isAlphaNum isAlphanum
+#endif
+
 -- lexeme
 data Lexeme = Ide String
            | Evar String
@@ -19,7 +23,7 @@ lexer ""      = ([], True)
 lexer r@(c:s) = 
        if isSpace c      then lexer (dropWhile isSpace s)
        else if isAlpha c then 
-                          let (str1,str2) = span isAlphanum r
+                          let (str1,str2) = span isAlphaNum r
                           in current_lexeme (Ide str1) str2
        else if isDigit c then 
                           let (lexeme, rest) = (lexerNum r)
@@ -30,7 +34,7 @@ lexer r@(c:s) =
        else if c == '('  then current_lexeme Lparen s
        else if c == ')'  then current_lexeme Rparen s
        else if c == ','  then current_lexeme Comma s
-       else if c == '$'  then let (str1,str2) = span isAlphanum s
+       else if c == '$'  then let (str1,str2) = span isAlphaNum s
                                in current_lexeme (Evar ('$':str1)) str2
        else (consume s, False)
  where
index 2a71e71..da23072 100644 (file)
@@ -6,7 +6,7 @@ import Env
 import Print
 import Eval
 import BasicNumber -- partain
-import IO(isEOF)
+import IO --(isEOF,hFlush,stdout)
 
 ----------------------------------------------------------------------------
 
@@ -18,14 +18,18 @@ prompt = "-> "
 main :: IO ()
 main = cmdloop (initEnv [])
   where
-    cmdloop env = putStr prompt >>
-                 getLine >>= (\l ->
-                 if l == "exit" then return () else
-                    let (res, nenv) = cmd_process (l, env)
-                        res1 = if res=="" then ""
-                                          else res++"\n" in
-                      putStr res1 >> cmdloop nenv)
+    cmdloop env = do
+        putStr prompt
+        hFlush stdout
+        l <- getLine
+        if l == "exit" then 
+          return ()
+        else do
+           let (res, nenv) = cmd_process (l, env)
+          putStrLn res
+          cmdloop nenv
 
+#if 0
     -- partain: getLine isn't in 1.3 I/O any more
     getLine :: IO String
     getLine =  get ""
@@ -40,6 +44,7 @@ main = cmdloop (initEnv [])
                    return (reverse s)
                 else
                    get (c:s)
+#endif
 
 ----------------------------------------------------------------------------
 
index 2210d3b..cf1e803 100644 (file)
@@ -1,5 +1,6 @@
 TOP = ../..
 include $(TOP)/mk/boilerplate.mk
+SRC_HC_OPTS += -cpp
 EXTRA_RUNTEST_OPTS += +RTS -H60m -RTS
 include $(TOP)/mk/target.mk
 
index c720a4e..007b8b6 100644 (file)
@@ -7,6 +7,11 @@ import System -- 1.3
 import List -- 1.3
 import Char -- 1.3
 
+-- To keep it backward compatible with pre-Haskell 98 compilers..
+#if __HASKELL1__ >= 5
+#define fail ioError
+#endif
+
 -- Picture handling:
 
 infixr 5 `above`, `beside`
index e9456f5..9eb3171 100644 (file)
@@ -1,6 +1,8 @@
 TOP = ../..
 include $(TOP)/mk/boilerplate.mk
 
+SRC_HC_OPTS += -cpp
+
 # Arguments for test program
 SRC_RUNTEST_OPTS += 1993
 
index 04ebff5..0fef42b 100644 (file)
@@ -2,13 +2,13 @@ module Main where
 
 import Prog (prog)
 
---#ifdef PAR
+-- #ifdef PAR
 --main input = prog input
---#else
+-- #else
 -- partain: doesn't actually look at input;
 -- real input is wired into Key.lhs
 
 main = do
     str <- getContents
     putStr (prog str)
---#endif
+-- #endif
index b1ef150..35eaf96 100644 (file)
@@ -36,11 +36,11 @@ type FeedBack = Status HashFun
 cichelli :: FeedBack
 cichelli = findhash hashkeys
                 where
---#ifdef SORTED
+-- #ifdef SORTED
                 hashkeys = (blocked.freqsorted) attribkeys
---#else
+-- #else
 --                hashkeys = blocked attribkeys
---#endif
+-- #endif
 
        
 findhash :: [Key] -> FeedBack 
index 4ae833e..0b54f64 100644 (file)
@@ -126,7 +126,7 @@ firstPiece::ChessSet -> Tile
 firstPiece (Board _ _ _ f _) = f
 
 pieceAtTile::Tile -> ChessSet -> Int
-pieceAtTile x (Board s _ _ _ts)
+pieceAtTile x (Board s _ _ _ ts)
    = ts ! (tileIndex s x)
 
 isSquareFree::Tile -> ChessSet -> Bool
index 7ff8a01..ddc51bc 100644 (file)
@@ -14,6 +14,11 @@ import KnightHeuristic
 import Queue
 import System--1.3
 import Char--1.3
+
+#if __HASKELL1__ >= 5
+#define fail ioError
+#endif
+
 \end{code}
 
 %%%%%%%%%%%%%%%%%%%%% B O D Y  O F  M O D U L E %%%%%%%%%%%%%%%%%%%%%
index 64fbde8..84cd228 100644 (file)
@@ -1,7 +1,7 @@
 TOP = ../..
 include $(TOP)/mk/boilerplate.mk
 
-# SRC_HC_OPTS += -syslib hbc
+SRC_HC_OPTS += -cpp
 
 # Arguments for the test program
 SRC_RUNTEST_OPTS += 8 3
index 006d28a..f8c5745 100644 (file)
@@ -1,4 +1,4 @@
---!!! strongly-connected components of a graph
+-- !!! strongly-connected components of a graph
 -- (courtesy mainly of John Launchbury)
 
 import Digraph