You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
82 lines
4.8 KiB
82 lines
4.8 KiB
import { L, P, _ } 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';
|
|
|
|
export type Pair<F extends P, S extends P> = L<<R extends P>(f: L<(f: F) => L<(s: S) => R>>) => R>;
|
|
|
|
export const Pair: L<<F extends P, S extends P>(f: F) => L<(s: S) => Pair<F, S>>>
|
|
= _(<F extends P, S extends P>(f: F) =>
|
|
_((s: S) =>
|
|
_(<R extends P>(p: L<(f: F) => L<(s: S) => R>>) => p(f)(s))));
|
|
|
|
export const fst: L<<F extends P, S extends P>(p: Pair<F, S>) => F>
|
|
= _(p => p(_(f => _(_s => f))));
|
|
|
|
export const snd: L<<F extends P, S extends P>(p: Pair<F, S>) => S>
|
|
= _(p => p(_(_f => _(s => s))));
|
|
|
|
export const first: L<<F extends P, FR extends P, S extends P>(t: L<(f: F) => FR>) => L<(p: Pair<F, S>) => Pair<FR, S>>>
|
|
= _(<F extends P, FR extends P>(t: L<(f: F) => FR>) =>
|
|
_(<S extends P>(p: Pair<F, S>) => p(_(f => _(s => Pair(t(f))(s))))));
|
|
|
|
export const second: L<<F extends P, S extends P, SR extends P>(t: L<(s: S) => SR>) => L<(p: Pair<F, S>) => Pair<F, SR>>>
|
|
= _(<S extends P, SR extends P>(t: L<(s: S) => SR>) =>
|
|
_(<F extends P>(p: Pair<F, S>) => p(_(f => _(s => Pair(f)(t(s)))))));
|
|
|
|
export const both: L<<F extends P, FR extends P, S extends P, SR extends P>(tf: L<(f: F) => FR>) => L<(ts: L<(s: S) => SR>) => L<(p: Pair<F, S>) => Pair<FR, SR>>>>
|
|
= _(<F extends P, FR extends P>(tf: L<(f: F) => FR>) =>
|
|
_(<S extends P, SR extends P>(ts: L<(s: S) => SR>) =>
|
|
_((p: Pair<F, S>) => p(_(f => _(s => Pair(tf(f))(ts(s))))))));
|
|
|
|
export const uncurry: L<<F extends P, S extends P, R extends P>(t: L<(f: F) => L<(s: S) => R>>) => L<(p: Pair<F, S>) => R>>
|
|
= _(<F extends P, S extends P, R extends P>(t: L<(f: F) => L<(s: S) => R>>) =>
|
|
_((p: Pair<F, S>) => p(t)));
|
|
|
|
export const cmp: L<<F extends P, S extends P>(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 P, S extends P>(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 lt: L<<F extends P, S extends P>(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 P, S extends P>(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 le: L<<F extends P, S extends P>(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 P, S extends P>(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 eq: L<<F extends P, S extends P>(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 P, S extends P>(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 ge: L<<F extends P, S extends P>(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 P, S extends P>(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 gt: L<<F extends P, S extends P>(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 P, S extends P>(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 P, S extends P>(fshow: L<(f: F) => String>) => L<(sshow: L<(s: S) => String>) => L<(p: Pair<F, S>) => String>>>
|
|
= _(<F extends P>(fshow: L<(f: F) => String>) =>
|
|
_(<S extends P>(sshow: L<(s: S) => String>) =>
|
|
uncurry(_((f: F) => _((s: S) => concat(cons(_s('('))(cons(fshow(f))(cons(_s(', '))(cons(sshow(s))(cons(_s(')'))(Nil)))))))))));
|
|
|