[MLton] ffi improvements

[Daniel C. Wang]

Stephen Weeks wrote:

>>I suspect what I want is a slightly more refined interface for the
>>user. I don't see any problem having a Pointer type in the compiler,
>>but I would expect more type-checking in the exposed user
>>interfaces.
> 
> 
> I agree completely.  I was worried that you had a reason for compiler
> mods.  Yes, someone should build a nicer front end to the pointer
> stuff using phantom types or whatever to get better type safety.
> 

How about this?
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.

signature POINTER = sig
     type 'a T
     type 'a ptr
     type 'a seq

     structure T : sig
       val word8  : Word8.word T
       val word16 : Word16.word T
       val word32 : Word32.word T
       val word64 : Word64.word T
	
       val int8  : Int8.int T
       val int16 : Int16.int T
       val int32 : Int32.int T
       val int64 : Int64.int T
	
       val real32 : Real32.real T
       val real64 : Real64.real T

       val ptr : 'a T -> 'a ptr T
     end

     val eq:   ('a ptr * 'a ptr) -> bool
     val null : 'a ptr
     val diff: ('a ptr * 'a ptr) -> word

     val get:  'a T -> 'a ptr -> 'a
     val set:  'a T -> ('a ptr * 'a) -> unit

     (* make a sequence with a bounds *)
     val seq : 'a ptr * int -> 'a seq
     (* preforms bounds check *)
     val getElt: 'a T -> ('a seq * int) -> 'a
     val setElt: 'a T -> ('a seq * int * 'a) -> unit

end
functor Pointer(structure P : MLTON_POINTER) :> POINTER =
   struct
     type 'a ptr = P.t
     type 'a T = {get: (P.t * int) -> 'a,
		 set: (P.t * int * 'a) -> unit}
     type 'a seq = (P.t * int)
     structure T = struct
       val word8 = {get=P.getWord8,set=P.setWord8}
       val word16 = {get=P.getWord16,set=P.setWord16}
       val word32 = {get=P.getWord32,set=P.setWord32}
       val word64 = {get=P.getWord64,set=P.setWord64}

       val int8 = {get=P.getInt8,set=P.setInt8}
       val int16 = {get=P.getInt16,set=P.setInt16}
       val int32 = {get=P.getInt32,set=P.setInt32}
       val int64 = {get=P.getInt64,set=P.setInt64}

       val real32 = {get=P.getReal32,set=P.setReal32}
       val real64 = {get=P.getReal64,set=P.setReal64}
       fun ptr x = {get=P.getPointer,set=P.setPointer}
     end
     fun eq (x,y) = (x=y)
     val null = P.null
     val diff = P.diff
     fun get {get=f,set} = (fn p => f(p,0))
     fun set {get,set=f} = (fn (p,v) => f(p,0,v))
     fun seq x = x
     fun getElt {get,set} ((p,max),i) =
       if i > 0 andalso i < max then
	get(p,i)
       else raise General.Subscript

     fun setElt {get,set} ((p,max),i,v) =
       if i > 0 andalso i < max then
	set(p,i,v)
       else raise General.Subscript
   end