(*
                   A modern optimizing compiler
           for a dynamically typed programming language:
                    Standard ML of New Jersey
                       (preliminary report)

                     Ian Zerny <ian@zerny.dk>
               http://www.zerny.dk/dynamic-ml.html

                   SIGBOVIK, CMU, Pittsburgh
                         April 1, 2012

 The proceedings paper presents Dynamic ML and shows how it
 outperforms existing dynamic languages.

 In this presentation we will look at what Dynamic ML gives us. 
 The subtitle for the talk is:

                Program based Semantic Synthesis:
     write the desired program---derive the needed semantics

 Note to reader:
 This file contains the final result from the SIGBOVIK 2012 talk and
 does not detail the development.  The "desired program"s are at the
 end of the file. They guided the derivation of the "needed
 semantics" in the MySem module below.  So, skip to the end of the
 file to see where things start.

 To compile this file requires an installation of Dynamic ML found
 on the project website: http://www.zerny.dk/dynamic-ml.html

 **************************************************************** *)

(* MySem is the derived "needed semantics" for Dynamic ML. *)
structure MySem = struct

(* helper to decompose a string to a number and its context *)
fun decomp s
  = let fun return (ds, pre, post)
          = (case Num.fromString (implode (rev ds))
              of NONE => NONE
               | SOME n => 
                 SOME (n,
                    fn m => implode (rev pre)
                            ^ Num.toString m ^
                            implode post))
        fun indig ([], ds, str)
            = return (ds, str, [])
          | indig (c :: cs, ds, str)
            = if Char.isDigit c
              then indig (cs, c :: ds, str)
              else return (ds, str, c::cs)
        fun instr ([], str)
            = NONE
          | instr (c :: cs, str)
            = if Char.isDigit c
              then indig (cs, [c], str)
              else instr (cs, c :: str)
    in instr (explode s, [])
    end

(* runtime type coercion to a number *)
fun asNUM d
  = (case d
      of NUM n => n
       | STR s => 
         (case decomp s
           of NONE => DML.asNUM d
            | SOME (n, _) => n)
       | _ => DML.asNUM d)

(* runtime type coercion to a string *)
fun asSTR d
  = (case d
      of NUM n => Num.toString n
       | STR s => s
       | _ => DML.asSTR d)

(* generalized equality *)
fun x == y
  = (case (x, y)
      of (NUM n, _) => BOOL (n = asNUM y)
       | (_, NUM n) => BOOL (n = asNUM x)
       | (STR s, _) => BOOL (s = asSTR y)
       | (_, STR s) => BOOL (s = asSTR x)
       | p => DML.== p)

(* generalized concatenation *)
fun concat (x, y)
  = STR (asSTR x ^ " " ^ asSTR y)

(* generalized subtraction *)
fun x - y
  = (case (x, y)
      of p as (NUM n, STR s)
         => (case decomp s
              of NONE => raise TYPE_CAST_ERROR
               | SOME (m, k) => STR (k (Num.- (n, m))))
       | p as (STR s, NUM n)
         => (case decomp s
              of NONE => raise TYPE_CAST_ERROR
               | SOME (m, k) => STR (k (Num.- (m, n))))
       | p
         => raise TYPE_CAST_ERROR)

(* generalized addition *)
fun x + y
  = (case (x, y)
      of p as (NUM x, NUM y)
         => DML.+ p
       | p as (STR s, NUM n)
         => (case decomp s
              of NONE => concat p
               | SOME (m, k) => STR (k (Num.+ (m, n))))
       | p as (NUM n, STR s)
         => (case decomp s
              of NONE => concat p
               | SOME (m, k) => STR (k (Num.+ (n, m))))
       | p as (STR s1, STR s2)
         => (case (decomp s1, decomp s2)
              of (SOME (n1, k1), SOME (n2, k2))
                 => STR (k1 (Num.+ (n1, n2)))
               | _
                 => concat p)
       | p
         => concat p)
end

(* ************************************************************** *)

local open MySem in

(* Our motivating programs:
   The intended results should be self explanatory *)
val s1 = STR "I've got"
val s2 = STR "trombones"
val s3 = s1 + s2
val s4 = s1 + NUM 10
val s5 = s4 + NUM 1
val s6 = STR "10" + NUM 1
val s7 = STR "I've got 10 trombones" + NUM 1
val s8 = STR "I've got 10 trombones" + NUM ~1
val s9 = STR "I've got 10 trombones" + STR "I've got 1 trombone"

(* The Fibonacci function from the paper *)
FUN fib[x] =
    IF x == NUM 0
    THEN x
    ELSE IF x == NUM 1
         THEN x
         ELSE fib$[x - NUM 1] + fib$[x - NUM 2]
NUF

(* Our semantics does indeed make sense! *)
val profit = fib$[STR "I've got 10 trombones"]

end