lrt-2.js

var assert = require('assert')

/*
  LAM - Lazy Abstract Machine.
  
  It evaluates the tree built from AST descendants lazily.
  No optimization is performed (and minded - it should be done in compile-phase).
  
  Call `run(ast)` to reduce it to Weak-Head Normal Form (go google it).
  
  The language is untyped and funtions aren't autocurried.
  Its meant to be compiled into, run in some places to "supercompile" (lol),
  and the to be converted to JS.
*/

/*
  All descendants of this are meant to run().
  Abstract.
*/
class AST {
  substitute() {
    return this
  }
  
  step() {
    return this
  }
  
  reducible() {
    return false
  }
}

/*
  All descendants of this are meant to run().
  Abstract.
*/
class Var extends AST {
  constructor(name) {
    super()
    assert(name.constructor === String, "var name: not a string - " + name)
    this.name = name
  }
  
  toString() {
    return this.name
  }
  
  substitute(names, things) {
    for (var i = 0; i < names.length; i++) {
      if (names[i] == this.name) {
        return new Substituted(this.name, things[i])
      }
    }
    return this
  }
  
  step() {
    throw Error("undefined valiable: " + this.name)
  }
  
  reducible() {
    return true
  }
}

/*
  So we can use strings instead of vars. Convenient.
*/
String.prototype.reducible = function () {
  return true
}

String.prototype.step = function () {
  return this[0] && this[0] === this[0].toUpperCase() ? new Ctor(this) : new Var(this)
}

String.prototype.substitute = function (names, things) {
  return this.step().substitute(names, things)
}

/*
  This is the result of substituting things into variable.
  It retains the name of var and holds the value.
  
  And the trace log doesn't turn into bloody mess.
*/
class Substituted extends AST {
  constructor(name, value) {
    super()
    assert(name.constructor === String, "subst name: not a string - " + name)
    assert(value instanceof AST,        "subst value: not an AST - " + value)
    Object.assign(this, {name, value})
  }
  
  toString() {
    return this.name + "!"
  }
  
  substitute(names, things) {
    return new Substituted(this.name, this.value.substitute(names, things))
  }
  
  step() {
    return this.value.reducible() ? this.value.step() : this.value
  }
  
  reducible() {
    return true
  }
}

class Const extends AST {
  constructor(c) {
    super()
    this.const = c
  }
  
  toString() {
    return this.const.toString()
  }
}

/*
  Is used to store native/LAM function calls (reducible)
  and ctor-calls (irreducible).
*/
class Call extends AST {
  constructor(f, xs) {
    super()
    //assert(f instanceof AST,              "call f: not an AST - " + f)
    //assert(xs.all(x => x instanceof AST), "call xs: some is not an AST - " + xs)
    this.f  = f
    this.xs = xs
  }
  
  toString() {
    return this.f.toString() + "(" + this.xs.map(x => x.toString()) + ")"
  }
  
  substitute(names, things) {
    return new Call(
      this.f.substitute(names, things),
      this.xs.map(x => {
        console.log({x})
        return x.substitute(names, things)
      })
    )
  }
  
  step() {
    switch (this.f.constructor) {
      case Lambda:
        return this.f.body.substitute(this.f.args, this.xs)
        
      case Native:
        return this.f.fun(this.f.xs)
      
      /* reduce innermost-left redex in the tree */
      case Substituted:
      case Call:
        return new Call(this.f.step(), this.xs)
        
      case Ctor:
        return this
        
      default:
        throw Error("invalid call: " + this.f.toString())
    }
  }
  
  reducible() {
    return this.f.constructor !== Ctor
  }
}

class Ctor extends AST {
  constructor(name) {
    super()
    this.name = name
  }
  
  toString() {
    return "#" + this.name
  }
}

class Lambda extends AST {
  constructor(args, body) {
    super()
    var facts = args.constructor === String? args.split(" ") : args
    //assert(facts.every(fact => fact instanceof String), "fun aargs: some is not a String - " + facts)
    //assert(body instanceof AST, "fun body: not an AST - " + body)
    this.args = facts
    this.body = body
  }
  
  toString() {
    return "(" + this.args + " -> " + this.body.toString() + ")"
  }

  substitute(names, things) {
    let ns  = []
    let ths = []
    
    for (var i = 0; i < names.length; i++) {
      if (!this.args.includes(names[i])) {
        ns .push(names [i])
        ths.push(things[i])
      }
    }
    
    return new Lambda(this.args, this.body.substitute(ns, ths))
  }
}

