[project @ 1999-11-02 11:55:02 by sof]

Simple example of callback'ery in action

diff --git a/ghc/tests/programs/callback/Main.hs b/ghc/tests/programs/callback/Main.hs
new file mode 100644 (file)
index 0000000..f86af7c
--- /dev/null
+++ b/ghc/tests/programs/callback/Main.hs
@@ -0,0 +1,27 @@
+-- !!! Testing callbacks
+module Main(main) where
+
+import IOExts
+import Addr
+
+count :: IORef Int -> IO Int
+count ref = do
+  x <- readIORef ref
+  writeIORef ref (x+1)
+  return x
+
+createCounter :: IO Addr
+createCounter = do
+  ref <- newIORef 0
+  mkCounter (count ref)
+
+foreign export dynamic mkCounter :: (IO Int) -> IO Addr
+
+main :: IO ()
+main = do
+  x  <- createCounter
+  v1 <- _casm_GC_ `` do { typedef int (*f)(); %r=(int)((f)%0)();} while (0); '' x
+  print (v1::Int)
+  v2 <- _casm_GC_ `` do { typedef int (*f)(); %r=(int)((f)%0)();} while (0); '' x
+  print (v2::Int)
+

diff --git a/ghc/tests/programs/callback/Makefile b/ghc/tests/programs/callback/Makefile
new file mode 100644 (file)
index 0000000..8eb5c96
--- /dev/null
+++ b/ghc/tests/programs/callback/Makefile
@@ -0,0 +1,10 @@
+TOP = ..
+include $(TOP)/mk/boilerplate.mk
+
+SRC_HC_OPTS += -fglasgow-exts
+
+CC = $(HC)
+
+all :: runtest
+
+include $(TOP)/mk/target.mk