Initial data commit

Task/Call-a-foreign-language-function/Haskell/call-a-foreign-language-function-1.hs

@@ -0,0 +1,15 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+import Foreign (free)
+import Foreign.C.String (CString, withCString, peekCString)
+
+-- import the strdup function itself
+-- the "unsafe" means "assume this foreign function never calls back into Haskell and avoid extra bookkeeping accordingly"
+foreign import ccall unsafe "string.h strdup" strdup :: CString -> IO CString
+
+testC = withCString "Hello World!" -- marshall the Haskell string "Hello World!" into a C string...
+        (\s -> -- ... and name it s
+         do s2 <- strdup s
+            s2_hs <- peekCString s2 -- marshall the C string called s2 into a Haskell string named s2_hs
+            putStrLn s2_hs
+            free s2) -- s is automatically freed by withCString once done

Task/Call-a-foreign-language-function/Haskell/call-a-foreign-language-function-2.hs

@@ -0,0 +1,18 @@
+#include <string.h>
+#include "icall.h"  // a header routine from the Unicon sources - provides helpful type-conversion macros
+
+int strdup_wrapper (int argc, descriptor *argv)
+{
+  ArgString (1); // check that the first argument is a string
+
+  RetString (strdup (StringVal(argv[1]))); // call strdup, convert and return result
+}
+
+// and strcat, for a result that does not equal the input
+int strcat_wrapper (int argc, descriptor *argv)
+{
+  ArgString (1);
+  ArgString (2);
+  char * result = strcat (StringVal(argv[1]), StringVal(argv[2]));
+  RetString (result);
+}

Task/Call-a-foreign-language-function/Haskell/call-a-foreign-language-function-3.hs

@@ -0,0 +1,23 @@
+$define LIB "libstrdup-wrapper.so"
+
+# the unicon wrapper to access the C function
+procedure strdup (str)
+  static f
+  initial {
+    f := loadfunc (LIB, "strdup_wrapper") // pick out the wrapped function from the shared library
+  }
+  return f(str) // call the wrapped function
+end
+
+procedure strcat (str1, str2)
+  static f
+  initial {
+    f := loadfunc (LIB, "strcat_wrapper")
+  }
+  return f(str1, str2)
+end
+
+procedure main ()
+  write (strdup ("abc"))
+  write (strcat ("abc", "def"))
+end