[project @ 1999-01-23 18:07:42 by sof]

updates and tweaks

ghc/tests/programs/andre_monad/Main.hs

@@ -56,7 +56,7 @@ u `quo` v		=  Bin Quo u v
 term0,term1,term2	:: Term
 term0			=  Con 6 `mul` Con 9
 term1			=  (Con 4 `mul` Con 13) `add` Con 2
-term2			=  (Con 1 `quo` Con 0) `add` Con 2
+term2			=  (Con 1 `quo` Con 2) `add` Con 2
 term3                   =  ((((((((((((((((((((((((((((((((
                            ((((((((((((((((((((((((((((((
                                  Con 7777 `mul` Con  13) `quo` Con  13)

ghc/tests/programs/andre_monad/andre_monad.stdout

@@ -0,0 +1 @@
+"(2,15002)"

ghc/tests/programs/barton-mangler-bug/Basic.hs

@@ -223,8 +223,7 @@ makeWin st wid sig =
              nullWindow
   in PieceContRep wins
 instance Signal BasicSignal where
-  toSig Overshoot{start_delay,pulse_width,
-                  ringing,oscillation,damp_fac} =
+  toSig (Overshoot start_delay pulse_width ringing oscillation damp_fac) =
     let ring = sine ringing oscillation 0.0
         cond = asTypeOf (expc damp_fac) ring
         sig = temp ring cond
@@ -237,8 +236,16 @@ instance Signal BasicSignal where
                Window LocalZero (TimeEvent (fromPhysical pulse_width)) sig |>
                nullWindow
     in PieceContRep wins
-  toSig Pulse_dc{start_delay,rise_time,pulse_width,fall_time,
-                 dc_offset,period,amplitude,over,under} =
+  toSig Pulse_dc{ start_delay = start_delay
+                , rise_time   = rise_time
+		, pulse_width = pulse_width
+		, fall_time   = fall_time
+		, dc_offset   = dc_offset
+		, period      = period
+		, amplitude   = amplitude
+		, over        = over
+		, under       = under
+		} =
     let pul = trap start_delay rise_time pulse_width fall_time amplitude
         so = toPhysical ((fromPhysical start_delay) + (fromPhysical rise_time))
         su = toPhysical ((fromPhysical so) + (fromPhysical pulse_width) + (fromPhysical fall_time))

ghc/tests/programs/cholewo-eval/Arr.lhs

@@ -46,7 +46,7 @@ fromVector :: Vector a -> Array Int a
 fromVector (Vector x) = x
 
 instance Functor (Vector) where
-  map fn x = toVector (map fn (fromVector x))    
+  fmap fn x = toVector (fmap fn (fromVector x))    
 
 {-instance Eq a => Eq (Vector a) where
 --  (Vector x) == (Vector y) = x == y
@@ -62,11 +62,11 @@ instance Read a => Read (Vector a) where
 instance Num b => Num (Vector b) where
   (+) = zipVector "+" (+)
   (-) = zipVector "-" (-)
-  negate = map negate
-  abs = map abs
-  signum = map signum
+  negate = fmap negate
+  abs = fmap abs
+  signum = fmap signum
 --   (*) = matMult -- works only for matrices!
---  fromInteger = map fromInteger
+--  fromInteger = fmap fromInteger
 \end{code}
 
 
@@ -88,7 +88,7 @@ zipVector s f (Vector a) (Vector b)
   | otherwise            = error ("zipVector: " ++ s ++ ": unconformable arrays")
 
 scaleVector :: Num a => a -> Vector a -> Vector a
-scaleVector a = map (* a)
+scaleVector a = fmap (* a)
 
 sumVector :: Num a => Vector a -> a
 sumVector = sum . elems . fromVector
@@ -113,7 +113,7 @@ fromMatrix :: Matrix a -> Array (Int, Int) a
 fromMatrix (Matrix x) = x
 
 instance Functor (Matrix) where
-  map fn x = toMatrix (map fn (fromMatrix x))    
+  fmap fn x = toMatrix (fmap fn (fromMatrix x))    
 
 --instance Eq a => Eq (Matrix a) where
 --  (Matrix x) == (Matrix y) = x == y
@@ -133,11 +133,11 @@ instance Read a => Read (Matrix a) where
 instance Num b => Num (Matrix b) where
   (+) = zipMatrix "+" (+)
   (-) = zipMatrix "-" (-)
-  negate = map negate
-  abs = map abs
-  signum = map signum
+  negate = fmap negate
+  abs = fmap abs
+  signum = fmap signum
   x * y = toMatrix (matMult (fromMatrix x) (fromMatrix y)) -- works only for matrices!
---  fromInteger = map fromInteger
+--  fromInteger = fmap fromInteger
 \end{code}
 
 Convert a nested list to a matrix.
@@ -159,7 +159,7 @@ zipMatrix s f (Matrix a) (Matrix b)
   | otherwise            = error ("zipMatrix: " ++ s ++ ": unconformable arrays")
 
 scaleMatrix :: Num a => a -> Matrix a -> Matrix a
-scaleMatrix a = map (* a)
+scaleMatrix a = fmap (* a)
 
 sumMatrix :: Num a => Matrix a -> a
 sumMatrix = sum . elems . fromMatrix
@@ -204,9 +204,9 @@ Overload arithmetical operators to work on lists.
 instance Num a => Num [a] where
   (+) = safezipWith "+" (+)
   (-) = safezipWith "-" (-)
-  negate = map negate
-  abs = map abs
-  signum = map signum
+  negate = fmap negate
+  abs = fmap abs
+  signum = fmap signum
 --   (*) = undefined
 --   fromInteger = undefined
 \end{code}
@@ -219,8 +219,8 @@ sum1 = foldl1 (+)
 \end{code}
 
 \begin{code}
-map2 f = map (map f) 
-map3 f = map (map2 f) 
+map2 f = fmap (fmap f) 
+map3 f = fmap (map2 f) 
 \end{code}
 
 Map function f at position n only.  Out of range indices are silently
@@ -260,16 +260,16 @@ Overload arithmetical operators to work on arrays.
 instance (Ix a, Show a, Num b) => Num (Array a b) where
   (+) = zipArr "+" (+)
   (-) = zipArr "-" (-)
-  negate = map negate
-  abs = map abs
-  signum = map signum
+  negate = fmap negate
+  abs = fmap abs
+  signum = fmap signum
 --   (*) = matMult -- works only for matrices!
 --   fromInteger = map fromInteger
 \end{code}
 
 \begin{xcode}
 scaleArr :: (Ix i, Num a) => a -> Array i a -> Array i a
-scaleArr a = map (*a)
+scaleArr a = fmap (*a)
 
 sumArr :: (Ix i, Num a) => Array i a -> a
 sumArr = sum . elems
@@ -362,23 +362,23 @@ padleft n x | n <= length x = x
 
 \begin{code}
 padMatrix :: RealFloat a => Int -> Matrix a -> Matrix String
-padMatrix n x = let ss = map (\a -> showFFloat (Just n) a "") x 
-                    maxw = maximum (map length (elems (fromMatrix ss)))
-              in map (padleft maxw) ss
+padMatrix n x = let ss = fmap (\a -> showFFloat (Just n) a "") x 
+                    maxw = maximum (fmap length (elems (fromMatrix ss)))
+              in fmap (padleft maxw) ss
 \end{code}
 
 \begin{xcode}
 showsVector :: (RealFloat a) => Int -> Vector a -> ShowS
 showsVector n x z1 = let x' = padArr n x
                          (l,u) = bounds x' in
-                  concat (map (\ (i, s) -> if i == u then s ++ "\n" else s ++ " ") (assocs x')) ++ z1
+                  concat (fmap (\ (i, s) -> if i == u then s ++ "\n" else s ++ " ") (assocs x')) ++ z1
 \end{xcode}
 
 \begin{xcode}
 showsMatrix :: RealFloat a => Int -> Matrix a -> ShowS
 showsMatrix n x z1 = let x' = padMatrix n x
                          ((l,l'),(u,u')) = bounds x' in
-                   concat (map (\ ((i,j), s) -> if j == u' then s ++ "\n" else s ++ " ") (assocs x')) ++ z1
+                   concat (fmap (\ ((i,j), s) -> if j == u' then s ++ "\n" else s ++ " ") (assocs x')) ++ z1
 \end{xcode}
 
 {-

ghc/tests/programs/cholewo-eval/Main.lhs

@@ -9,7 +9,7 @@ type DF a = Vector a -> Vector a
 \end{code}
 
 \begin{code}
-data (Eval a) => ScgData a = ScgData {k :: !Int, err :: !a,
+data {-(Eval a) =>-} ScgData a = ScgData {k :: !Int, err :: !a,
                           w, p, r :: !(Vector a),
                           delta, pnorm2, lambda, lambdabar :: !a,
                           success :: !Bool}

ghc/tests/programs/cholewo-eval/cholewo-eval.stdout

@@ -1 +1 @@
-[-0.5105811455265337, -0.7565080326002654]
+[-0.5105811455265337,-0.7565080326002654]

ghc/tests/programs/dmgob_native1/Main.lhs

@@ -33,7 +33,7 @@ blank line, etc.
 >                  let
 >                    vs = readVectors bs
 >                  in
->                  putStr (display vs)
+>                  putStrLn (display vs)
 >
 >       _       -> error " need a binary file name"
 

ghc/tests/programs/dmgob_native1/Makefile

@@ -2,7 +2,10 @@ TOP = ..
 include $(TOP)/mk/boilerplate.mk
 
 SRC_RUNTEST_OPTS += test_data 
-SRC_HC_OPTS += -cpp -syslib hbc
+SRC_HC_OPTS += -cpp -syslib misc
+EXTRA_LD_OPTS += -syslib misc
+
+OBJS = $(HS_OBJS)
 
 all :: runtest
 

ghc/tests/programs/dmgob_native1/dmgob_native1.stdout

@@ -1,10 +1,11 @@
 3
-[1.00000000, 2.00000000, 3.00000000]
+[1.0,2.0,3.0]
 
 2
-[1.00000000, 2.00000000]
+[1.0,2.0]
 
 4
-[1.00000000, 2.00000000, 3.00000000, 4.00000000]
+[1.0,2.0,3.0,4.0]
+
 
 

ghc/tests/programs/dmgob_native2/Makefile

@@ -1,7 +1,7 @@
 TOP = ..
 include $(TOP)/mk/boilerplate.mk
 
-SRC_HC_OPTS += -cpp -syslib hbc
+SRC_HC_OPTS += -cpp -syslib misc
 
 all :: runtest
 

ghc/tests/programs/fast2haskell/Fast2haskell.hs

@@ -6,7 +6,7 @@
             land_i, lnot_i, lor_i, lshift_i, rshift_i,
             descr,
             destr_update, indassoc, lowbound, tabulate, upbound, update, valassoc) where {
-            import Word;
+            import Word2;
 	    import Complex; -- 1.3
 	    import Array; -- 1.3
             type Complex_type   = Complex Double;

ghc/tests/programs/fast2haskell/Word.hs

@@ -7,7 +7,7 @@ module Word2 (
 	byteToInt, shortToInt, wordToInt
     ) where
 
-import GHC
+import PrelGHC
 import PrelBase
 
 infixl 8 `bitLsh`, `bitRsh`
@@ -32,10 +32,10 @@ instance Bits Word where
 	bitXor (Word x) (Word y) = error "later..." -- Word (XOR x y)
 	bitCompl (Word x)        = case not# x of x' -> Word x'
 	bitLsh (Word x) (I# y)	 = case shiftL# x y of z -> Word z
-	bitRsh (Word x) (I# y)	 = case shiftRA# x y of z -> Word z
+	bitRsh (Word x) (I# y)	 = case shiftRL# x y of z -> Word z
         bitSwap (Word x)         = --Word (OR (LSH x 16) (AND (RSH x 16) 65535))
 				   case shiftL# x 16# of { a# ->
-				   case shiftRA# x 16# of { b# ->
+				   case shiftRL# x 16# of { b# ->
 				   case and# b# (i2w 65535#) of { c# ->
 				   case or#  a# c# of  { r# ->
 				   Word r# }}}}
@@ -46,17 +46,17 @@ w2i x = word2Int# x
 i2w x = int2Word# x
 
 instance Num Word where
-	Word x + Word y = case plusInt#  (w2i x) (w2i y) of z -> Word (i2w z)
-	Word x - Word y = case minusInt# (w2i x) (w2i y) of z -> Word (i2w z)
-	Word x * Word y = case timesInt# (w2i x) (w2i y) of z -> Word (i2w z)
+	Word x + Word y = case (w2i x) +# (w2i y) of z -> Word (i2w z)
+	Word x - Word y = case (w2i x) -# (w2i y) of z -> Word (i2w z)
+	Word x * Word y = case (w2i x) *# (w2i y) of z -> Word (i2w z)
 	negate (Word x) = case negateInt# (w2i x)  of z -> Word (i2w z)
 	fromInteger (J# a# s# d#)
 	  = case integer2Int# a# s# d# of { z# ->
 	    Word (i2w z#) }
 
 instance Show Word where
 	showsPrec _ (Word w) =
-		let i = toInteger (I# (w2i w)) + (if geWord# w (i2w 0#) then 0 else  2*(toInteger maxBound + 1))
+		let i = toInteger (I# (w2i w)) + (if geWord# w (i2w 0#) then 0 else  2*(toInteger (maxBound::Int) + 1))
 		in  showString (conv 8 i)
 
 conv :: Int -> Integer -> String

ghc/tests/programs/fun_insts/Main.hs

@@ -1,4 +1,4 @@
---!!! Defines functions as an instance of Num
+-- !!! Defines functions as an instance of Num
 
 module Main where
 
@@ -20,4 +20,4 @@ cc = cos * cos
 tt = ss + cc
 -- sin**2 + cos**2 = 1
 
-main = putStr ((show (tt 0.4))++ "  "++(show (tt 1.652)))
+main = putStrLn ((show (tt 0.4))++ "  "++(show (tt 1.652)))

ghc/tests/programs/jules_xref/Main.hs

@@ -1,4 +1,4 @@
---!!! a performance-problem test from Jules.
+-- !!! a performance-problem test from Jules.
 --  further comment at the end
 -- 
 module Main where 
@@ -40,7 +40,7 @@ avAdd (ABranch l yk yv r hy) xk xv
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 {-
 avLookup :: Ord a  =>  ATree a b -> 
@@ -56,7 +56,7 @@ avLookup (ABranch l k v r _) kk
 
 
 
---==========================================================--
+-- ==========================================================--
 --
 avCombine :: ATree a b -> 
              Int -> 
@@ -86,9 +86,9 @@ avCombine t1 h1 t2 h2 t3 h3 ak av ck cv
       max1 n m = 1 + (if n > m then n else m)
 
 
---==========================================================--
---=== end                                     AVLTree.hs ===--
---==========================================================--
+-- ==========================================================--
+-- === end                                     AVLTree.hs ===--
+-- ==========================================================--
 
 
 
@@ -99,7 +99,7 @@ xref stab lineno [] = stab
 xref stab lineno ('\n':cs) = xref stab (lineno+1) cs
 xref stab lineno (c:cs) 
    = if isAlpha c then 
-        let (word, rest) = span isAlphanum cs
+        let (word, rest) = span isAlphaNum cs
         in  xref (avAdd stab (c:word) lineno) lineno rest
      else xref stab lineno cs