Lazy Abstract Machine

lam.js

/*
  This is a Lazy Abstract Machine (LAM).
  
  This code is meant to be glued before output of the compilator
    (or `let {Node, func, call, etc...} = require('runtime.js')`)
  - it depends on how will I implement a compiler.
  
  It allows representing lazy programs for the lazy language with:
  1) Push { elem: 1, to: Empty }                         - Algebraic datatypes
  2) ones = Push { elem: 1, to: ones }                   - Recursive values
  3) match ones with { | Push { elem: x, to: xs } => x } - Pattern matches
  4) let x = Push { elem: 1, to: y }
       ; y = Push { elem: 2, to: x }
     in  x                                               - Mutually recursive lets
  
  It is call-by-need, so in...

  > let
  >   ; sqr(x) = mult(x, x)
  > in sqr(add(2, 3))
  
  "add" will be evaluated only once.
  
  Minute of theoretical humor:
    And of course, the implementation contains half of buggy and slow implementation
    of Stateless Tagless G-machine (STG).
*/

/*
  I understand why this shit is hidden. But I need this shit.
*/
let show = (x) => require('util').inspect(x, {depth: null})

/*
  So, everything is a value. And values are represented by lazy nodes.
  
  Node has 2 things in it:
  1) r[esult]: if its here - and it isn't another Node - it will be returned
     as value().
     
     If it is a Node, it will be rewritten to that Node value()
     
     If its not there (=== undefined),
     it means that Node haven't been evaluated yet.
     
  2) t[hunk] - this is a function (() => result).
     It will be called iff r[esult] === undefined.
*/
class Node {
  /*
    Just because I hate operator "new". This method exists only because of that.
  */
  static of(r, t) {
    return new Node(r, t)
  }
  
  constructor(r, t) {
    Object.assign(this, {r, t})
  }
  
  /*
    "Force" the node to evaluate, if it haven't been evaluated yet.
  */
  value() {
    /*
      It was recursive before, but now its a plain cycle.
    */
    while (this.r === undefined || this.r instanceof Node) {
      /*
        Current node was not evaluated - so lets do it.
      */
      if (this.r === undefined) {
        this.r = this.t() // the update seems to touch another node here
                          // and I'm fine with it doing so!
        continue
      }
    
      /*
        Current node was evaluated to another node - squash it.

        NOTE for future me or anybody touching this:
          This SEEMS to update the node we're pointing at.
          I think, that because we reference its "r" and "t".
          
          But the matters are thin. Don't touch this lines.
          It works by black magic and I'm happy it does so.
          
          AND DON'T CHANGE THE ORDER OF LINES!
      */
      this.t = this.r.t
      this.r = this.r.r
    }
        
    return this.r
  }
}

let immediate = (x) => Node.of(x)
let thunk     = (t) => Node.of(undefined, t)

/*
  Functions are constants. When function is called, it can produce fresh,
  unevaluated nodes again.
  
  If some of the nodes inside the function SHOULD NOT be evaluated multiple times
  (constant expr independent of the function arguments), they should be extracted
  to the outside of the function. So
  
  > addCrap(a) = foo * bar + a
  
  will become
  
  > addCrap =
  >   let
  >     ; __freshVar_42 = foo * bar
  >   in (a) -> __freshVar_42 * a
  
  The let-expression is an unevaluated (yet) node, so it will make it only force
  (foo * bar) once.
  
  This optimisation should be authomatically done by compiler.
*/
let func = immediate

/*
  Lazy call node. It links to function and argument nodes -
  - params are references to them.
*/
let call = (f, ...xs) => thunk(() => {
  let func = f.value()

  if (! (func instanceof Function)) {
    throw Error("call: calling non-function - " + show(f))
  }

  return func(...xs)
})

/*
  An "object" in the language I want to compile from.
  It has a tag (a name, in fact) and some named fields.
  
  TL;DR: This is for testing purposes only.
  
  Its costly to create that way, mapping through args. When doing the compiler,
  I would rather compile ctor _definitions_ like
  
  > constructor Push { elem, to }
  
  in
  
  > class Push extends Record { }
  
    (where Record is declared like
    
    > class Record {
    >   constructor(delta) {
    >     Object.assign(this, delta)
    >   }
    > }
    
    )
  
  and then create object of that type
  
  > let x = Push { elem: 1, to: other-list }
  
  liek this
  
  > var x = thunk(() => new Push({elem: 1, to: other_list}))
*/
let ctor = (tag, ...args) => {
  return func((...facts) => {
    if (args.length != facts.length) {
      throw Error("ctor " + tag + " - argument count mismatch: expected (" + args + "), got (" + facts + ")")
    }

    return Object.assign({tag}, ...args.map((arg, i) => ({[arg]: facts[i]})))
  })
}

