Testsuite: tabs -> spaces [skip ci]
authorThomas Miedema <thomasmiedema@gmail.com>
Sat, 18 Jun 2016 20:44:19 +0000 (22:44 +0200)
committerThomas Miedema <thomasmiedema@gmail.com>
Mon, 20 Jun 2016 14:22:07 +0000 (16:22 +0200)
28 files changed:
testsuite/tests/boxy/PList1.hs
testsuite/tests/boxy/PList2.hs
testsuite/tests/boxy/boxy.hs
testsuite/tests/programs/Queens/queens.hs
testsuite/tests/programs/andre_monad/Main.hs
testsuite/tests/programs/barton-mangler-bug/Basic.hs
testsuite/tests/programs/fast2haskell/Fast2haskell.hs
testsuite/tests/programs/galois_raytrace/CSG.hs
testsuite/tests/programs/galois_raytrace/Construct.hs
testsuite/tests/programs/galois_raytrace/Data.hs
testsuite/tests/programs/galois_raytrace/Eval.hs
testsuite/tests/programs/galois_raytrace/Geometry.hs
testsuite/tests/programs/galois_raytrace/Illumination.hs
testsuite/tests/programs/galois_raytrace/Intersections.hs
testsuite/tests/programs/galois_raytrace/Interval.hs
testsuite/tests/programs/galois_raytrace/Pixmap.hs
testsuite/tests/programs/galois_raytrace/Surface.hs
testsuite/tests/programs/joao-circular/Data_Lazy.hs
testsuite/tests/programs/jtod_circint/Signal.hs
testsuite/tests/programs/lennart_range/Main.hs
testsuite/tests/programs/lex/Main.hs
testsuite/tests/programs/life_space_leak/Main.hs
testsuite/tests/programs/maessen-hashtab/Data/HashTab.hs
testsuite/tests/programs/record_upd/Main.hs
testsuite/tests/programs/rittri/Main.hs
testsuite/tests/programs/strict_anns/Main.hs
testsuite/tests/programs/thurston-modular-arith/Main.hs
testsuite/tests/programs/thurston-modular-arith/TypeVal.hs

