On Wed, 2005-02-02 at 17:01 +0000, Simon Marlow wrote:
> On 02 February 2005 13:38, Duncan Coutts wrote:
> > Would looking at the core files help? What would I be looking for?
> > 
> > Here's a simple version that I would expect to run in constance space.
> > 
> > pixbufSetGreen :: Pixbuf -> IO ()
> > pixbufSetGreen pixbuf = do
> >   ptr <- pixbufGetPixels pixbuf
> >   sequence_
> >     [ do pokeByteOff ptr (y*384+3*x)   (0  ::Word8)
> >          pokeByteOff ptr (y*384+3*x+1) (128::Word8)
> >          pokeByteOff ptr (y*384+3*x+2) (96 ::Word8)
> >     | y <- [0..127]
> >     , x <- [0..127] ]
> > 
> 
> Yes, let's see the core.  Since you're interested in allocation, you
> might be better off with -ddump-prep rather than -ddump-simpl: the
> former has all the allocation made into explicit 'let' expressions ready
> for code generation.

Ok, attached it the -ddump-prep for the version using pixbufSetGreen,
and another file for the longer more complicated one which is using
setWierdColour. Both versions do contain 'let's.

I've also attached the original code. (which you won't be able to build
without hacking the gtk bits out of it)

Duncan
==================== CorePrep ====================
Main.lvl :: GHC.Base.Int
[GlobalId]
NoCafRefs Str: DmdType m
Main.lvl = GHC.Base.I# 100

Main.lvl1 :: GHC.Base.Int
[GlobalId]
NoCafRefs
Main.lvl1 = GHC.Base.I# 8

Main.lvl2 :: GHC.Base.Int
[GlobalId]
NoCafRefs
Main.lvl2 = GHC.Base.I# 256

Main.lvl3 :: GHC.IOBase.IO Graphics.UI.Gtk.Types.Pixbuf
[GlobalId]
Str: DmdType
Main.lvl3 = Graphics.UI.Gtk.Gdk.Pixbuf.pixbufNew
              Graphics.UI.Gtk.Gdk.Pixbuf.ColorspaceRgb
              GHC.Base.False
              Main.lvl1
              Main.lvl2
              Main.lvl2

lvl4 :: [GHC.Base.Int]
[GlobalId]
Str: DmdType
lvl4 = GHC.Enum.eftInt 0 127

