ghc/tests/io/stable001/Main.lhs

   1 \begin{code}
   2 module Main(main) where
   3
   4 --import PreludeGlaST
   5 --old:import GHCio(stThen)
   6 --old:import PreludeGlaMisc
   7
   8 main =  makeStablePtr test      >>= \ stablePtr ->
   9         ((_casm_GC_ ``SaveAllStgRegs(); test1(%0); RestoreAllStgRegs();'' stablePtr)
  10                                                 :: PrimIO ())
  11                                 >>= \ _ ->
  12         return ()
  13
  14 test :: IO Int
  15 test =
  16         let f x = sum [1..x]
  17             f :: Int -> Int
  18         in
  19         _ccall_ printf
  20               "The stable pointer has just been used to print this number %d\n" (f 100)
  21                                 >>= \ _ ->
  22         return 5
  23 \end{code}
  24
  25 This is a rather exciting experiment in using the new call
  26 @makeStablePtr#@ and @performIO@. It doesn't do much but it took an
  27 incredible effort to get it to do it.
  28
  29 \begin{code}[C-code]
  30 #define NULL_REG_MAP
  31 #include "stgdefs.h"
  32
  33 int
  34 test1( stableIOPtr )
  35   StgStablePtr stableIOPtr;
  36 {
  37   int i;
  38   int result;
  39
  40   printf("Using stable pointer %x\n", stableIOPtr);
  41
  42   for( i = 0; i != 10; i = i + 1 ) {
  43     printf( "Calling stable pointer for %dth time\n", i );
  44     performIO( stableIOPtr );
  45     printf( "Returned after stable pointer\n" );
  46   }
  47
  48   return 1;
  49 }
  50 \end{code}