Untyped implementation of sequental and parallel composition on stack machine.

seqpar.js

// append elem to list with number of the list cell - 'time'
var Push = (head, tail) => ({head, tail, time: ++Push.time})
Push.time = 0

// this is the empty list - append to it or other list only
var Empty = {empty: true}

// flip(f) is 'f' but with args swapped
var flip = (f) => (x, y) => f(y, x)

// List(1,2,3) === Push(1, Push(2, Push(3, Empty)))
var List = (...elems) => Prepend(...elems, Empty)

// add some elements to the list
var Prepend = (...things) => {
  var tail = things.pop()
  return things.reduceRight(flip(Push), tail)
}

// from accum and x-to-accum-reducer make whole-list-reducer
// NON STACK-SAFE
var reduce_list = (zero, add) =>
  function aux (list) {
    if (list.empty) {
      return zero
    } else {
      return add(nn(list.head), aux(nn(list.tail)))
    }
  }

// list -> string
// NON STACK-SAFE
var show_list = reduce_list('[]', (x, xs) => x + ' :: ' + xs)

var print_list = (list) => console.log(show_list(list))

// list -> {before: [...n top elems], after: list without n top elems}
var splitAt = (n, list) => {
  var acc = []
  for (var i = list; n > 0 && !list.empty; i = nn(i.tail)) {
    acc.push(nn(i.head))
    n--
  }
  return {before: acc, after: i}
}

// die if x is undefined
// TODO: place an 'assert' here
var nn = (x) => {
  if (x === undefined) {
    throw Error('undefined')
  }
  return x
}

// given old list and new list, find how deep the common part is in a new list
var bedrockDepth = (was, now) => {
  var last = was.empty ? 0 : nn(was.time)
  var depth = 0
  for (var i = now; !i.empty && nn(i.time) > last; i = nn(i.tail)) {
    depth++
  }
  return depth
}

var apply = (f, x) => f(x)

// apply funcs in sequence
var seq = (...fs) => (list) => fs.reduce(flip(apply), list)

// apply funcs in 'parallel'
// in par(f, g, h) the 'f' will be applied at top
var par = (...fs) => (list) => {
  var blocks = []
  var i = list
  fs.forEach(f => {
    var newi = f(i)
    var depth = bedrockDepth(i, newi)
    var {before, after} = splitAt(depth, newi)
    blocks.unshift(before)
    i = after
  })
  return blocks.reduce((j, block) => block.reduceRight(flip(Push), j), i)
}

var push = (x) => (xs) => Push(x, xs)

var swap = (list) => {
  var {before: [a, b], after} = splitAt(2, list)
  return Prepend(b, a, after)
}

var drop = (list) => {
  return nn(list.tail)
}

// dup touches the duplicated element, too! so its a (1 -> 2) func
var dup = (list) => {
  var {before: [a], after} = splitAt(1, list)
  return Prepend(a, a, after)
}

// must update the list!
var id = (n) => (list) => {
  var {before, after} = splitAt(n, list)
  return Prepend(...before, after)
}

var ival = (list) => {
  var {before: [box], after} = splitAt(1, list)
  var f = nn(box.unbox)
  return f(after)
}

var Box = (item) => ({unbox: item})

var binOp = (op) => (list) => {
  var {before: [a, b], after} = splitAt(2, list)
  return Prepend({
    '+': a + b,
    '-': b - 1,
    '*': a * b,
    '/': b / a,
    '>': a > b,
    '>=': a >= b,
    '<': a < b,
    '<=': a <= b,
    '=': a == b,
    '/=': a != b,
  }[op], after)
}

var bool = (x) => {
  nn(x)
  if (x === true || x === false) {
    return x
  }
  throw Error('non-boolean')
}

// rec :: (_ -> bool _) _ -> _
var rec = (f) => (list) => {
  for (var i = f(list); bool(i.head) == true; i = f(nn(i.tail)));
  return nn(i.tail)
}

var dump = (label) => (list) => {
  console.log(label, show_list(list))
  return list
}

module.exports = {
  List: {Push, Empty, of: List, reduce_list, show_list, splitAt, bedrockDepth},
  Prelude: {flip, apply, nn},
  SeqPar: {seq, par, Functions: {push, swap, drop, id}}
}

var test = par    (dup, swap,                              ival, dup, drop)
var list = Prepend(1,   2, 3, Box(seq(dup, push(42))), List(4,   5,   6))

print_list(list)
print_list(test(list))

var powerOf2 = seq
  ( par(id(1), push(1))
  , rec
    ( par
      ( seq(push(1), binOp('-'), dup, push(0), binOp('/='))
      , seq(dup, binOp('+'))
      )
    )
  , drop
  )
var list = List(10)

print_list(list)
print_list(powerOf2(list))

var list = List(10)

/*
  fac = (id1; 1) [dup dup (0 /=; 1 -; *)] rec drop
*/

var over_one = seq(push(1), binOp('<'))
var dec      = seq(push(1), binOp('-'))

var fac = seq
  ( par(id(1), push(1))
  , rec(seq(dup, dup, dump('before par:'), par(over_one, dec, binOp('*'))))
  , drop
  )

print_list(list)
print_list(fac(list))