+ = do sp <- makeStablePtr fun
+ p <- copy_String_to_cstring typestr -- is never freed
+ a <- hugsCreateAdjThunk sp p callconv
+ return a
+ where
+ copy_String_to_cstring :: String -> IO Addr
+ copy_String_to_cstring s
+ = malloc (1 + length s) >>= \ptr0 ->
+ let loop off [] = writeCharOffAddr ptr0 off (chr 0)
+ >> return ptr0
+ loop off (c:cs) = writeCharOffAddr ptr0 off c
+ >> loop (off+1) cs
+ in
+ if isNullAddr ptr0
+ then error "copy_String_to_cstring: malloc failed"
+ else loop 0 s
+
+ isNullAddr a = a == nullAddr
+
+ writeCharOffAddr :: Addr -> Int -> Char -> IO ()
+ writeCharOffAddr (A# buf#) (I# n#) (C# c#)
+ = IO ( \ s# ->
+ case (writeCharOffAddr# buf# n# c# s#) of
+ s2# -> (# s2#, () #) )
+
+