ceskusecase.js

class Control {
    to(name, rest) {
        return new LetControl(name, this, rest);
    }

    apply(x) {
        return new ApplyControl(this, x);
    }

    map(f) {
        return new ConstControl(f).apply(this);
    }
}

class Node extends Control {
}

class FragmentNode extends Node {
    children;

    constructor(children) {
        super();
        this.children = children;
    }
}

class ElementNode extends Node {
    tag;
    children;

    constructor(tag, children) {
        super();
        this.tag = tag;
        this.children = children;
    }
}
class TextNode extends Node {
    text;

    constructor(text) {
        super();
        this.text = text;
    }
}

class VarControl extends Control {
    name;
    constructor(name) {
        super();
        this.name = name;
    }
}

class LetControl extends Control {
    name;
    value;
    rest;

    constructor(name, value, rest) {
        super();
        this.name = name;
        this.value = value;
        this.rest = rest;
    }
}

class ConstControl extends Control {
    value;

    constructor(value) {
        super();
        this.value = value;
    }
}
class ApplyControl extends Control {
    modify;
    next;

    constructor(modify, next) {
        super();
        this.modify = modify;
        this.next = next;
    }
}

const txt = str => new TextNode(str);
const elm = str => children => new ElementNode(str, children);
const frg = children => new FragmentNode(children);
const vr = name => new VarControl(name);
const konst = value => new ConstControl(value);

class Free {
    bind(f) {
        return bind(this, f);
    }
    step(y) {
        return bind(this, () => y);
    }
    apply(x) {
        return this.bind(fv => x.bind(xv => pure(fv(xv))));
    }
}

class Bind extends Free {
    op;
    next;

    constructor(op, next) {
        super();
        this.op = op;
        this.next = next;
    }
}
class Pure extends Free {
    value;

    constructor(value) {
        super();
        this.value = value;
    }
}

const pure = v => new Pure(v);

function bind(x, f) {
    switch (true) {
    case (x instanceof Pure):
        return f(x.value);
    case (x instanceof Bind): {
        const { op, next } = x;
        return new Bind(op, xv =>
            bind(next(xv), f));
    }
    default:
        throw new Error(`Unknown free monad type ${x}`);
    }
}

class Op {
};

class AskOp extends Op {
}
class PushOp extends Op {
    constructor(name, value) {
        super();
        this.name = name;
        this.value = value;
    }
}
class PopOp extends Op {
}
class PutOp extends Op {
    s;
    constructor(s) {
        super();
        this.s = s;
    }
}
class GetOp extends Op {
}

const prim = op => new Bind(op, pure);

const ask = prim(new AskOp());
const push = (name, value) => prim(new PushOp(name, value));
const pop = prim(new PopOp());
const get = prim(new GetOp());
const put = s => prim(new PutOp(s));

// FIXME compile state monad to CESK machine?
const execute = (t, e = {}, s = {}) => {
    const k = null;
    const es = [];
    while (t instanceof Bind) {
        const { op, next } = t;
        switch (true) {
        case (op instanceof PushOp): {
            const { name, value } = op;
            es.push(e);
            e = { ...e, [name]: value };
            t = next(null);
            continue;
        }
        case (op instanceof PopOp):
            e = es.pop();
            t = next(null);
            continue;
        case (op instanceof AskOp):
            t = next(e);
            continue;
        case (op instanceof GetOp):
            t = next(s);
            continue;
        case (op instanceof PutOp):
            s = op.s;
            t = next(null);
            continue;
        default:
            throw new Error(`Unknown op ${op}`);
        }
    }
    return {v:t.value, e, s};
}

const elm_nil = tag => pure(new ElementNode(tag, []));

const elm_app = (t, h) =>
      t.bind(tv =>
          h.bind(hv =>
              pure(new ElementNode(tv.tag, [...tv.children, hv]))));

const frg_nil = pure(new FragmentNode([]));
const frg_app = (t, h) =>
      t.bind(tv =>
          h.bind(hv =>
              pure(new FragmentNode([...tv.children, hv]))));

function compile(node) {
    switch (true) {
    case (node instanceof TextNode): {
        const { text } = node;
        return pure(new TextNode(text));
    }

    case (node instanceof ElementNode): {
        const { tag, children } = node;

        let result = elm_nil(tag);
        for (const child of children) {
            result = elm_app(result, compile(child));
        }
        return result;
    }

    case (node instanceof FragmentNode): {
        const { children } = node;
        let result = frg_nil;
        for (const child of children) {
            const code = compile(child);
            result = frg_app(code, result);
        }
        return result;
    }

    case (node instanceof ConstControl): {
        const { value } = node;
        return pure(value);
    }

    case (node instanceof ApplyControl): {
        const { modify, next } = node;
        return compile(modify).apply(compile(next));
    }

    case (node instanceof VarControl): {
        const { name } = node;

        return ask.bind(e => pure(e[name]));
    }

    case (node instanceof LetControl): {
        const { name, value, rest } = node;

        const valueC = compile(value);
        const restC = compile(rest);

        return valueC.bind(x =>
            push(name, x)
                .step(
                    restC.bind(y =>
                        pop.step(pure(y)))));
    }

    default:
        throw new Error(`Unknown node type ${node}`);
    }
}

const h1 = elm("h1");

const heading = h1([
    txt("Hello"),
    vr("x").map(x => txt("world " + x))
]);

const e = {
    x: "Molo",
};

console.log(heading);

const code = compile(heading);

console.log(code);

const result = execute(code, e);

console.log(result.v);