index 80fac96..6869d90 100644 (file)
@@ -1,26 +1,26 @@
 {-# OPTIONS_GHC -XImpredicativeTypes -fno-warn-deprecated-flags #-}
 
-module PList1 where 
--- Polymorphic lists 1: requires smart-app-res  
+module PList1 where
+-- Polymorphic lists 1: requires smart-app-res
 
 type Sid = forall a . a -> a
 
-ids :: [Sid] 
-ids = [] 
+ids :: [Sid]
+ids = []
 
--- requires smart-app-res 
-test0 :: [Sid] 
-test0 = (\x->x) : ids 
+-- requires smart-app-res
+test0 :: [Sid]
+test0 = (\x->x) : ids
 
-test1 :: [Sid] -- SLPJ added
-test1 = ids ++ test0 
+test1 :: [Sid]  -- SLPJ added
+test1 = ids ++ test0
 
-test2 :: [Sid] 
-test2 = tail test1 
+test2 :: [Sid]
+test2 = tail test1
 
 
-test3 :: [Sid] -- SLPJ added
-test3 = reverse test2 
-test4 = (tail::([Sid]->[Sid])) test2 
+test3 :: [Sid]  -- SLPJ added
+test3 = reverse test2
+test4 = (tail::([Sid]->[Sid])) test2
 
-test5 = (head::([Sid]->Sid)) test2 
\ No newline at end of file
+test5 = (head::([Sid]->Sid)) test2
index 581ce08..316e879 100644 (file)
@@ -1,27 +1,27 @@
 {-# OPTIONS_GHC -XImpredicativeTypes -fno-warn-deprecated-flags #-}
 
-module PList2 where 
+module PList2 where
 -- Polymorphic lists 2: require smart-app-arg & smart-app-res: Should fail w/o smart-app-arg
 
-type Sid = forall a. a -> a 
+type Sid = forall a. a -> a
 
-ids :: [Sid] 
-ids = [] 
+ids :: [Sid]
+ids = []
 
-test0 :: [Sid] 
+test0 :: [Sid]
 test0 = (\x -> x):ids  -- requires smart-app-res
 
-test1 :: [Sid] -- Added SLPJ
-test1 = ids ++ test0 
+test1 :: [Sid]  -- Added SLPJ
+test1 = ids ++ test0
 
 test2 :: [Sid]
-test2 = tail test1 -- requires smart-app-arg 
+test2 = tail test1 -- requires smart-app-arg
 
-test3 :: [Sid]         -- Added SLPJ 
-test3 = reverse test2 
+test3 :: [Sid]  -- Added SLPJ
+test3 = reverse test2
 
 test4 :: Sid
 test4 = head ids  --requires smart-app-arg
 
 test5 :: Sid
-test5 = head ids  -- still requires smart-app-arg 
+test5 = head ids  -- still requires smart-app-arg
index 4d2bd02..c4835b1 100644 (file)
@@ -12,14 +12,14 @@ g :: Maybe (forall a. [a] -> a) -> (Int, Char)
 g Nothing = (0, '0')
 g (Just get) = (get [1,2], get ['a','b','c'])
 
-sing x = [x] 
+sing x = [x]
 
 id1 :: forall a. a -> a
 id1 = id
 
 {-
-ids :: [forall a. a -> a]  
-ids = [id1,id1] 
+ids :: [forall a. a -> a]
+ids = [id1,id1]
 
 t1 :: [forall a. a -> a]
 t1 = tail ids
@@ -41,7 +41,7 @@ qG choose id = choose id
 
 qH :: (forall a. a -> a -> a) -> (forall a. a -> a) -> (forall b. b -> b) -> (forall b. b -> b)
 qH choose id = choose id
-   
+
 choose :: forall a. a -> a -> a
 choose x y = x
 
@@ -58,10 +58,10 @@ impred2 = id qF
 --- all of these currently work in GHC with higher-rank types
 
 self1 :: (forall a. a -> a) -> (forall a. a -> a)
-self1 f = f f 
+self1 f = f f
 
 self2 :: (forall a. a -> a) -> b -> b
-self2 f = f f 
+self2 f = f f
 
 gr1 = self1 id
 
@@ -109,8 +109,8 @@ fixMT :: (MapTree -> MapTree) -> MapTree
 fixMT f = f (fixMT f)
 
 mapTree' = fixMT (\ (mapTree :: MapTree) -> \f tree -> case tree of
-                           Branch a t -> Branch (f a) (mapTree (cross f) t)
-                           Leaf -> Leaf)
+                            Branch a t -> Branch (f a) (mapTree (cross f) t)
+                            Leaf -> Leaf)
 
 -- polymorphic fix
 fix :: (a -> a) -> a
@@ -119,6 +119,6 @@ fix f = f (fix f)
 
 -- mapTree'' :: MapTree
 mapTree'' = (fix :: (MapTree -> MapTree) -> MapTree)
-              (\ mapTree -> \f tree -> case tree of
-                           Branch a t -> Branch (f a) (mapTree (cross f) t)
-                           Leaf -> Leaf)
+               (\ mapTree -> \f tree -> case tree of
+                            Branch a t -> Branch (f a) (mapTree (cross f) t)
+                            Leaf -> Leaf)
index 548e20c..249f371 100644 (file)
@@ -8,25 +8,25 @@ main =
     solutions = queens 8
 
 queens :: Int -> [[Int]]
-queens n = valid n n 
+queens n = valid n n
 
 valid :: Int -> Int -> [[Int]]
 valid 0 n = [[]]
-valid m n = filter safe (extend n (valid (m-1) n)) 
+valid m n = filter safe (extend n (valid (m-1) n))
 
-extend n b = cp (fromTo 1 n) b 
+extend n b = cp (fromTo 1 n) b
 
 cp :: [a] -> [[a]] -> [[a]]
 cp [] y = []
-cp (a:x) y = map (a:) y ++ cp x y 
+cp (a:x) y = map (a:) y ++ cp x y
 
 safe (a:b) = no_threat a b 1
 
 no_threat a [] m = True
 no_threat a (b:y) m =
-    a /= b && a+m /= b && a-m /= b && no_threat a y (m+1) 
+    a /= b && a+m /= b && a-m /= b && no_threat a y (m+1)
 
-board :: [Int] -> String 
+board :: [Int] -> String
 board b =
     unlines (concat (zipWith rank (from 1) b))
   where
@@ -34,12 +34,12 @@ board b =
         map line ["o o o", " \\|/ ", " === "]
       where
         line crown_slice =
-           concat (zipWith square (from 1) b)
+            concat (zipWith square (from 1) b)
           where
-           square scol _ =
-               if scol == qcol then crown_slice
-               else if (scol `rem` (2::Int)) == (r `rem` (2::Int)) then "....."
-               else "     "
+            square scol _ =
+                if scol == qcol then crown_slice
+                else if (scol `rem` (2::Int)) == (r `rem` (2::Int)) then "....."
+                else "     "
 
 -- in place of ..
 
index 7e3dda6..5df32d7 100644 (file)
@@ -6,57 +6,57 @@
 
 -- The count monad
 
-type  M a              =  (a, Int)
+type  M a               =  (a, Int)
 
-unit                   :: a -> M a
-unit a                 =  (a, 0)
+unit                    :: a -> M a
+unit a                  =  (a, 0)
 
-bind                   :: M a -> (a -> M b) -> M b
-m `bind` k             =  case m of 
-                             (a,i) -> case k a of 
+bind                    :: M a -> (a -> M b) -> M b
+m `bind` k              =  case m of
+                             (a,i) -> case k a of
                                         (b,j) -> (b,i+j)
 
--- disp                        :: Text a => M a -> String
-disp (a,i)             =  show a ++ "\nCount: " ++ show i
+-- disp                 :: Text a => M a -> String
+disp (a,i)              =  show a ++ "\nCount: " ++ show i
 
-tick                   :: M ()
-tick                   =  ((), 1)
+tick                    :: M ()
+tick                    =  ((), 1)
 
 -- The evaluator
 -- Lines with * are only change from evalIdent
 
-data  Op               =  Add | Sub | Mul | Quo
-data  Term             =  Con Int | Bin Op Term Term
+data  Op                =  Add | Sub | Mul | Quo
+data  Term              =  Con Int | Bin Op Term Term
 
-eval                   :: Term -> M Int
-eval (Con i)           =  unit i
-eval (Bin op u v)      =  eval u     `bind` (\a  ->
-                          eval v     `bind` (\b  ->
-                          go op a b  `bind` (\c  ->    -- *
-                          tick       `bind` (\ () ->   -- *
-                          unit c))))                   -- *
+eval                    :: Term -> M Int
+eval (Con i)            =  unit i
+eval (Bin op u v)       =  eval u     `bind` (\a  ->
+                           eval v     `bind` (\b  ->
+                           go op a b  `bind` (\c  ->    -- *
+                           tick       `bind` (\ () ->   -- *
+                           unit c))))                   -- *
 
-go                     :: Op -> Int -> Int -> M Int
-go Add a b             =  unit (a+b)
-go Sub a b             =  unit (a-b)
-go Mul a b             =  unit (a*b)
-go Quo a b             =  unit (a `quot` b) -- WDP: was "div"
+go                      :: Op -> Int -> Int -> M Int
+go Add a b              =  unit (a+b)
+go Sub a b              =  unit (a-b)
+go Mul a b              =  unit (a*b)
+go Quo a b              =  unit (a `quot` b) -- WDP: was "div"
 
-test                   :: Term -> String
-test t                 =  disp (eval t)
+test                    :: Term -> String
+test t                  =  disp (eval t)
 
 -- Test data
 
-add, sub, mul, quo     :: Term -> Term -> Term
-u `add` v              =  Bin Add u v
-u `sub` v              =  Bin Sub u v
-u `mul` v              =  Bin Mul u v
-u `quo` v              =  Bin Quo u v
+add, sub, mul, quo      :: Term -> Term -> Term
+u `add` v               =  Bin Add u v
+u `sub` v               =  Bin Sub u v
+u `mul` v               =  Bin Mul u v
+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 2) `add` Con 2
+term0,term1,term2       :: Term
+term0                   =  Con 6 `mul` Con 9
+term1                   =  (Con 4 `mul` Con 13) `add` Con 2
+term2                   =  (Con 1 `quo` Con 2) `add` Con 2
 term3                   =  ((((((((((((((((((((((((((((((((
                            ((((((((((((((((((((((((((((((
                                  Con 7777 `mul` Con  13) `quo` Con  13)
index 1597a86..f446ff2 100644 (file)
@@ -33,10 +33,10 @@ instance Signal SignalRep where
   toSig = id
 instance (Physical a, Physical b) => Eq (a -> b) where
   a == b = error "Attempt to apply equality to functions"
-binop:: (Physical a, Physical b) => (Float -> Float -> Float) -> 
+binop:: (Physical a, Physical b) => (Float -> Float -> Float) ->
                                     (a -> b) -> (a -> b) -> a -> b
 binop op f g t = toPhysical ((fromPhysical (f t)) `op` (fromPhysical (g t)))
-unop:: (Physical a, Physical b ) => (Float -> Float) -> 
+unop:: (Physical a, Physical b ) => (Float -> Float) ->
                                     (a -> b) -> a -> b
 unop op f t = toPhysical (op (fromPhysical (f t)))
 instance (Physical a, Physical b) => Num (SignalRep a b) where
@@ -47,11 +47,11 @@ instance (Physical a, Physical b) => Num (SignalRep a b) where
   signum f = FunctionRep (unop abs (mapSignal f))
   fromInteger i = FunctionRep (\t -> toPhysical (fromInteger i))
   --fromInt i = FunctionRep (\t -> toPhysical (fromInt i))
-instance (Physical a, Physical b) => 
+instance (Physical a, Physical b) =>
          Fractional (SignalRep a b) where
   f / g = FunctionRep (binop (/) (mapSignal f) (mapSignal g))
   fromRational r = FunctionRep (\t -> (toPhysical (fromRational r)))
-instance (Physical a, Physical b) => 
+instance (Physical a, Physical b) =>
           Floating (SignalRep a b) where
   pi = FunctionRep (\t -> (toPhysical pi))
   exp   f = FunctionRep (unop exp (mapSignal f))
@@ -67,7 +67,7 @@ instance (Physical a, Physical b) =>
   acosh f = FunctionRep (unop acosh (mapSignal f))
   atanh f = FunctionRep (unop atanh (mapSignal f))
 data Event =
-  TimeEvent Float | 
+  TimeEvent Float |
   FunctionEvent (Float -> Bool) |
   BurstEvent Int Event
 
@@ -82,7 +82,7 @@ instance Eq Event where
 eventOccurs:: Event -> Float -> Float
 eventOccurs (TimeEvent t) x = if x < t then x else t
 eventOccurs (FunctionEvent f) x = stepEval f x
-eventOccurs (BurstEvent i e) x = 
+eventOccurs (BurstEvent i e) x =
           if i == 1 then
             eventOccurs e x
           else
@@ -90,7 +90,7 @@ eventOccurs (BurstEvent i e) x =
 stepEval:: (Float -> Bool) -> Float -> Float
 stepEval f x = if f x then x else stepEval f (x + eventEps x)
 data ZeroIndicator = LocalZero | GlobalZero deriving (Eq, Show)
-data {- (Physical a, Physical b) => -} FunctionWindow a b = 
+data {- (Physical a, Physical b) => -} FunctionWindow a b =
      Window ZeroIndicator Event (SignalRep a b)
      deriving (Eq, Show)
 data PieceCont a b = Windows [FunctionWindow a b]
@@ -100,43 +100,43 @@ instance Signal PieceCont where
   mapSignal (Windows wl) t = (mapSignal s) (toPhysical t')
       where (t', (Window z e s), wl') = getWindow 0.0 (fromPhysical t) wl
   toSig = PieceContRep
-getWindow:: (Physical a, Physical b) => 
-            Float -> Float -> [ FunctionWindow a b ] -> 
+getWindow:: (Physical a, Physical b) =>
+            Float -> Float -> [ FunctionWindow a b ] ->
             (Float, FunctionWindow a b, [ FunctionWindow a b ])
 getWindow st t [] = (t, Window LocalZero e f, [])
                     where e = TimeEvent (realmul 2 t)
                           f = FunctionRep (\t -> toPhysical 0.0)
-getWindow st t (w:wl) = if t' <= wt then (t',w,w:wl) 
+getWindow st t (w:wl) = if t' <= wt then (t',w,w:wl)
                         else getWindow (st+wt) t wl
     where wt = eventOccurs e t'
           (Window z e s) = w
           t' = if z == LocalZero then t-st else t
-(|>) :: (Physical a, Physical b) => FunctionWindow a b -> 
+(|>) :: (Physical a, Physical b) => FunctionWindow a b ->
         PieceCont a b -> PieceCont a b
 w |> (Windows wl) = Windows (w:wl)
 nullWindow = Windows []
-cycleWindows:: (Physical a, Physical b) => 
+cycleWindows:: (Physical a, Physical b) =>
                 PieceCont a b -> PieceCont a b
 cycleWindows (Windows wl) = Windows (cycle wl)
 constant:: (Physical a, Physical b) => b -> SignalRep a b
 constant x = FunctionRep (\t -> x)
 linear:: (Physical a, Physical b) => Float -> b -> SignalRep a b
 linear m b  = FunctionRep (\x -> toPhysical (realmul m (fromPhysical x) + (fromPhysical b)))
-sine:: (Physical a, Physical b) => 
+sine:: (Physical a, Physical b) =>
        b -> Frequency -> Float -> SignalRep a b
 sine mag omeg phase = FunctionRep (\x -> toPhysical (realmul (fromPhysical mag) (sin (realmul (realmul (realmul 2 pi) (fromPhysical omeg)) (fromPhysical x) + phase))))
 waveform:: (Physical a, Physical b) => a -> [b] -> SignalRep a b
 waveform samp ampls =
   let stepSlope y y' = realdiv ((fromPhysical y') - (fromPhysical y)) (fromPhysical samp)
-      makeWin (v,v') = Window LocalZero (TimeEvent (fromPhysical samp)) 
+      makeWin (v,v') = Window LocalZero (TimeEvent (fromPhysical samp))
                        (linear (stepSlope v v') v)
       points = cycle ampls
   in PieceContRep (Windows (map makeWin (zip points (tail points))))
-random:: (Physical a, Physical b) => 
+random:: (Physical a, Physical b) =>
          Integer -> a -> SignalRep a b
 random i s = waveform s (map toPhysical (rand i))
 ramp:: (Physical a, Physical b) => a -> b -> SignalRep a b
-ramp per v = 
+ramp per v =
   let sig = linear (realdiv (fromPhysical v) (fromPhysical per)) (toPhysical 0.0)
   in PieceContRep (Windows (cycle ([Window LocalZero (TimeEvent (fromPhysical per)) sig ])))
 triangle:: (Physical a, Physical b) => a -> b -> SignalRep a b
@@ -163,7 +163,7 @@ pulse st wid lvl =
       f t = if (fromPhysical t) < (fromPhysical st) then (toPhysical 0.0)
             else if (fromPhysical t) < tr then lvl else (toPhysical 0.0)
   in FunctionRep f
-trap:: (Physical a, Physical b) => a -> a -> a -> a -> b -> 
+trap:: (Physical a, Physical b) => a -> a -> a -> a -> b ->
                                    SignalRep a b
 trap st r wid f lvl =
   let stepSlope y y' t = realdiv (y' -  y) (fromPhysical t)
@@ -226,7 +226,7 @@ pulse_ac = Pulse_ac {dc_offset = toPhysical 0.0,
                      amplitude = toPhysical 0.0}
 -}
 
-makeWin:: (Physical a, Physical b) => a -> a -> 
+makeWin:: (Physical a, Physical b) => a -> a ->
            SignalRep a b -> SignalRep a b
 makeWin st wid sig =
   let wins = Window LocalZero (TimeEvent (fromPhysical st)) (constant (toPhysical 0.0)) |>
@@ -238,7 +238,7 @@ instance Signal BasicSignal where
     let ring = sine ringing oscillation 0.0
         cond = asTypeOf (expc damp_fac) ring
         sig = temp ring cond
-        temp:: (Physical a, Physical b) => SignalRep a b -> 
+        temp:: (Physical a, Physical b) => SignalRep a b ->
                 SignalRep a b -> SignalRep a b
         temp f g = FunctionRep (binop (*) (mapSignal f) (mapSignal g))
 --        temp f g = f * g
@@ -249,21 +249,21 @@ instance Signal BasicSignal where
     in PieceContRep wins
   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
-               } =
+                , 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))
         oversh = toSig over{start_delay=so}
         undersh = toSig under{start_delay=su}
         off = constant dc_offset
-        temp:: (Physical a, Physical b) => SignalRep a b -> 
+        temp:: (Physical a, Physical b) => SignalRep a b ->
                 SignalRep a b -> SignalRep a b
         temp f g = FunctionRep (binop (+) (mapSignal f) (mapSignal g))
         sig = temp (temp (temp pul oversh) undersh) off
@@ -272,13 +272,13 @@ instance Signal BasicSignal where
     in PieceContRep (cycleWindows wins)
 sumSig:: (Physical a, Physical b, Signal s, Signal s') =>
          (s a b) -> (s' a b) -> SignalRep a b
-sumSig f f' = 
+sumSig f f' =
    let s1 t = fromPhysical (mapSignal f t)
        s2 t = fromPhysical (mapSignal f' t)
    in FunctionRep (\t -> toPhysical ((s1 t) + (s2 t)))
 mulSig:: (Physical a, Physical b, Signal s, Signal s') =>
          (s a b) -> (s' a b) -> SignalRep a b
-mulSig f f' = 
+mulSig f f' =
    let f1 t = fromPhysical (mapSignal f t)
        f2 t = fromPhysical (mapSignal f' t)
    in FunctionRep (\t -> toPhysical ((f1 t) * (f2 t)))
index da8789e..9bcd4de 100644 (file)
@@ -6,12 +6,12 @@
             land_i, lnot_i, lor_i, lshift_i, rshift_i,
             descr,
             destr_update, indassoc, lowbound, tabulate, upbound, update, valassoc) where {
-           import Data.Bits;
+            import Data.Bits;
 --            import Word2;
             import Data.Word;
-           import Data.Complex; -- 1.3
-           import Data.Array; -- 1.3
---         import Data.Int ( Num(fromInt) );
+            import Data.Complex; -- 1.3
+            import Data.Array; -- 1.3
+--          import Data.Int ( Num(fromInt) );
             type Complex_type   = Complex Double;
             type Array_type b   = Array Int b;
             type Assoc_type a   = (Int, a);
index ba37a17..f5680d5 100644 (file)
@@ -4,10 +4,10 @@
 -- which is included in the distribution.
 
 module CSG(module Construct,
-          module Geometry,
-          module Intersections,
-          module Interval,
-          module Misc) where
+           module Geometry,
+           module Intersections,
+           module Interval,
+           module Misc) where
 
 import Construct
 import Geometry
index 90dbc60..c0702ad 100644 (file)
@@ -69,7 +69,7 @@ data CSG a
 -- the a is application-specific texture information
 type Texture a = (Face, Point, a)
 
-union, intersect, difference           :: CSG a -> CSG a -> CSG a
+union, intersect, difference            :: CSG a -> CSG a -> CSG a
 
 union p@(Box b1 _) q@(Box b2 _) = Box (mergeBox b1 b2) (Union p q)
 union p q = Union p q
@@ -85,25 +85,25 @@ difference p q = Difference p q
 
 mkBox b p = Box b p
 
-plane, sphere, cube, cylinder, cone    :: a -> CSG a
+plane, sphere, cube, cylinder, cone     :: a -> CSG a
 
 plane = Plane
 sphere s =
     mkBox (B (-1 - epsilon) (1 + epsilon)
-            (-1 - epsilon) (1 + epsilon)
-            (-1 - epsilon) (1 + epsilon)) (Sphere s)
+             (-1 - epsilon) (1 + epsilon)
+             (-1 - epsilon) (1 + epsilon)) (Sphere s)
 cone s =
     mkBox (B (-1 - epsilon) (1 + epsilon)
-            (   - epsilon) (1 + epsilon)
-            (-1 - epsilon) (1 + epsilon)) (Cone s)
+             (   - epsilon) (1 + epsilon)
+             (-1 - epsilon) (1 + epsilon)) (Cone s)
 cube s =
     mkBox (B (- epsilon) (1 + epsilon)
-            (- epsilon) (1 + epsilon)
-            (- epsilon) (1 + epsilon)) (Cube s)
+             (- epsilon) (1 + epsilon)
+             (- epsilon) (1 + epsilon)) (Cube s)
 cylinder s =
     mkBox (B (-1 - epsilon) (1 + epsilon)
-            (   - epsilon) (1 + epsilon)
-            (-1 - epsilon) (1 + epsilon)) (Cylinder s)
+             (   - epsilon) (1 + epsilon)
+             (-1 - epsilon) (1 + epsilon)) (Cylinder s)
 
 ----------------------------
 -- Object transformations
@@ -120,16 +120,16 @@ transform mm'       (Difference p q)     = Difference (transform mm' p)   (trans
 transform mm'@(m,_) (Box box p)          = Box        (transformBox m box) (transform mm' p)
 transform (m, m')   prim                 = Transform  m m' prim
 
-translate                              :: Coords -> CSG a -> CSG a
-translateX, translateY, translateZ     :: Double -> CSG a -> CSG a
+translate                               :: Coords -> CSG a -> CSG a
+translateX, translateY, translateZ      :: Double -> CSG a -> CSG a
 
 translate xyz = transform $ transM xyz
 translateX x = translate (x, 0, 0)
 translateY y = translate (0, y, 0)
 translateZ z = translate (0, 0, z)
 
-scale                                  :: Coords -> CSG a -> CSG a
-scaleX, scaleY, scaleZ, uscale         :: Double -> CSG a -> CSG a
+scale                                   :: Coords -> CSG a -> CSG a
+scaleX, scaleY, scaleZ, uscale          :: Double -> CSG a -> CSG a
 
 scale xyz = transform $ scaleM xyz
 scaleX x = scale (x, 1, 1)
@@ -137,7 +137,7 @@ scaleY y = scale (1, y, 1)
 scaleZ z = scale (1, 1, z)
 uscale u = scale (u,u,u)
 
-rotateX, rotateY, rotateZ              :: Radian -> CSG a -> CSG a
+rotateX, rotateY, rotateZ               :: Radian -> CSG a -> CSG a
 
 rotateX a = transform $ rotxM a
 rotateY a = transform $ rotyM a
@@ -145,72 +145,72 @@ rotateZ a = transform $ rotzM a
 
 unit = matrix
       ( ( 1.0, 0.0, 0.0, 0.0 ),
-       ( 0.0, 1.0, 0.0, 0.0 ),
-       ( 0.0, 0.0, 1.0, 0.0 ),
-       ( 0.0, 0.0, 0.0, 1.0 ) )
+        ( 0.0, 1.0, 0.0, 0.0 ),
+        ( 0.0, 0.0, 1.0, 0.0 ),
+        ( 0.0, 0.0, 0.0, 1.0 ) )
 
 transM (x, y, z)
   = ( matrix
       ( ( 1, 0, 0, x ),
-       ( 0, 1, 0, y ),
-       ( 0, 0, 1, z ),
-       ( 0, 0, 0, 1 ) ),
+        ( 0, 1, 0, y ),
+        ( 0, 0, 1, z ),
+        ( 0, 0, 0, 1 ) ),
       matrix
       ( ( 1, 0, 0, -x ),
-       ( 0, 1, 0, -y ),
-       ( 0, 0, 1, -z ),
-       ( 0, 0, 0,  1 ) ) )
+        ( 0, 1, 0, -y ),
+        ( 0, 0, 1, -z ),
+        ( 0, 0, 0,  1 ) ) )
 
 scaleM (x, y, z)
   = ( matrix
       ( (   x',    0,    0, 0 ),
-       (    0,   y',    0, 0 ),
-       (    0,    0,   z', 0 ),
-       (    0,    0,    0, 1 ) ),
+        (    0,   y',    0, 0 ),
+        (    0,    0,   z', 0 ),
+        (    0,    0,    0, 1 ) ),
       matrix
       ( ( 1/x',    0,    0, 0 ),
-       (    0, 1/y',    0, 0 ),
-       (    0,    0, 1/z', 0 ),
-       (    0,    0,    0, 1 ) ) )
+        (    0, 1/y',    0, 0 ),
+        (    0,    0, 1/z', 0 ),
+        (    0,    0,    0, 1 ) ) )
   where x' = nonZero x
-       y' = nonZero y
-       z' = nonZero z
+        y' = nonZero y
+        z' = nonZero z
 
 rotxM t
   = ( matrix
       ( (      1,      0,      0, 0 ),
-       (      0,  cos t, -sin t, 0 ),
-       (      0,  sin t,  cos t, 0 ),
-       (      0,      0,      0, 1 ) ),
+        (      0,  cos t, -sin t, 0 ),
+        (      0,  sin t,  cos t, 0 ),
+        (      0,      0,      0, 1 ) ),
       matrix
       ( (      1,      0,      0, 0 ),
-       (      0,  cos t,  sin t, 0 ),
-       (      0, -sin t,  cos t, 0 ),
-       (      0,      0,      0, 1 ) ) )
+        (      0,  cos t,  sin t, 0 ),
+        (      0, -sin t,  cos t, 0 ),
+        (      0,      0,      0, 1 ) ) )
 
 rotyM t
   = ( matrix
       ( (  cos t,      0,  sin t, 0 ),
-       (      0,      1,      0, 0 ),
-       ( -sin t,      0,  cos t, 0 ),
-       (      0,      0,      0, 1 ) ),
+        (      0,      1,      0, 0 ),
+        ( -sin t,      0,  cos t, 0 ),
+        (      0,      0,      0, 1 ) ),
       matrix
       ( (  cos t,      0, -sin t, 0 ),
-       (      0,      1,      0, 0 ),
-       (  sin t,      0,  cos t, 0 ),
-       (      0,      0,      0, 1 ) ) )
+        (      0,      1,      0, 0 ),
+        (  sin t,      0,  cos t, 0 ),
+        (      0,      0,      0, 1 ) ) )
 
 rotzM t
   = ( matrix
       ( (  cos t, -sin t,      0, 0 ),
-       (  sin t,  cos t,      0, 0 ),
-       (      0,      0,      1, 0 ),
-       (      0,      0,      0, 1 ) ),
+        (  sin t,  cos t,      0, 0 ),
+        (      0,      0,      1, 0 ),
+        (      0,      0,      0, 1 ) ),
       matrix
       ( (  cos t,  sin t,      0, 0 ),
-       ( -sin t,  cos t,      0, 0 ),
-       (      0,      0,      1, 0 ),
-       (      0,      0,      0, 1 ) ) )
+        ( -sin t,  cos t,      0, 0 ),
+        (      0,      0,      1, 0 ),
+        (      0,      0,      0, 1 ) ) )
 
 -------------------
 -- Eye transformations
@@ -220,9 +220,9 @@ rotzM t
 -- These are implemented as inverse transforms of the model.
 -------------------
 
-eye                                    :: Transform
-translateEye                           :: Coords -> Transform -> Transform
-rotateEyeX, rotateEyeY, rotateEyeZ     :: Radian -> Transform -> Transform
+eye                                     :: Transform
+translateEye                            :: Coords -> Transform -> Transform
+rotateEyeX, rotateEyeY, rotateEyeZ      :: Radian -> Transform -> Transform
 
 eye = (unit, unit)
 translateEye xyz (eye1, eye2)
@@ -255,11 +255,11 @@ transformBox t (B x1  x2  y1  y2  z1  z2)
        (foldr1 min (map zCoord pts'))
        (foldr1 max (map zCoord pts')))
   where pts' = map (multMP t) pts
-       pts =  [point x1 y1 z1,
-               point x1 y1 z2,
-               point x1 y2 z1,
-               point x1 y2 z2,
-               point x2 y1 z1,
-               point x2 y1 z2,
-               point x2 y2 z1,
-               point x2 y2 z2]
+        pts =  [point x1 y1 z1,
+                point x1 y1 z2,
+                point x1 y2 z1,
+                point x1 y2 z2,
+                point x2 y1 z1,
+                point x2 y1 z2,
+                point x2 y2 z1,
+                point x2 y2 z2]
index f02aabe..6cbd112 100644 (file)
@@ -23,19 +23,19 @@ type Code = [GMLToken]
 
 data GMLToken
     -- All these can occur in parsed code
-       = TOp     GMLOp
-       | TId     Name
-       | TBind   Name
-       | TBool   Bool
-       | TInt    Int
-       | TReal   Double
-       | TString String
-       | TBody   Code
-       | TArray  Code
-       | TApply
-       | TIf
-        -- These can occur in optimized/transformed code
-        -- NONE (yet!)
+        = TOp     GMLOp
+        | TId     Name
+        | TBind   Name
+        | TBool   Bool
+        | TInt    Int
+        | TReal   Double
+        | TString String
+        | TBody   Code
+        | TArray  Code
+        | TApply
+        | TIf
+         -- These can occur in optimized/transformed code
+         -- NONE (yet!)
 
 
 instance Show GMLToken where
@@ -63,22 +63,22 @@ instance Show GMLToken where
 type Stack = [GMLValue]
 
 data GMLValue
-       = VBool    !Bool
-       | VInt     !Int
-       | VReal    !Double
-       | VString  String
-       | VClosure Env Code
-       | VArray   (Array Int GMLValue)         -- FIXME: Haskell array
+        = VBool    !Bool
+        | VInt     !Int
+        | VReal    !Double
+        | VString  String
+        | VClosure Env Code
+        | VArray   (Array Int GMLValue)         -- FIXME: Haskell array
         -- uses the interpreter version of point
-       | VPoint   { xPoint :: !Double
+        | VPoint   { xPoint :: !Double
                    , yPoint :: !Double
                    , zPoint :: !Double
                    }
         -- these are abstract to the interpreter
-       | VObject  Object
-       | VLight   Light
-       -- This is an abstract object, used by the abstract interpreter
-       | VAbsObj  AbsObj
+        | VObject  Object
+        | VLight   Light
+        -- This is an abstract object, used by the abstract interpreter
+        | VAbsObj  AbsObj
 
 
 -- There are only *3* basic abstract values,
@@ -200,7 +200,7 @@ opTable = [ (kwd,op) | (kwd,op,_) <- opcodes ]
 
 opNameTable :: Array GMLOp Name
 opNameTable = array (minBound,maxBound)
-                 [ (op,name) | (name,TOp op,_) <- opcodes ]
+                  [ (op,name) | (name,TOp op,_) <- opcodes ]
 
 undef = error "undefined function"
 image = error "undefined function: talk to image group"
@@ -210,62 +210,62 @@ image = error "undefined function: talk to image group"
 
 opcodes :: [(String,GMLToken,PrimOp)]
 opcodes =
- [ ("apply",     TApply,               error "incorrect use of apply")
- , ("if",        TIf,                  error "incorrect use of if")
- , ("false",     TBool False,          error "incorrect use of false")
- , ("true",      TBool True,           error "incorrect use of true")
+ [ ("apply",      TApply,               error "incorrect use of apply")
+ , ("if",         TIf,                  error "incorrect use of if")
+ , ("false",      TBool False,          error "incorrect use of false")
+ , ("true",       TBool True,           error "incorrect use of true")
  ] ++ map (\ (a,b,c) -> (a,TOp b,c))
    -- These are just invocation, any coercions need to occur between here
    -- and before arriving at the application code (like deg -> rad).
- [ ("acos",      Op_acos,       Real_Real (rad2deg . acos))
- , ("addi",      Op_addi,       Int_Int_Int (+))
- , ("addf",      Op_addf,       Real_Real_Real (+))
- , ("asin",      Op_asin,       Real_Real (rad2deg . asin))
- , ("clampf",    Op_clampf,     Real_Real clampf)
- , ("cone",      Op_cone,       Surface_Obj cone)
- , ("cos",       Op_cos,        Real_Real (cos . deg2rad))
- , ("cube",      Op_cube,       Surface_Obj cube)
- , ("cylinder",          Op_cylinder,   Surface_Obj cylinder)
+ [ ("acos",       Op_acos,       Real_Real (rad2deg . acos))
+ , ("addi",       Op_addi,       Int_Int_Int (+))
+ , ("addf",       Op_addf,       Real_Real_Real (+))
+ , ("asin",       Op_asin,       Real_Real (rad2deg . asin))
+ , ("clampf",     Op_clampf,     Real_Real clampf)
+ , ("cone",       Op_cone,       Surface_Obj cone)
+ , ("cos",        Op_cos,        Real_Real (cos . deg2rad))
+ , ("cube",       Op_cube,       Surface_Obj cube)
+ , ("cylinder",   Op_cylinder,   Surface_Obj cylinder)
  , ("difference", Op_difference, Obj_Obj_Obj difference)
- , ("divi",      Op_divi,       Int_Int_Int (ourQuot))
- , ("divf",      Op_divf,       Real_Real_Real (/))
- , ("eqi",       Op_eqi,        Int_Int_Bool (==))
- , ("eqf",       Op_eqf,        Real_Real_Bool (==))
- , ("floor",     Op_floor,      Real_Int floor)
- , ("frac",      Op_frac,       Real_Real (snd . properFraction))
- , ("get",       Op_get,        Arr_Int_Value ixGet)
- , ("getx",      Op_getx,       Point_Real (\ x y z -> x))
- , ("gety",      Op_gety,       Point_Real (\ x y z -> y))
- , ("getz",      Op_getz,       Point_Real (\ x y z -> z))
+ , ("divi",       Op_divi,       Int_Int_Int (ourQuot))
+ , ("divf",       Op_divf,       Real_Real_Real (/))
+ , ("eqi",        Op_eqi,        Int_Int_Bool (==))
+ , ("eqf",        Op_eqf,        Real_Real_Bool (==))
+ , ("floor",      Op_floor,      Real_Int floor)
+ , ("frac",       Op_frac,       Real_Real (snd . properFraction))
+ , ("get",        Op_get,        Arr_Int_Value ixGet)
+ , ("getx",       Op_getx,       Point_Real (\ x y z -> x))
+ , ("gety",       Op_gety,       Point_Real (\ x y z -> y))
+ , ("getz",       Op_getz,       Point_Real (\ x y z -> z))
  , ("intersect",  Op_intersect,  Obj_Obj_Obj intersect)
- , ("length",    Op_length,     Arr_Int (succ . snd . bounds))
- , ("lessi",     Op_lessi,      Int_Int_Bool (<))
- , ("lessf",     Op_lessf,      Real_Real_Bool (<))
- , ("light",     Op_light,      Point_Color_Light light)
- , ("modi",      Op_modi,       Int_Int_Int (ourRem))
- , ("muli",      Op_muli,       Int_Int_Int (*))
- , ("mulf",      Op_mulf,       Real_Real_Real (*))
- , ("negi",      Op_negi,       Int_Int negate)
- , ("negf",      Op_negf,       Real_Real negate)
- , ("plane",     Op_plane,      Surface_Obj plane)
- , ("point",     Op_point,      Real_Real_Real_Point VPoint)
+ , ("length",     Op_length,     Arr_Int (succ . snd . bounds))
+ , ("lessi",      Op_lessi,      Int_Int_Bool (<))
+ , ("lessf",      Op_lessf,      Real_Real_Bool (<))
+ , ("light",      Op_light,      Point_Color_Light light)
+ , ("modi",       Op_modi,       Int_Int_Int (ourRem))
+ , ("muli",       Op_muli,       Int_Int_Int (*))
+ , ("mulf",       Op_mulf,       Real_Real_Real (*))
+ , ("negi",       Op_negi,       Int_Int negate)
+ , ("negf",       Op_negf,       Real_Real negate)
+ , ("plane",      Op_plane,      Surface_Obj plane)
+ , ("point",      Op_point,      Real_Real_Real_Point VPoint)
  , ("pointlight", Op_pointlight, Point_Color_Light pointlight)
- , ("real",      Op_real,       Int_Real fromIntegral)
- , ("render",    Op_render,     Render $ render eye)
- , ("rotatex",   Op_rotatex,    Obj_Real_Obj (\ o d -> rotateX (deg2rad d) o))
- , ("rotatey",   Op_rotatey,    Obj_Real_Obj (\ o d -> rotateY (deg2rad d) o))
- , ("rotatez",   Op_rotatez,    Obj_Real_Obj (\ o d -> rotateZ (deg2rad d) o))
- , ("scale",     Op_scale,      Obj_Real_Real_Real_Obj (\ o x y z -> scale (x,y,z) o))
- , ("sin",       Op_sin,        Real_Real (sin . deg2rad))
- , ("sphere",    Op_sphere,     Surface_Obj sphere') -- see comment at end of file
+ , ("real",       Op_real,       Int_Real fromIntegral)
+ , ("render",     Op_render,     Render $ render eye)
+ , ("rotatex",    Op_rotatex,    Obj_Real_Obj (\ o d -> rotateX (deg2rad d) o))
+ , ("rotatey",    Op_rotatey,    Obj_Real_Obj (\ o d -> rotateY (deg2rad d) o))
+ , ("rotatez",    Op_rotatez,    Obj_Real_Obj (\ o d -> rotateZ (deg2rad d) o))
+ , ("scale",      Op_scale,      Obj_Real_Real_Real_Obj (\ o x y z -> scale (x,y,z) o))
+ , ("sin",        Op_sin,        Real_Real (sin . deg2rad))
+ , ("sphere",     Op_sphere,     Surface_Obj sphere') -- see comment at end of file
  , ("spotlight",  Op_spotlight,  Point_Point_Color_Real_Real_Light mySpotlight)
- , ("sqrt",      Op_sqrt,       Real_Real ourSqrt)
- , ("subi",      Op_subi,       Int_Int_Int (-))
- , ("subf",      Op_subf,       Real_Real_Real (-))
+ , ("sqrt",       Op_sqrt,       Real_Real ourSqrt)
+ , ("subi",       Op_subi,       Int_Int_Int (-))
+ , ("subf",       Op_subf,       Real_Real_Real (-))
  , ("trace",      Op_trace,      Value_String_Value mytrace)
  , ("translate",  Op_translate,  Obj_Real_Real_Real_Obj (\ o x y z -> translate (x,y,z) o))
- , ("union",     Op_union,      Obj_Obj_Obj union)
- , ("uscale",    Op_uscale,     Obj_Real_Obj (\ o r -> uscale r o))
+ , ("union",      Op_union,      Obj_Obj_Obj union)
+ , ("uscale",     Op_uscale,     Obj_Real_Obj (\ o r -> uscale r o))
  ]
 
 -- This enumerate all possible ways of calling the fixed primitives
index bd9d419..bf43d10 100644 (file)
@@ -47,10 +47,10 @@ instance MonadEval IO where
   err  s = error s
 
 data State
-       = State { env   :: Env
-               , stack :: Stack
-               , code  :: Code
-               } deriving Show
+        = State { env   :: Env
+                , stack :: Stack
+                , code  :: Code
+                } deriving Show
 
 callback :: Env -> Code -> Stack -> Stack
 callback env code stk
@@ -151,7 +151,7 @@ step _ = err "Tripped on sidewalk while stepping."
 
 opFnTable :: Array GMLOp PrimOp
 opFnTable = array (minBound,maxBound)
-                 [ (op,prim) | (_,TOp op,prim) <- opcodes ]
+                  [ (op,prim) | (_,TOp op,prim) <- opcodes ]
 
 
 
@@ -181,7 +181,7 @@ doPrimOp (Surface_Obj fn) _ (VClosure env code:stk)
   = case absapply env code [VAbsObj AbsFACE,VAbsObj AbsU,VAbsObj AbsV] of
       Just [VReal r3,VReal r2,VReal r1,VPoint c1 c2 c3] ->
            let
-              res = prop (color c1 c2 c3) r1 r2 r3
+               res = prop (color c1 c2 c3) r1 r2 r3
            in
                return ((VObject (fn (SConst res))) : stk)
       _ -> return ((VObject (fn (SFun call))) : stk)
@@ -190,7 +190,7 @@ doPrimOp (Surface_Obj fn) _ (VClosure env code:stk)
         call i r1 r2 =
           case callback env code [VReal r2,VReal r1,VInt i] of
              [VReal r3,VReal r2,VReal r1,VPoint c1 c2 c3]
-                -> prop (color c1 c2 c3) r1 r2 r3
+                 -> prop (color c1 c2 c3) r1 r2 r3
              stk -> error ("callback failed: incorrectly typed return arguments"
                          ++ show stk)
 
@@ -241,10 +241,10 @@ doPrimOp primOp op args
   = err ("\n\ntype error when attempting to execute builtin primitive \"" ++
           show op ++ "\"\n\n| " ++
           show op ++ " takes " ++ show (length types) ++ " argument" ++ s
-                  ++ " with" ++ the ++ " type" ++ s ++ "\n|\n|" ++
+                   ++ " with" ++ the ++ " type" ++ s ++ "\n|\n|" ++
           "      " ++ unwords [ show ty | ty <- types ]  ++ "\n|\n|" ++
           " currently, the relevent argument" ++ s ++ " on the stack " ++
-                 are ++ "\n|\n| " ++
+                  are ++ "\n|\n| " ++
           unwords [ "(" ++ show arg ++ ")"
                   | arg <-  reverse (take (length types) args) ]  ++ "\n|\n| "
           ++ "    (top of stack is on the right hand side)\n\n")
@@ -261,7 +261,7 @@ doPrimOp primOp op args
 
 doAllOp :: PrimOp -> GMLOp -> Stack -> IO Stack
 doAllOp (Render render) Op_render
-                          (VString str:VInt ht:VInt wid:VReal fov
+                           (VString str:VInt ht:VInt wid:VReal fov
                            :VInt dep:VObject obj:VArray arr
                            :VPoint r g b : stk)
   = do { render (color r g b) lights obj dep (fov * (pi / 180.0)) wid ht str
@@ -303,7 +303,7 @@ instance Applicative Abs where
 
 instance Monad Abs where
     (Abs fn) >>= k = Abs (\ s -> case fn s of
-                                  AbsState r s' -> runAbs (k r) s'
+                                   AbsState r s' -> runAbs (k r) s'
                                    AbsFail m     -> AbsFail m)
     return       = pure
     fail s       = Abs (\ n -> AbsFail s)
@@ -333,9 +333,9 @@ mainEval prog = do { stk <- eval (State emptyEnv [] prog)
   * Oops, one of the example actually has something
   * on the stack at the end.
   * Oh well...
-                  ; if null stk
+                   ; if null stk
                      then return ()
-                    else do { putStrLn done
+                     else do { putStrLn done
                              ; print stk
                              }
 -}
index de9d960..8bca3a3 100644 (file)
@@ -160,7 +160,7 @@ tangents :: Vector -> (Vector, Vector)
 tangents v@(V x y z)
   = (v1, v `cross` v1)
   where v1 | x == 0    = normalize (vector 0 z (-y))
-          | otherwise = normalize (vector (-y) x 0)
+           | otherwise = normalize (vector (-y) x 0)
 
 {-# INLINE dot4 #-}
 dot4 :: Quad -> Quad -> Double
@@ -195,7 +195,7 @@ norm (V x y z) = sqrt (sq x + sq y + sq z)
 normalize :: Vector -> Vector
 normalize v@(V x y z)
              | norm /= 0 = multSV (1/norm) v
-            | otherwise = error "normalize empty!"
+             | otherwise = error "normalize empty!"
     where norm = sqrt (sq x + sq y + sq z)
 
 -- This does computes the distance *squared*
index b68eea8..5f780ff 100644 (file)
@@ -98,14 +98,14 @@ illum cxt (pos,normV,(col,kd,ks,n)) v
 
     ambTerm = multSC kd (multCC amb col)
     difTerm = multSC kd (sumCC [multSC (dot normV lj) (multCC intensity col)
-              |(loc,intensity) <- visibleLights,
-              let lj = normalize ({- pos `subVV` -} loc)])
+               |(loc,intensity) <- visibleLights,
+               let lj = normalize ({- pos `subVV` -} loc)])
     -- ZZ might want to avoid the phong, when you can...
     spcTerm = multSC ks (sumCC [multSC ((dot normV hj) ** n ) (multCC intensity col)
-              |(loc,intensity) <- visibleLights,
-              -- ZZ note this is specific to the light at infinity
-              let lj = {- pos `subVV` -} normalize loc,
-              let hj = normalize (lj `subVV` normalize v)])
+               |(loc,intensity) <- visibleLights,
+               -- ZZ note this is specific to the light at infinity
+               let lj = {- pos `subVV` -} normalize loc,
+               let hj = normalize (lj `subVV` normalize v)])
     recTerm  = if recCoeff `nearC` black then black else multCC recCoeff recRay
     recCoeff = multSC ks col
     recRay   = illumination cxt (pos,newV)
@@ -203,8 +203,8 @@ castRay ray p
     (False, (0, b, _) : _, _)        -> Nothing -- eye is inside
     (False, (i, False, _) : _, _)    -> Nothing -- eye is inside
     (False, (t, b, (s, p0)) : _, _)     ->
-       let (v, prop) = surface s p0 in
-           Just (offsetToPoint ray t, v, prop)
+        let (v, prop) = surface s p0 in
+            Just (offsetToPoint ray t, v, prop)
 
 intersects ray p
   = case intersectRayWithObject ray p of
index 58210c3..6d7f275 100644 (file)
@@ -41,22 +41,22 @@ clampIntervals ivals@(False, is@((i, True, p) : is'), isOpen)
 intersections ray (Union p q)
   = unionIntervals is js
   where is = intersections ray p
-       js = intersections ray q
+        js = intersections ray q
 
 intersections ray (Intersect p q)
   = intersectIntervals is js
   where is = intersections ray p
-       js = intersections ray q
+        js = intersections ray q
 
 intersections ray (Difference p q)
   = differenceIntervals is (negateSurfaces js)
   where is = intersections ray p
-       js = intersections ray q
+        js = intersections ray q
 
 intersections ray (Transform m m' p)
   = mapI (xform m) is
   where is = intersections (m' `multMR` ray) p
-       xform m (i, b, (s, p0)) = (i, b, (transformSurface m s, p0))
+        xform m (i, b, (s, p0)) = (i, b, (transformSurface m s, p0))
 
 intersections ray (Box box p)
   | intersectWithBox ray box = intersections ray p
@@ -93,27 +93,27 @@ negateSurface (Conic p0 v0 v1)
 transformSurface m (Planar p0 v0 v1)
   = Planar p0' v0' v1'
   where p0' = multMP m p0
-       v0' = multMV m v0
-       v1' = multMV m v1
+        v0' = multMV m v0
+        v1' = multMV m v1
 
 transformSurface m (Spherical p0 v0 v1)
   = Spherical p0' v0' v1'
   where p0' = multMP m p0
-       v0' = multMV m v0
-       v1' = multMV m v1
+        v0' = multMV m v0
+        v1' = multMV m v1
 
 -- ditto as above
 transformSurface m (Cylindrical p0 v0 v1)
   = Cylindrical p0' v0' v1'
   where p0' = multMP m p0
-       v0' = multMV m v0
-       v1' = multMV m v1
+        v0' = multMV m v0
+        v1' = multMV m v1
 
 transformSurface m (Conic p0 v0 v1)
   = Conic p0' v0' v1'
   where p0' = multMP m p0
-       v0' = multMV m v0
-       v1' = multMV m v1
+        v0' = multMV m v0
+        v1' = multMV m v1
 
 --------------------------------
 -- Plane
@@ -133,25 +133,25 @@ intersectXZPlane n (r,v) yoffset texture
     -- t may be negative (the ray starts within the halfspace),
     -- but we'll catch that later when we clamp the intervals
 
-  | b < 0      -- the ray is pointing downwards
+  | b < 0       -- the ray is pointing downwards
   = (False, [mkEntry (t0, (Planar p0 v0 v1, (n, p0, texture)))], True)
 
-  | otherwise  -- the ray is pointing upwards
+  | otherwise   -- the ray is pointing upwards
   = (True,  [mkExit (t0, (Planar p0 v0 v1, (n, p0, texture)))],  False)
 
   where t0 = (yoffset-y) / b
-       x0 = x + a * t0
-       z0 = z + c * t0
-       p0 = point x0 0 z0
-       v0 = vector 0 0 1
-       v1 = vector 1 0 0
+        x0 = x + a * t0
+        z0 = z + c * t0
+        p0 = point x0 0 z0
+        v0 = vector 0 0 1
+        v1 = vector 1 0 0
 
-       x = xCoord r
-       y = yCoord r
-       z = zCoord r
-       a = xComponent v
-       b = yComponent v
-       c = zComponent v
+        x = xCoord r
+        y = yCoord r
+        z = zCoord r
+        a = xComponent v
+        b = yComponent v
+        c = zComponent v
 
 
 --------------------------------
@@ -166,26 +166,26 @@ intersectSphere ray@(r, v) texture
     -- This is a quadratic equation in t:
     --   t^2(a^2 + b^2 + c^2) + 2t(xa + yb + zc) + (x^2 + y^2 + z^2 - 1) = 0
     let c1 = sq a + sq b + sq c
-       c2 = 2 * (x * a + y * b + z * c)
-       c3 = sq x + sq y + sq z - 1
+        c2 = 2 * (x * a + y * b + z * c)
+        c3 = sq x + sq y + sq z - 1
     in
-       case quadratic c1 c2 c3 of
+        case quadratic c1 c2 c3 of
         Nothing -> emptyIList
         Just (t1, t2) -> entryexit (g t1) (g t2)
     where x = xCoord r
-         y = yCoord r
-         z = zCoord r
-         a = xComponent v
-         b = yComponent v
-         c = zComponent v
-         g t = (t, (Spherical origin v1 v2, (SphereFace, p0, texture)))
-             where origin = point 0 0 0
-                   x0 = x + t * a
-                   y0 = y + t * b
-                   z0 = z + t * c
-                   p0 = point  x0 y0 z0
-                   v0 = vector x0 y0 z0
-                   (v1, v2) = tangents v0
+          y = yCoord r
+          z = zCoord r
+          a = xComponent v
+          b = yComponent v
+          c = zComponent v
+          g t = (t, (Spherical origin v1 v2, (SphereFace, p0, texture)))
+              where origin = point 0 0 0
+                    x0 = x + t * a
+                    y0 = y + t * b
+                    z0 = z + t * c
+                    p0 = point  x0 y0 z0
+                    v0 = vector x0 y0 z0
+                    (v1, v2) = tangents v0
 
 
 --------------------------------
@@ -200,32 +200,32 @@ intersectCube ray@(r, v) texture
     -- The minimum and maximum such values of t give us the two
     -- intersection points.
     case intersectSlabIval (intersectCubeSlab face2 face3 x a)
-       (intersectSlabIval (intersectCubeSlab face5 face4 y b)
-                          (intersectCubeSlab face0 face1 z c)) of
+        (intersectSlabIval (intersectCubeSlab face5 face4 y b)
+                           (intersectCubeSlab face0 face1 z c)) of
     Nothing -> emptyIList
     Just (t1, t2) -> entryexit (g t1) (g t2)
   where g ((n, v0, v1), t)
-         = (t, (Planar p0 v0 v1, (n, p0, texture)))
-         where p0 = offsetToPoint ray t
-       face0 = (CubeFront,  vectorY, vectorX)
-       face1 = (CubeBack,   vectorX, vectorY)
-       face2 = (CubeLeft,   vectorZ, vectorY)
-       face3 = (CubeRight,  vectorY, vectorZ)
-       face4 = (CubeTop,    vectorZ, vectorX)
-       face5 = (CubeBottom, vectorX, vectorZ)
-       vectorX = vector 1 0 0
-       vectorY = vector 0 1 0
-       vectorZ = vector 0 0 1
-       x = xCoord r
-       y = yCoord r
-       z = zCoord r
-       a = xComponent v
-       b = yComponent v
-       c = zComponent v
+          = (t, (Planar p0 v0 v1, (n, p0, texture)))
+          where p0 = offsetToPoint ray t
+        face0 = (CubeFront,  vectorY, vectorX)
+        face1 = (CubeBack,   vectorX, vectorY)
+        face2 = (CubeLeft,   vectorZ, vectorY)
+        face3 = (CubeRight,  vectorY, vectorZ)
+        face4 = (CubeTop,    vectorZ, vectorX)
+        face5 = (CubeBottom, vectorX, vectorZ)
+        vectorX = vector 1 0 0
+        vectorY = vector 0 1 0
+        vectorZ = vector 0 0 1
+        x = xCoord r
+        y = yCoord r
+        z = zCoord r
+        a = xComponent v
+        b = yComponent v
+        c = zComponent v
 
 intersectCubeSlab n m w d
   | d `near` 0 = if (0 <= w) && (w <= 1)
-                then Just ((n, -inf), (m, inf)) else Nothing
+                 then Just ((n, -inf), (m, inf)) else Nothing
   | d > 0      = Just ((n,  (-w)/d), (m, (1-w)/d))
   | otherwise  = Just ((m, (1-w)/d), (n,  (-w)/d))
 
@@ -233,15 +233,15 @@ intersectSlabIval Nothing Nothing  = Nothing
 intersectSlabIval Nothing (Just i) = Nothing
 intersectSlabIval (Just i) Nothing = Nothing
 intersectSlabIval (Just (nu1@(n1, u1), mv1@(m1, v1)))
-                 (Just (nu2@(n2, u2), mv2@(m2, v2)))
+                  (Just (nu2@(n2, u2), mv2@(m2, v2)))
   = checkInterval (nu, mv)
   where nu = if u1 < u2 then nu2 else nu1
-       mv = if v1 < v2 then mv1 else mv2
-       checkInterval numv@(nu@(_, u), (m, v))
-         -- rounding error may force us to push v out a bit
-         | u `near` v = Just (nu, (m, u + epsilon))
-         | u    <   v = Just numv
-         | otherwise  = Nothing
+        mv = if v1 < v2 then mv1 else mv2
+        checkInterval numv@(nu@(_, u), (m, v))
+          -- rounding error may force us to push v out a bit
+          | u `near` v = Just (nu, (m, u + epsilon))
+          | u    <   v = Just numv
+          | otherwise  = Nothing
 
 
 --------------------------------
@@ -252,9 +252,9 @@ intersectCylinder :: Ray -> a -> IList (Surface, Texture a)
 intersectCylinder ray texture
   = isectSide `intersectIntervals` isectTop `intersectIntervals` isectBottom
   where isectSide   = intersectCylSide ray texture
-       isectTop    = intersectXZPlane CylinderTop ray 1.0 texture
-       isectBottom = complementIntervals $ negateSurfaces $
-                     intersectXZPlane CylinderBottom ray 0.0 texture
+        isectTop    = intersectXZPlane CylinderTop ray 1.0 texture
+        isectBottom = complementIntervals $ negateSurfaces $
+                      intersectXZPlane CylinderBottom ray 0.0 texture
 
 intersectCylSide (r, v) texture
   = -- The ray (x + ta, y + tb, z + tc) intersects the sides of the
@@ -262,34 +262,34 @@ intersectCylSide (r, v) texture
     --    (x + ta)^2 + (z + tc)^2 = 1  and 0 <= y + tb <= 1.
     if (sq a + sq c) `near` 0
     then -- The ray is parallel to the Y-axis, and does not intersect
-        -- the cylinder sides.  It's either all in, or all out
-       if (sqxy `near` 1.0 || sqxy < 1.0) then openIList else emptyIList
+         -- the cylinder sides.  It's either all in, or all out
+        if (sqxy `near` 1.0 || sqxy < 1.0) then openIList else emptyIList
    else -- Find values of t that solve the quadratic equation
-       --   (a^2 + c^2)t^2 + 2(ax + cz)t + x^2 + z^2 - 1 = 0
+        --   (a^2 + c^2)t^2 + 2(ax + cz)t + x^2 + z^2 - 1 = 0
         let c1 = sq a + sq c
             c2 = 2 * (x * a + z * c)
             c3 = sq x + sq z - 1
-       in
-       case quadratic c1 c2 c3 of
+        in
+        case quadratic c1 c2 c3 of
         Nothing -> emptyIList
         Just (t1, t2) -> entryexit (g t1) (g t2)
 
   where sqxy = sq x + sq y
-       g t = (t, (Cylindrical origin v1 v2, (CylinderSide, p0, texture)))
-           where origin = point 0 0 0
-                 x0 = x + t * a
-                 y0 = y + t * b
-                 z0 = z + t * c
-                 p0 = point  x0 y0 z0
-                 v0 = vector x0 0 z0
-                 (v1, v2) = tangents v0
-
-       x = xCoord r
-       y = yCoord r
-       z = zCoord r
-       a = xComponent v
-       b = yComponent v
-       c = zComponent v
+        g t = (t, (Cylindrical origin v1 v2, (CylinderSide, p0, texture)))
+            where origin = point 0 0 0
+                  x0 = x + t * a
+                  y0 = y + t * b
+                  z0 = z + t * c
+                  p0 = point  x0 y0 z0
+                  v0 = vector x0 0 z0
+                  (v1, v2) = tangents v0
+
+        x = xCoord r
+        y = yCoord r
+        z = zCoord r
+        a = xComponent v
+        b = yComponent v
+        c = zComponent v
 
 
 -------------------
@@ -300,9 +300,9 @@ intersectCone :: Ray -> a -> IList (Surface, Texture a)
 intersectCone ray texture
   = isectSide `intersectIntervals` isectTop `intersectIntervals` isectBottom
   where isectSide   = intersectConeSide ray texture
-       isectTop    = intersectXZPlane ConeBase ray 1.0 texture
-       isectBottom = complementIntervals $ negateSurfaces $
-                     intersectXZPlane ConeBase ray 0.0 texture
+        isectTop    = intersectXZPlane ConeBase ray 1.0 texture
+        isectBottom = complementIntervals $ negateSurfaces $
+                      intersectXZPlane ConeBase ray 0.0 texture
 
 intersectConeSide (r, v) texture
   = -- Find the points where the ray intersects the cond side.  At any points of
@@ -311,42 +311,42 @@ intersectConeSide (r, v) texture
     -- which is the following quadratic equation:
     --    t^2(a^2-b^2+c^2) + 2t(xa-yb+cz) + (x^2-y^2+z^2) = 0
     let c1 = sq a - sq b + sq c
-       c2 = 2 * (x * a - y * b + c * z)
-       c3 = sq x - sq y + sq z
+        c2 = 2 * (x * a - y * b + c * z)
+        c3 = sq x - sq y + sq z
     in  case quadratic c1 c2 c3 of
-       Nothing -> emptyIList
-       Just (t1, t2) ->
-           -- If either intersection strikes the middle, then the other
-           -- can only be off by rounding error, so we make a tangent
-           -- strike using the "good" value.
-           -- If the intersections straddle the origin, then it's
-           -- an exit/entry pair, otherwise it's an entry/exit pair.
-           let y1 = y + t1 * b
-               y2 = y + t2 * b
-           in  if y1 `near` 0                  then entryexit (g t1) (g t1)
-               else if y2 `near` 0             then entryexit (g t2) (g t2)
-               else if (y1 < 0) `xor` (y2 < 0) then exitentry (g t1) (g t2)
-               else                                 entryexit (g t1) (g t2)
+        Nothing -> emptyIList
+        Just (t1, t2) ->
+            -- If either intersection strikes the middle, then the other
+            -- can only be off by rounding error, so we make a tangent
+            -- strike using the "good" value.
+            -- If the intersections straddle the origin, then it's
+            -- an exit/entry pair, otherwise it's an entry/exit pair.
+            let y1 = y + t1 * b
+                y2 = y + t2 * b
+            in  if y1 `near` 0                  then entryexit (g t1) (g t1)
+                else if y2 `near` 0             then entryexit (g t2) (g t2)
+                else if (y1 < 0) `xor` (y2 < 0) then exitentry (g t1) (g t2)
+                else                                 entryexit (g t1) (g t2)
 
   where g t = (t, (Conic origin v1 v2, (ConeSide, p0, texture)))
-           where origin = point 0 0 0
-                 x0 = x + t * a
-                 y0 = y + t * b
-                 z0 = z + t * c
-                 p0 = point  x0 y0 z0
-                 v0 = normalize $ vector x0 (-y0) z0
-                 (v1, v2) = tangents v0
-
-       x = xCoord r
-       y = yCoord r
-       z = zCoord r
-       a = xComponent v
-       b = yComponent v
-       c = zComponent v
-
-       -- beyond me why this isn't defined in the prelude...
-       xor False b = b
-       xor True  b = not b
+            where origin = point 0 0 0
+                  x0 = x + t * a
+                  y0 = y + t * b
+                  z0 = z + t * c
+                  p0 = point  x0 y0 z0
+                  v0 = normalize $ vector x0 (-y0) z0
+                  (v1, v2) = tangents v0
+
+        x = xCoord r
+        y = yCoord r
+        z = zCoord r
+        a = xComponent v
+        b = yComponent v
+        c = zComponent v
+
+        -- beyond me why this isn't defined in the prelude...
+        xor False b = b
+        xor True  b = not b
 
 
 -------------------
@@ -361,17 +361,17 @@ quadratic a b c =
   in if d' < 0
      then Nothing -- There are no real roots.
      else
-       if a > 0 then Just (((-b) - sqrt d') / (2 * a),
-                           ((-b) + sqrt d') / (2 * a))
-                else Just (((-b) + sqrt d') / (2 * a),
-                           ((-b) - sqrt d') / (2 * a))
+        if a > 0 then Just (((-b) - sqrt d') / (2 * a),
+                            ((-b) + sqrt d') / (2 * a))
+                 else Just (((-b) + sqrt d') / (2 * a),
+                            ((-b) - sqrt d') / (2 * a))
 
 -------------------
 -- Bounding boxes
 -------------------
 
 data MaybeInterval = Interval !Double !Double
-                  | NoInterval
+                   | NoInterval
 
 isInterval (Interval _ _) = True
 isInterval _              = False
@@ -380,10 +380,10 @@ intersectWithBox :: Ray -> Box -> Bool
 intersectWithBox (r, v) (B x1 x2 y1 y2 z1 z2)
   = isInterval interval
   where x_interval = intersectRayWithSlab (xCoord r) (xComponent v) (x1, x2)
-       y_interval = intersectRayWithSlab (yCoord r) (yComponent v) (y1, y2)
-       z_interval = intersectRayWithSlab (zCoord r) (zComponent v) (z1, z2)
-       interval = intersectInterval x_interval
-                  (intersectInterval y_interval z_interval)
+        y_interval = intersectRayWithSlab (yCoord r) (yComponent v) (y1, y2)
+        z_interval = intersectRayWithSlab (zCoord r) (zComponent v) (z1, z2)
+        interval = intersectInterval x_interval
+                   (intersectInterval y_interval z_interval)
 
 intersectInterval :: MaybeInterval -> MaybeInterval -> MaybeInterval
 intersectInterval NoInterval _ = NoInterval
@@ -399,6 +399,6 @@ intersectRayWithSlab xCoord alpha (x1, x2)
   | alpha >  0 = Interval a b
   | otherwise  = Interval b a
   where a = (x1 - xCoord) / alpha
-       b = (x2 - xCoord) / alpha
+        b = (x2 - xCoord) / alpha
 
 infInterval = Interval (-inf) inf
index a4d313f..174b3ff 100644 (file)
@@ -29,8 +29,8 @@ import Geometry
 -- solid.  As a convenience, we also keep an additional flag that
 -- indicates whether the last intersection ends inside or outside.
 
-type IList a           = (Bool, [Intersection a], Bool)
-type Intersection a    = (Double, Bool, a)
+type IList a            = (Bool, [Intersection a], Bool)
+type Intersection a     = (Double, Bool, a)
 
 emptyIList = (False, [], False)
 openIList = (True, [], True)
@@ -46,7 +46,7 @@ mkExit  (t, a) = (t, False, a)
 entryexit w1 w2 = (False, [mkEntry w1, mkExit w2], False)
 exitentry w1 w2 = (True, [mkExit w1, mkEntry w2], True)
 arrange   w1@(t1, _) w2@(t2, _) | t1 < t2   = entryexit w1 w2
-                               | otherwise = entryexit w2 w1
+                                | otherwise = entryexit w2 w1
 
 
 cmpI :: Intersection a -> Intersection a -> Ordering
@@ -66,23 +66,23 @@ unionIntervals :: IList a -> IList a -> IList a
 unionIntervals (isStartOpen, is, isEndOpen) (jsStartOpen, js, jsEndOpen)
   = (isStartOpen || jsStartOpen, uniIntervals is js, isEndOpen || jsEndOpen)
   where uniIntervals is [] | jsEndOpen = []
-                          | otherwise = is
-       uniIntervals [] js | isEndOpen = []
-                          | otherwise = js
-       uniIntervals is@(i : is') js@(j : js')
-         = case cmpI i j of
-           EQ -> if isEntry i == isEntry j then i : uniIntervals is' js'
-                                           else uniIntervals is' js'
-           LT -> if isEntry j then i : uniIntervals is' js
-                              else     uniIntervals is' js
-           GT -> if isEntry i then j : uniIntervals is js'
-                              else     uniIntervals is js'
+                           | otherwise = is
+        uniIntervals [] js | isEndOpen = []
+                           | otherwise = js
+        uniIntervals is@(i : is') js@(j : js')
+          = case cmpI i j of
+            EQ -> if isEntry i == isEntry j then i : uniIntervals is' js'
+                                            else uniIntervals is' js'
+            LT -> if isEntry j then i : uniIntervals is' js
+                               else     uniIntervals is' js
+            GT -> if isEntry i then j : uniIntervals is js'
+                               else     uniIntervals is js'
 
 intersectIntervals :: IList a -> IList a -> IList a
 intersectIntervals is js
   = complementIntervals (unionIntervals is' js')
   where is' = complementIntervals is
-       js' = complementIntervals js
+        js' = complementIntervals js
 
 differenceIntervals :: IList a -> IList a -> IList a
 differenceIntervals is js
@@ -114,8 +114,8 @@ t7 = differenceIntervals i2 i2
 
 sh (o1,is,o2) =
     do  if o1 then putStr "..." else return ()
-       putStr $ foldr1 (++) (map si is)
-       if o2 then putStr "..." else return ()
+        putStr $ foldr1 (++) (map si is)
+        if o2 then putStr "..." else return ()
 si (i, True, _, _) = "<" ++ show i
 si (i, False, _, _) = " " ++ show i ++ ">"
 -}
index edb75af..4aa488c 100644 (file)
@@ -11,29 +11,29 @@ import Text.ParserCombinators.Parsec
 
 readPPM f
   = do  h <- openFile f ReadMode
-       s <- hGetContents h
-       case (parse parsePPM f s) of
-         Left err -> error (show err)
-         Right x  -> return x
+        s <- hGetContents h
+        case (parse parsePPM f s) of
+          Left err -> error (show err)
+          Right x  -> return x
 
 writePPM f ppm
   = do  h <- openFile f WriteMode
-       let s = showPPM (length (head ppm)) (length ppm) ppm
-       hPutStr h s
+        let s = showPPM (length (head ppm)) (length ppm) ppm
+        hPutStr h s
 
 -- parsing
 
 parsePPM
   = do  string "P6"
-       whiteSpace
-       width <- number
-       whiteSpace
-       height <- number
-       whiteSpace
-       colormax <- number
-       whiteSpace
-       cs <- getInput
-       return (chop width (chopColors cs))
+        whiteSpace
+        width <- number
+        whiteSpace
+        height <- number
+        whiteSpace
+        colormax <- number
+        whiteSpace
+        cs <- getInput
+        return (chop width (chopColors cs))
 
 chopColors [] = []
 chopColors (a:b:c:ds) = (ord a, ord b, ord c) : chopColors ds
@@ -44,15 +44,15 @@ chop n xs = h : chop n t
 
 number
   = do  ds <- many1 digit
-       return (read ds :: Int)
+        return (read ds :: Int)
 
 whiteSpace
   = skipMany (simpleSpace <|> oneLineComment <?> "")
     where simpleSpace = skipMany1 (oneOf " \t\n\r\v")
-         oneLineComment =
-             do  char '#'
-                 skipMany (noneOf "\n\r\v")
-                 return ()
+          oneLineComment =
+              do  char '#'
+                  skipMany (noneOf "\n\r\v")
+                  return ()
 
 -- printing
 
index 832f0fc..ea706eb 100644 (file)
@@ -53,42 +53,42 @@ evalSurface (SFun f)   = f
 surface (Planar _ v0 v1) (n, p0, fn)
   = (norm, evalSurface fn n' u v)
   where norm = normalize $ cross v0 v1
-       (n', u, v) = planarUV n p0
+        (n', u, v) = planarUV n p0
 
 surface (Spherical _ v0 v1) (_, p0, fn)
   = (norm, evalSurface fn 0 u v)
   where x = xCoord p0
-       y = yCoord p0
-       z = zCoord p0
-       k = sqrt (1 - sq y)
-       theta = adjustRadian (atan2 (x / k) (z / k))
-       -- correct so that the image grows left-to-right
-       -- instead of right-to-left
-       u = 1.0 - clampf (theta / (2 * pi))
-       v =       clampf ((y + 1) / 2)
-       norm = normalize $ cross v0 v1
+        y = yCoord p0
+        z = zCoord p0
+        k = sqrt (1 - sq y)
+        theta = adjustRadian (atan2 (x / k) (z / k))
+        -- correct so that the image grows left-to-right
+        -- instead of right-to-left
+        u = 1.0 - clampf (theta / (2 * pi))
+        v =       clampf ((y + 1) / 2)
+        norm = normalize $ cross v0 v1
 
 -- ZZ ignore the (incorrect) surface model, and estimate the normal
 -- from the intersection in object space
 surface (Cylindrical _ v0 v1) (_, p0, fn)
   = (norm, evalSurface fn 0 u v)
   where x = xCoord p0
-       y = yCoord p0
-       z = zCoord p0
-       u = clampf $ adjustRadian (atan2 x z) / (2 * pi)
-       v = y
-       norm = normalize $ cross v0 v1
+        y = yCoord p0
+        z = zCoord p0
+        u = clampf $ adjustRadian (atan2 x z) / (2 * pi)
+        v = y
+        norm = normalize $ cross v0 v1
 
 -- ZZ ignore the (incorrect) surface model, and estimate the normal
 -- from the intersection in object space
 surface (Conic _ v0 v1) (_, p0, fn)
   = (norm, evalSurface fn 0 u v)
   where x = xCoord p0
-       y = yCoord p0
-       z = zCoord p0
-       u = clampf $ adjustRadian (atan2 (x / y) (z / y)) / (2 * pi)
-       v = y
-       norm = normalize $ cross v0 v1
+        y = yCoord p0
+        z = zCoord p0
+        u = clampf $ adjustRadian (atan2 (x / y) (z / y)) / (2 * pi)
+        v = y
+        norm = normalize $ cross v0 v1
 
 planarUV face p0
   = case face of
@@ -106,8 +106,8 @@ planarUV face p0
 
     ConeBase       -> (1, (x + 1) / 2, (z + 1) / 2)
   where x = xCoord p0
-       y = yCoord p0
-       z = zCoord p0
+        y = yCoord p0
+        z = zCoord p0
 
 -- misc
 
index d5ab24a..71c5a49 100644 (file)
@@ -7,135 +7,135 @@ import LrcPrelude
 --
 --
 data P
-       = C_RootProd_1 !Defs 
-       deriving (Show , Eq , Ord)
+        = C_RootProd_1 !Defs
+        deriving (Show , Eq , Ord)
 
 data Defs
-       = C_Defs2_1 !Def !Defs 
-       | C_NoDefs_1 
-       deriving (Show , Eq , Ord)
+        = C_Defs2_1 !Def !Defs
+        | C_NoDefs_1
+        deriving (Show , Eq , Ord)
 
 data Def
-       = C_Arraydecl_1 !Type !Name !INT 
-       | C_Declfunc_1 !Type !Name !FormPars !Stats 
-       | C_Declfunc_header_1 !Type !Name !FormPars !Stats 
-       | C_Declfunc_header_novar_1 !Type !Name !FormPars !Stats 
-       | C_Vardecl_1 !Type !Name 
-       deriving (Show , Eq , Ord)
+        = C_Arraydecl_1 !Type !Name !INT
+        | C_Declfunc_1 !Type !Name !FormPars !Stats
+        | C_Declfunc_header_1 !Type !Name !FormPars !Stats
+        | C_Declfunc_header_novar_1 !Type !Name !FormPars !Stats
+        | C_Vardecl_1 !Type !Name
+        deriving (Show , Eq , Ord)
 
 data Type
-       = C_Booltype_1 
-       | C_Chartype_1 
-       | C_Errortype_1 
-       | C_Inttype_1 
-       | C_Realtype_1 
-       deriving (Show , Eq , Ord)
+        = C_Booltype_1
+        | C_Chartype_1
+        | C_Errortype_1
+        | C_Inttype_1
+        | C_Realtype_1
+        deriving (Show , Eq , Ord)
 
 data Name
-       = C_Ident_1 !STR 
-       deriving (Show , Eq , Ord)
+        = C_Ident_1 !STR
+        deriving (Show , Eq , Ord)
 
 data FormPars
-       = C_Emptyformpars_1 
-       | C_Lstformpars_1 !FormPar !FormPars 
-       deriving (Show , Eq , Ord)
+        = C_Emptyformpars_1
+        | C_Lstformpars_1 !FormPar !FormPars
+        deriving (Show , Eq , Ord)
 
 data FormPar
-       = C_Declformpar_1 !Type !Name 
-       deriving (Show , Eq , Ord)
+        = C_Declformpar_1 !Type !Name
+        deriving (Show , Eq , Ord)
 
 data Stats
-       = C_Emptystat_1 
-       | C_Lststats_1 !Stat !Stats 
-       deriving (Show , Eq , Ord)
+        = C_Emptystat_1
+        | C_Lststats_1 !Stat !Stats
+        deriving (Show , Eq , Ord)
 
 data Stat
-       = C_ArrAssign_1 !ArrayUse !Exp 
-       | C_Assign_1 !Name !Exp 
-       | C_Funccall_1 !Name !ActPars 
-       | C_If_t_e_1 !Exp !Stats !Stats 
-       | C_Input_1 !Name 
-       | C_LocalDecl_1 !Type !Name 
-       | C_Print_1 !Exp 
-       | C_While_1 !Exp !Stats 
-       deriving (Show , Eq , Ord)
+        = C_ArrAssign_1 !ArrayUse !Exp
+        | C_Assign_1 !Name !Exp
+        | C_Funccall_1 !Name !ActPars
+        | C_If_t_e_1 !Exp !Stats !Stats
+        | C_Input_1 !Name
+        | C_LocalDecl_1 !Type !Name
+        | C_Print_1 !Exp
+        | C_While_1 !Exp !Stats
+        deriving (Show , Eq , Ord)
 
 data ArrayUse
-       = C_ArrayInd_1 !Name !Exp 
-       deriving (Show , Eq , Ord)
+        = C_ArrayInd_1 !Name !Exp
+        deriving (Show , Eq , Ord)
 
 data Exp
-       = C_AddExp_1 !Exp !Exp 
-       | C_AndExp_1 !Exp !Exp 
-       | C_DivExp_1 !Exp !Exp 
-       | C_EqExp_1 !Exp !Exp 
-       | C_Factor_1 !Fac 
-       | C_GTExp_1 !Exp !Exp 
-       | C_LTExp_1 !Exp !Exp 
-       | C_MinExp_1 !Exp 
-       | C_MulExp_1 !Exp !Exp 
-       | C_NotExp_1 !Exp 
-       | C_OrExp_1 !Exp !Exp 
-       | C_SubExp_1 !Exp !Exp 
-       deriving (Show , Eq , Ord)
+        = C_AddExp_1 !Exp !Exp
+        | C_AndExp_1 !Exp !Exp
+        | C_DivExp_1 !Exp !Exp
+        | C_EqExp_1 !Exp !Exp
+        | C_Factor_1 !Fac
+        | C_GTExp_1 !Exp !Exp
+        | C_LTExp_1 !Exp !Exp
+        | C_MinExp_1 !Exp
+        | C_MulExp_1 !Exp !Exp
+        | C_NotExp_1 !Exp
+        | C_OrExp_1 !Exp !Exp
+        | C_SubExp_1 !Exp !Exp
+        deriving (Show , Eq , Ord)
 
 data Fac
-       = C_ArrayConst_1 !ArrayUse 
-       | C_BoolConst_1 !BOOL 
-       | C_CNIdent_1 !Name 
-       | C_Expr_1 !Exp 
-       | C_Funcinv_1 !Name !ActPars 
-       | C_IntConst_1 !INT 
-       | C_RealConst_1 !REAL 
-       deriving (Show , Eq , Ord)
+        = C_ArrayConst_1 !ArrayUse
+        | C_BoolConst_1 !BOOL
+        | C_CNIdent_1 !Name
+        | C_Expr_1 !Exp
+        | C_Funcinv_1 !Name !ActPars
+        | C_IntConst_1 !INT
+        | C_RealConst_1 !REAL
+        deriving (Show , Eq , Ord)
 
 data ActPars
-       = C_Emptyactpars_1 
-       | C_Lstactpars_1 !Exp !ActPars 
-       deriving (Show , Eq , Ord)
+        = C_Emptyactpars_1
+        | C_Lstactpars_1 !Exp !ActPars
+        deriving (Show , Eq , Ord)
 
 data PPRoot
-       = C_All_1 !PPS 
-       | C_Best_1 !PPS 
-       deriving (Show , Eq , Ord)
+        = C_All_1 !PPS
+        | C_Best_1 !PPS
+        deriving (Show , Eq , Ord)
 
 data PPS
-       = C_Above_1 !PPS !PPS 
-       | C_Apply_1 !PPC !PPSArgs 
-       | C_Beside_1 !PPS !PPS 
-       | C_Dup_1 !PPS !PPS 
-       | C_Empty_1 
-       | C_FillBlock_1 !INT !FillList 
-       | C_Filla_1 !FillList 
-       | C_Indent_1 !INT !PPS 
-       | C_Join_1 !PPS 
-       | C_Text_1 !STR 
-       deriving (Show , Eq , Ord)
+        = C_Above_1 !PPS !PPS
+        | C_Apply_1 !PPC !PPSArgs
+        | C_Beside_1 !PPS !PPS
+        | C_Dup_1 !PPS !PPS
+        | C_Empty_1
+        | C_FillBlock_1 !INT !FillList
+        | C_Filla_1 !FillList
+        | C_Indent_1 !INT !PPS
+        | C_Join_1 !PPS
+        | C_Text_1 !STR
+        deriving (Show , Eq , Ord)
 
 data PPC
-       = C_AboveC_1 !PPC !PPC 
-       | C_ApplyC_1 !PPC !PPCArgs 
-       | C_BesideC_1 !PPC !PPC 
-       | C_DupC_1 !PPC !PPC 
-       | C_IndentC_1 !INT !PPC 
-       | C_JoinC_1 !PPC 
-       | C_ParC_1 
-       deriving (Show , Eq , Ord)
+        = C_AboveC_1 !PPC !PPC
+        | C_ApplyC_1 !PPC !PPCArgs
+        | C_BesideC_1 !PPC !PPC
+        | C_DupC_1 !PPC !PPC
+        | C_IndentC_1 !INT !PPC
+        | C_JoinC_1 !PPC
+        | C_ParC_1
+        deriving (Show , Eq , Ord)
 
 data PPCArgs
-       = C_ConsPPCArgs_1 !PPC !PPCArgs 
-       | C_NilPPCArgs_1 
-       deriving (Show , Eq , Ord)
+        = C_ConsPPCArgs_1 !PPC !PPCArgs
+        | C_NilPPCArgs_1
+        deriving (Show , Eq , Ord)
 
 data PPSArgs
-       = C_ConsArgs_1 !PPS !PPSArgs 
-       | C_NilArgs_1 
-       deriving (Show , Eq , Ord)
+        = C_ConsArgs_1 !PPS !PPSArgs
+        | C_NilArgs_1
+        deriving (Show , Eq , Ord)
 
 data FillList
-       = C_ConsFillList_1 !PPS !FillList 
-       | C_NilFillList_1 
-       deriving (Show , Eq , Ord)
+        = C_ConsFillList_1 !PPS !FillList
+        | C_NilFillList_1
+        deriving (Show , Eq , Ord)
 
 
 --
@@ -147,108 +147,108 @@ type Code = [Instr]
 type CodeParams = [Code]
 
 data Disp
-       = C_Displ_1 !PPS 
-       deriving (Show , Eq , Ord)
+        = C_Displ_1 !PPS
+        deriving (Show , Eq , Ord)
 
 data ENTRY
-       = C_Consarray_1 !Type !INT !INT 
-       | C_Consfunc_1 !Type !INT !LSTPARAM 
-       | C_Consvar_1 !Type !INT 
-       | C_EmptyEntry_1 
-       deriving (Show , Eq , Ord)
+        = C_Consarray_1 !Type !INT !INT
+        | C_Consfunc_1 !Type !INT !LSTPARAM
+        | C_Consvar_1 !Type !INT
+        | C_EmptyEntry_1
+        deriving (Show , Eq , Ord)
 
 type ERROR = [OneError]
 
 data Format
-       = C_Elem_1 !INT !INT !INT !Lst_Str 
-       deriving (Show , Eq , Ord)
+        = C_Elem_1 !INT !INT !INT !Lst_Str
+        deriving (Show , Eq , Ord)
 
 type Formats = [Format]
 
 data Instr
-       = C_ALabel_1 !Name 
-       | C_Add_1 
-       | C_And_1 
-       | C_Call_1 !Name 
-       | C_Cod_1 
-       | C_Data_1 
-       | C_Div_1 
-       | C_Eq_1 
-       | C_Gt_1 
-       | C_Halt_1 
-       | C_IIn_1 
-       | C_IOut_1 
-       | C_Jump_1 !Name 
-       | C_Jumpf_1 !Name 
-       | C_Load_1 
-       | C_Lt_1 
-       | C_Minus_1 
-       | C_Mul_1 
-       | C_Neq_1 
-       | C_Not_1 
-       | C_Or_1 
-       | C_Pusha_1 !Name !INT 
-       | C_Pushb_1 !BOOL 
-       | C_Pushi_1 !INT 
-       | C_Pushr_1 !REAL 
-       | C_Ret_1 
-       | C_Store_1 
-       | C_Sub_1 
-       | C_Var_1 !Name !INT !Type 
-       deriving (Show , Eq , Ord)
+        = C_ALabel_1 !Name
+        | C_Add_1
+        | C_And_1
+        | C_Call_1 !Name
+        | C_Cod_1
+        | C_Data_1
+        | C_Div_1
+        | C_Eq_1
+        | C_Gt_1
+        | C_Halt_1
+        | C_IIn_1
+        | C_IOut_1
+        | C_Jump_1 !Name
+        | C_Jumpf_1 !Name
+        | C_Load_1
+        | C_Lt_1
+        | C_Minus_1
+        | C_Mul_1
+        | C_Neq_1
+        | C_Not_1
+        | C_Or_1
+        | C_Pusha_1 !Name !INT
+        | C_Pushb_1 !BOOL
+        | C_Pushi_1 !INT
+        | C_Pushr_1 !REAL
+        | C_Ret_1
+        | C_Store_1
+        | C_Sub_1
+        | C_Var_1 !Name !INT !Type
+        deriving (Show , Eq , Ord)
 
 type LSTPARAM = [OneParam]
 
 type Lst_Str = [STR]
 
 data OneError
-       = C_E_FormParam_AD_1 !Name 
-       | C_E_Fun_ND_1 !Name 
-       | C_E_Loc_Name_AD_1 !Name 
-       | C_E_Name_AD_1 !Name 
-       | C_E_Name_ND_1 !Name 
-       deriving (Show , Eq , Ord)
+        = C_E_FormParam_AD_1 !Name
+        | C_E_Fun_ND_1 !Name
+        | C_E_Loc_Name_AD_1 !Name
+        | C_E_Name_AD_1 !Name
+        | C_E_Name_ND_1 !Name
+        deriving (Show , Eq , Ord)
 
 data OneParam
-       = C_AParam_1 !Type !Name 
-       deriving (Show , Eq , Ord)
+        = C_AParam_1 !Type !Name
+        deriving (Show , Eq , Ord)
 
 data OneTypeError
-       = C_E_T_ActParam_1 
-       | C_E_T_BOP_1 
-       | C_E_T_DT_1 !Name 
-       | C_E_T_IndArrNotInt_1 
-       | C_E_T_NC_1 !Type !Type 
-       | C_E_T_NotArithExp_1 
-       | C_E_T_NotBooleanExp_1 
-       | C_E_T_if_t_e_1 
-       | C_E_T_while_1 
-       | C_NoTypeError_1 
-       deriving (Show , Eq , Ord)
+        = C_E_T_ActParam_1
+        | C_E_T_BOP_1
+        | C_E_T_DT_1 !Name
+        | C_E_T_IndArrNotInt_1
+        | C_E_T_NC_1 !Type !Type
+        | C_E_T_NotArithExp_1
+        | C_E_T_NotBooleanExp_1
+        | C_E_T_if_t_e_1
+        | C_E_T_while_1
+        | C_NoTypeError_1
+        deriving (Show , Eq , Ord)
 
 data Pair_Formats
-       = C_C_Pair_Formats_1 !Formats !BOOL 
-       deriving (Show , Eq , Ord)
+        = C_C_Pair_Formats_1 !Formats !BOOL
+        deriving (Show , Eq , Ord)
 
 data Pair_Lst_T_Errs
-       = C_CPair_Lst_T_Errs_1 !T_Errs !T_Errs 
-       deriving (Show , Eq , Ord)
+        = C_CPair_Lst_T_Errs_1 !T_Errs !T_Errs
+        deriving (Show , Eq , Ord)
 
 data Pair_Lst_T_Fmts
-       = C_CPair_Lst_T_Fmts_1 !T_Fmts !T_Fmts 
-       deriving (Show , Eq , Ord)
+        = C_CPair_Lst_T_Fmts_1 !T_Fmts !T_Fmts
+        deriving (Show , Eq , Ord)
 
 data Pair_Lst_T_Mins
-       = C_CPair_Lst_T_Mins_1 !T_Mins !T_Mins 
-       deriving (Show , Eq , Ord)
+        = C_CPair_Lst_T_Mins_1 !T_Mins !T_Mins
+        deriving (Show , Eq , Ord)
 
 data Pair_T_Formats
-       = C_C_Pair_T_Formats_1 !T_Formats !BOOL 
-       deriving (Show , Eq , Ord)
+        = C_C_Pair_T_Formats_1 !T_Formats !BOOL
+        deriving (Show , Eq , Ord)
 
 data Sizes
-       = C_Triple_1 !INT !INT !INT 
-       deriving (Show , Eq , Ord)
+        = C_Triple_1 !INT !INT !INT
+        deriving (Show , Eq , Ord)
 
 type TYPES = [Type]
 
@@ -257,13 +257,13 @@ type T_Errs = [BOOL]
 type T_Fmts = [T_Formats]
 
 data T_Formats
-       = C_AFormat_1 !Formats 
-       | C_TFormats_1 !Formats !Formats !BOOL !BOOL 
-       deriving (Show , Eq , Ord)
+        = C_AFormat_1 !Formats
+        | C_TFormats_1 !Formats !Formats !BOOL !BOOL
+        deriving (Show , Eq , Ord)
 
 data T_Frame
-       = C_F_1 !INT !INT 
-       deriving (Show , Eq , Ord)
+        = C_F_1 !INT !INT
+        deriving (Show , Eq , Ord)
 
 type T_Mins = [Sizes]
 
index 38a1fc8..9e5b783 100644 (file)
@@ -91,12 +91,12 @@ stake, sdrop :: Int -> Stream a -> Stream a
 stake 0 xs = xs
 --should be: stake (i+1) (Scons x xs) = Scons x (stake i xs)
 stake i (Scons x xs) | i < 0     = error "Signal.stake: < 0"
-                    | otherwise = Scons x (stake (i-1) xs)
+                     | otherwise = Scons x (stake (i-1) xs)
 
 sdrop 0 xs = xs
 --should be:sdrop (i+1) (Scons x xs) = sdrop i xs
-sdrop i (Scons x xs) | i < 0    = error "Signal.sdrop: < 0"
-                    | otherwise = sdrop i xs
+sdrop i (Scons x xs) | i < 0     = error "Signal.sdrop: < 0"
+                     | otherwise = sdrop i xs
 
 smap2 :: (a->b->c) -> Stream a -> Stream b -> Stream c
 smap2 f as bs =
index c45e4b2..0f9bcfb 100644 (file)
@@ -7,11 +7,11 @@ Subject: ghc bug
 
 
 Some floating constants that are within the floating range
-become wrong, e.g. 
+become wrong, e.g.
 
-       1.82173691287639817263897126389712638972163e-300::Double
+        1.82173691287639817263897126389712638972163e-300::Double
 
-       -- Lennart
+        -- Lennart
 
 PS.  Maybe you use fromRational as defined in the Prelude?
 That won't do.  It is badly broken, tell me if you want
index 4c9a448..9c53564 100644 (file)
@@ -2,8 +2,8 @@ module Main where
 
 main = interact ( \ s -> shows (lex' s) "\n")
      where lex' "" = []
-          lex' s = tok : lex' s' where -- [(tok,s')] = lex s
-                                       (tok,s') = case lex s of
-                                                   [r]   -> r
-                                                   []    -> error ("Empty: " ++ s) 
-                                                   other -> error ("Multi: " ++ s)
+           lex' s = tok : lex' s' where -- [(tok,s')] = lex s
+                                        (tok,s') = case lex s of
+                                                    [r]   -> r
+                                                    []    -> error ("Empty: " ++ s)
+                                                    other -> error ("Multi: " ++ s)
index b794a37..f044ecf 100644 (file)
@@ -1,5 +1,5 @@
 --------------------------------
---     The Game of Life      --
+--      The Game of Life      --
 --------------------------------
 
 generations x = 30
@@ -70,20 +70,20 @@ gen1 n board = map1 row1 (shift1 (copy1 n 0) board)
 
 row1 :: Tuple3 (L Int) (L Int) (L Int) -> L Int
 row1 (T3 last this next)
-  = zipWith31 elt1 (shift2 0 last) 
-                   (shift2 0 this) 
+  = zipWith31 elt1 (shift2 0 last)
+                   (shift2 0 this)
                    (shift2 0 next)
 
 
-elt1 :: Tuple3 Int Int Int 
-        -> (Tuple3 Int Int Int) 
+elt1 :: Tuple3 Int Int Int
+        -> (Tuple3 Int Int Int)
         -> (Tuple3 Int Int Int) -> Int
-elt1 (T3 a b c) (T3 d e f) (T3 g h i) 
+elt1 (T3 a b c) (T3 d e f) (T3 g h i)
  = if (not (eq tot 2))
           && (not (eq tot 3))
       then 0
       else if (eq tot 3) then 1 else e
-   where tot = a `plus` b `plus` c `plus` d 
+   where tot = a `plus` b `plus` c `plus` d
                `plus` f `plus` g `plus` h `plus` i
 
 eq :: Int -> Int -> Bool
@@ -98,7 +98,7 @@ shiftr1 x xs = append2 (C1 x N)  (init1 xs)
 shiftl1 :: L Int -> L (L Int) -> L (L Int)
 shiftl1 x xs = append2 (tail1 xs) (C1 x N)
 
-shift1 :: L Int -> L (L Int) 
+shift1 :: L Int -> L (L Int)
             -> L (Tuple3 (L Int) (L Int) (L Int))
 shift1 x xs = zip31 (shiftr1 x xs) xs (shiftl1 x xs)
 
@@ -128,9 +128,9 @@ copy3 n x = C1 x (copy3 (n-1) x)
 -- Displaying one generation
 
 disp1 :: (Tuple2 (L Char) (L (L Int))) -> L Char
-disp1 (T2 gen xss) 
- = append1 gen 
-    (append1 (C1 '\n' (C1 '\n' N)) 
+disp1 (T2 gen xss)
+ = append1 gen
+    (append1 (C1 '\n' (C1 '\n' N))
              (foldr_1 (glue1 (C1 '\n' N)) N
                        (map4 (compose2 concat1 (map2 star1)) xss)))
 
@@ -139,13 +139,13 @@ star1 i = case i of
            0 -> C1 ' ' (C1 ' ' N)
            1 -> C1 ' ' (C1 'o' N)
 
-glue1 :: L Char -> L Char -> L Char -> L Char 
+glue1 :: L Char -> L Char -> L Char -> L Char
 glue1 s xs ys = append1 xs (append1 s ys)
 
 -- Generating and displaying a sequence of generations
 
 life1 :: Int -> L (L Int) -> L Char
-life1 n xss 
+life1 n xss
   = foldr_1 (glue1 (copy3 (n+2) '\VT')) N
             (map5 disp1
               (zip1_ (map6 (string_ListChar.show) (ints 0))
@@ -165,7 +165,7 @@ initial1 n xss = take1 n (append2 (map3 (compose1 (take2 n)
                            (`append3` (copy1 n 0))) xss)
                                 (copy2 n (copy1 n 0)))
 
-iterate1 :: (L (L Int) -> L (L Int)) 
+iterate1 :: (L (L Int) -> L (L Int))
                -> L (L Int) -> L (L (L Int))
 iterate1 f x = C1 x (iterate1 f (f x))
 
@@ -177,14 +177,14 @@ take1 0 _ = N
 take1 _ N = N
 --should be:take1 (n+1) (C1 x xs) = C1 x (take1 n xs)
 take1 n (C1 x xs) | n < 0     = error "Main.take1"
-                 | otherwise = C1 x (take1 (n-1) xs)
+                  | otherwise = C1 x (take1 (n-1) xs)
 
 take2 :: Int -> L Int -> L Int
 take2 0 _ = N
 take2 _ N = N
 --should be:take2 (n+1) (C1 x xs) = C1 x (take2 n xs)
 take2 n (C1 x xs) | n < 0     = error "Main.take2"
-                 | otherwise = C1 x (take2 (n-1) xs)
+                  | otherwise = C1 x (take2 (n-1) xs)
 
 take3 :: Int -> L (L (L Int))
              -> L (L (L Int))
@@ -216,7 +216,7 @@ tail2 N = error "tail2 got a bad list"
 
 -- maps
 
-map1 :: (Tuple3 (L Int) (L Int) (L Int) -> L Int) -> 
+map1 :: (Tuple3 (L Int) (L Int) (L Int) -> L Int) ->
                 L (Tuple3 (L Int) (L Int) (L Int))
              -> L (L Int)
 map1 f N = N
@@ -235,7 +235,7 @@ map4 :: (L Int -> L Char)
 map4 f N = N
 map4 f (C1 x xs) = C1 (f x) (map4 f xs)
 
-map5 :: (Tuple2 (L Char) (L (L Int)) -> L Char) 
+map5 :: (Tuple2 (L Char) (L (L Int)) -> L Char)
           -> L (Tuple2 (L Char) (L (L Int)))
           -> L (L Char)
 map5 f N = N
@@ -247,12 +247,12 @@ map6 f (C1 x xs) = C1 (f x) (map6 f xs)
 
 -- compose
 
-compose2 :: (L (L Char) -> L Char) 
-            -> (L Int -> L (L Char)) 
+compose2 :: (L (L Char) -> L Char)
+            -> (L Int -> L (L Char))
             -> L Int -> L Char
 compose2 f g xs = f (g xs)
 
-compose1 :: (L Int -> L Int) 
+compose1 :: (L Int -> L Int)
              -> (L Int -> L Int) -> L Int -> L Int
 compose1 f g xs = f (g xs)
 
@@ -263,7 +263,7 @@ concat1 = foldr_1 append1 N
 
 -- foldr
 
-foldr_1 :: (L Char -> L Char -> L Char) 
+foldr_1 :: (L Char -> L Char -> L Char)
             -> L Char -> L (L Char) -> L Char
 foldr_1 f a N = a
 foldr_1 f a (C1 x xs) = f x (foldr_1 f a xs)
@@ -297,26 +297,26 @@ zip1_ = pzip T2
 zip2_ :: L (L Int)
          -> L (L Int)
          -> L (Tuple2 (L Int) (L Int))
-zip2_ = pzip T2 
+zip2_ = pzip T2
 
-zip3d :: L Int -> (Tuple2 (L Int) (L Int)) 
+zip3d :: L Int -> (Tuple2 (L Int) (L Int))
             -> (Tuple3 (L Int) (L Int) (L Int))
 zip3d x (T2 y z) = T3 x y z
 
-zip3_ :: L (L Int) 
+zip3_ :: L (L Int)
          -> L (Tuple2 (L Int) (L Int))
          -> L (Tuple3 (L Int) (L Int) (L Int))
 zip3_ = pzip zip3d
 
 zip4_ :: L Int
-         -> L Int 
+         -> L Int
          -> L (Tuple2 Int Int)
 zip4_ = pzip T2
 
 zip5d :: Int -> (Tuple2 Int Int) -> (Tuple3 Int Int Int)
 zip5d x (T2 y z) = T3 x y z
 
-zip5_ :: L Int 
+zip5_ :: L Int
          -> L (Tuple2 Int Int)
          -> L (Tuple3 Int Int Int)
 zip5_ = pzip zip5d
@@ -327,30 +327,30 @@ zip6_ :: L (Tuple3 Int Int Int)
                       (Tuple3 Int Int Int))
 zip6_ = pzip T2
 
-zip31 :: L (L Int) -> L (L Int) 
-         -> L (L Int)  
+zip31 :: L (L Int) -> L (L Int)
+         -> L (L Int)
          -> L (Tuple3 (L Int) (L Int) (L Int))
 zip31 as bs cs
   = zip3_ as (zip2_ bs cs)
 
-zip32 :: L Int -> L Int -> L Int 
+zip32 :: L Int -> L Int -> L Int
           -> L (Tuple3 Int Int Int)
 zip32 as bs cs
   = zip5_ as (zip4_ bs cs)
 
 -- zipWith
 
-zipWith21 :: ((Tuple3 Int Int Int) 
-              -> (Tuple2 (Tuple3 Int Int Int) 
+zipWith21 :: ((Tuple3 Int Int Int)
+              -> (Tuple2 (Tuple3 Int Int Int)
                          (Tuple3 Int Int Int)) -> Int)
-              -> L (Tuple3 Int Int Int) 
-              -> L (Tuple2 (Tuple3 Int Int Int) 
+              -> L (Tuple3 Int Int Int)
+              -> L (Tuple2 (Tuple3 Int Int Int)
                            (Tuple3 Int Int Int))
               -> L Int
-zipWith21 = pzip 
+zipWith21 = pzip
 
-zipWith31 :: ((Tuple3 Int Int Int) 
-              -> (Tuple3 Int Int Int) 
+zipWith31 :: ((Tuple3 Int Int Int)
+              -> (Tuple3 Int Int Int)
               -> (Tuple3 Int Int Int) -> Int)
                -> L (Tuple3 Int Int Int)
                -> L (Tuple3 Int Int Int)
index 8251a76..e96d5c5 100644 (file)
 -----------------------------------------------------------------------------
 
 module Data.HashTab (
-       -- * Basic hash table operations
-       HashTable, new, insert, delete, lookup, update,
-       -- * Converting to and from lists
-       fromList, toList,
-       -- * Hash functions
-       -- $hash_functions
-       hashInt, hashString,
-       prime,
-       -- * Diagnostics
-       longestChain
+        -- * Basic hash table operations
+        HashTable, new, insert, delete, lookup, update,
+        -- * Converting to and from lists
+        fromList, toList,
+        -- * Hash functions
+        -- $hash_functions
+        hashInt, hashString,
+        prime,
+        -- * Diagnostics
+        longestChain
  ) where
 
 -- This module is imported by Data.Typeable, which is pretty low down in the
 -- module hierarchy, so don't import "high-level" modules
 
 -- Right now we import high-level modules with gay abandon.
-import Prelude hiding  ( lookup )
-import Data.Tuple      ( fst )
+import Prelude  hiding  ( lookup )
+import Data.Tuple       ( fst )
 import Data.Bits
 import Data.Maybe
-import Data.List       ( maximumBy, partition, concat, foldl )
-import Data.Int                ( Int32 )
+import Data.List        ( maximumBy, partition, concat, foldl )
+import Data.Int         ( Int32 )
 
 import Data.Array.Base
 import Data.Array       hiding (bounds)
 import Data.Array.IO
 
-import Data.Char       ( ord )
-import Data.IORef      ( IORef, newIORef, readIORef, writeIORef )
-import Control.Monad   ( mapM, sequence_ )
+import Data.Char        ( ord )
+import Data.IORef       ( IORef, newIORef, readIORef, writeIORef )
+import Control.Monad    ( mapM, sequence_ )
 
 
 -----------------------------------------------------------------------
@@ -81,11 +81,11 @@ newtype HashTable key val = HashTable (IORef (HT key val))
 
 data HT key val
   = HT {
-       kcount  :: !Int32,              -- Total number of keys.
-       buckets :: !(HTArray [(key,val)]),
+        kcount  :: !Int32,              -- Total number of keys.
+        buckets :: !(HTArray [(key,val)]),
         bmask   :: !Int32,
-       hash_fn :: key -> Int32,
-       cmp     :: key -> key -> Bool
+        hash_fn :: key -> Int32,
+        cmp     :: key -> key -> Bool
    }
 
 -- -----------------------------------------------------------------------------
@@ -151,7 +151,7 @@ hYSTERESIS = 0 :: Int32 -- entries to ignore in load computation
 --
 new
   :: (key -> key -> Bool)    -- ^ @eq@: An equality comparison on keys
-  -> (key -> Int32)         -- ^ @hash@: A hash function on keys
+  -> (key -> Int32)          -- ^ @hash@: A hash function on keys
   -> IO (HashTable key val)  -- ^ Returns: an empty hash table
 
 new cmpr hash = do
@@ -190,9 +190,9 @@ insert (HashTable ref) key val = do
   writeMutArray bkts' indx ((key,val):bucket)
   freezeArray bkts'
   table2 <-
-       if tooBig k b
-          then expandHashTable table1
-          else return table1
+        if tooBig k b
+           then expandHashTable table1
+           else return table1
   writeIORef ref table2
 
 tooBig :: Int32 -> Int32 -> Bool
@@ -280,9 +280,9 @@ update (HashTable ref) key val = do
   writeMutArray bkts' indx ((key,val):bucket')
   freezeArray bkts'
   table2 <-
-       if tooBig k' b          -- off by one from insert's resize heuristic.
-          then expandHashTable table1
-          else return table1
+        if tooBig k' b          -- off by one from insert's resize heuristic.
+           then expandHashTable table1
+           else return table1
   writeIORef ref table2
   return (deleted>0)
 
@@ -297,8 +297,8 @@ lookup (HashTable ref) key = do
   let indx = bucketIndex table key
   bucket <- readHTArray bkts indx
   case [ val | (key',val) <- bucket, cmpr key key' ] of
-       [] -> return Nothing
-       (v:_) -> return (Just v)
+        [] -> return Nothing
+        (v:_) -> return (Just v)
 
 -- -----------------------------------------------------------------------------
 -- Converting to/from lists
index 3b6b3ae..0fd8e80 100644 (file)
@@ -1,25 +1,25 @@
-{-     The purpose of this is to test that record update is
-       sufficiently polymorphic.  See comments with
-       tcExpr (RecordUpd) in TcExpr.lhs
+{-      The purpose of this is to test that record update is
+        sufficiently polymorphic.  See comments with
+        tcExpr (RecordUpd) in TcExpr.lhs
 -}
 
 module Main where
 
 data T a b c d  = MkT1 { op1 :: a, op2 :: b }
-              | MkT2 { op1 :: a, op3 :: c }
-              | MkT3 { op4 :: a, op5 :: d }
+               | MkT2 { op1 :: a, op3 :: c }
+               | MkT3 { op4 :: a, op5 :: d }
 
 update1 :: a2 -> T a b c d -> T a2 b c d2
 update1 x t = t { op1 = x }
-       -- NB: the MkT3.op4 case doesn't constrain the result because
-       -- it doesn't have an op1 field
+        -- NB: the MkT3.op4 case doesn't constrain the result because
+        -- it doesn't have an op1 field
 
 update2 :: a2 -> T a b c d -> T a2 b2 c2 d
 update2 x t = t { op4 = x }
 
-main = print (op4 $ 
-             update2 True $ 
-             MkT3 { op4 = op2 $
-                          update1 (1::Int) $
-                          MkT1 { op1 = True }
-             })
+main = print (op4 $
+              update2 True $
+              MkT3 { op4 = op2 $
+                           update1 (1::Int) $
+                           MkT1 { op1 = True }
+              })
index e62c8a4..1bc0203 100644 (file)
@@ -1,39 +1,39 @@
-infixr ->!,=\
+infixr  ->!,=\
 
 -- auxiliary functions -----------------------------------------------------
 
 g u v w (x:y:z) = i(v x y)(u x y (w z) z)(x:w(y:z))
-g u v w [x]    = [x,512]
-q u v w nil    = u : 95 : z v : w
+g u v w [x]     = [x,512]
+q u v w nil     = u : 95 : z v : w
 
 long = several.length
 ((->!),(=\))=(map,($))
-a          = g q f
-y          = (-)32
-z          = (+)32
-several            = (>)2
+a           = g q f
+y           = (-)32
+z           = (+)32
+several     = (>)2
 fairlySmall = (<)64
 notTooSmall = (>)91
 justRight   = (==)95
 notTooBig   = (<)96
-veryBig            = (>)123
+veryBig     = (>)123
 goodSize x  =foldr(&&)
   otherwise =\($x)->![notTooBig,veryBig]
-f y z      =fairlySmall(z)&&goodSize(y)&&notTooSmall(z)
+f y z       =fairlySmall(z)&&goodSize(y)&&notTooSmall(z)
 i cond th el=if(cond)then(th)else(el)
 toBeIsToDoAndToDoIsToBeSaidConFuTse
 
 -- main functions ----------------------------------------------------------
 
-  g  = interact$map
-           toEnum.g.map
-           fromEnum
+  g  =  interact$map
+            toEnum.g.map
+            fromEnum
 main =
  toBeIsToDoAndToDoIsToBeSaidConFuTse(let h=a;t=x where x x=i(long x)x(h t x)
-                                                      q v w x z = - y w:x
-                                                      a = g q f
-                                                      f x y = justRight x
-                                                            && goodSize y
-                                    in t)
+                                                       q v w x z = - y w:x
+                                                       a = g q f
+                                                       f x y = justRight x
+                                                             && goodSize y
+                                     in t)
 
 -- rittri@cs.chalmers.se ---------------------------------------------------
index b2ee82d..d9deac6 100644 (file)
@@ -2,12 +2,12 @@
 -- at least parse correctly.  In GHC 2.02 they didn't!
 
 module Main where
+
 data Foo1 = Crunch1 ! Int ! Int Int deriving( Show )
 
 data Foo2 = Crunch2 ! Int Int Int   deriving( Show )
 
 main = do
-       print (Crunch1 (1+1) (2+2) (3+3))
-       print (Crunch2 (1+1) (2+2) (3+3))
-  
+        print (Crunch1 (1+1) (2+2) (3+3))
+        print (Crunch2 (1+1) (2+2) (3+3))
+
index 608025b..024c1dd 100644 (file)
@@ -1,25 +1,25 @@
 {-# LANGUAGE UndecidableInstances, ExistentialQuantification,
               ScopedTypeVariables, Rank2Types #-}
 
---     Modular arithmetic, due to Dale Thurston
+--      Modular arithmetic, due to Dale Thurston
 
 -- Here's a way to mimic dependent types using existential types,
 -- illustrated by an implementation of modular arithmetic.  To try it
 -- out, load modulus.hs and try something like
---     inModulus (mkModulus (1234567890123::Integer)) (^ 98765432198765) 2
+--      inModulus (mkModulus (1234567890123::Integer)) (^ 98765432198765) 2
 -- to compute 2 to the 98765432198765'th power modulo 1234567890123.
 
 -- The key is the definitions at the top of TypeVal.hs:
--- 
+--
 --   class TypeVal a t | t -> a where
 --       -- typeToVal should ignore its argument.
 --       typeToVal :: t -> a
---   
+--
 --   data Wrapper a = forall t . (TypeVal a t) => Wrapper t
---   
+--
 --   class ValToType a where
 --      valToType :: a -> Wrapper a
--- 
+--
 -- `valToType' takes a value `x' and returns a (wrapped version of a)
 -- fake value in a new type; from the new type, `x' can be recovered by
 -- applying typeToVal.
@@ -45,13 +45,13 @@ data Modulus a = forall s. TypeVal a s => Modulus (a -> Mod s a) (Mod s a -> a)
 
 mkModulus :: (ValToType a, Integral a) => a -> Modulus a
 mkModulus x = case valToType x of {Wrapper (y :: t) ->
-             Modulus normalize (value :: Mod t a -> a)}
+              Modulus normalize (value :: Mod t a -> a)}
 
 normalize :: forall a s. (TypeVal a s, Integral a) => a -> Mod s a
 normalize x = (Mod (x `mod` typeToVal (undefined::s)))
 
 inModulus :: Modulus a -> (forall s . TypeVal a s =>  Mod s a -> Mod s a)
-               -> a -> a
+                -> a -> a
 inModulus (Modulus in_ out) f x = out (f (in_ x))
 
 instance (TypeVal a s, Integral a) => Num (Mod s a) where
index f1608a7..8562d89 100644 (file)
@@ -48,18 +48,18 @@ instance (TypeVal Integer n) => TypeVal Integer (Dbl n)
 
 instance ValToType Integer where
     valToType n | n == 0 = Wrapper (undefined :: Zero)
-               | even n    =
-                  case valToType (div n 2) of {Wrapper x ->
-                  case x of {(_ :: t) ->
-                  Wrapper (undefined :: Dbl t)}}
-               | n > 0  =
-                  case valToType (n-1) of {Wrapper x ->
-                  case x of {(_ :: t) ->
-                  Wrapper (undefined :: Succ t)}}
-               | n < 1  =
-                  case valToType (n+1) of {Wrapper x ->
-                  case x of {(_ :: t) ->
-                  Wrapper (undefined :: Pred t)}}
+                | even n    =
+                   case valToType (div n 2) of {Wrapper x ->
+                   case x of {(_ :: t) ->
+                   Wrapper (undefined :: Dbl t)}}
+                | n > 0  =
+                   case valToType (n-1) of {Wrapper x ->
+                   case x of {(_ :: t) ->
+                   Wrapper (undefined :: Succ t)}}
+                | n < 1  =
+                   case valToType (n+1) of {Wrapper x ->
+                   case x of {(_ :: t) ->
+                   Wrapper (undefined :: Pred t)}}
 
 --- ValToType (a,b)
 --- Doesn't work.  Perhaps a bug in ghc?
@@ -69,8 +69,8 @@ instance ValToType Integer where
 
 --instance (ValToType a, ValToType b) => ValToType (a,b) where
 --    valToType (a,b) = case valToType a of {x ->
---                 case valToType b of {y ->
---                 Wrapper (x,y)}}
+--                  case valToType b of {y ->
+--                  Wrapper (x,y)}}
 
 data NIL a = Dummy20
 instance TypeVal [a] (NIL a)
@@ -82,8 +82,8 @@ instance (TypeVal [a] r, TypeVal a t) => TypeVal [a] (CONS t r)
 instance (ValToType a) => ValToType [a] where
   valToType [] = Wrapper (undefined::NIL a)
   valToType (x:xs) = case valToType x of {Wrapper x' ->
-                    case x' of {(_::xt) ->
-                    case valToType xs of {Wrapper xs' ->
-                    case xs' of {(_::xst) ->
-                    Wrapper (undefined::CONS xt xst)}}}}
+                     case x' of {(_::xt) ->
+                     case valToType xs of {Wrapper xs' ->
+                     case xs' of {(_::xst) ->
+                     Wrapper (undefined::CONS xt xst)}}}}