debugging memory allocations

Duncan Coutts duncan.coutts at worc.ox.ac.uk
Wed Feb 2 13:42:21 EST 2005


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
-------------- next part --------------

==================== 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



-------------- next part --------------
A non-text attachment was scrubbed...
Name: CustomDraw.hs
Type: text/x-haskell
Size: 3643 bytes
Desc: not available
Url : http://www.haskell.org//pipermail/glasgow-haskell-users/attachments/20050202/73fb1d66/CustomDraw-0001.bin
-------------- next part --------------

==================== 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





More information about the Glasgow-haskell-users mailing list