[MLton] ffi improvements
Stephen Weeks
MLton@mlton.org
Thu, 23 Sep 2004 13:51:19 -0700
> How about this?
>
> signature POINTER = sig
...
> functor Pointer (structure P : MLTON_POINTER) :> POINTER =
...
Looks nice. Here's a MLtonized version.
----------------------------------------------------------------------
signature POINTER =
sig
type 'a t (* available for FFI *)
structure CType:
sig
type 'a ptr
type 'a t
val int16: Int16.int t
val int32: Int32.int t
val int64: Int64.int t
val int8: Int8.int t
val ptr: 'a t -> 'a ptr t
val real32: Real32.real t
val real64: Real64.real t
val word16: Word16.word t
val word32: Word32.word t
val word64: Word64.word t
val word8: Word8.word t
end
sharing type t = CType.ptr
structure Seq:
sig
type 'a ptr
type 'a t
val make: 'a ptr * int -> 'a t
val sub: 'a t * 'a CType.t * int -> 'a
val update: 'a t * 'a CType.t * int * 'a -> unit
end
sharing type t = Seq.ptr
val diff: 'a t * 'a t -> word
val equals: 'a t * 'a t -> bool
val get: 'a t * 'a CType.t -> 'a
val null: 'a t
val set: 'a t * 'a CType.t * 'a -> unit
end
functor Pointer (structure P: MLTON_POINTER):> POINTER =
struct
type 'a t = P.t
structure CType =
struct
type 'a ptr = 'a t
datatype 'a t = T of {get: P.t * int -> 'a,
set: P.t * int * 'a -> unit}
val int16 = T {get = P.getInt16, set = P.setInt16}
val int32 = T {get = P.getInt32, set = P.setInt32}
val int64 = T {get = P.getInt64, set = P.setInt64}
val int8 = T {get = P.getInt8, set = P.setInt8}
fun ptr _ = T {get = P.getPointer, set = P.setPointer}
val real32 = T {get = P.getReal32, set = P.setReal32}
val real64 = T {get = P.getReal64, set = P.setReal64}
val word16 = T {get = P.getWord16, set = P.setWord16}
val word32 = T {get = P.getWord32, set = P.setWord32}
val word64 = T {get = P.getWord64, set = P.setWord64}
val word8 = T {get = P.getWord8, set = P.setWord8}
end
structure Seq =
struct
type 'a ptr = 'a t
datatype 'a t = T of {max: Word.word,
ptr: P.t}
fun make (ptr, max) =
T {max = Word.fromInt max,
ptr = ptr}
fun check (T {max, ptr}, i, f) =
if Word.>= (Word.fromInt i, max)
then raise Subscript
else f ptr
fun sub (s, CType.T {get, ...}, i) =
check (s, i, fn ptr => get (ptr, i))
fun update (s, CType.T {set, ...}, i, v) =
check (s, i, fn ptr => set (ptr, i, v))
end
val diff = P.diff
val equals: 'a t * 'a t -> bool = op =
fun get (p, CType.T {get, ...}) = get (p, 0)
val null = P.null
fun set (p, CType.T {set, ...}, v) = set (p, 0, v)
end
----------------------------------------------------------------------
Your design is nice because one can use 'a Pointer.t in an FFI
expression, since it expands to MLton.Pointer.t. Another way to go
would be to keep run-time type information with the pointer. This
would make get and set simpler, since the client wouldn't need to pass
the CType. Here's what I mean.
----------------------------------------------------------------------
signature RTTI_POINTER_STRUCTS =
sig
structure Pointer: MLTON_POINTER
end
signature RTTI_POINTER =
sig
include RTTI_POINTER_STRUCTS
type 'a t (* not available for FFI *)
structure CType:
sig
type 'a ptr
type 'a t
val int16: Int16.int t
val int32: Int32.int t
val int64: Int64.int t
val int8: Int8.int t
val ptr: 'a t -> 'a ptr t
val real32: Real32.real t
val real64: Real64.real t
val word16: Word16.word t
val word32: Word32.word t
val word64: Word64.word t
val word8: Word8.word t
end
sharing type t = CType.ptr
val diff: 'a t * 'a t -> word
val equals: 'a t * 'a t -> bool
val get: 'a t -> 'a
val make: Pointer.t * 'a CType.t -> 'a t
val null: 'a CType.t -> 'a t
val set: 'a t * 'a -> unit
end
functor RttiPointer (S: RTTI_POINTER_STRUCTS): RTTI_POINTER =
struct
open S
structure P = Pointer
structure CType =
struct
datatype 'a t = T of {get: P.t * int -> 'a,
set: P.t * int * 'a -> unit}
val int16 = T {get = P.getInt16, set = P.setInt16}
val int32 = T {get = P.getInt32, set = P.setInt32}
val int64 = T {get = P.getInt64, set = P.setInt64}
val int8 = T {get = P.getInt8, set = P.setInt8}
fun ptr _ = T {get = P.getPointer, set = P.setPointer}
val real32 = T {get = P.getReal32, set = P.setReal32}
val real64 = T {get = P.getReal64, set = P.setReal64}
val word16 = T {get = P.getWord16, set = P.setWord16}
val word32 = T {get = P.getWord32, set = P.setWord32}
val word64 = T {get = P.getWord64, set = P.setWord64}
val word8 = T {get = P.getWord8, set = P.setWord8}
end
datatype 'a t = T of {ctype: 'a CType.t,
ptr: P.t}
structure RttiPointer =
struct
datatype t = datatype t
end
structure CType =
struct
open CType
type 'a ptr = 'a RttiPointer.t
fun ptr (ctype: 'a t): 'a ptr t =
let
fun get (p: P.t, i: int): 'a ptr =
RttiPointer.T {ctype = ctype,
ptr = P.getPointer (p, i)}
fun set (p: P.t, i: int, RttiPointer.T {ptr = p', ...}): unit =
P.setPointer (p, i, p')
in
T {get = get,
set = set}
end
end
local
fun binary f (T {ptr = p1, ...}, T {ptr = p2, ...}) =
f (p1, p2)
in
val diff = fn z => binary P.diff z
val equals = fn z => binary (op =) z
end
fun get (T {ctype = CType.T {get, ...}, ptr}) = get (ptr, 0)
fun null ctype = T {ctype = ctype,
ptr = P.null}
fun set (T {ctype = CType.T {set, ...}, ptr}, v) = set (ptr, 0, v)
fun make (p: Pointer.t, ctype: 'a CType.t) =
T {ctype = ctype, ptr = p}
end
----------------------------------------------------------------------
Of course, this does sacrifice the ability to use the pointer type
directly with the FFI, and requires manual wrappers around imported
functions to express their type and make them safe. But it could be
worth it in some situations.
> But, since this is all expressible as a library, I would hope MLTon
> is smart enough to optimize away all the overheads, but adding
> explicit support for this in the compiler/optimizer to use the
> typinfo might not be hard.
I'm pretty sure in your design that all the overhead would get
simplified away, while with the RTTI approach, MLton will keep the
RTTI around. One should certainly check the ILs to confirm, though.
One factor that might come into play is that MLton has a pass
(xml/simplify-types.fun) that eliminates phantom types to avoid
"spurious" code duplication due to phantom types when monomorphising.
Overall, since MLton.Pointer provides enough support to implement
these approaches, and there is more of the design space to explore,
I'd rather leave them to be added as a library, after the upcoming
release. We also need to consider integration with NLFFI, which is
also due for after the upcoming release.