class Native extends AST {
  constructor(name, fun) {
    super()
    this.name = name
    this.fun  = fun
  }
  
  toString() {
    return "<" + this.name + ">"
  }
}

class Match extends AST {
  constructor(obj, alts) {
    super()
    this.obj  = obj
    this.alts = alts
  }
  
  toString() {
    return "match " + this.obj.toString() + " of {" +
      this.alts.map(alt => alt.toString()).join("") + "}"
  }
  
  substitute(names, things) {
    return new Match(
      this.obj.substitute(names, things),
      this.alts.map(alt => alt.substitute(names, things))
    )  
  }
  
  step() {
    let obj = this.obj
    while (obj.reducible()) {
      obj = obj.step()
    }
    switch (obj.constructor) {
      case Call:
        switch (obj.f.constructor) {
          case Ctor:
            for (var i = 0; i < this.alts.length; i++) {
              if (this.alts[i].tag == obj.f.name) {
                return new Call(this.alts[i].lam, obj.xs)
              }
            }
            throw Error("no alternative matched: " + this.toString())
          default:
            throw Error("cannot match call: " + obj.toString())
        }
      default:
        throw Error("cannot match: " + obj.toString())
    }
  }
  
  reducible() {
    return true
  }
}

class MatchAlt extends AST {
  constructor(tag, lam) {
    super()
    Object.assign(this, {tag, lam})
  }
  
  toString() {
    return "| #" + this.tag + "(" + this.lam.args.toString() + ") => " + this.lam.body.toString()
  }
  
  substitute(names, things) {
    return new MatchAlt(this.tag, this.lam.substitute(names, things))
  }
}

class Let extends AST {
  constructor(decls, rest) {
    super()
    this.decls = decls
    this.rest  = rest
  }
  
  toString() {
    return "let " + this.decls.map(decl => decl.toString()).join("")
      + " in " + this.rest.toString()
  }
  
  substitute(names, things) {
    return new Let(
      this.decls.map(decl => decl.substitute(names, things)),
      this.rest.substitute(names, things)
    )
  }
  
  step() {
    let fields = this.decls.filter(decl => decl.constructor === Field)
    let names  = fields.map(field => field.name)
    let things = fields.map(field => field.value)
    
    return this.rest.substitute(names, things)
  }
  
  reducible() {
    return true
  }
}

class Decl extends AST {}

class Field extends Decl {
  constructor(name, value) {
    super()
    this.name = name
    this.value = value
  }
  
  toString() {
    return "; " + this.name + " = " + this.value.toString()
  }
  
  substitute(names, things) {
    return new Field(
      this.name,
      new Lambda(this.name, this.value)
        .substitute(names, things)
        .body
    )
  }
}

class Extend extends Decl {
  constructor(tag, method, value) {
    super()
    Object.assign(this, {tag, method, value})
  }
  
  toString() {
    return "; extend #" + this.tag + "." + this.method + " = " + this.value.toString()
  }
  
  substitute(names, things) {
    return new Extend(tag, method, value.substitute(names, things))
  }
}

let
  v   = (n)       => new Var(n)
  c   = (c)       => new Const(c)
  app = (f, ...xs)   => new Call(f, xs)
  o   = (tag)     => new Ctor(tag)
  fun = (a, b)    => new Lambda(a, b)
  n   = (n, f)       => new Native(n, f)
  m   = (o, ...ps)   => new Match(o, ps)
  d   = (n, v)    => new Field(n, v)
  e   = (t, m, v) => new Extend(t, m, v)
  may = (d, r)    => new Let(d, r)
  alt = (t, p)    => new MatchAlt(t, p)

let foldr = fun("z op list",
  may(
    [ d("aux", fun("list", m("list",
        alt("Cons", fun("x xs",
          app("op", "x", app("aux", "xs")))),
          
        alt("Nil", fun([],
          "z")))))
    ],
    app("aux", "list")
  ))

let ones = may(
  [ d("ones", app("Cons", c(1), "ones")) ],
  "ones"
)

let ast = may(
  [ d("foldr", foldr) ],
  app("foldr", c(0), n("+", (x, y) => c(x.const + y.const)), app("Cons", c(1), app("Nil")))
)

let indent = (lines) =>
  lines.map(line => "  " + line)

let show = (x) => require('util').inspect(x, {depth: null})

let run = (ast) => {
  console.log(ast.toString())
  while (ast.reducible()) {
    ast = ast.step()
    console.log()  
    console.log(ast.toString())
  }
}

run(ast)