Skip to content
Browse files

newclay/lib-clay prelude.procedures: import monomorphic? and monomorp…

…hicInputTypes primitives. overload CodePointer(#'f) | monomorphic?('f) and CCodePointer(#'f) | monomorphic?('f) to automatically derive the [[..'I], [..'O]] type arguments from the monomorphic function's signature
  • Loading branch information...
1 parent 59c593c commit 9110038d7af5e2d535006f78379c7adf99e1863d @jckarter jckarter committed Jun 16, 2011
View
1 newclay/lib-clay/prelude/io/io.clay
@@ -14,7 +14,6 @@ define read1;
overload #Source?('S) = Regular?('S) and callDefined?(read1, Ref['S]);
#sourceValueType('S) = ..type((ref s:'S) -> ..required(read1(s)));
-
//
// sink operations
View
16 newclay/lib-clay/prelude/procedures/procedures.clay
@@ -3,6 +3,8 @@ import __primitives__.(
makeCodePointer,
makeExternalCodePointer,
callCodePointer,
+ monomorphic?,
+ monomorphicInputTypes,
);
import meta.symbols.(symbolWithTag?, symbol?, private symbolBodyWithTag?);
import unsafe.valuesemantics.(POD?);
@@ -69,6 +71,10 @@ overload CodePointer[[..'I], [..'O]](#'f) inline
| definedWithType?(-> forward ..'f(..arg(..'I)), ..'O)
= makeCodePointer(#'f, ..'I);
+overload CodePointer(#'f) inline
+ | monomorphic?('f)
+ = makeCodePointer(#'f, ..#monomorphicInputTypes('f));
+
overload call(c:CodePointer[[..'I], [..'O]], forward ..args) inline
| defined?(-> forward callCodePointer(c, ..args))
= forward ..callCodePointer(c, ..args);
@@ -78,6 +84,16 @@ overload ExternalCodePointer['A, false, [..'I], [..'O]](#'f) inline
and definedWithType?((..args:'I) -> ..'f(..args), ..'O)
= makeExternalCodePointer(#'f, 'A, ..'I);
+overload CCodePointer(#'f) inline
+ | monomorphic?('f)
+ and allValues?(POD?, ..monomorphicInputTypes('f))
+ = makeExternalCodePointer(#'f, CdeclABI, ..#monomorphicInputTypes('f));
+
+overload StdcallCodePointer(#'f) inline
+ | monomorphic?('f)
+ and allValues?(POD?, ..monomorphicInputTypes('f))
+ = makeExternalCodePointer(#'f, StdcallABI, ..#monomorphicInputTypes('f));
+
//
// XXX
View
5 newclay/test/prelude/procedures/CodePointers/main.clay
@@ -6,9 +6,12 @@ main() {
var foo1 = CodePointer[[Int], [Int]](foo);
var foo2 = CodePointer[[Float64], [Float64]](foo);
+ var foo3 = CodePointer((x:Float64) -> x + x);
+
////2
////4
////2.5
////4.5
- show(foo1(1), foo1(2), foo2(1.25), foo2(2.25));
+ ////6.5
+ show(foo1(1), foo1(2), foo2(1.25), foo2(2.25), foo3(3.25));
}
View
1 newclay/test/prelude/procedures/CodePointers/out.txt
@@ -2,3 +2,4 @@
4
2.5
4.5
+6.5
View
20 newclay/test/prelude/procedures/ExternalCodePointers2/main.clay
@@ -0,0 +1,20 @@
+import ctypes.*;
+import unsafe.coordinates.(begin);
+import show.(show);
+
+alias QsortComparator = CCodePointer[[OpaquePointer, OpaquePointer], [CInt]];
+external qsort(base:OpaquePointer, nel:CSizeT, width:CSizeT, compar:QsortComparator);
+
+main() {
+ var numbers = Array[Int, 5](3, 0, 2, 4, 1);
+
+ qsort(
+ OpaquePointer(begin(numbers)), 5u, CSizeT(typeSize(Int)),
+ CCodePointer((pa:OpaquePointer, pb:OpaquePointer) ->
+ CInt(Pointer[Int](pb)^ - Pointer[Int](pa)^)
+ )
+ );
+
+ for (n in numbers)
+ show(n);
+}
View
5 newclay/test/prelude/procedures/ExternalCodePointers2/out.txt
@@ -0,0 +1,5 @@
+4
+3
+2
+1
+0

0 comments on commit 9110038

Please sign in to comment.
Something went wrong with that request. Please try again.