MLton

Just as MLton can directly call C functions, it is possible to make indirect function calls; that is, function calls through a function pointer. MLton extends the syntax of SML to allow expressions like the following:

_import * : MLton.Pointer.t -> real * char -> int;

This expression denotes a function of type

MLton.Pointer.t -> real * char -> int

whose behavior is implemented by calling the C function at the address denoted by the MLton.Pointer.t argument, and supplying the C function two arguments, a double and an int. The C function pointer may be obtained, for example, by the dynamic linking loader (dlopen, dlsym, …​).

The general form of an indirect _import expression is:

_import * attr... : cPtrTy -> cFuncTy;

The type and the semicolon are not optional.

Example

This example uses dlopen and friends (imported using normal _import) to dynamically load the math library (libm) and call the cos function. Suppose iimport.sml contains the following.

signature DYN_LINK =
   sig
      type hndl
      type mode
      type fptr

      val dlopen : string * mode -> hndl
      val dlsym : hndl * string -> fptr
      val dlclose : hndl -> unit

      val RTLD_LAZY : mode
      val RTLD_NOW : mode
   end

structure DynLink :> DYN_LINK =
   struct
      type hndl = MLton.Pointer.t
      type mode = Word32.word
      type fptr = MLton.Pointer.t

      (* These symbols come from a system libray, so the default import scope
       * of external is correct.
       *)
      val dlopen =
         _import "dlopen" : string * mode -> hndl;
      val dlerror =
         _import "dlerror": unit -> MLton.Pointer.t;
      val dlsym =
         _import "dlsym" : hndl * string -> fptr;
      val dlclose =
         _import "dlclose" : hndl -> Int32.int;

      val RTLD_LAZY = 0wx00001 (* Lazy function call binding.  *)
      val RTLD_NOW  = 0wx00002 (* Immediate function call binding.  *)

      val dlerror = fn () =>
         let
            val addr = dlerror ()
         in
            if addr = MLton.Pointer.null
               then NONE
               else let
                       fun loop (index, cs) =
                          let
                             val w = MLton.Pointer.getWord8 (addr, index)
                             val c = Byte.byteToChar w
                          in
                             if c = #"\000"
                                then SOME (implode (rev cs))
                                else loop (index + 1, c::cs)
                          end
                    in
                       loop (0, [])
                    end
         end

      val dlopen = fn (filename, mode) =>
         let
            val filename = filename ^ "\000"
            val hndl = dlopen (filename, mode)
         in
            if hndl = MLton.Pointer.null
               then raise Fail (case dlerror () of
                                   NONE => "???"
                                 | SOME s => s)
               else hndl
         end

      val dlsym = fn (hndl, symbol) =>
         let
            val symbol = symbol ^ "\000"
            val fptr = dlsym (hndl, symbol)
         in
            case dlerror () of
               NONE => fptr
             | SOME s => raise Fail s
         end

      val dlclose = fn hndl =>
         if MLton.Platform.OS.host = MLton.Platform.OS.Darwin
            then ()  (* Darwin reports the following error message if you
                      * try to close a dynamic library.
                      *   "dynamic libraries cannot be closed"
                      * So, we disable dlclose on Darwin.
                      *)
         else
            let
               val res = dlclose hndl
            in
               if res = 0
                  then ()
               else raise Fail (case dlerror () of
                                   NONE => "???"
                                 | SOME s => s)
            end
   end

val dll =
   let
      open MLton.Platform.OS
   in
      case host of
         Cygwin => "cygwin1.dll"
       | Darwin => "libm.dylib"
       | _ => "libm.so"
   end

val hndl = DynLink.dlopen (dll, DynLink.RTLD_LAZY)

local
   val double_to_double =
      _import * : DynLink.fptr -> real -> real;
   val cos_fptr = DynLink.dlsym (hndl, "cos")
in
   val cos = double_to_double cos_fptr
end

val _ = print (concat ["    Math.cos(2.0) = ", Real.toString (Math.cos 2.0), "\n",
                       "libm.so::cos(2.0) = ", Real.toString (cos 2.0), "\n"])

val _ = DynLink.dlclose hndl

Compile and run iimport.sml.

% mlton -default-ann 'allowFFI true'    \
        -target-link-opt linux -ldl     \
        -target-link-opt solaris -ldl   \
         iimport.sml
% iimport
    Math.cos(2.0) = ~0.416146836547
libm.so::cos(2.0) = ~0.416146836547

This example also shows the -target-link-opt option, which uses the switch when linking only when on the specified platform. Compile with -verbose 1 to see in more detail what’s being passed to gcc.

Download