[MLton] ffi improvements

[Stephen Weeks]

> 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.