Custom engine
This commit is contained in:
@@ -1,82 +1,58 @@
|
||||
import { L, _, fromNative as __, cnst, id, pipe } from './core';
|
||||
import { Bool, iif } from './bool';
|
||||
import { Num, Zero, ge, ifz, pred, succ } from './num';
|
||||
import { _, cnst, g, id, l, m, pipe, r } from './core';
|
||||
import { iif } from './bool';
|
||||
import { Zero, ge, ifz, pred, succ } from './num';
|
||||
import { x00 } from './byte';
|
||||
import { Char, fromChar as _c, dec as cdec, inc as cinc, eq, ifn } from './char';
|
||||
import { fromChar as _c, dec as cdec, inc as cinc, eq, ifn } from './char';
|
||||
import { Pair, first, fst, second, snd, uncurry } from './pair';
|
||||
import { List, cons, head, repeat, set, singleton, tail, update } from './list';
|
||||
import { Empty, String, get, len, snoc } from './string';
|
||||
import { cons, head, repeat, set, singleton, tail, update } from './list';
|
||||
import { Empty, get, len, snoc } from './string';
|
||||
|
||||
type Program = Pair<List<Num>, String>;
|
||||
m('bf');
|
||||
|
||||
type Tape = Pair<Num, List<Char>>;
|
||||
const done = g('done', uncurry._(l('p', cnst._(uncurry._(l('is', l('cs', ge._(head._('is'))._(len._('cs')))))._('p')))));
|
||||
|
||||
type IO = Pair<String, String>;
|
||||
const command = g('command', l('c', uncurry._(l('p', cnst._(eq._('c')._(uncurry._(pipe._(get)._(head))._('p')))))));
|
||||
|
||||
type State = Pair<Program, Pair<Tape, IO>>;
|
||||
const advance = g('advance', first._(first._(update._(succ)._(Zero))));
|
||||
|
||||
const done: L<(s: State) => Bool>
|
||||
= uncurry(_(p => cnst(uncurry(_(is => _(cs => ge(head(is))(len(cs)))))(p))));
|
||||
const save = g('save', first._(first._(l('is', cons._(head._('is'))._('is')))));
|
||||
|
||||
const command: L<(c: String) => L<(s: State) => Bool>>
|
||||
= _(c => uncurry(_(p => cnst(eq(c)(uncurry(pipe(get)(head))(p))))));
|
||||
const restore = g('restore', first._(first._(tail)));
|
||||
|
||||
const advance: L<(s: State) => State>
|
||||
= first(first(update(succ)(Zero)));
|
||||
const reset = g('reset', first._(first._(l('is', cons._(head._('is'))._(tail._(tail._('is')))))));
|
||||
|
||||
const save: L<(s: State) => State>
|
||||
= first(first(_(is => cons(head(is))(is))));
|
||||
const inc = g('inc', second._(first._(l('t', second._(update._(cinc)._(fst._('t')))._('t')))));
|
||||
|
||||
const restore: L<(s: State) => State>
|
||||
= first(first(tail));
|
||||
const dec = g('dec', second._(first._(l('t', second._(update._(cdec)._(fst._('t')))._('t')))));
|
||||
|
||||
const reset: L<(s: State) => State>
|
||||
= first(first(_(is => cons(head(is))(tail(tail(is))))));
|
||||
const read = g('read', pipe._(pipe._(uncurry._(get))._(fst))._(snd));
|
||||
|
||||
const inc: L<(t: State) => State>
|
||||
= second(first(_(t => second(update(cinc)(fst(t)))(t))));
|
||||
const input = g('input', second._(uncurry._(l('t', l('io', Pair._(second._(set._(head._(fst._('io')))._(fst._('t')))._('t'))._(first._(tail)._('io')))))));
|
||||
|
||||
const dec: L<(t: State) => State>
|
||||
= second(first(_(t => second(update(cdec)(fst(t)))(t))));
|
||||
const output = g('output', second._(uncurry._(l('t', pipe._(Pair._('t'))._(second._(l('os', snoc._('os')._(uncurry._(get)._('t')))))))));
|
||||
|
||||
const read: L<(s: State) => Char>
|
||||
= pipe(pipe(uncurry(get))(fst))(snd);
|
||||
const next = g('next', second._(first._(first._(succ))));
|
||||
|
||||
const input: L<(s: State) => State>
|
||||
= second(uncurry(_(t => _(io => Pair(second(set(head(fst(io)))(fst(t)))(t))(first(tail)(io))))));
|
||||
const prev = g('prev', second._(first._(first._(pred))));
|
||||
|
||||
const output: L<(s: State) => State>
|
||||
= second(uncurry(_(t => pipe(Pair(t))(second(_(os => snoc(os)(uncurry(get)(t))))))));
|
||||
const jump = g('jump', l('d', l('s',
|
||||
iif._(command._(_c('['))._('s'))._(r('bf::jump')._(succ._('d')))
|
||||
._(iif._(command._(_c(']'))._('s'))._(ifz._(pred._('d'))._(cnst._('s'))._(r('bf::jump')._(pred._('d'))))
|
||||
._(r('bf::jump')._('d')))._(advance._('s')))));
|
||||
|
||||
const next: L<(t: State) => State>
|
||||
= second(first(first(succ)));
|
||||
const whlnz = g('whlnz', l('s', ifn._(read._('s'))._(jump._(Zero))._(save)._('s')));
|
||||
|
||||
const prev: L<(t: State) => State>
|
||||
= second(first(first(pred)));
|
||||
const endwhl = g('endwhl', l('s', ifn._(read._('s'))._(reset)._(pipe._(save)._(restore))._('s')));
|
||||
|
||||
const jump: L<(d: Num) => L<(s: State) => State>>
|
||||
= _(d => _(s =>
|
||||
iif(command(_c('['))(s))(jump(succ(d)))
|
||||
(iif(command(_c(']'))(s))(ifz(pred(d))(cnst(s))(jump(pred(d))))
|
||||
(jump(d)))(advance(s))));
|
||||
const exec = g('exec', l('s', iif._(done._('s'))._('s')._(r('bf::exec')._(advance
|
||||
._(iif._(command._(_c('>'))._('s'))._(next)
|
||||
._(iif._(command._(_c('<'))._('s'))._(prev)
|
||||
._(iif._(command._(_c('+'))._('s'))._(inc)
|
||||
._(iif._(command._(_c('-'))._('s'))._(dec)
|
||||
._(iif._(command._(_c('.'))._('s'))._(output)
|
||||
._(iif._(command._(_c(','))._('s'))._(input)
|
||||
._(iif._(command._(_c('['))._('s'))._(whlnz)
|
||||
._(iif._(command._(_c(']'))._('s'))._(endwhl)
|
||||
._(id))))))))._('s'))))));
|
||||
|
||||
const whlnz: L<(t: State) => State>
|
||||
= _(s => ifn(read(s))(jump(Zero))(save)(s));
|
||||
|
||||
const endwhl: L<(t: State) => State>
|
||||
= _(s => ifn(read(s))(reset)(pipe(save)(restore))(s));
|
||||
|
||||
const exec: L<(s: State) => State>
|
||||
= _(s => iif<State>(done(s))(s)(exec(advance
|
||||
(iif(command(_c('>'))(s))(next)
|
||||
(iif(command(_c('<'))(s))(prev)
|
||||
(iif(command(_c('+'))(s))(inc)
|
||||
(iif(command(_c('-'))(s))(dec)
|
||||
(iif(command(_c('.'))(s))(output)
|
||||
(iif(command(_c(','))(s))(input)
|
||||
(iif(command(_c('['))(s))(whlnz)
|
||||
(iif(command(_c(']'))(s))(endwhl)
|
||||
(id))))))))(s)))));
|
||||
|
||||
export const run: L<(p: String) => L<(i: String) => String>>
|
||||
= _(p => _(i => snd(snd(snd(exec(Pair(Pair(singleton(Zero))(p))(Pair(Pair(Zero)(repeat(x00)))(Pair(i)(Empty)))))))));
|
||||
export const run = g('run', l('p', l('i', snd._(snd._(snd._(exec._(Pair._(Pair._(singleton._(Zero))._('p'))._(Pair._(Pair._(Zero)._(repeat._(x00)))._(Pair._('i')._(Empty))))))))));
|
||||
|
||||
@@ -0,0 +1,7 @@
|
||||
import { m, g, l } from './core';
|
||||
import { iif } from './bool';
|
||||
import { fromString as _s } from './string';
|
||||
|
||||
m('bool.show');
|
||||
|
||||
export const show = g('show', l('b', iif._('b')._(_s('True'))._(_s('False'))));
|
||||
+18
-37
@@ -1,53 +1,34 @@
|
||||
import { toNative as $$, L, _, fromNative as __, id, pipe } from './core';
|
||||
import { EQ, GT, LT, Ord } from './ord';
|
||||
import { String, fromString as _s } from './string';
|
||||
import { $, Term, _, c, g, id, l, m, pipe } from './core';
|
||||
import { EQ, GT, LT } from './ord';
|
||||
|
||||
export type Bool = L<<T extends L>(t: T) => L<(f: T) => T>>;
|
||||
m('bool');
|
||||
|
||||
export const True: Bool
|
||||
= _(t => _(_f => t)) as Bool;
|
||||
export const True = g('True', l('t', l('_', 't')));
|
||||
|
||||
export const False: Bool
|
||||
= _(_t => _(f => f));
|
||||
export const False = g('False', l('_', l('f', 'f')));
|
||||
|
||||
export const iif: L<<T extends L>(b: Bool) => L<(t: T) => L<(f: T) => T>>>
|
||||
= id;
|
||||
export const iif = g('iif', id);
|
||||
|
||||
export const not: L<(b: Bool) => Bool>
|
||||
= _(b => b(False)(True));
|
||||
export const not = g('not', l('b', c('b', False, True)));
|
||||
|
||||
export const cmp: L<(l: Bool) => L<(r: Bool) => Ord>>
|
||||
= _(l => _(r => l(r(EQ)(GT))(r(LT)(EQ))));
|
||||
export const cmp = g('cmp', l('l', l('r', c('l', c('r', EQ, GT), c('r', LT, EQ)))));
|
||||
|
||||
export const lt: L<(l: Bool) => L<(r: Bool) => Bool>>
|
||||
= _(l => l(False));
|
||||
export const lt = g('lt', l('l', c('l', False)));
|
||||
|
||||
export const le: L<(l: Bool) => L<(r: Bool) => Bool>>
|
||||
= _(l => not(l)(True));
|
||||
export const le = g('le', l('l', not._('l')._(True)));
|
||||
|
||||
export const eq: L<(l: Bool) => L<(r: Bool) => Bool>>
|
||||
= _(l => _(r => l(r)(not(r))));
|
||||
export const eq = g('eq', l('l', l('r', c('l', 'r', not._('r')))));
|
||||
|
||||
export const ge: L<(l: Bool) => L<(r: Bool) => Bool>>
|
||||
= _(l => pipe(not)(lt(l)));
|
||||
export const ge = g('ge', l('l', pipe._(not)._(lt._('l'))));
|
||||
|
||||
export const gt: L<(l: Bool) => L<(r: Bool) => Bool>>
|
||||
= _(l => pipe(not)(le(l)));
|
||||
export const gt = g('gt', l('l', pipe._(not)._(le._('l'))));
|
||||
|
||||
export const and: L<(l: Bool) => L<(r: Bool) => Bool>>
|
||||
= _(l => not(l)(False));
|
||||
export const and = g('and', l('l', not._('l')._(False)));
|
||||
|
||||
export const or: L<(l: Bool) => L<(r: Bool) => Bool>>
|
||||
= _(l => l(True));
|
||||
export const or = g('or', l('l', c('l', True)));
|
||||
|
||||
export const xor: L<(l: Bool) => L<(r: Bool) => Bool>>
|
||||
= _(l => _(r => l(not(r))(r)));
|
||||
export const xor = g('xor', l('l', l('r', c('l', not._('r'), 'r'))));
|
||||
|
||||
export const show: L<(b: Bool) => String>
|
||||
= _(b => iif(b)(_s('True'))(_s('False')));
|
||||
export const fromBoolean: (b: boolean) => Term = b => b ? True : False;
|
||||
|
||||
export const fromBoolean: (b: boolean) => Bool
|
||||
= b => b ? True : False;
|
||||
|
||||
export const toBoolean: (b: Bool) => boolean
|
||||
= b => $$(b(__(true))(__(false)));
|
||||
export const toBoolean: (b: Term) => boolean = b => $(b._(_(true))._(_(false)).reduce());
|
||||
|
||||
@@ -0,0 +1,5 @@
|
||||
import { m } from './core';
|
||||
|
||||
m('byte.show');
|
||||
|
||||
export { show } from './num.show';
|
||||
+13
-22
@@ -1,34 +1,25 @@
|
||||
import { L, _, id } from './core';
|
||||
import { Term, _, g, id, l, m, r } from './core';
|
||||
import { iif } from './bool';
|
||||
import { Num, Succ, Zero, fromNumber as _n, eq } from './num';
|
||||
import { Succ, Zero, fromNumber as _n, eq } from './num';
|
||||
|
||||
export type Byte = Num;
|
||||
m('byte');
|
||||
|
||||
export const x00: Byte
|
||||
= Zero;
|
||||
export const x00 = g('x00', Zero);
|
||||
|
||||
export const xFF: Num
|
||||
= _n(255);
|
||||
export const xFF = g('xFF', _n(255));
|
||||
|
||||
export const Inc: L<(p: Byte) => Byte>
|
||||
= _(p => iif(eq(xFF)(p))(x00)(Succ(p)));
|
||||
export const Inc = g('Inc', l('p', iif._(eq._(xFF)._('p'))._(x00)._(Succ._('p'))));
|
||||
|
||||
export { ifz, cmp, lt, le, eq, ge, gt, even, odd, div, mod, show, toNumber } from './num';
|
||||
export { ifz, cmp, lt, le, eq, ge, gt, even, odd, div, mod, toNumber } from './num';
|
||||
|
||||
export const inc: L<(n: Byte) => Byte>
|
||||
= Inc;
|
||||
export const inc = g('inc', Inc);
|
||||
|
||||
export const dec: L<(n: Byte) => Byte>
|
||||
= _(n => n(xFF)(id));
|
||||
export const dec = g('dec', l('n', r('n')._(xFF)._(id)));
|
||||
|
||||
export const sum: L<(l: Byte) => L<(r: Byte) => Byte>>
|
||||
= _(l => _(r => r(l)(sum(inc(l)))));
|
||||
export const sum = g('sum', l('l', l('r', r('r')._('l')._(r('byte::sum')._(inc._('l'))))));
|
||||
|
||||
export const sub: L<(l: Byte) => L<(r: Byte) => Byte>>
|
||||
= _(l => _(r => r(l)(sub(dec(l)))));
|
||||
export const sub = g('sub', l('l', l('r', r('r')._('l')._(r('byte::sub')._(dec._('l'))))));
|
||||
|
||||
export const mul: L<(l: Byte) => L<(r: Byte) => Byte>>
|
||||
= _(l => _(r => l(x00)(_(pl => sum(r)(mul(pl)(r))))));
|
||||
export const mul = g('mul', l('l', l('r', r('l')._(x00)._(l('pl', sum._('r')._(r('byte::mul')._('pl')._('r')))))));
|
||||
|
||||
export const fromNumber: (n: number) => Byte
|
||||
= n => _n(n % 256);
|
||||
export const fromNumber: (n: number) => Term = n => _n(n % 256);
|
||||
|
||||
@@ -0,0 +1,7 @@
|
||||
import { g, l, m, pipe } from './core';
|
||||
import { singleton } from './list';
|
||||
import { wrap, fromString as _s } from './string';
|
||||
|
||||
m('char.show');
|
||||
|
||||
export const show = g('show', l('c', pipe._(wrap._(_s('\'')))._(singleton)._('c')));
|
||||
+6
-13
@@ -1,20 +1,13 @@
|
||||
import { L, _, pipe } from './core';
|
||||
import { toNumber as $n, Byte, fromNumber as _n, x00 } from './byte';
|
||||
import { Term, g, l, m, pipe } from './core';
|
||||
import { toNumber as $n, fromNumber as _n, x00 } from './byte';
|
||||
import { singleton } from './list';
|
||||
import { String, fromString as _s, wrap } from './string';
|
||||
|
||||
export type Char = Byte;
|
||||
m('char');
|
||||
|
||||
export const Null: Char
|
||||
= x00;
|
||||
export const Null = g('Null', x00);
|
||||
|
||||
export { inc, dec, ifz as ifn, cmp, lt, le, eq, ge, gt } from './byte';
|
||||
|
||||
export const show: L<(c: Char) => String>
|
||||
= _(c => pipe(wrap(_s('\'')))(singleton)(c));
|
||||
export const fromChar: (c: string) => Term = c => _n(c.charCodeAt(0));
|
||||
|
||||
export const fromChar: (c: string) => Char
|
||||
= c => _n(c.charCodeAt(0));
|
||||
|
||||
export const toChar: (c: Char) => string
|
||||
= c => String.fromCharCode($n(c));
|
||||
export const toChar: (c: Term) => string = c => String.fromCharCode($n(c));
|
||||
|
||||
+229
-22
@@ -1,29 +1,236 @@
|
||||
type F = (v: L) => L<any>;
|
||||
import { withLog } from './debug';
|
||||
|
||||
export type L<T extends F = F> = T & { run: () => T };
|
||||
let index = 0;
|
||||
|
||||
const defer: <T extends F>(run: () => T) => L<T> = <T extends F>(run: () => T) =>
|
||||
Object.assign(((p: Parameters<T>[0]): ReturnType<T> => {
|
||||
let v: F;
|
||||
return defer(() => run()(defer(() => v ??= p.run())).run());
|
||||
}) as T, { run });
|
||||
export abstract class Term {
|
||||
protected id = index++;
|
||||
protected cache: Term | null = null;
|
||||
|
||||
export const _ = <T extends F>(v: T): L<T> => defer(() => v);
|
||||
public constructor(protected bindings: Record<string, Term>) { }
|
||||
|
||||
export const fromNative: <T>(v: T) => L<any>
|
||||
= v => defer(() => v as any);
|
||||
export const toNative: <T>(v: L<any>) => T
|
||||
= <T>(v: L<any>) => v.run() as T;
|
||||
public refs(_name: string): boolean {
|
||||
return false;
|
||||
};
|
||||
|
||||
export const y = (f: () => L<F>) => defer(() => f().run());
|
||||
public bind(_name: string, _term: Term): Term {
|
||||
return this;
|
||||
}
|
||||
|
||||
export const undef: any = defer(() => { throw new Error('undefined'); });
|
||||
public reduce(): Term {
|
||||
return this;
|
||||
}
|
||||
|
||||
export const id: L<<T extends L>(v: T) => T>
|
||||
= _(v => v);
|
||||
export const cnst: L<<T extends L>(v: T) => L<(_: unknown) => T>>
|
||||
= _(v => _(_ => v)) as L<<T extends L>(v: T) => L<(_: unknown) => T>>;
|
||||
export const pipe: L<<A extends L, B extends L, C extends L>(f: L<(v: B) => C>) => L<(g: L<(v: A) => B>) => L<(v: A) => C>>>
|
||||
= _(<A extends L, B extends L, C extends L>(f: L<(v: B) => C>) =>
|
||||
_((g: L<(v: A) => B>) =>
|
||||
_((v: A) => f(g(v)))));
|
||||
public context(): string {
|
||||
return !Object.keys(this.bindings).length ? `<${this.id}>` : `<${this.id}>[bound ${Object.keys(this.bindings).join(', ')}] `;
|
||||
}
|
||||
|
||||
public stringify(context?: boolean): string {
|
||||
return `${context ? this.context() : ''}${this.constructor.name}`;
|
||||
}
|
||||
|
||||
public _(arg: RefTerm): Term {
|
||||
return c(this, arg);
|
||||
}
|
||||
}
|
||||
|
||||
export class Undef extends Term {
|
||||
constructor(
|
||||
public from: string,
|
||||
) { super({}); }
|
||||
|
||||
override reduce(): Term {
|
||||
throw new Error(`${this.from} = undef`);
|
||||
}
|
||||
}
|
||||
|
||||
export class Native extends Term {
|
||||
constructor(
|
||||
public value: any,
|
||||
) { super({}); }
|
||||
|
||||
public override stringify(): string {
|
||||
return `\`${JSON.stringify(this.value)}\``;
|
||||
}
|
||||
}
|
||||
|
||||
export class Deferred extends Term {
|
||||
constructor(
|
||||
public func: (bindings: Record<string, Term>) => Term,
|
||||
bindings: Record<string, Term> = {},
|
||||
) { super(bindings); }
|
||||
|
||||
override refs(_name: string): boolean {
|
||||
return true;
|
||||
}
|
||||
|
||||
public override bind(name: string, term: Term): Term {
|
||||
return this.bindings[name] || !this.refs(name)
|
||||
? this
|
||||
: new Deferred(this.func, { ...this.bindings, [name]: term });
|
||||
}
|
||||
|
||||
public override reduce(): Term {
|
||||
const term = this.cache
|
||||
? withLog(
|
||||
`Executing ${this.stringify()}`,
|
||||
() => this.cache!,
|
||||
r => `got ${r.stringify()} (cached)`,
|
||||
)
|
||||
: this.cache = withLog(
|
||||
`Executing ${this.stringify()}`,
|
||||
() => this.func({ ...globals, ...this.bindings }),
|
||||
r => `got ${r.stringify()}`,
|
||||
);
|
||||
return Object.entries(this.bindings).reduce((t, b) => t.bind(...b), term).reduce();
|
||||
}
|
||||
|
||||
public override stringify(context: boolean = true): string {
|
||||
return `${context ? this.context() : ''}\`deferred\``;
|
||||
}
|
||||
}
|
||||
|
||||
export class Ref extends Term {
|
||||
constructor(
|
||||
public name: string,
|
||||
bindings: Record<string, Term> = {},
|
||||
) { super(bindings); }
|
||||
|
||||
override refs(name: string): boolean {
|
||||
return this.name === name;
|
||||
}
|
||||
|
||||
public override bind(name: string, term: Term): Term {
|
||||
return this.bindings[name] || !this.refs(name)
|
||||
? this
|
||||
: new Ref(this.name, { [name]: term });
|
||||
}
|
||||
|
||||
public override reduce(): Term {
|
||||
if (this.cache) {
|
||||
return withLog(
|
||||
`Substituting ${this.stringify()}`,
|
||||
() => this.cache!,
|
||||
r => `with ${r.stringify()} (cached)`,
|
||||
);
|
||||
} else {
|
||||
return this.cache = withLog(
|
||||
`Substituting ${this.stringify()}`,
|
||||
() => (this.bindings[this.name] ?? globals[this.name] ?? new Undef(this.name)).reduce(),
|
||||
r => `with ${r.stringify()}`,
|
||||
).reduce();
|
||||
}
|
||||
}
|
||||
|
||||
public override stringify(context = true): string {
|
||||
return `${context ? this.context() : ''}${this.name}`;
|
||||
}
|
||||
}
|
||||
|
||||
export class Lambda extends Term {
|
||||
constructor(
|
||||
public param: string,
|
||||
public body: Term,
|
||||
bindings: Record<string, Term> = {},
|
||||
) { super(bindings); }
|
||||
|
||||
override refs(name: string): boolean {
|
||||
return this.param !== name && this.body.refs(name);
|
||||
}
|
||||
|
||||
override bind(name: string, term: Term): Term {
|
||||
return this.bindings[name] || !this.refs(name)
|
||||
? this
|
||||
: new Lambda(this.param, this.body.bind(name, term), { ...this.bindings, [name]: term });
|
||||
}
|
||||
|
||||
public override stringify(context = true): string {
|
||||
return this.body instanceof Lambda
|
||||
? `${context ? this.context() : ''}\\ ${this.param} ${this.body.stringify(false).slice(2)}`
|
||||
: `${context ? this.context() : ''}\\ ${this.param} . ${this.body.stringify(false)}`;
|
||||
}
|
||||
}
|
||||
|
||||
export class Call extends Term {
|
||||
constructor(
|
||||
public func: Term,
|
||||
public arg: Term,
|
||||
bindings: Record<string, Term> = {},
|
||||
) { super(bindings); }
|
||||
|
||||
override refs(name: string): boolean {
|
||||
return this.func.refs(name) || this.arg.refs(name);
|
||||
}
|
||||
|
||||
override bind(name: string, term: Term): Term {
|
||||
return this.bindings[name] || !this.refs(name)
|
||||
? this
|
||||
: new Call(this.func.bind(name, term), this.arg.bind(name, term), { ...this.bindings, [name]: term });
|
||||
}
|
||||
|
||||
override reduce(): Term {
|
||||
if (this.cache) {
|
||||
return withLog(
|
||||
`Reducing ${this.stringify()}`,
|
||||
() => this.cache!,
|
||||
r => `to ${r.stringify()} (cached)`,
|
||||
);
|
||||
} else {
|
||||
return this.cache = withLog(
|
||||
`Reducing ${this.stringify()}`,
|
||||
() => {
|
||||
const func = this.func.reduce();
|
||||
if (func instanceof Lambda) {
|
||||
return withLog(
|
||||
`Applying ${func.stringify()} to ${this.arg.stringify()}`,
|
||||
() => func.body.bind(func.param, this.arg),
|
||||
r => `got ${r.stringify()}`,
|
||||
).reduce();
|
||||
}
|
||||
return this;
|
||||
},
|
||||
r => `to ${r.stringify()}`,
|
||||
);
|
||||
}
|
||||
}
|
||||
|
||||
public override stringify(context = true): string {
|
||||
return `${context ? this.context() : ''}${this.func instanceof Lambda ? `(${this.func.stringify(false)})` : this.func.stringify(false)} ${this.arg instanceof Ref || this.arg instanceof Native ? this.arg.stringify(false) : `(${this.arg.stringify(false)})`}`;
|
||||
}
|
||||
}
|
||||
|
||||
const globals: Record<string, Term> = {};
|
||||
|
||||
type RefTerm = string | Term;
|
||||
|
||||
const termify = (t: RefTerm) => typeof t === 'string' ? r(t) : t;
|
||||
|
||||
export const _ = (v: any) => new Native(v);
|
||||
export const r = (name: string): Ref => new Ref(name);
|
||||
export const l = (param: string, body: RefTerm): Lambda => new Lambda(param, termify(body));
|
||||
export const c = (func: RefTerm, arg: RefTerm, ...args: RefTerm[]): Call =>
|
||||
args.reduce<Call>((f: Call, a: RefTerm) => new Call(f, termify(a)), new Call(termify(func), termify(arg)));
|
||||
export const d = (func: (bindings: Record<string, Term>) => Term) => new Deferred(func);
|
||||
|
||||
export const $ = <T>(t: Term): T => {
|
||||
const rt = t.reduce();
|
||||
return rt instanceof Native ? rt.value : rt.stringify();
|
||||
};
|
||||
|
||||
let cm: string = 'core';
|
||||
|
||||
export const m = (name: string) => cm = name;
|
||||
|
||||
export const g = (name: string, term: RefTerm) => {
|
||||
name = `${cm}::${name}`;
|
||||
if (globals[name]) {
|
||||
throw new Error(`Duplicate global: "${name}"`);
|
||||
}
|
||||
globals[name] = termify(term);
|
||||
return new Ref(name);
|
||||
};
|
||||
|
||||
export const undef = g('undef', new Undef('undef'));
|
||||
|
||||
export const id = g('id', l('f', 'f'));
|
||||
export const cnst = g('cnst', l('x', l('_', 'x')));
|
||||
export const pipe = g('pipe', l('f', l('g', l('x', c('f', c('g', 'x'))))));
|
||||
|
||||
+29
-7
@@ -1,8 +1,30 @@
|
||||
import { L, _ } from './core';
|
||||
import { String, toString } from './string';
|
||||
let indent: string = '';
|
||||
const logs: string[] = [];
|
||||
|
||||
export const log: L<<T extends L>(s: String) => L<(p: T) => T>>
|
||||
= _(s => _(p => {
|
||||
console.log(toString(s));
|
||||
return p;
|
||||
}));
|
||||
let logging: boolean = false;
|
||||
export function log(): void {
|
||||
logging = true;
|
||||
}
|
||||
|
||||
export function withLog<T>(before: string, f: () => T, after: (v: T) => string): T {
|
||||
if (!logging) {
|
||||
return f();
|
||||
}
|
||||
|
||||
logs.push(`${indent}${before}`);
|
||||
const l = logs.length;
|
||||
indent += ' ';
|
||||
const result = f();
|
||||
indent = indent.slice(2);
|
||||
if (logs.length === l) {
|
||||
logs[logs.length - 1] += ` ${after(result)}`;
|
||||
} else {
|
||||
logs.push(`${indent}${after(result)}`);
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
export function dump() {
|
||||
console.log('\n\nExecution log:');
|
||||
console.log(logs.join('\n'));
|
||||
}
|
||||
|
||||
+13
-6
@@ -1,7 +1,14 @@
|
||||
import { _, fromNative as __ } from './core';
|
||||
import { toString as $s, fromString as _s } from './string';
|
||||
import { run } from './bf';
|
||||
import { dump, log } from './debug';
|
||||
import { _ } from './core';
|
||||
import { fromNumber, toNumber } from './num';
|
||||
import { Cons, Nil, toArray } from './list';
|
||||
|
||||
console.log($s(run
|
||||
(_s('++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.'))
|
||||
(_s(''))));
|
||||
log();
|
||||
|
||||
const program = Cons._(fromNumber(0))._(Nil);
|
||||
|
||||
try {
|
||||
console.log(program.stringify(), ' -> ', toArray(program).map(toNumber));
|
||||
} finally {
|
||||
dump();
|
||||
}
|
||||
|
||||
@@ -0,0 +1,7 @@
|
||||
import { _, g, l, m } from './core';
|
||||
import { concat, intersperse, map } from './list';
|
||||
import { fromString as _s, cons, snoc } from './string';
|
||||
|
||||
m('list.show');
|
||||
|
||||
export const show = g('show', l('eshow', l('xs', concat._(snoc._(cons._(_s('['))._(intersperse._(_s(', '))._(map._('eshow')._('xs'))))._(_s(']'))))));
|
||||
+38
-110
@@ -1,144 +1,72 @@
|
||||
import { toNative as $$, L, _, fromNative as __, cnst, id, pipe, undef, y } from './core';
|
||||
import { EQ, GT, LT, Ord, eq as eqc } from './ord';
|
||||
import { Bool, False, True, and, iif, or } from './bool';
|
||||
import { Num, Zero, succ } from './num';
|
||||
import { String, fromString as _s } from './string';
|
||||
import { $, Term, _, cnst, d, g, id, l, m, pipe, r, undef } from './core';
|
||||
import { EQ, GT, LT, eq as eqc } from './ord';
|
||||
import { False, True, and, iif, or } from './bool';
|
||||
import { Zero, succ } from './num';
|
||||
|
||||
export type List<T extends L> = L<<R extends L>(z: R) => L<(f: L<(x: T) => L<(xs: List<T>) => R>>) => R>>;
|
||||
m('list');
|
||||
|
||||
export const Nil: List<any>
|
||||
= _(z => _(_f => z)) as List<any>;
|
||||
export const Nil = g('Nil', l('z', l('_', 'z')));
|
||||
|
||||
export const Cons: L<<T extends L>(x: T) => L<(xs: List<T>) => List<T>>>
|
||||
= _(<T extends L>(x: T) => _((xs: List<T>) => _(_z => _(f => f(x)(xs))) as List<T>));
|
||||
export const Cons = g('Cons', l('x', l('xs', l('_', l('f', r('f')._('x')._('xs'))))));
|
||||
|
||||
export const cons: L<<T extends L>(x: T) => L<(xs: List<T>) => List<T>>>
|
||||
= Cons;
|
||||
export const cons = g('cons', Cons);
|
||||
|
||||
export const snoc: L<<T extends L>(xs: List<T>) => L<(x: T) => List<T>>>
|
||||
= _(<T extends L>(xs: List<T>) =>
|
||||
_((x: T) => xs(cons(x)(Nil))(_(y => _(ys => cons(y)(snoc(ys)(x)))))));
|
||||
export const snoc = g('snoc', l('xs', l('x', r('xs')._(cons._('x')._(Nil))._(l('y', l('ys', cons._('y')._(r('list::snoc')._('ys')._('x'))))))));
|
||||
|
||||
export const nul: L<<T extends L>(xs: List<T>) => Bool>
|
||||
= _(xs => xs(True)(cnst(cnst(False))));
|
||||
export const nul = g('nul', l('xs', r('xs')._(True)._(cnst._(cnst._(False)))));
|
||||
|
||||
export const len: L<<T extends L>(xs: List<T>) => Num>
|
||||
= _(xs => xs(Zero)(cnst(pipe(succ)(len))));
|
||||
export const len = g('len', l('xs', r('xs')._(Zero)._(cnst._(pipe._(succ)._(r('list::len'))))));
|
||||
|
||||
export const singleton: L<<T extends L>(v: T) => List<T>>
|
||||
= _(x => cons(x)(Nil));
|
||||
export const singleton = g('singleton', l('x', cons._('x')._(Nil)));
|
||||
|
||||
export const append: L<<T extends L>(l: List<T>) => L<(r: List<T>) => List<T>>>
|
||||
= _(l => _(r => l(r)(_(x => _(xs => cons(x)(append(xs)(r)))))));
|
||||
export const append = g('append', l('l', l('r', r('l')._('r')._(l('x', l('xs', cons._('x')._(r('list::append')._('xs')._('r'))))))));
|
||||
|
||||
export const concat: L<<T extends L>(ls: List<List<T>>) => List<T>>
|
||||
= _(ls => ls(Nil)(_(x => pipe(append(x))(concat))));
|
||||
export const concat = g('concat', l('ls', r('ls')._(Nil)._(l('x', pipe._(append._('x'))._(r('list::concat'))))));
|
||||
|
||||
export const repeat: L<<T extends L>(x: T) => List<T>>
|
||||
= _(x => cons(x)(repeat(x)));
|
||||
export const repeat = g('repeat', l('x', cons._('x')._(r('list::repeat')._('x'))));
|
||||
|
||||
export const iterate: L<<T extends L>(f: L<(x: T) => T>) => L<(x: T) => List<T>>>
|
||||
= _(<T extends L>(f: L<(x: T) => T>) => _((x: T) => cons(x)(iterate(f)(f(x)))));
|
||||
export const iterate = g('iterate', l('f', l('x', cons._('x')._(r('list::iterate')._('f')._(r('f')._('x'))))));
|
||||
|
||||
export const head: L<<T extends L>(xs: List<T>) => T>
|
||||
= _(xs => xs(undef)(cnst));
|
||||
export const head = g('head', l('xs', r('xs')._(undef)._(cnst)));
|
||||
|
||||
export const tail: L<<T extends L>(xs: List<T>) => List<T>>
|
||||
= _(xs => xs(undef)(cnst(id)));
|
||||
export const tail = g('tail', l('xs', r('xs')._(undef)._(cnst._(id))));
|
||||
|
||||
export const foldl: L<<T extends L, R extends L>(f: L<(a: R) => L<(x: T) => R>>) => L<(z: R) => L<(xs: List<T>) => R>>>
|
||||
= _(<T extends L, R extends L>(f: L<(a: R) => L<(x: T) => R>>) =>
|
||||
_((z: R) =>
|
||||
_((xs: List<T>) => xs(z)(pipe(foldl(f))(f(z))))));
|
||||
export const foldl = g('foldl', l('f', l('z', l('xs', r('xs')._('z')._(pipe._(r('list::foldl')._('f'))._(r('f')._('z')))))));
|
||||
|
||||
export const foldlz: L<<T extends L>(f: L<(a: T) => L<(x: T) => T>>) => L<(xs: List<T>) => T>>
|
||||
= _(<T extends L>(f: L<(a: T) => L<(x: T) => T>>) => _((xs: List<T>) => xs(undef)(foldl(f))));
|
||||
export const foldlz = g('foldlz', l('f', l('xs', r('xs')._(undef)._(foldl._('f')))));
|
||||
|
||||
export const foldr: L<<T extends L, R extends L>(f: L<(x: T) => L<(a: R) => R>>) => L<(z: R) => L<(xs: List<T>) => R>>>
|
||||
= _(<T extends L, R extends L>(f: L<(x: T) => L<(a: R) => R>>) =>
|
||||
_((z: R) =>
|
||||
_((xs: List<T>) => xs(z)(_(x => pipe(f(x))(foldr(f)(z)))))));
|
||||
export const foldr = g('foldr', l('f', l('z', l('xs', r('xs')._('z')._(l('x', pipe._(r('f')._('x'))._(r('list::foldr')._('f')._('z'))))))));
|
||||
|
||||
export const foldrz: L<<T extends L>(f: L<(x: T) => L<(a: T) => T>>) => L<(xs: List<T>) => T>>
|
||||
= undef;
|
||||
export const foldrz = g('foldrz', undef);
|
||||
|
||||
export const cmp: L<<T extends L>(ecmp: L<(l: T) => L <(r: T) => Ord>>) => L<(l: List<T>) => L<(r: List<T>) => Ord>>>
|
||||
= _(<T extends L>(ecmp: L<(l: T) => L<(r: T) => Ord>>) =>
|
||||
_((l: List<T>) =>
|
||||
_((r: List<T>) => l
|
||||
(r(EQ)(cnst(cnst(LT))))
|
||||
(_(lx => _(lxs => r(GT)(_(rx => _(rxs => iif
|
||||
(eqc(EQ)(ecmp(lx)(rx)))
|
||||
(cmp(ecmp)(lxs)(rxs))
|
||||
(ecmp(lx)(rx)))))))))));
|
||||
export const cmp = g('cmp', l('ecmp', l('l', l('r', r('l')._(r('r')._(EQ)._(cnst._(cnst._(LT))))._(l('lx', l('lxs', r('r')._(GT)._(l('rx', l('rxs', iif._(eqc._(EQ)._(r('ecmp')._('lx')._('rx')))._(r('list::cmp')._('ecmp')._('lxs')._('rxs'))._(r('ecmp')._('lx')._('rx'))))))))))));
|
||||
|
||||
export const lt: L<<T extends L>(ecmp: L<(l: T) => L <(r: T) => Ord>>) => L<(l: List<T>) => L<(r: List<T>) => Bool>>>
|
||||
= _(<T extends L>(ecmp: L<(l: T) => L<(r: T) => Ord>>) =>
|
||||
_((l: List<T>) =>
|
||||
_((r: List<T>) =>
|
||||
r(False)(_(rx => _(rxs => l(True)(_(lx => _(lxs => ecmp(lx)(rx)(True)(lt(ecmp)(lxs)(rxs))(False))))))))));
|
||||
export const lt = g('lt', l('ecmp', l('l', l('r', r('r')._(False)._(l('rx', l('rxs', r('l')._(True)._(l('lx', l('lxs', r('ecmp')._('lx')._('rx')._(True)._(r('list::lt')._('ecmp')._('lxs')._('rxs'))._(False)))))))))));
|
||||
|
||||
export const le: L<<T extends L>(ecmp: L<(l: T) => L <(r: T) => Ord>>) => L<(l: List<T>) => L<(r: List<T>) => Bool>>>
|
||||
= _(<T extends L>(ecmp: L<(l: T) => L<(r: T) => Ord>>) =>
|
||||
_((l: List<T>) =>
|
||||
_((r: List<T>) =>
|
||||
l(True)(_(lx => _(lxs => r(False)(_(rx => _(rxs => ecmp(lx)(rx)(True)(le(ecmp)(lxs)(rxs))(False))))))))));
|
||||
export const le = g('le', l('ecmp', l('l', l('r', r('l')._(True)._(l('lx', l('lxs', r('r')._(False)._(l('rx', l('rxs', r('ecmp')._('lx')._('rx')._(True)._(r('list::le')._('ecmp')._('lxs')._('rxs'))._(False)))))))))));
|
||||
|
||||
export const eq: L<<T extends L>(eeq: L<(l: T) => L <(r: T) => Bool>>) => L<(l: List<T>) => L<(r: List<T>) => Bool>>>
|
||||
= _(<T extends L>(eeq: L<(l: T) => L<(r: T) => Bool>>) =>
|
||||
_((l: List<T>) =>
|
||||
_((r: List<T>) => l
|
||||
(r(True)(cnst(cnst(False))))
|
||||
(_(lx => _(lxs => r(False)(_(rx => _(rxs => and(eeq(lx)(rx))(eq(eeq)(lxs)(rxs)))))))))));
|
||||
export const eq = g('eq', l('eeq', l('l', l('r', r('l')._(r('r')._(True)._(cnst._(cnst._(False))))._(l('lx', l('lxs', r('r')._(False)._(l('rx', l('rxs', and._(r('eeq')._('lx')._('rx'))._(r('list::eq')._('eeq')._('lxs')._('rxs'))))))))))));
|
||||
|
||||
export const ge: L<<T extends L>(ecmp: L<(l: T) => L <(r: T) => Ord>>) => L<(l: List<T>) => L<(r: List<T>) => Bool>>>
|
||||
= _(<T extends L>(ecmp: L<(l: T) => L<(r: T) => Ord>>) =>
|
||||
_((l: List<T>) =>
|
||||
_((r: List<T>) =>
|
||||
r(True)(_(rx => _(rxs => l(False)(_(lx => _(lxs => ecmp(lx)(rx)(False)(ge(ecmp)(lxs)(rxs))(True))))))))));
|
||||
export const ge = g('ge', l('ecmp', l('l', l('r', r('r')._(True)._(l('rx', l('rxs', r('l')._(False)._(l('lx', l('lxs', r('ecmp')._('lx')._('rx')._(False)._(r('list::ge')._('ecmp')._('lxs')._('rxs'))._(True)))))))))));
|
||||
|
||||
export const gt: L<<T extends L>(ecmp: L<(l: T) => L <(r: T) => Ord>>) => L<(l: List<T>) => L<(r: List<T>) => Bool>>>
|
||||
= _(<T extends L>(ecmp: L<(l: T) => L<(r: T) => Ord>>) =>
|
||||
_((l: List<T>) =>
|
||||
_((r: List<T>) =>
|
||||
l(False)(_(lx => _(lxs => r(True)(_(rx => _(rxs => ecmp(lx)(rx)(False)(gt(ecmp)(lxs)(rxs))(True))))))))));
|
||||
export const gt = g('gt', l('ecmp', l('l', l('r', r('l')._(False)._(l('lx', l('lxs', r('r')._(True)._(l('rx', l('rxs', r('ecmp')._('lx')._('rx')._(False)._(r('list::gt')._('ecmp')._('lxs')._('rxs'))._(True)))))))))));
|
||||
|
||||
export const map: L<<T extends L, R extends L>(f: L<(x: T) => R>) => L<(xs: List<T>) => List<R>>>
|
||||
= _(<T extends L, R extends L>(f: L<(x: T) => R>) =>
|
||||
_((xs: List<T>) => xs(Nil)(_(x => pipe(cons(f(x)))(map(f))))));
|
||||
export const map = g('map', l('f', l('xs', r('xs')._(Nil)._(l('x', pipe._(cons._(r('f')._('x')))._(r('list::map')._('f')))))));
|
||||
|
||||
export const filter: L<<T extends L>(f: L<(x: T) => Bool>) => L<(xs: List<T>) => List<T>>>
|
||||
= _(<T extends L>(f: L<(x: T) => Bool>) =>
|
||||
_((xs: List<T>) => xs(Nil)(_(x => pipe(iif(f(x))(cons(x))(id))(filter(f))))));
|
||||
export const filter = g('filter', l('f', l('xs', r('xs')._(Nil)._(l('x', pipe._(iif._(r('f')._('x'))._(cons._('x'))._(id))._(r('list::filter')._('f')))))));
|
||||
|
||||
export const any: L<<T extends L>(f: L<(x: T) => Bool>) => L<(xs: List<T>) => Bool>>
|
||||
= _(<T extends L>(f: L<(x: T) => Bool>) =>
|
||||
_((xs: List<T>) => xs(False)(_(x => pipe(or(f(x)))(any(f))))));
|
||||
export const any = g('any', l('f', l('xs', r('xs')._(False)._(l('x', pipe._(or._(r('f')._('x')))._(r('list::any')._('f')))))));
|
||||
|
||||
export const all: L<<T extends L>(f: L<(x: T) => Bool>) => L<(xs: List<T>) => Bool>>
|
||||
= _(<T extends L>(f: L<(x: T) => Bool>) =>
|
||||
_((xs: List<T>) => xs(True)(_(x => pipe(and(f(x)))(all(f))))));
|
||||
export const all = g('all', l('f', l('xs', r('xs')._(True)._(l('x', pipe._(and._(r('f')._('x')))._(r('list::all')._('f')))))));
|
||||
|
||||
export const get: L<<T extends L>(i: Num) => L<(xs: List<T>) => T>>
|
||||
= _(i => _(xs => xs(undef)(_(x => i(cnst(x))(get)))));
|
||||
export const get = g('get', l('i', l('xs', r('xs')._(undef)._(l('x', r('i')._(cnst._('x'))._('list::get'))))));
|
||||
|
||||
export const update: L<<T extends L>(f: L< (p: T) => T>) => L<(i: Num) => L<(xs: List<T>) => List<T>>>>
|
||||
= _(<T extends L>(f: L< (p: T) => T>) =>
|
||||
_((i: Num) =>
|
||||
_((xs: List<T>) =>
|
||||
xs(undef)(_(x => _(xs => i(cons(f(x))(xs))(_(pi => cons(x)(update(f)(pi)(xs))))))))));
|
||||
export const update = g('update', l('f', l('i', l('xs', r('xs')._(undef)._(l('x', l('xs', r('i')._(cons._(r('f')._('x'))._('xs'))._(l('pi', cons._('x')._(r('list::update')._('f')._('pi')._('xs')))))))))));
|
||||
|
||||
export const set: L<<T extends L>(v: T) => L<(i: Num) => L<(xs: List<T>) => List<T>>>>
|
||||
= pipe(update)(cnst);
|
||||
export const set = g('set', pipe._(update)._(cnst));
|
||||
|
||||
export const intersperse: L<<T extends L>(v: T) => L<(xs: List<T>) => List<T>>>
|
||||
= _(v => _(xs => xs(xs)(_(x => _(rxs => rxs(xs)(cnst(cnst(cons(x)(cons(v)(intersperse(v)(rxs)))))))))));
|
||||
export const intersperse = g('intersperse', l('v', l('xs', r('xs')._('xs')._(l('x', l('rxs', r('rxs')._('xs')._(cnst._(cnst._(cons._('x')._(cons._('v')._(r('list::intersperse')._('v')._('rxs'))))))))))));
|
||||
|
||||
export const show: L<<T extends L>(eshow: L<(e: T) => String>) => L<(xs: List<T>) => String>>
|
||||
= _(eshow => _(xs => concat(snoc(cons(_s('['))(intersperse(_s(', '))(map(eshow)(xs))))(_s(']')))));
|
||||
export const fromArray: (xs: Term[]) => Term = xs => !xs.length ? Nil : Cons._(xs[0])._(d(() => fromArray(xs.slice(1))));
|
||||
|
||||
export const fromArray: <T extends L>(xs: T[]) => List<T>
|
||||
= xs => xs.length === 0 ? Nil : cons(xs[0])(y(() => fromArray(xs.slice(1))));
|
||||
|
||||
export const toArray: <T extends L>(xs: List<T>) => L[]
|
||||
= xs => $$(xs(__([]))(_(x => _(xs => __([x, ...toArray(xs)])))));
|
||||
export const toArray: (xs: Term) => Term[] = xs => $(xs._(_([]))._(l('x', l('xs', d(bs => _([bs['x'], ...toArray(bs['xs'])]))))));
|
||||
|
||||
@@ -0,0 +1,7 @@
|
||||
import { l, d } from './core';
|
||||
import { toString } from './string';
|
||||
|
||||
export const log = l('s', l('p', d(bs => {
|
||||
console.log(toString(bs['s']));
|
||||
return bs['p'];
|
||||
})));
|
||||
@@ -0,0 +1,8 @@
|
||||
import { _, g, l, m, r } from './core';
|
||||
import { iif } from './bool';
|
||||
import { fromNumber as _n, sum, div, mod, lt } from './num';
|
||||
import { append, cons, Empty } from './string';
|
||||
|
||||
m('num.show');
|
||||
|
||||
export const show = g('show', l('n', iif._(lt._('n')._(_n(10)))._(cons._(sum._('n')._(_n(48)))._(Empty))._(append._(r('num.show::show')._(div._('n')._(_n(10))))._(r('num.show::show')._(mod._('n')._(_n(10)))))));
|
||||
+24
-50
@@ -1,71 +1,45 @@
|
||||
import { toNative as $$, L, _, fromNative as __, cnst, id, pipe, y } from './core';
|
||||
import { EQ, GT, LT, Ord } from './ord';
|
||||
import { Bool, False, True, iif } from './bool';
|
||||
import { Empty, String, append, cons } from './string';
|
||||
import { $, Term, _, cnst, d, g, id, l, m, pipe, r } from './core';
|
||||
import { EQ, GT, LT } from './ord';
|
||||
import { False, True, iif } from './bool';
|
||||
|
||||
export type Num = L<<T extends L>(z: T) => L<(n: L<(p: Num) => T>) => T>>;
|
||||
m('num');
|
||||
|
||||
export const Zero: Num
|
||||
= _(z => _(_n => z)) as Num;
|
||||
export const Zero = g('Zero', l('z', l('_n', 'z')));
|
||||
|
||||
export const Succ: L<(p: Num) => Num>
|
||||
= _(p => _(_z => _(n => n(p))));
|
||||
export const Succ = g('Succ', l('p', l('_z', l('n', r('n')._('p')))));
|
||||
|
||||
export const ifz: L<<T extends L>(n: Num) => L<(t: T) => L<(f: T) => T>>>
|
||||
= _(n => _(t => _(f => n(t)(cnst(f)))));
|
||||
export const ifz = g('ifz', l('n', l('t', l('f', r('n')._('t')._(cnst._('f'))))));
|
||||
|
||||
export const succ: L<(n: Num) => Num>
|
||||
= Succ;
|
||||
export const succ = g('succ', Succ);
|
||||
|
||||
export const pred: L<(n: Num) => Num>
|
||||
= _(n => n(Zero)(id));
|
||||
export const pred = g('pred', l('n', r('n')._(Zero)._(id)));
|
||||
|
||||
export const cmp: L<(l: Num) => L<(r: Num) => Ord>>
|
||||
= _(l => _(r => l(r(EQ)(cnst(LT)))(pipe(r(GT))(cmp))));
|
||||
export const cmp = g('cmp', l('l', l('r', r('l')._(r('r')._(EQ)._(cnst._(LT)))._(pipe._(r('r')._(GT))._('num::cmp')))));
|
||||
|
||||
export const lt: L<(l: Num) => L<(r: Num) => Bool>>
|
||||
= _(l => _(r => r(False)(l(cnst(True))(lt))));
|
||||
export const lt = g('lt', l('l', l('r', r('r')._(False)._(r('l')._(cnst._(True))._('num::lt')))));
|
||||
|
||||
export const le: L<(l: Num) => L<(r: Num) => Bool>>
|
||||
= _(l => _(r => l(True)(r(cnst(False))(ge))));
|
||||
export const le = g('le', l('l', l('r', r('l')._(True)._(r('r')._(cnst._(False))._('num::ge')))));
|
||||
|
||||
export const eq: L<(l: Num) => L<(r: Num) => Bool>>
|
||||
= _(l => _(r => l(r(True)(cnst(False)))(r(cnst(False))(eq))));
|
||||
export const eq = g('eq', l('l', l('r', r('l')._(r('r')._(True)._(cnst._(False)))._(r('r')._(cnst._(False))._('num::eq')))));
|
||||
|
||||
export const ge: L<(l: Num) => L<(r: Num) => Bool>>
|
||||
= _(l => _(r => r(True)(l(cnst(False))(ge))));
|
||||
export const ge = g('ge', l('l', l('r', r('r')._(True)._(r('l')._(cnst._(False))._('num::ge')))));
|
||||
|
||||
export const gt: L<(l: Num) => L<(r: Num) => Bool>>
|
||||
= _(l => _(r => l(False)(r(cnst(True))(lt))));
|
||||
export const gt = g('gt', l('l', l('r', r('l')._(False)._(r('r')._(cnst._(True))._(lt)))));
|
||||
|
||||
export const even: L<(n: Num) => Bool>
|
||||
= _(n => n(True)(odd));
|
||||
export const even = g('even', l('n', r('n')._(True)._('num::odd')));
|
||||
|
||||
export const odd: L<(n: Num) => Bool>
|
||||
= _(n => n(False)(even));
|
||||
export const odd = g('odd', l('n', r('n')._(False)._('num::even')));
|
||||
|
||||
export const sum: L<(l: Num) => L<(r: Num) => Num>>
|
||||
= _(l => _(r => r(l)(sum(Succ(l)))));
|
||||
export const sum = g('sum', l('l', l('r', r('r')._('l')._(r('num::sum')._(Succ._('l'))))));
|
||||
|
||||
export const sub: L<(l: Num) => L<(r: Num) => Num>>
|
||||
= _(l => _(r => r(l)(l(cnst(Zero))(sub))));
|
||||
export const sub = g('sub', l('l', l('r', r('r')._('l')._(r('l')._(cnst._(Zero))._('num::sub')))));
|
||||
|
||||
export const mul: L<(l: Num) => L<(r: Num) => Num>>
|
||||
= _(l => _(r => l(Zero)(_(pl => sum(r)(mul(pl)(r))))));
|
||||
export const mul = g('mul', l('l', l('r', r('l')._(Zero)._(l('pl', sum._('r')._(r('num::mul')._('pl')._('r')))))));
|
||||
|
||||
export const div: L<(l: Num) => L<(r: Num) => Num>>
|
||||
= _(l => _(r => iif(lt(l)(r))(Zero)(succ(div(sub(l)(r))(r)))));
|
||||
export const div = g('div', l('l', l('r', iif._(lt._('l')._('r'))._(Zero)._(succ._(r('num::div')._(sub._('l')._('r'))._('r'))))));
|
||||
|
||||
export const mod: L<(l: Num) => L<(r: Num) => Num>>
|
||||
= _(l => _(r => iif(lt(l)(r))(l)(mod(sub(l)(r))(r))));
|
||||
export const mod = g('mod', l('l', l('r', iif._(lt._('l')._('r'))._('l')._(r('num::mod')._(sub._('l')._('r'))._('r')))));
|
||||
|
||||
export const show: L<(n: Num) => String>
|
||||
= _(n => iif(lt(n)(fromNumber(10)))
|
||||
(cons(sum(n)(fromNumber(48)))(Empty))
|
||||
(append(show(div(n)(fromNumber(10))))(show(mod(n)(fromNumber(10))))));
|
||||
export const fromNumber: (n: number) => Term = n => !n ? Zero : Succ._(d(() => fromNumber(n - 1)));
|
||||
|
||||
export const fromNumber: (n: number) => Num
|
||||
= n => !n ? Zero : Succ(y(() => fromNumber(n - 1)));
|
||||
|
||||
export const toNumber: (n: Num) => number
|
||||
= n => $$(n(__(0))(_(p => __(1 + toNumber(p)))));
|
||||
export const toNumber: (n: Term) => number = n => $(n._(_(0))._(l('p', d(bs => _(1 + toNumber(bs['p']))))));
|
||||
|
||||
@@ -0,0 +1,6 @@
|
||||
import { _, g, l, m, r } from './core';
|
||||
import { fromString as _s } from './string';
|
||||
|
||||
m('ord.show');
|
||||
|
||||
export const show = g('show', l('o', r('o')._(_s('LT'))._(_s('EQ'))._(_s('GT'))));
|
||||
+12
-21
@@ -1,8 +1,6 @@
|
||||
import { toNative as $$, L, _, fromNative as __ } from './core';
|
||||
import { Bool, False, True } from './bool';
|
||||
import { String, fromString as _s } from './string';
|
||||
import { $, Term, _, c, g, l, m, r } from './core';
|
||||
|
||||
export type Ord = L<<T extends L>(lt: T) => L<(eq: T) => L<(gt: T) => T>>>;
|
||||
m('ord');
|
||||
|
||||
export const enum NOrd {
|
||||
LT,
|
||||
@@ -10,26 +8,19 @@ export const enum NOrd {
|
||||
GT,
|
||||
};
|
||||
|
||||
export const LT: Ord
|
||||
= _(lt => _(_eq => _(_gt => lt))) as Ord;
|
||||
export const LT = g('LT', l('lt', l('_', l('_', 'lt'))));
|
||||
|
||||
export const EQ: Ord
|
||||
= _(_lt => _(eq => _(_gt => eq)));
|
||||
export const EQ = g('EQ', l('_', l('eq', l('_', 'eq'))));
|
||||
|
||||
export const GT: Ord
|
||||
= _(_lt => _(_eq => _(gt => gt)));
|
||||
export const GT = g('GT', l('_', l('_', l('gt', 'gt'))));
|
||||
|
||||
export const eq: L<(l: Ord) => L<(r: Ord) => Bool>>
|
||||
= _(l => _(r => l
|
||||
(r(True)(False)(False))
|
||||
(r(False)(True)(False))
|
||||
(r(False)(False)(True))));
|
||||
export const eq = g('eq', l('l', l('r', c('l',
|
||||
c('r', 'bool::True', 'bool::False', 'bool::False'),
|
||||
c('r', 'bool::False', 'bool::True', 'bool::False'),
|
||||
c('r', 'bool::False', 'bool::False', 'bool::True')))));
|
||||
|
||||
export const show: L<(o: Ord) => String>
|
||||
= _(o => o(_s('LT'))(_s('EQ'))(_s('GT')));
|
||||
|
||||
export const fromNOrd: (b: NOrd) => Ord
|
||||
export const fromNOrd: (o: NOrd) => Term
|
||||
= o => o === NOrd.LT ? LT : o === NOrd.EQ ? EQ : GT;
|
||||
|
||||
export const toNOrd: (b: Ord) => NOrd
|
||||
= o => $$(o(__(NOrd.LT))(__(NOrd.EQ))(__(NOrd.GT)));
|
||||
export const toNOrd: (o: Term) => NOrd
|
||||
= o => $(c(o, _(NOrd.LT), _(NOrd.EQ), _(NOrd.GT)).reduce());
|
||||
|
||||
@@ -0,0 +1,8 @@
|
||||
import { _, g, l, m, r } from './core';
|
||||
import { uncurry } from './pair';
|
||||
import { concat, cons, Nil } from './list';
|
||||
import { fromString as _s } from './string';
|
||||
|
||||
m('pair.show');
|
||||
|
||||
export const show = g('show', l('fshow', l('sshow', uncurry._(l('f', l('s', concat._(cons._(_s('('))._(cons._(r('fshow')._('f'))._(cons._(_s(', '))._(cons._(r('sshow')._('s'))._(cons._(_s(')'))._(Nil))))))))))));
|
||||
+18
-68
@@ -1,82 +1,32 @@
|
||||
import { L, _ } from './core';
|
||||
import { GT, LT, Ord } from './ord';
|
||||
import { Bool, False, True, and } from './bool';
|
||||
import { Nil, concat, cons } from './list';
|
||||
import { String, fromString as _s } from './string';
|
||||
import { _, g, l, m, r } from './core';
|
||||
import { GT, LT } from './ord';
|
||||
import { False, True, and } from './bool';
|
||||
import { fromString as _s } from './string';
|
||||
|
||||
export type Pair<F extends L, S extends L> = L<<R extends L>(f: L<(f: F) => L<(s: S) => R>>) => R>;
|
||||
m('pair');
|
||||
|
||||
export const Pair: L<<F extends L, S extends L>(f: F) => L<(s: S) => Pair<F, S>>>
|
||||
= _(<F extends L, S extends L>(f: F) =>
|
||||
_((s: S) =>
|
||||
_(<R extends L>(p: L<(f: F) => L<(s: S) => R>>) => p(f)(s))));
|
||||
export const Pair = g('Pair', l('f', l('s', l('p', r('p')._('f')._('s')))));
|
||||
|
||||
export const fst: L<<F extends L, S extends L>(p: Pair<F, S>) => F>
|
||||
= _(p => p(_(f => _(_s => f))));
|
||||
export const fst = g('fst', l('p', r('p')._(l('f', l('_', 'f')))));
|
||||
|
||||
export const snd: L<<F extends L, S extends L>(p: Pair<F, S>) => S>
|
||||
= _(p => p(_(_f => _(s => s))));
|
||||
export const snd = g('snd', l('p', r('p')._(l('_', l('s', 's')))));
|
||||
|
||||
export const first: L<<F extends L, FR extends L, S extends L>(t: L<(f: F) => FR>) => L<(p: Pair<F, S>) => Pair<FR, S>>>
|
||||
= _(<F extends L, FR extends L>(t: L<(f: F) => FR>) =>
|
||||
_(<S extends L>(p: Pair<F, S>) => p(_(f => _(s => Pair(t(f))(s))))));
|
||||
export const first = g('first', l('t', l('p', r('p')._(l('f', l('s', Pair._(r('t')._('f'))._('s')))))));
|
||||
|
||||
export const second: L<<F extends L, S extends L, SR extends L>(t: L<(s: S) => SR>) => L<(p: Pair<F, S>) => Pair<F, SR>>>
|
||||
= _(<S extends L, SR extends L>(t: L<(s: S) => SR>) =>
|
||||
_(<F extends L>(p: Pair<F, S>) => p(_(f => _(s => Pair(f)(t(s)))))));
|
||||
export const second = g('second', l('t', l('p', r('p')._(l('f', l('s', Pair._('f')._(r('t')._('s'))))))));
|
||||
|
||||
export const both: L<<F extends L, FR extends L, S extends L, SR extends L>(tf: L<(f: F) => FR>) => L<(ts: L<(s: S) => SR>) => L<(p: Pair<F, S>) => Pair<FR, SR>>>>
|
||||
= _(<F extends L, FR extends L>(tf: L<(f: F) => FR>) =>
|
||||
_(<S extends L, SR extends L>(ts: L<(s: S) => SR>) =>
|
||||
_((p: Pair<F, S>) => p(_(f => _(s => Pair(tf(f))(ts(s))))))));
|
||||
export const both = g('both', l('tf', l('ts', l('p', r('p')._(l('f', l('s', Pair._(r('tf')._('f'))._(r('ts')._('s')))))))));
|
||||
|
||||
export const uncurry: L<<F extends L, S extends L, R extends L>(t: L<(f: F) => L<(s: S) => R>>) => L<(p: Pair<F, S>) => R>>
|
||||
= _(<F extends L, S extends L, R extends L>(t: L<(f: F) => L<(s: S) => R>>) =>
|
||||
_((p: Pair<F, S>) => p(t)));
|
||||
export const uncurry = g('uncurry', l('t', l('p', r('p')._('t'))));
|
||||
|
||||
export const cmp: L<<F extends L, S extends L>(fcmp: L<(l: F) => L<(r: F) => Ord>>) => L<(scmp: L<(l: S) => L<(r: S) => Ord>>) => L<(l: Pair<F, S>) => L<(r: Pair<F, S>) => Ord>>>>
|
||||
= _(<F extends L, S extends L>(fcmp: L<(l: F) => L<(r: F) => Ord>>) =>
|
||||
_((scmp: L<(l: S) => L<(r: S) => Ord>>) =>
|
||||
uncurry(_((lf: F) => _((ls: S) =>
|
||||
uncurry(_((rf: F) => _((rs: S) =>
|
||||
fcmp(lf)(rf)(LT)(scmp(ls)(rs))(GT)))))))));
|
||||
export const cmp = g('cmp', l('fcmp', l('scmp', uncurry._(l('lf', l('ls', uncurry._(l('rf', l('rs', r('fcmp')._('lf')._('rf')._(LT)._(r('scmp')._('ls')._('rs'))._(GT))))))))));
|
||||
|
||||
export const lt: L<<F extends L, S extends L>(fcmp: L<(l: F) => L<(r: F) => Ord>>) => L<(scmp: L<(l: S) => L<(r: S) => Bool>>) => L<(l: Pair<F, S>) => L<(r: Pair<F, S>) => Bool>>>>
|
||||
= _(<F extends L, S extends L>(fcmp: L<(l: F) => L<(r: F) => Ord>>) =>
|
||||
_((scmp: L<(l: S) => L<(r: S) => Ord>>) =>
|
||||
uncurry(_((lf: F) => _((ls: S) =>
|
||||
uncurry(_((rf: F) => _((rs: S) =>
|
||||
fcmp(lf)(rf)(True)(scmp(ls)(rs)(True)(False)(False))(False)))))))));
|
||||
export const lt = g('lt', l('fcmp', l('scmp', uncurry._(l('lf', l('ls', uncurry._(l('rf', l('rs', r('fcmp')._('lf')._('rf')._(True)._(r('scmp')._('ls')._('rs')._(True)._(False)._(False))._(False))))))))));
|
||||
|
||||
export const le: L<<F extends L, S extends L>(fcmp: L<(l: F) => L<(r: F) => Ord>>) => L<(scmp: L<(l: S) => L<(r: S) => Bool>>) => L<(l: Pair<F, S>) => L<(r: Pair<F, S>) => Bool>>>>
|
||||
= _(<F extends L, S extends L>(fcmp: L<(l: F) => L<(r: F) => Ord>>) =>
|
||||
_((scmp: L<(l: S) => L<(r: S) => Ord>>) =>
|
||||
uncurry(_((lf: F) => _((ls: S) =>
|
||||
uncurry(_((rf: F) => _((rs: S) =>
|
||||
fcmp(lf)(rf)(True)(scmp(ls)(rs)(True)(True)(False))(False)))))))));
|
||||
export const le = g('le', l('fcmp', l('scmp', uncurry._(l('lf', l('ls', uncurry._(l('rf', l('rs', r('fcmp')._('lf')._('rf')._(True)._(r('scmp')._('ls')._('rs')._(True)._(True)._(False))._(False))))))))));
|
||||
|
||||
export const eq: L<<F extends L, S extends L>(feq: L<(l: F) => L<(r: F) => Bool>>) => L<(seq: L<(l: S) => L<(r: S) => Bool>>) => L<(l: Pair<F, S>) => L<(r: Pair<F, S>) => Bool>>>>
|
||||
= _(<F extends L, S extends L>(feq: L<(l: F) => L<(r: F) => Bool>>) =>
|
||||
_((seq: L<(l: S) => L<(r: S) => Bool>>) =>
|
||||
uncurry(_((lf: F) => _((ls: S) =>
|
||||
uncurry(_((rf: F) => _((rs: S) =>
|
||||
and(feq(lf)(rf))(seq(ls)(rs))))))))));
|
||||
export const eq = g('eq', l('feq', l('seq', uncurry._(l('lf', l('ls', uncurry._(l('rf', l('rs', and._(r('feq')._('lf')._('rf'))._(r('seq')._('ls')._('rs')))))))))));
|
||||
|
||||
export const ge: L<<F extends L, S extends L>(fcmp: L<(l: F) => L<(r: F) => Ord>>) => L<(scmp: L<(l: S) => L<(r: S) => Bool>>) => L<(l: Pair<F, S>) => L<(r: Pair<F, S>) => Bool>>>>
|
||||
= _(<F extends L, S extends L>(fcmp: L<(l: F) => L<(r: F) => Ord>>) =>
|
||||
_((scmp: L<(l: S) => L<(r: S) => Ord>>) =>
|
||||
uncurry(_((lf: F) => _((ls: S) =>
|
||||
uncurry(_((rf: F) => _((rs: S) =>
|
||||
fcmp(lf)(rf)(False)(scmp(ls)(rs)(False)(True)(True))(True)))))))));
|
||||
export const ge = g('ge', l('fcmp', l('scmp', uncurry._(l('lf', l('ls', uncurry._(l('rf', l('rs', r('fcmp')._('lf')._('rf')._(False)._(r('scmp')._('ls')._('rs')._(False)._(True)._(True))._(True))))))))));
|
||||
|
||||
export const gt: L<<F extends L, S extends L>(fcmp: L<(l: F) => L<(r: F) => Ord>>) => L<(scmp: L<(l: S) => L<(r: S) => Bool>>) => L<(l: Pair<F, S>) => L<(r: Pair<F, S>) => Bool>>>>
|
||||
= _(<F extends L, S extends L>(fcmp: L<(l: F) => L<(r: F) => Ord>>) =>
|
||||
_((scmp: L<(l: S) => L<(r: S) => Ord>>) =>
|
||||
uncurry(_((lf: F) => _((ls: S) =>
|
||||
uncurry(_((rf: F) => _((rs: S) =>
|
||||
fcmp(lf)(rf)(False)(scmp(ls)(rs)(False)(False)(True))(True)))))))));
|
||||
|
||||
export const show: L<<F extends L, S extends L>(fshow: L<(f: F) => String>) => L<(sshow: L<(s: S) => String>) => L<(p: Pair<F, S>) => String>>>
|
||||
= _(<F extends L>(fshow: L<(f: F) => String>) =>
|
||||
_(<S extends L>(sshow: L<(s: S) => String>) =>
|
||||
uncurry(_((f: F) => _((s: S) => concat(cons(_s('('))(cons(fshow(f))(cons(_s(', '))(cons(sshow(s))(cons(_s(')'))(Nil)))))))))));
|
||||
export const gt = g('gt', l('fcmp', l('scmp', uncurry._(l('lf', l('ls', uncurry._(l('rf', l('rs', r('fcmp')._('lf')._('rf')._(False)._(r('scmp')._('ls')._('rs')._(False)._(False)._(True))._(True))))))))));
|
||||
|
||||
@@ -0,0 +1,7 @@
|
||||
import { _, g, m } from './core';
|
||||
import { fromChar as _c } from './char';
|
||||
import { wrap, fromString as _s } from './string';
|
||||
|
||||
m('string.show');
|
||||
|
||||
export const show = g('show', wrap._(_s('"')));
|
||||
+17
-28
@@ -1,40 +1,29 @@
|
||||
import { toNative as $$, L, _, fromNative as __, y } from './core';
|
||||
import { Ord } from './ord';
|
||||
import { Bool } from './bool';
|
||||
import { fromNumber as _nn } from './num';
|
||||
import { toChar as $c, Char, fromChar as _c, cmp as cmpc, eq as eqc } from './char';
|
||||
import { Cons, List, Nil, append, cmp as cmpl, eq as eql, ge as gel, gt as gtl, le as lel, lt as ltl } from './list';
|
||||
import { $, Term, _, d, g, l, m } from './core';
|
||||
import { fromChar as _c, cmp as cmpc, eq as eqc, fromChar, toChar } from './char';
|
||||
import { Cons, Nil, append, cmp as cmpl, eq as eql, ge as gel, gt as gtl, le as lel, lt as ltl, nul } from './list';
|
||||
|
||||
export type String = List<Char>;
|
||||
export { len, Cons, cons, snoc, append, repeat, iterate, get, update, set } from './list';
|
||||
|
||||
export { Nil as Empty, nul as empty, len, Cons, cons, snoc, append, repeat, iterate, get, update, set } from './list';
|
||||
m('string');
|
||||
|
||||
export const cmp: L<(l: String) => L<(r: String) => Ord>>
|
||||
= cmpl(cmpc);
|
||||
export const Empty = g('Empty', Nil);
|
||||
|
||||
export const lt: L<(l: String) => L<(r: String) => Bool>>
|
||||
= ltl(cmpc);
|
||||
export const empty = g('empty', nul);
|
||||
|
||||
export const le: L<(l: String) => L<(r: String) => Bool>>
|
||||
= lel(cmpc);
|
||||
export const cmp = g('cmp', cmpl._(cmpc));
|
||||
|
||||
export const eq: L<(l: String) => L<(r: String) => Bool>>
|
||||
= eql(eqc);
|
||||
export const lt = g('lt', ltl._(cmpc));
|
||||
|
||||
export const ge: L<(l: String) => L<(r: String) => Bool>>
|
||||
= gel(cmpc);
|
||||
export const le = g('le', lel._(cmpc));
|
||||
|
||||
export const gt: L<(l: String) => L<(r: String) => Bool>>
|
||||
= gtl(cmpc);
|
||||
export const eq = g('eq', eql._(eqc));
|
||||
|
||||
export const wrap: L<(w: String) => L<(c: String) => String>>
|
||||
= _(w => _(c => append(w)(append(c)(w))));
|
||||
export const ge = g('ge', gel._(cmpc));
|
||||
|
||||
export const fromString: (xs: string) => String
|
||||
= xs => xs.length === 0 ? Nil : Cons(_c(xs[0]))(y(() => fromString(xs.slice(1))));
|
||||
export const gt = g('gt', gtl._(cmpc));
|
||||
|
||||
export const toString: (xs: String) => string
|
||||
= xs => $$(xs(__(''))(_(x => _(xs => __($c(x) + toString(xs))))));
|
||||
export const wrap = g('wrap', l('w', l('c', append._('w')._(append._('c')._('w')))));
|
||||
|
||||
export const show: L<(s: String) => String>
|
||||
= wrap(fromString('"'));
|
||||
export const fromString: (xs: string) => Term = s => !s.length ? Nil : Cons._(fromChar(s[0]))._(d(() => fromString(s.slice(1))));
|
||||
|
||||
export const toString: (xs: Term) => string = s => $(s._(_(''))._(l('x', l('xs', d(bs => _(toChar(bs['x']) + toString(bs['xs'])))))));
|
||||
|
||||
Reference in New Issue
Block a user