runtime.js

let assert = require('assert')
let util   = require('util')

let defined    = value =>   value !== undefined
let notDefined = value =>   value === undefined
let not        = value => ! value

let log        = console.log
let say        = (msg, value) => (log(msg), value)

let inc        = x => 1 + (x|0)

/*
 * The program is graph, where the expressions are Vertices.
 *
 * Evaluation of program is reduction of such graph to a value.
 */
class Vertex {
	constructor(value, lazy) {
		assert(not(defined(value) && defined(lazy)),
			"value and thunk cannot be defined simultaneously" +
			`{value: ${value}, lazy: ${lazy}`)
		assert(not(notDefined(value) && notDefined(lazy)),
			"value and thunk cannot be undefined simultaneously")

		Vertex.created = inc(Vertex.created)

		Object.assign(this, {value, lazy})
	}

	/*
	 * Here we evaluate program while we hold a Vertex in our hands.
	 */
	getValue() {
		while(true) {
			if (defined(this.value) && not (this.value instanceof Vertex)) {
				break
			}
			if (notDefined(this.value)) {
				this.value = this.lazy()
			}
			if (this.value instanceof Vertex) {
				Object.assign(this, this.value)
			}

			Vertex.reductions = inc(Vertex.reductions)
		}
		return this.value
	}

	/*
	 * Apply a Vertex with fuction to bunch of Vertices with arguments strictly.
	 */
	strictAp(...others) {
		let f = this.getValue()
		
		assert(f instanceof Function,     `${f} is not a function`)
		assert(others.length == f.length, `${f} requires ${f.length} params, but given ${others.length}`)
		
		return just(f(...others.map(whnf)))
	}

	/*
	 * Apply a Vertex with fuction to bunch of Vertices with arguments lazily.
	 */
	ap(...others) {
		let f = this.getValue()
		
		assert(f instanceof Function,     `${f} is not a function`)
		assert(others.length == f.length, `${f} requires ${f.length} params, but given ${others.length}`)
		
		return later(() => f(...others))
	}

	/*
	 * Ok, _now_ console.log print what _I_ need.
	 */
	[util.inspect.custom]() {
		let {value, lazy} = this
		
		if (defined(value)) {
			return `just(${util.inspect(value)})`
		} else {
			return `later(${lazy})`
		}
	}
}

/*
 * If Vertex, reduce to a value.
 */
let whnf = val => val instanceof Vertex? val.getValue() : val

/*
 * If Vertex, reduce to a value.
 */
let apply = (f, ...xs) => whnf(f.ap(...xs))

/*
 * Construct Vertex from already existing value.
 */
let just  = x => new Vertex(x)

/*
 * Construct Vertex from delayed value, which is `() => value`.
 */
let later = t => new Vertex(undefined, t)

/*
 * Declare abstract type.
 */
let makeType = (name) => eval(`
	function ${name} () {}
	${name}
`)

/*
 * Declare concrete child of abstract type.
 *
 * I hate that classes could only be called with `new`, thats why its done via `function`.
 *
 * After the `let X = makeConstructor` expression `X` cam be used as
 *  `X(...)` to construct objects, and as `x.constructor == X`.
 */
let makeConstructor = (name, type, ...fields) => {
	let generator = eval(`
		ty => {
			let ctor = function ${name} (${fields}) {
				if (new.target) {
					Object.assign(this, {${fields}})
				} else {
					return new ${name}(${fields})
				}
			}
			let proto = new ty()
			ctor.prototype = proto
			ctor.prototype.constructor = ctor
			return ctor
		}
	`)
	return generator(type)
}

/*
 * Create:
 *  - abstract class List;
 *  - case class Push(head, tail) extends List;
 *  - case class Empty()          extends List.
 */
let List  = makeType("List")
let Push  = makeConstructor("Push",  List, "head", "tail")
let Empty = makeConstructor("Empty", List)

/*
 * Its just a `Push(1, Empty)`.
 */
let list = just(Push).ap(later(() => 1), just(Empty).ap())

/*
 * Its an infinite list of `1`s: `ones = Push(1, ones)`.
 */
let ones = Push(just(1), later(() => ones))

/*
 * This is how compiled functions will look like.
 *
 * this is a compilation of
 * ```
 * show-list(show-elem) = loop
 *   where
 *     loop(list) = case list {
 *       | Push(x, xs) ? show-elem(x) <> " :: " <> loop(xs)
 *       | Empty       ? "[]"
 *     }
 * ```
 */
let reduce_list = just((zero, plus) => {
	let loop = just((list) => {
		let l = whnf(list)
		switch (l.constructor) {
		case Push:
			return plus.ap(l.head, later(() => apply(loop, l.tail)))
		case Empty:
			return zero
		default:
			assert(false, "list required")
		}
	})
	return loop
})

let bool_true = x => {
	switch (x) {
	case true:
		return true
	case false:
		return false
	default:
		assert(false, "boolean required")
	}
}

/*
	take-while (pred) = reduce(
		Empty,
		\(x, xs) -> if
			| pred(x) ? Push(x, xs)
			| else    ? Empty
	)
*/
let take_while = just(pred =>
	apply(reduce_list,
		Empty(),
		just((x, xs) => bool_true(whnf(pred.ap(x))) ? Push(x, xs) : Empty())
	)
)

/*
	show-list (show-elem) = reduce(
		"[]",
		\(x, xs) -> x <> " :: " <> xs
	)
*/
let show_list = just(show_elem =>
	apply(reduce_list,
		"[]",
		just((x, y) =>
			apply(show_elem, x) + " :: " + whnf(y)
		)
	)
)

/*
	map-list (f) = reduce(
		Empty,
		\(x, xs) -> f(x) Push xs
	)
*/
let map_list    = just(f => 
	reduce_list
		.ap(Empty(), just((x, xs) => Push(f.ap(x), xs)))
)

/*
	map-list (f) = reduce(
		0,
		\(x, xs) -> 1 + xs
	)
*/
let length_list = reduce_list.ap(0, just((x, xs) => 1 + whnf(xs)))

/*
	nats = Push(1, nats map(-> it + 1))
*/
let nats = Push(0,
	later(() =>
		map_list
			.ap(just(x => whnf(x) + 1))
			.ap(nats)
	)
)

/*
 * Checking that Vertex is logged correctly.
 */
log(nats)

/*
	ten = take-while(-> it < 10)(nats)
*/
let ten = take_while.ap(just(x => whnf(x) < 1000)).ap(nats)

log(show_list
	.ap(just(x => `${whnf(x)}`))
	.ap(ten)
	.getValue())

log("l = ", whnf(length_list.ap(ten)), ";")