Simple model of the Julia language in Standard ML via dynamic classification

julia.sml

signature OBJECT =
  sig
    type 'a tag
    type t

    val Bool : bool tag
    and Int : int tag
    and String : string tag

    val toString : t -> string

    val new : unit -> t list tag
    (* new () = T:
      julia> struct T ... end *)
    and make : 'a tag -> 'a -> t
    (* make T x:
      julia> T(x) *)

    (* register (T, [T1, T2, ..., Tn]) method:
      julia> (f::T)(x1::T1, x2::T2, ..., xn::Tn) = method(f, [x1, x2, ..., xn]) *)
    val register : 'a tag * 'b tag list -> ('a * 'b list -> t) -> unit
    (* register (typeof(f), [T1, T2, ..., Tn]) method:
      julia> (_::typeof(f))(x1::T1, x2::T2, ..., xn::Tn) = method([x1, x2, ..., xn])
        i.e.,
      julia> f(x1::T1, x2::T2, ..., xn::Tn) = method([x1, x2, ..., xn]) *)
    and register' : 'a tag * 'b tag list -> ('b list -> t) -> unit

    exception MethodError of string
    (* apply (f, args)
      julia> f(args) *)
    val apply : t * t list -> t
  end

structure Object :> OBJECT =
  struct
    structure Key =
      struct
        type t = int
        val compare = Int.compare
      end

    type 'a tag = { tag : 'a Universal.tag, key : Key.t }
    type t = { obj : Universal.universal, key : Key.t }

    local
      val counter : Key.t ref = ref 0
    in
      val new = fn () =>
        { tag = Universal.tag (), key = !counter } before Ref.modify (fn i => i + 1) counter
    end

    val Bool : bool tag = new ()
    and Int : int tag = new ()
    and String : string tag = new ()

    val toString = fn { obj = universal, ... } : t =>
      if Universal.tagIs (#tag Bool  ) universal then Bool  .toString (Universal.tagProject (#tag Bool  ) universal) else
      if Universal.tagIs (#tag Int   ) universal then Int   .toString (Universal.tagProject (#tag Int   ) universal) else
      if Universal.tagIs (#tag String) universal then String.toString (Universal.tagProject (#tag String) universal) else
      raise Fail "currently, can only toString built-in classes"

    val make = fn tag : 'a tag => fn x =>
      { obj = Universal.tagInject (#tag tag) x, key = #key tag }

    local
      structure Map =
        RedBlackMapFn (
          type ord_key = Key.t
          val compare = Int.compare
        )

      structure MapN =
        RedBlackMapFn (
          type ord_key = Key.t list

          (* lexicographic comparison on lists of keys *)
          fun compare ([]     , []     ) = EQUAL
            | compare ([]     , _ :: _ ) = LESS
            | compare (_ :: _ , []     ) = GREATER
            | compare (x :: xs, y :: ys) = (
                case Int.compare (x, y) of
                  EQUAL => compare (xs, ys)
                | order => order
              )
        )

      val registry : (Universal.universal * Universal.universal list -> t) MapN.map Map.map ref = ref Map.empty
    in
      exception MethodError of string

      val register = fn (f_tag, arg_tags) : 'a tag * 'b tag list => fn method =>
        Ref.modify
          (fn registry =>
            let
              val method_table =
                case Map.find (registry, #key f_tag) of
                  NONE              => MapN.empty
                | SOME method_table => method_table
              val method_table =
                MapN.insert (method_table, List.map #key arg_tags,
                  fn (f_obj, arg_objs) =>
                    method (
                      Universal.tagProject (#tag f_tag) f_obj,
                      ListPair.mapEq (fn (x_tag, x_obj) => Universal.tagProject (#tag x_tag) x_obj) (arg_tags, arg_objs)
                    )
                )
            in
              Map.insert (registry, #key f_tag, method_table)
            end
          )
          registry

      val apply = fn (f_obj, arg_objs) : t * t list =>
        case Map.find (!registry, (#key f_obj)) of
          NONE              => raise MethodError "objects of the given type are not callable"
        | SOME method_table => (
            case MapN.find (method_table, List.map #key arg_objs) of
              NONE        => raise MethodError "no method matching given argument type"
            | SOME method => method (#obj f_obj, List.map #obj arg_objs)
          )
    end

    val register' = fn (f_obj, x_obj) => fn method => register (f_obj, x_obj) (fn (_, x) => method x)
  end


(* --- declaration of square function --- *)
(* julia> function square end *)
val typeof_square = Object.new ()
val square = Object.make typeof_square []

(* julia> square(n::Int) = Base.mul_int(n, n) *)
val () =
  Object.register' (typeof_square, [Object.Int])
    (fn [n] => Object.make Object.Int (Int.* (n, n)))
val "9" = Object.toString (Object.apply (square, [Object.make Object.Int 3]))

(* --- declaration of show function, using multiple dispatch --- *)
(* julia> function show end *)
val typeof_show = Object.new ()
val show = Object.make typeof_show []

(* julia> show(b::Bool) = ... *)
val () =
  Object.register' (typeof_show, [Object.Bool])
    (fn [b] => Object.make Object.String (Bool.toString b))
(* julia> show(n::Int) = ... *)
val () =
  Object.register' (typeof_show, [Object.Int])
    (fn [n] => Object.make Object.String (Int.toString n))
(* julia> show(s::String) = ... *)
val () =
  Object.register' (typeof_show, [Object.String])
    (fn [s] => Object.make Object.String (String.toString s))

(* --- declaration of a new Coord type --- *)
(* julia> struct Coord ... end *)
val Coord = Object.new ()
(* julia> point = Coord(3, 4) *)
val point =
  Object.make Coord
    [Object.make Object.Int 3, Object.make Object.Int 4]

(* julia> show(s1::String, s2::String) = "($s1, $s2)" *)
val () =
  Object.register' (typeof_show, [Object.String, Object.String])
    (fn [s1, s2] => Object.make Object.String ("(" ^ s1 ^ ", " ^ s2 ^ ")"))

(* julia> show(c::Coord) = show(show(c.x), show(c.y)) *)
val () =
  Object.register' (typeof_show, [Coord])
    (fn [[x, y]] => Object.apply (show, [Object.apply (show, [x]), Object.apply (show, [y])]))

(* julia> show(42) *)
val "42" = Object.toString (Object.apply (show, [Object.make Object.Int 42]))
(* julia> show(point) *)
val "(3, 4)" = Object.toString (Object.apply (show, [point]))