Adds Function.unsafe-ptr & Function.unsafe-env-ptr (#1026)

This functions are useful with binding callback based C APIs

core/Core.carp

@@ -21,6 +21,7 @@
 (load-once "Introspect.carp")
 (load-once "Pointer.carp")
 (load-once "Unsafe.carp")
+(load-once "Function.carp")
 (load-once "Generics.carp")
 (load-once "Maybe.carp")
 (load-once "Result.carp")

core/Function.carp

@@ -0,0 +1,7 @@
+(defmodule Function
+  (doc unsafe-ptr "returns void pointer to the function passed in."
+                 "This is unsafe as unsafe-ptr can't check the value passed in is a function.")
+  (deftemplate unsafe-ptr (Fn [(Ref a)] (Ptr ())) "void* $NAME($a *fn)" "$DECL { return fn->callback; }")
+  (doc unsafe-env-ptr "returns void pointer to the environment captured by a lambda."
+                   "This is unsafe as unsafe-env-ptr can't check the value passed in is a function.")
+  (deftemplate unsafe-env-ptr (Fn [(Ref a)] (Ptr ())) "void* $NAME($a *fn)" "$DECL { return fn->env; }"))

test/function.carp

@@ -0,0 +1,20 @@
+(load-and-use Test)
+
+(deftemplate runner (Fn [(Ptr ()) (Ptr ())] a)
+                    "$a $NAME(void* fn, void* args)"
+                    "$a $NAME(void* fnptr, void* args) {
+                       return (($a(*)(void*))fnptr)(args);
+                    }")
+
+(deftest test
+  (assert-equal test
+                (let [x 42 fnfn (fn [] @&x)]
+                  (runner (Function.unsafe-ptr &fnfn) (Function.unsafe-env-ptr &fnfn)))
+                42
+                "Function.unsafe-ptr & Function.unsafe-env-ptr works as expected")
+
+  (assert-equal test
+                (let [x 42 fnfn (fn [y] (Int.copy y))]
+                  (runner (Function.unsafe-ptr &fnfn) (Unsafe.coerce &x)))
+                42
+                "Function.unsafe-ptr & Unsafe.coerce works as expected"))