Data commit

Task/Use-another-language-to-call-a-function/Haskell/use-another-language-to-call-a-function-1.hs

@@ -0,0 +1,31 @@
+#ifdef __GLASGOW_HASKELL__
+#include "Called_stub.h"
+extern void __stginit_Called(void);
+#endif
+#include <stdio.h>
+#include <HsFFI.h>
+
+int main (int argc, char * argv [])
+{
+    char     Buffer [1024];
+    size_t   Size = sizeof (Buffer);
+
+    hs_init(&argc, &argv);
+#ifdef __GLASGOW_HASKELL__
+    hs_add_root(__stginit_Called);
+#endif
+
+    if (0 == query_hs (Buffer, &Size))
+        {
+            printf ("failed to call Query\n");
+        }
+    else
+        {
+            char * Ptr = Buffer;
+            while (Size-- > 0) putchar (*Ptr++);
+            putchar ('\n');
+        }
+
+    hs_exit();
+    return 0;
+}

Task/Use-another-language-to-call-a-function/Haskell/use-another-language-to-call-a-function-2.hs

@@ -0,0 +1,26 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module Called where
+
+import Foreign
+import Foreign.C.String (CString, withCStringLen)
+import Foreign.C.Types
+
+-- place a string into the buffer pointed to by ptrBuff (with size
+-- pointed to by ptrSize). If successful, sets number of overwritten
+-- bytes in ptrSize and returns 1, otherwise, it does nothing and
+-- returns 0
+query_hs ::  CString -> Ptr CSize -> IO CInt
+query_hs ptrBuff ptrSize = withCStringLen "Here I am"
+               (\(str, len) -> do
+                   buffSize <- peek ptrSize
+                   if sizeOf str > (fromIntegral buffSize)
+                     then do
+                       poke ptrSize 0
+                       return 0
+                     else do
+                       poke ptrSize (fromIntegral len)
+                       copyArray ptrBuff str len
+                       return 1)
+
+foreign export ccall query_hs :: CString -> Ptr CSize -> IO CInt

Task/Use-another-language-to-call-a-function/Haskell/use-another-language-to-call-a-function-3.hs

@@ -0,0 +1 @@
+ghc -c -O Called.hs

Task/Use-another-language-to-call-a-function/Haskell/use-another-language-to-call-a-function-4.hs

@@ -0,0 +1 @@
+ghc -optc-O calling.c Called.o Called_stub.o -o calling