Defunctionalization Subtractorial

subtratorial.sml

(* direct style *)
fun substractorial n =
    if n < 0 
    then 0
    else n - substractorial (n-1)

(*  Continuation passing style *)
(*  In a functional language, when every branch is a "tail call", it optimizes to a jumps *)
(*     this could already be turned into a loop pretty easily,
       but in a non functional language would cause a stack overflow on the final call to the accumulated cont
*)
(*  -call-> subtractorial n 
    -jump-> loop n      done  (* where n=N[] *)
    ...
    -jump-> loop (N[i]) (C[i])  (* if we mathematically think of N[i] as all possible values of n at iteration i
                                   this step will induce transitions from (N[i],C[i]) -> (N[i+1], C[i+1])
                                   until we reach the base case
                              *)
    -jump-> loop x C[last]  (* where x < 0, base case *)
    -jump-> C[last] 0
    ...
    -jump-> C[last-j] R[j]
    ... 
    -jump-> C[0] return_value (* where C[0] == done *)
    = return_value
*)
fun substractorial n = loop n done
and loop n cont =
    if n < 0 
    then cont 0 
    else loop (n-1) (sub n cont)
and done x = x
and sub lhs cont ret = cont ( lhs - ret )

(*  Defunctionalized style *)
(*  In defunctionalized style we still do tail calls, 
      but we turn the building and reducing of the accumulated continuation into an explicit data stack.
      The stack is implemented as a linked list, but only for simpicity. A contiguous stack would likely perform better.
      To call our continuation, we then have a separate function apply that calls our continuation with
    ```
    apply cont n
    ```
    At this point it should be clear how to turn this into a stack safe loop.
*)
datatype Cont = DONE 
              | SUB of {lhs : int, cont : Cont }

fun substractorial n = loop n DONE
and loop n cont =
    if n < 0 
    then (apply cont) 0
    else loop (n-1) (SUB {lhs = n, cont = cont})
and apply DONE              n = n
  | apply (SUB {lhs, cont}) n = apply cont (lhs - n)


(*  State machine style *)
(*  The defunctionalized version has separated state from execution, but it is still "self propelling"
      If we turn our code paths into datatypes,
      we eventually get to the point where the whole program state can be described as data.
    
    Once we have the whole program as data, it becomes clear that it is now possible to advance 
    the program one `atomic` step at a time.

    We can now do "time travel" on the program, simply by advancing with step, or saving and reloading previous states.
      Concurrent programming becomes possible.

    It also becomes possible to serialize program state.
    If we allow ourselves to modify the program state from outside, 
      Creating custom exception handling becomes possible,
      Backtracking becomes possible,
      Custom debugging becomes possible.

    There is one more step that can be done past this, but is much more involved,
    turning the step function into data itself.
    That would require either implementing a VM and targeting it, or making native code...
*)
datatype Cont = DONE 
              | SUB  of {lhs : int, cont : Cont }

datatype State = LOOP     of {n    : int , cont : Cont} 
               | APPLY    of {func : Cont, arg  : int }
               | COMPLETE of int

fun init n = LOOP {n=n, cont = DONE}
fun step (LOOP  {n           , cont}) = if n < 0 
                                   then APPLY    {func = cont   , arg  = 0                       }
                                   else LOOP     {n    = n-1    , cont = SUB {lhs = n, cont=cont}} 
  | step (APPLY {func = SUB s, arg }) = APPLY    {func = #cont s, arg  = #lhs s - arg            }
  | step (APPLY {func = DONE , arg }) = COMPLETE arg
  | step (c as COMPLETE _)            = c

(* trace is a function that get a view of the state at any point and can do side effects such as 
     pause the program, print the current state, and reload, or generate new states  *)
fun substractorial n trace trace_state =
  let fun run ((COMPLETE v), _ ) = v 
        | run (s           , ts) = run (trace ts s)
  in
    run (init n, trace_state)
  end