/*
  Pattern-matcher. Very basic - it allows to determine only the outermost record
  subtype. All the
  
  > case list of
  > | Push(Just(1), xs) -> ...
  
  will be done through ifs (== 1?) inside matcher (Just?) inside matcher (Push?).
*/
let match = (o, pats) => thunk(() => {
  let ov = o.value()
  /*
    TODO: Change the check to (! (ov instanceof Record))
  */
  if (! (ov.tag))
    throw Error("Matching non-ADT construct, but: " + o.value())

  /*
    TODO: Change this shit, too. Compiler will be able to infer field names,
          positions and other stuff by itself.
          
          And also, it shoud differentiate by ".constructor", not by ".tag".
  */
  let [fields, fun] = pats[o.value().tag || "*"]

  /*
    MAYBE I will rewrite this to a cycle (if the JS optimizer won't).
  */  
  let values = fields.map(field => {
    let val = ov[field]

    if (val === undefined) {
      throw Error("this ADT construct doesn't have a `" + field + "`:" + show(ov))
    }

    return val
  })
  
  return call(fun, ...values)
})

/*
  VERY important thing I almost forgot.
  
  It is a node that on evaluation forces all the nodes from the list
  to evaluate and returns the last one.
*/
let sequence = (...nodes) => thunk(() => {
  if (!nodes.length === 0) {
    throw Error("sequence of zero elements is unallowed (hint: what should it return, huh?)")
  }
  // I hope, its the most concise (and cryptic!) way to implement this!
  return nodes.reduce((_, node) => node.value())
})

let Int = ctor("Int", "getInt")
let Nat = ctor("Nat", "getNat")

let Cons = ctor("Cons", "head", "tail")
let Nil  = ctor("Nil")

// "elevens", lol
var ones = thunk(() => call(Cons, call(Int, 11), ones))

let one = call(Int, 1)
let two = call(Int, 2)

let add = func((x, y) => {
  // We're calling Array.prototype.forEach for each addition! Oh, no!
  // But, you know, shit happens and the more elaborate the message is the better.
  [x, y].forEach(arg => {
    if (! (arg instanceof Node)) {
      throw Error("non-Node argument: " + show(arg))
    }
  })
  console.log("ADDING", x.value(), y.value())
  return call(Int, x.value().getInt + y.value().getInt)
})

let sub = func((x, y) => {
  [x, y].forEach(arg => {
    if (! (arg instanceof Node)) {
      throw Error("non-Node argument: " + show(arg))
    }
  })
  let xv = x.value(), yv = y.value()
  return call(Int, x.value().getInt - y.value().getInt)
})

let sqr = func((x) => {
  return call(Int, x.value().getInt * x.value().getInt)
})

// This code is used to test.

let test = match(ones, {
  "Cons": [["head", "tail"], func((h, t) => call(add, h, call(Int, 1)))]
})

let take = func((n, list) => match(n, {
  "Int": [["getInt"], func((rawn) => {
    if (rawn === 0) {
      return call(Nil)
    } else {
      return match(list, {
        "Nil": [[], func(() => call(Nil))],
        "Cons": [["head", "tail"], func((h, t) => {
          return call(Cons, h, call(take, call(sub, n, one), t))
        })]
      })
    }
  })]
}))

let foldl = func((z, op) => {
  var aux = func(list => match(list, {
    "Cons": [["head", "tail"], func((h, t) =>
      call(op, h, call(aux, t)))
    ],
    "Nil": [[], func(() => z)]
  }))
  return aux
})

let zero = call(Int, 0)

let five = call(call(foldl, zero, add), call(take, call(Int, 5), ones))

let three = call(add, one, two)
let four  = call(add, one, three)
let xteen = call(sqr, four)
let tty   = call(add, four, xteen)

let addCrap = func((a) => call(add, call(add, xteen, four), a))
let addCrapLet = thunk(() => {
  var __freshVar_42 = call(add, xteen, four)
  return func((a) => call(add, __freshVar_42, a))
})

let test1 = call(addCrap, call(Int, 1))
let test2 = call(addCrap, call(Int, 2))

let test3 = call(addCrapLet, call(Int, 3))
let test4 = call(addCrapLet, call(Int, 4))

console.log("---")
console.log(five.value())
console.log("---")
test1.value()
test2.value()
console.log("---")
test3.value()
test4.value()

let i    = call(Int, 1)
let ii   = call(add, i, i)
let iii  = call(add, i, ii)
let iiii = call(add, i, iii)
let what = call(Nat, 42)

console.log(sequence(i, ii, iii, what).value())