z :: GHC.IOBase.IO ()
[GlobalId]
Arity 1 NoCafRefs Str: DmdType L
z = \ s :: GHC.Prim.State# GHC.Prim.RealWorld ->
      (# s, GHC.Base.() #)

Main.pixbufSetGreen :: Graphics.UI.Gtk.Types.Pixbuf
                       -> GHC.IOBase.IO ()
[GlobalId]
Arity 2 Str: DmdType
Main.pixbufSetGreen = \ pixbuf :: Graphics.UI.Gtk.Types.Pixbuf
                        eta :: GHC.Prim.State# GHC.Prim.RealWorld ->
                        case Graphics.UI.Gtk.Gdk.Pixbuf.pixbufGetPixels pixbuf 
eta
                        of wild { (# new_s, a41 #) ->
                        __letrec {
                          go :: [GHC.Base.Int] -> GHC.IOBase.IO ()
                          Arity 1 Str: DmdType S
                          go = \ ds :: [GHC.Base.Int] ->
                                 case ds of wild1 {
                                   GHC.Base.: y ys ->
                                     let {
                                       lvl5 :: GHC.Base.Int
                                       Str: DmdType
                                       lvl5 = case y of wild2 { GHC.Base.I# x ->
                                              case GHC.Prim.*# x 384 of 
sat_s6Mx { __DEFAULT ->
                                              GHC.Base.I# sat_s6Mx
                                              }
                                              } } in
                                     let {
                                       lvl6 :: GHC.Base.Int
                                       Str: DmdType
                                       lvl6 = case y of wild2 { GHC.Base.I# x ->
                                              case GHC.Prim.*# x 384 of 
sat_s6MG { __DEFAULT ->
                                              GHC.Base.I# sat_s6MG
                                              }
                                              } } in
                                     let {
                                       lvl7 :: GHC.Base.Int
                                       Str: DmdType
                                       lvl7 = case y of wild2 { GHC.Base.I# x ->
                                              case GHC.Prim.*# x 384 of 
sat_s6MP { __DEFAULT ->
                                              GHC.Base.I# sat_s6MP
                                              }
                                              } } in
                                     let {
                                       ds1 :: GHC.IOBase.IO ()
                                       Str: DmdType
                                       ds1 = go ys } in
                                     __letrec {
                                       go1 :: [GHC.Base.Int] -> GHC.IOBase.IO ()
                                       Arity 1 Str: DmdType S
                                       go1 = \ ds2 :: [GHC.Base.Int] ->
                                               case ds2 of wild2 {
                                                 GHC.Base.: y1 ys1 ->
                                                   let {
                                                     ds3 :: GHC.IOBase.IO ()
                                                     Str: DmdType
                                                     ds3 = go1 ys1 } in
                                                   let {
                                                     sat_s6Pd :: 
GHC.Prim.State# GHC.Prim.RealWorld
                                                                 -> (# 
GHC.Prim.State#
                                                                           
GHC.Prim.RealWorld,
                                                                       () #)
                                                     sat_s6Pd = \ eta1 :: 
GHC.Prim.State#
                                                                              
GHC.Prim.RealWorld ->
                                                                  case y1
                                                                  of wild11 { 
GHC.Base.I# y2 ->
                                                                  case lvl5
                                                                  of wild3 { 
GHC.Base.I# x ->
                                                                  case a41
                                                                  of wild4 { 
GHC.Ptr.Ptr addr ->
                                                                  case 
GHC.Prim.*# 3 y2
                                                                  of sat_s6Nn { 
__DEFAULT ->
                                                                  case 
GHC.Prim.+# x sat_s6Nn
                                                                  of sat_s6Nq { 
__DEFAULT ->
                                                                  case 
GHC.Prim.plusAddr#
                                                                         addr 
sat_s6Nq
                                                                  of sat_s6Nt { 
__DEFAULT ->
                                                                  case 
GHC.Prim.writeWord8OffAddr#
                                                                         @ 
GHC.Prim.RealWorld
                                                                         
sat_s6Nt
                                                                         0
                                                                         __word 0
                                                                         eta1
                                                                  of s2 { 
__DEFAULT ->
                                                                  case lvl6
                                                                  of wild5 { 
GHC.Base.I# x1 ->
                                                                  case 
GHC.Prim.*# 3 y2
                                                                  of sat_s6NC { 
__DEFAULT ->
                                                                  case 
GHC.Prim.+# x1 sat_s6NC
                                                                  of sat_s6NF { 
__DEFAULT ->
                                                                  case 
GHC.Prim.+# sat_s6NF 1
                                                                  of sat_s6NI { 
__DEFAULT ->
                                                                  case 
GHC.Prim.plusAddr#
                                                                         addr 
sat_s6NI
                                                                  of sat_s6NL { 
__DEFAULT ->
                                                                  case 
GHC.Prim.writeWord8OffAddr#
                                                                         @ 
GHC.Prim.RealWorld
                                                                         
sat_s6NL
                                                                         0
                                                                         __word 
128
                                                                         s2
                                                                  of s21 { 
__DEFAULT ->
                                                                  case lvl7
                                                                  of wild6 { 
GHC.Base.I# x2 ->
                                                                  case 
GHC.Prim.*# 3 y2
                                                                  of sat_s6NU { 
__DEFAULT ->
                                                                  case 
GHC.Prim.+# x2 sat_s6NU
                                                                  of sat_s6NX { 
__DEFAULT ->
                                                                  case 
GHC.Prim.+# sat_s6NX 2
                                                                  of sat_s6O0 { 
__DEFAULT ->
                                                                  case 
GHC.Prim.plusAddr#
                                                                         addr 
sat_s6O0
                                                                  of sat_s6O3 { 
__DEFAULT ->
                                                                  case 
GHC.Prim.writeWord8OffAddr#
                                                                         @ 
GHC.Prim.RealWorld
                                                                         
sat_s6O3
                                                                         0
                                                                         __word 
96
                                                                         s21
                                                                  of s22 { 
__DEFAULT ->
                                                                  ds3 s22
                                                                  }
                                                                  }
                                                                  }
                                                                  }
                                                                  }
                                                                  }
                                                                  }
                                                                  }
                                                                  }
                                                                  }
                                                                  }
                                                                  }
                                                                  }
                                                                  }
                                                                  }
                                                                  }
                                                                  }
                                                                  }
                                                                  }
                                                   } in  sat_s6Pd;
                                                 GHC.Base.[] -> ds1
                                               };
                                     } in  go1 lvl4;
                                   GHC.Base.[] -> z
                                 };
                        } in  go lvl4 new_s
                        }

Main.widgetShowAll :: Graphics.UI.Gtk.Types.Window
                      -> GHC.IOBase.IO ()
[GlobalId]
Str: DmdType
Main.widgetShowAll = Graphics.UI.Gtk.Abstract.Widget.widgetShowAll
                       @ Graphics.UI.Gtk.Types.Window
                       Graphics.UI.Gtk.Types.$fContainerClassWindow

Main.containerAdd :: Graphics.UI.Gtk.Types.Window
                     -> Graphics.UI.Gtk.Types.Image -> GHC.IOBase.IO ()
[GlobalId]
Str: DmdType
Main.containerAdd = Graphics.UI.Gtk.Abstract.Container.containerAdd
                      @ Graphics.UI.Gtk.Types.Window
                      @ Graphics.UI.Gtk.Types.Image
                      Graphics.UI.Gtk.Types.$fContainerClassWindow
                      Graphics.UI.Gtk.Types.$fWidgetClassImage

Main.widgetQueueDraw :: Graphics.UI.Gtk.Types.Image
                        -> GHC.IOBase.IO ()
[GlobalId]
Str: DmdType
Main.widgetQueueDraw = Graphics.UI.Gtk.Abstract.Widget.widgetQueueDraw
                         @ Graphics.UI.Gtk.Types.Image
                         Graphics.UI.Gtk.Types.$fWidgetClassImage

Main.onDestroy :: Graphics.UI.Gtk.Types.Window
                  -> GHC.IOBase.IO ()
                     -> GHC.IOBase.IO
                            (Graphics.UI.Gtk.Signals.ConnectId 
Graphics.UI.Gtk.Types.Window)
[GlobalId]
Str: DmdType
Main.onDestroy = Graphics.UI.Gtk.Abstract.Widget.onDestroy
                   @ Graphics.UI.Gtk.Types.Window
                   Graphics.UI.Gtk.Types.$fContainerClassWindow

Main.lvl5 :: GHC.Prim.State# GHC.Prim.RealWorld
             -> (# GHC.Prim.State# GHC.Prim.RealWorld, () #)
[GlobalId]
Arity 1
Main.lvl5 = \ s :: GHC.Prim.State# GHC.Prim.RealWorld ->
              case Graphics.UI.Gtk.Windows.Window.windowNew s
              of wild { (# new_s, a41 #) ->
              case Main.onDestroy
                     a41 Graphics.UI.Gtk.General.General.mainQuit new_s
              of wild1 { (# new_s1, a411 #) ->
              case Main.lvl3 new_s1 of wild2 { (# new_s2, a412 #) ->
              case Graphics.UI.Gtk.Display.Image.imageNewFromPixbuf a412 new_s2
              of wild3 { (# new_s3, a413 #) ->
              let {
                m :: GHC.IOBase.IO ()
                Str: DmdType
                m = Main.widgetQueueDraw a413 } in
              let {
                sat_s6OS :: GHC.Prim.State# GHC.Prim.RealWorld
                            -> (# GHC.Prim.State# GHC.Prim.RealWorld, 
GHC.Base.Bool #)
                sat_s6OS = \ s1 :: GHC.Prim.State# GHC.Prim.RealWorld ->
                             case System.CPUTime.getCPUTime s1 of wild4 { (# 
new_s4, a414 #) ->
                             case Main.pixbufSetGreen a412 new_s4
                             of wild5 { (# new_s5, a415 #) ->
                             case m new_s5 of wild6 { (# new_s6, a416 #) ->
                             (# new_s6, GHC.Base.True #)
                             }
                             }
                             }
              } in 
                case Graphics.UI.Gtk.General.General.timeoutAdd
                       sat_s6OS Main.lvl new_s3
                of wild4 { (# new_s4, a414 #) ->
                case Main.containerAdd a41 a413 new_s4
                of wild5 { (# new_s5, a415 #) ->
                Main.widgetShowAll a41 new_s5
                }
                }
              }
              }
              }
              }

Main.main :: GHC.IOBase.IO ()
[GlobalId]
Str: DmdType
Main.main = Graphics.UI.Gtk.General.General.startGUI Main.lvl5

:Main.main :: GHC.IOBase.IO ()
[GlobalId]
Arity 1 Str: DmdType L
:Main.main = \ eta :: GHC.Prim.State# GHC.Prim.RealWorld ->
               GHC.Prim.catch#
                 @ ()
                 @ GHC.IOBase.Exception
                 Main.main
                 (GHC.TopHandler.topHandler @ ())
                 eta



{-# OPTIONS -fglasgow-exts -O #-}

module Main (Main.main) where

import Graphics.UI.Gtk

import System (getArgs, exitFailure)

import System.CPUTime (getCPUTime)

import Foreign.Storable
import Foreign.Ptr
import Data.Word (Word8)

main :: IO ()
main = do
  startGUI gui


gui :: IO ()
gui = do
  -- Create a new window
  window <- windowNew
  onDestroy window mainQuit

  -- Create a new image
  pixbuf <- pixbufNew ColorspaceRgb False 8 256 256
  --setWierdColour 0 pixbuf
  image <- imageNewFromPixbuf pixbuf

  -- Arrange for it to be changed every 0.2 seconds
  timeoutAdd (do
                counter <- getCPUTime
                -- redraw the pixmap
                setWierdColour (fromIntegral (counter `div` 2000000000)) pixbuf
                --pixbufSetGreen pixbuf
                -- and update the image to display the new contents
                -- of the pixmap
                widgetQueueDraw image
                return True) 100
  
  -- Put the image in the window
  containerAdd window image

  -- The final step is to display everything
  widgetShowAll window

{-# NOINLINE setWierdColour #-}
setWierdColour :: Int -> Pixbuf -> IO ()
setWierdColour counter pixbuf =
  let val = fromIntegral counter in
  pixbufSetPixelsRGB8 pixbuf (\x y -> (# fromIntegral x + val
                                       , fromIntegral y + val
                                       , fromIntegral x + fromIntegral y + val #))

-- TODO: for some reason the following code allocates lots of memory.
{-
{-# NOINLINE pixbufSetGreen #-}
pixbufSetGreen :: Pixbuf -> IO ()
pixbufSetGreen pixbuf = do
  ptr <- pixbufGetPixels pixbuf
  sequence_ 
    [ do pokeByteOff ptr (y*384+3*x)   (0  ::Word8)
         pokeByteOff ptr (y*384+3*x+1) (128::Word8)
         pokeByteOff ptr (y*384+3*x+2) (96 ::Word8)
    | y <- [0..127]
    , x <- [0..127] ]
-}
-- TODO: for some reason the following code allocates lots of memory.

{-# INLINE pixbufSetPixelsRGB8 #-}
pixbufSetPixelsRGB8 :: Pixbuf -> (Int -> Int -> (# Word8, Word8, Word8 #)) -> IO ()
pixbufSetPixelsRGB8 pixbuf setPixel = do
  -- assert that the format is RGB8
  rowStride <- pixbufGetRowstride pixbuf
  width <- pixbufGetWidth pixbuf
  height <- pixbufGetHeight pixbuf
  let loop ptr y | y == height = return ()
                 | otherwise = do
        let rowLoop ptr x | x == width = return ()
                          | otherwise =
              case setPixel x y of
                (# red, green, blue #) -> do
                  pokeByteOff ptr 0 red
                  pokeByteOff ptr 1 green
                  pokeByteOff ptr 2 blue
                  rowLoop (ptr `plusPtr` 3) (x+1)
        rowLoop ptr 0
        loop (ptr `plusPtr` rowStride) (y+1)

  pixelsPtr <- pixbufGetPixels pixbuf
  loop pixelsPtr 0

pixbufSetPixelsRGBA8 :: Pixbuf -> (Int -> Int -> (# Word8, Word8, Word8, Word8 #)) -> IO ()
pixbufSetPixelsRGBA8 pixbuf setPixel = do
  -- assert that the format is RGBA8
  rowStride <- pixbufGetRowstride pixbuf
  width <- pixbufGetWidth pixbuf
  height <- pixbufGetHeight pixbuf
  let loop ptr y | y == height = return ()
                 | otherwise = do
        let rowLoop ptr x | x == width = return ()
                          | otherwise =
              case setPixel x y of
                (# red, green, blue, alpha #) -> do
                  pokeByteOff ptr 0 red
                  pokeByteOff ptr 1 green
                  pokeByteOff ptr 2 blue
                  pokeByteOff ptr 3 alpha
                  rowLoop (ptr `plusPtr` 4) (x+1)
        rowLoop ptr 0
        loop (ptr `plusPtr` rowStride) (y+1)

  pixelsPtr <- pixbufGetPixels pixbuf
  loop pixelsPtr 0
==================== CorePrep ====================
Main.lvl :: GHC.Base.Int
[GlobalId]
NoCafRefs Str: DmdType m
Main.lvl = GHC.Base.I# 100

Main.lvl1 :: GHC.Base.Int
[GlobalId]
NoCafRefs
Main.lvl1 = GHC.Base.I# 8

Main.lvl2 :: GHC.Base.Int
[GlobalId]
NoCafRefs
Main.lvl2 = GHC.Base.I# 256

Main.lvl3 :: GHC.IOBase.IO Graphics.UI.Gtk.Types.Pixbuf
[GlobalId]
Str: DmdType
Main.lvl3 = Graphics.UI.Gtk.Gdk.Pixbuf.pixbufNew
              Graphics.UI.Gtk.Gdk.Pixbuf.ColorspaceRgb
              GHC.Base.False
              Main.lvl1
              Main.lvl2
              Main.lvl2

lvl4 :: GHC.Base.Int
[GlobalId]
NoCafRefs Str: DmdType m
lvl4 = GHC.Base.I# 0

lvl5 :: GHC.IOBase.IO ()
[GlobalId]
Arity 1 NoCafRefs Str: DmdType L
lvl5 = \ s :: GHC.Prim.State# GHC.Prim.RealWorld ->
         (# s, GHC.Base.() #)

lvl6 :: GHC.IOBase.IO ()
[GlobalId]
Arity 1 NoCafRefs Str: DmdType L
lvl6 = \ s :: GHC.Prim.State# GHC.Prim.RealWorld ->
         (# s, GHC.Base.() #)

Main.setWierdColour :: GHC.Base.Int
                       -> Graphics.UI.Gtk.Types.Pixbuf -> GHC.IOBase.IO ()
[GlobalId]
Arity 3 Str: DmdType
Main.setWierdColour = \ counter :: GHC.Base.Int
                        pixbuf :: Graphics.UI.Gtk.Types.Pixbuf
                        eta :: GHC.Prim.State# GHC.Prim.RealWorld ->
                        case Graphics.UI.Gtk.Gdk.Pixbuf.pixbufGetRowstride 
pixbuf eta
                        of wild { (# new_s, a41 #) ->
                        case Graphics.UI.Gtk.Gdk.Pixbuf.pixbufGetWidth pixbuf 
new_s
                        of wild1 { (# new_s1, a411 #) ->
                        case Graphics.UI.Gtk.Gdk.Pixbuf.pixbufGetHeight pixbuf 
new_s1
                        of wild2 { (# new_s2, a412 #) ->
                        case Graphics.UI.Gtk.Gdk.Pixbuf.pixbufGetPixels pixbuf 
new_s2
                        of wild3 { (# new_s3, a413 #) ->
                        let {
                          val :: GHC.Word.Word8
                          Str: DmdType
                          val = case counter of wild4 { GHC.Base.I# x# ->
                                case GHC.Prim.int2Word# x# of sat_s8lr { 
__DEFAULT ->
                                case GHC.Prim.narrow8Word# sat_s8lr of sat_s8lu 
{ __DEFAULT ->
                                GHC.Word.W8# sat_s8lu
                                }
                                }
                                } } in
                        __letrec {
                          $wpoly_loop :: forall b.
                                         GHC.Ptr.Ptr b -> GHC.Prim.Int# -> 
GHC.IOBase.IO ()
                          Arity 2 Str: DmdType LL
                          $wpoly_loop = \ @ b w :: GHC.Ptr.Ptr b ww :: 
GHC.Prim.Int# ->
                                          case a412 of wild11 { GHC.Base.I# y ->
                                          case GHC.Prim.==# ww y of wild4 {
                                            GHC.Base.True -> lvl6;
                                            GHC.Base.False ->
                                              let {
                                                k :: GHC.IOBase.IO ()
                                                Str: DmdType
                                                k = case GHC.Prim.+# ww 1 of 
sat_s8lP { __DEFAULT ->
                                                    let {
                                                      sat_s8lM :: GHC.Ptr.Ptr b
                                                      sat_s8lM = 
GHC.Ptr.plusPtr @ b @ b w a41
                                                    } in  $wpoly_loop @ b 
sat_s8lM sat_s8lP
                                                    } } in
                                              let {
                                                m :: GHC.IOBase.IO ()
                                                Str: DmdType
                                                m = __letrec {
                                                      rowLoop :: GHC.Ptr.Ptr b
                                                                 -> 
GHC.Base.Int -> GHC.IOBase.IO ()
                                                      Str: DmdType
                                                      rowLoop = case 
GHC.Prim.int2Word# ww
                                                                of sat_s8lZ { 
__DEFAULT ->
                                                                case 
GHC.Prim.narrow8Word# sat_s8lZ
                                                                of a { 
__DEFAULT ->
                                                                let {
                                                                  lvl7 :: 
GHC.Word.Word8
                                                                  Str: DmdType
                                                                  lvl7 = case 
val
                                                                         of 
wild12 { GHC.Word.W8# y# ->
                                                                         case 
GHC.Prim.plusWord#
                                                                                
a y#
                                                                         of 
sat_s8m9 { __DEFAULT ->
                                                                         case 
GHC.Prim.narrow8Word#
                                                                                
sat_s8m9
                                                                         of 
sat_s8mc { __DEFAULT ->
                                                                         
GHC.Word.W8# sat_s8mc
                                                                         }
                                                                         }
                                                                         } } in
                                                                let {
                                                                  sat_s8pJ :: 
GHC.Ptr.Ptr b
                                                                              
-> GHC.Base.Int
                                                                                
 -> GHC.IOBase.IO ()
                                                                  sat_s8pJ = \ 
ptr :: GHC.Ptr.Ptr b
                                                                               
x :: GHC.Base.Int ->
                                                                               
case x
                                                                               
of wild5 { GHC.Base.I# x1 ->
                                                                               
case a411
                                                                               
of wild12 { GHC.Base.I# y1 ->
                                                                               
case GHC.Prim.==#
                                                                                
      x1 y1
                                                                               
of wild6 {
                                                                                
 GHC.Base.True ->
                                                                                
   lvl5;
                                                                                
 GHC.Base.False ->
                                                                                
   let {
                                                                                
     k1 :: GHC.IOBase.IO
                                                                                
               ()
                                                                                
     Str: DmdType
                                                                                
     k1 = case GHC.Prim.+#
                                                                                
                 x1
                                                                                
                 1
                                                                                
          of sat_s8mD { __DEFAULT ->
                                                                                
          let {
                                                                                
            sat_s8mF :: GHC.Base.Int
                                                                                
            sat_s8mF = GHC.Base.I#
                                                                                
                         sat_s8mD } in
                                                                                
          let {
                                                                                
            sat_s8mA :: GHC.Ptr.Ptr
                                                                                
                            b
                                                                                
            sat_s8mA = case ptr
                                                                                
                       of wild7 { GHC.Ptr.Ptr addr ->
                                                                                
                       case GHC.Prim.plusAddr#
                                                                                
                              addr
                                                                                
                              3
                                                                                
                       of sat_s8my { __DEFAULT ->
                                                                                
                       GHC.Ptr.Ptr
                                                                                
                         @ b
                                                                                
                         sat_s8my
                                                                                
                       }
                                                                                
                       }
                                                                                
          } in 
                                                                                
            rowLoop
                                                                                
              sat_s8mA
                                                                                
              sat_s8mF
                                                                                
          } } in
                                                                                
   let {
                                                                                
     ds2 :: GHC.Word.Word8
                                                                                
     Str: DmdType
                                                                                
     ds2 = case val
                                                                                
           of wild13 { GHC.Word.W8# y# ->
                                                                                
           case GHC.Prim.int2Word#
                                                                                
                  x1
                                                                                
           of sat_s8mO { __DEFAULT ->
                                                                                
           case GHC.Prim.narrow8Word#
                                                                                
                  sat_s8mO
                                                                                
           of sat_s8mR { __DEFAULT ->
                                                                                
           case GHC.Prim.plusWord#
                                                                                
                  sat_s8mR
                                                                                
                  a
                                                                                
           of sat_s8mU { __DEFAULT ->
                                                                                
           case GHC.Prim.narrow8Word#
                                                                                
                  sat_s8mU
                                                                                
           of sat_s8mX { __DEFAULT ->
                                                                                
           case GHC.Prim.plusWord#
                                                                                
                  sat_s8mX
                                                                                
                  y#
                                                                                
           of sat_s8n1 { __DEFAULT ->
                                                                                
           case GHC.Prim.narrow8Word#
                                                                                
                  sat_s8n1
                                                                                
           of sat_s8n4 { __DEFAULT ->
                                                                                
           GHC.Word.W8#
                                                                                
             sat_s8n4
                                                                                
           }
                                                                                
           }
                                                                                
           }
                                                                                
           }
                                                                                
           }
                                                                                
           }
                                                                                
           } } in
                                                                                
   let {
                                                                                
     eta2 :: GHC.Ptr.Ptr
                                                                                
                 GHC.Word.Word8
                                                                                
     Str: DmdType
                                                                                
     eta2 = case ptr
                                                                                
            of wild7 { GHC.Ptr.Ptr addr ->
                                                                                
            case GHC.Prim.plusAddr#
                                                                                
                   addr
                                                                                
                   2
                                                                                
            of sat_s8nd { __DEFAULT ->
                                                                                
            GHC.Ptr.Ptr
                                                                                
              @ GHC.Word.Word8
                                                                                
              sat_s8nd
                                                                                
            }
                                                                                
            } } in
                                                                                
   let {
                                                                                
     eta21 :: GHC.Ptr.Ptr
                                                                                
                  GHC.Word.Word8
                                                                                
     Str: DmdType
                                                                                
     eta21 = case ptr
                                                                                
             of wild7 { GHC.Ptr.Ptr addr ->
                                                                                
             case GHC.Prim.plusAddr#
                                                                                
                    addr
                                                                                
                    1
                                                                                
             of sat_s8nm { __DEFAULT ->
                                                                                
             GHC.Ptr.Ptr
                                                                                
               @ GHC.Word.Word8
                                                                                
               sat_s8nm
                                                                                
             }
                                                                                
             } } in
                                                                                
   let {
                                                                                
     ds21 :: GHC.Word.Word8
                                                                                
     Str: DmdType
                                                                                
     ds21 = case val
                                                                                
            of wild13 { GHC.Word.W8# y# ->
                                                                                
            case GHC.Prim.int2Word#
                                                                                
                   x1
                                                                                
            of sat_s8nu { __DEFAULT ->
                                                                                
            case GHC.Prim.narrow8Word#
                                                                                
                   sat_s8nu
                                                                                
            of sat_s8nx { __DEFAULT ->
                                                                                
            case GHC.Prim.plusWord#
                                                                                
                   sat_s8nx
                                                                                
                   y#
                                                                                
            of sat_s8nB { __DEFAULT ->
                                                                                
            case GHC.Prim.narrow8Word#
                                                                                
                   sat_s8nB
                                                                                
            of sat_s8nE { __DEFAULT ->
                                                                                
            GHC.Word.W8#
                                                                                
              sat_s8nE
                                                                                
            }
                                                                                
            }
                                                                                
            }
                                                                                
            }
                                                                                
            } } in
                                                                                
   let {
                                                                                
     eta22 :: GHC.Ptr.Ptr
                                                                                
                  GHC.Word.Word8
                                                                                
     Str: DmdType
                                                                                
     eta22 = case ptr
                                                                                
             of wild7 { GHC.Ptr.Ptr addr ->
                                                                                
             case GHC.Prim.plusAddr#
                                                                                
                    addr
                                                                                
                    0
                                                                                
             of sat_s8nN { __DEFAULT ->
                                                                                
             GHC.Ptr.Ptr
                                                                                
               @ GHC.Word.Word8
                                                                                
               sat_s8nN
                                                                                
             }
                                                                                
             } } in
                                                                                
   let {
                                                                                
     sat_s8pT :: GHC.Prim.State#
                                                                                
                     GHC.Prim.RealWorld
                                                                                
                 -> (# GHC.Prim.State#
                                                                                
                           GHC.Prim.RealWorld,
                                                                                
                       () #)
                                                                                
     sat_s8pT = \ eta1 :: GHC.Prim.State#
                                                                                
                              GHC.Prim.RealWorld ->
                                                                                
                  case eta22
                                                                                
                  of wild7 { GHC.Ptr.Ptr a1 ->
                                                                                
                  case ds21
                                                                                
                  of wild21 { GHC.Word.W8# x2 ->
                                                                                
                  case GHC.Prim.writeWord8OffAddr#
                                                                                
                         @ GHC.Prim.RealWorld
                                                                                
                         a1
                                                                                
                         0
                                                                                
                         x2
                                                                                
                         eta1
                                                                                
                  of s2 { __DEFAULT ->
                                                                                
                  case eta21
                                                                                
                  of wild8 { GHC.Ptr.Ptr a2 ->
                                                                                
                  case lvl7
                                                                                
                  of wild22 { GHC.Word.W8# x3 ->
                                                                                
                  case GHC.Prim.writeWord8OffAddr#
                                                                                
                         @ GHC.Prim.RealWorld
                                                                                
                         a2
                                                                                
                         0
                                                                                
                         x3
                                                                                
                         s2
                                                                                
                  of s21 { __DEFAULT ->
                                                                                
                  case eta2
                                                                                
                  of wild9 { GHC.Ptr.Ptr a3 ->
                                                                                
                  case ds2
                                                                                
                  of wild23 { GHC.Word.W8# x4 ->
                                                                                
                  case GHC.Prim.writeWord8OffAddr#
                                                                                
                         @ GHC.Prim.RealWorld
                                                                                
                         a3
                                                                                
                         0
                                                                                
                         x4
                                                                                
                         s21
                                                                                
                  of s22 { __DEFAULT ->
                                                                                
                  k1
                                                                                
                    s22
                                                                                
                  }
                                                                                
                  }
                                                                                
                  }
                                                                                
                  }
                                                                                
                  }
                                                                                
                  }
                                                                                
                  }
                                                                                
                  }
                                                                                
                  }
                                                                                
   } in  sat_s8pT
                                                                               }
                                                                               }
                                                                               }
                                                                } in  sat_s8pJ
                                                                }
                                                                };
                                                    } in  rowLoop w lvl4 } in
                                              let {
                                                sat_s8q0 :: GHC.Prim.State# 
GHC.Prim.RealWorld
                                                            -> (# 
GHC.Prim.State#
                                                                      
GHC.Prim.RealWorld,
                                                                  () #)
                                                sat_s8q0 = \ eta1 :: 
GHC.Prim.State#
                                                                         
GHC.Prim.RealWorld ->
                                                             case m eta1
                                                             of wild5 { (# 
new_s4, a414 #) ->
                                                             k new_s4
                                                             }
                                              } in  sat_s8q0
                                          }
                                          };
                        } in  $wpoly_loop @ () a413 0 new_s3
                        }
                        }
                        }
                        }

Main.widgetShowAll :: Graphics.UI.Gtk.Types.Window
                      -> GHC.IOBase.IO ()
[GlobalId]
Str: DmdType
Main.widgetShowAll = Graphics.UI.Gtk.Abstract.Widget.widgetShowAll
                       @ Graphics.UI.Gtk.Types.Window
                       Graphics.UI.Gtk.Types.$fContainerClassWindow

Main.containerAdd :: Graphics.UI.Gtk.Types.Window
                     -> Graphics.UI.Gtk.Types.Image -> GHC.IOBase.IO ()
[GlobalId]
Str: DmdType
Main.containerAdd = Graphics.UI.Gtk.Abstract.Container.containerAdd
                      @ Graphics.UI.Gtk.Types.Window
                      @ Graphics.UI.Gtk.Types.Image
                      Graphics.UI.Gtk.Types.$fContainerClassWindow
                      Graphics.UI.Gtk.Types.$fWidgetClassImage

Main.widgetQueueDraw :: Graphics.UI.Gtk.Types.Image
                        -> GHC.IOBase.IO ()
[GlobalId]
Str: DmdType
Main.widgetQueueDraw = Graphics.UI.Gtk.Abstract.Widget.widgetQueueDraw
                         @ Graphics.UI.Gtk.Types.Image
                         Graphics.UI.Gtk.Types.$fWidgetClassImage

Main.lit :: GHC.Num.Integer
[GlobalId]
NoCafRefs Str: DmdType
Main.lit = GHC.Num.S# 2000000000

Main.onDestroy :: Graphics.UI.Gtk.Types.Window
                  -> GHC.IOBase.IO ()
                     -> GHC.IOBase.IO
                            (Graphics.UI.Gtk.Signals.ConnectId 
Graphics.UI.Gtk.Types.Window)
[GlobalId]
Str: DmdType
Main.onDestroy = Graphics.UI.Gtk.Abstract.Widget.onDestroy
                   @ Graphics.UI.Gtk.Types.Window
                   Graphics.UI.Gtk.Types.$fContainerClassWindow

Main.lvl7 :: GHC.Prim.State# GHC.Prim.RealWorld
             -> (# GHC.Prim.State# GHC.Prim.RealWorld, () #)
[GlobalId]
Arity 1
Main.lvl7 = \ s :: GHC.Prim.State# GHC.Prim.RealWorld ->
              case Graphics.UI.Gtk.Windows.Window.windowNew s
              of wild { (# new_s, a41 #) ->
              case Main.onDestroy
                     a41 Graphics.UI.Gtk.General.General.mainQuit new_s
              of wild1 { (# new_s1, a411 #) ->
              case Main.lvl3 new_s1 of wild2 { (# new_s2, a412 #) ->
              case Graphics.UI.Gtk.Display.Image.imageNewFromPixbuf a412 new_s2
              of wild3 { (# new_s3, a413 #) ->
              let {
                m :: GHC.IOBase.IO ()
                Str: DmdType
                m = Main.widgetQueueDraw a413 } in
              let {
                sat_s8pm :: GHC.Prim.State# GHC.Prim.RealWorld
                            -> (# GHC.Prim.State# GHC.Prim.RealWorld, 
GHC.Base.Bool #)
                sat_s8pm = \ s1 :: GHC.Prim.State# GHC.Prim.RealWorld ->
                             case System.CPUTime.getCPUTime s1 of wild4 { (# 
new_s4, a414 #) ->
                             let {
                               sat_s8pa :: GHC.Base.Int
                               sat_s8pa = case GHC.Num.$wdivModInteger a414 
Main.lit
                                          of ww { (# ww1, ww2 #) ->
                                          GHC.Num.integer2Int ww1
                                          }
                             } in 
                               case Main.setWierdColour sat_s8pa a412 new_s4
                               of wild5 { (# new_s5, a415 #) ->
                               case m new_s5 of wild6 { (# new_s6, a416 #) ->
                               (# new_s6, GHC.Base.True #)
                               }
                               }
                             }
              } in 
                case Graphics.UI.Gtk.General.General.timeoutAdd
                       sat_s8pm Main.lvl new_s3
                of wild4 { (# new_s4, a414 #) ->
                case Main.containerAdd a41 a413 new_s4
                of wild5 { (# new_s5, a415 #) ->
                Main.widgetShowAll a41 new_s5
                }
                }
              }
              }
              }
              }

Main.main :: GHC.IOBase.IO ()
[GlobalId]
Str: DmdType
Main.main = Graphics.UI.Gtk.General.General.startGUI Main.lvl7

:Main.main :: GHC.IOBase.IO ()
[GlobalId]
Arity 1 Str: DmdType L
:Main.main = \ eta :: GHC.Prim.State# GHC.Prim.RealWorld ->
               GHC.Prim.catch#
                 @ ()
                 @ GHC.IOBase.Exception
                 Main.main
                 (GHC.TopHandler.topHandler @ ())
                 eta



_______________________________________________
Glasgow-haskell-users mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

Reply via email to