diff options
Diffstat (limited to 'impls.js')
-rw-r--r-- | impls.js | 277 |
1 files changed, 277 insertions, 0 deletions
diff --git a/impls.js b/impls.js new file mode 100644 index 0000000..da7e0cf --- /dev/null +++ b/impls.js @@ -0,0 +1,277 @@ +/** + * Meta + */ + +print = console.log +y = f => x => f(y(f))(x) +k = t => f => t +ki = t => f => f + +/** + * Logic + */ + +// true/false Church booleans +tru = t => f => t +fls = t => f => f + +// evaluate +evalBool = bool => bool("true")("false") + +print(evalBool(tru)) // "true" +print(evalBool(fls)) // "false" + +// negate (c combinator) +negate = bool => t => f => bool(f)(t) + +print(evalBool(negate(tru))) // "false" +print(evalBool(negate(fls))) // "true" + +// logical and +and = a => b => b(a)(b) + +// how? +// - if b is true, then b is re-bound to a (first arg, see lines 1,3) +// - if b is false, then b is re-bound to b (second arg, always false, see lines 2,4) + +print(evalBool(and(tru)(tru))) // "true" +print(evalBool(and(tru)(fls))) // "false" +print(evalBool(and(fls)(tru))) // "false" +print(evalBool(and(fls)(fls))) // "false" + +/** + * Church Pairs + */ + +// construction +cons = a => b => s => s(a)(b) + +// example +examplePair = cons("a")("b") + +// selectors +car = pair => pair(a => b => a) +cdr = pair => pair(a => b => b) + +print(car(examplePair)) // "a" +print(cdr(examplePair)) // "b" + +/** + * Church Lists + */ + +// ["a", "b", "c"] => pair "a" (pair "b" (pair "c" nil)) +// => s1 => (s1 "a" (s2 => (s2 "b" (s3 => (s3 "c" nil))))) + +// end of list +nil = head => tail => tail + +exampleList = cons("a")(cons("b")(cons("c")(nil))) + +// true if list is empty +isNil = list => list(head => tail => rest => fls)(tru) +// first argument gets substituted into first selector (s1) +// just ignore all arguments and return false +// "rest" is the right argument "tru" +// nil ignores first argument, second one is just returned as is ("true") + +print(evalBool(isNil(nil))) // "true" +print(evalBool(isNil(exampleList))) // "false" + +// length = y(rec => n => list => isNil(list)(n)(rec(n + 1)(cdr(list))))(0) + +// thunked due to JS' strictness.. +length = y(rec => n => list => isNil(list)(() => n)(() => rec(n + 1)(cdr(list))()))(0) + +print(length(exampleList)()) + +/** + * Scott Lists + */ + +exampleScottList = end => s1 => s2("a")(s2 => s2("b")(end)) + +/** + * Parigot Lists + */ + +exampleParigotList = s1 => end1 => s1("a")(s2 => end2 => s2("b")(s3 => end3 => end3)) + +/** + * Product types + */ + +// data Friends = Friends { best :: String, friendly :: String, weird :: String } +Friends = best => friendly => weird => s => s(best)(friendly)(weird) +best = friends => friends(best => _ => _ => best) +friendly = friends => friends(_ => friendly => _ => friendly) +weird = friends => friends(_ => _ => weird => weird) + +friends = Friends("Alice")("Bob")("Carol") +print(best(friends)) + +/** + * Sum types, tagged unions + */ + +// data Tree = Leaf Int | Node Tree Tree +Leaf = n => leaf => node => leaf(n) +Node = a => b => leaf => node => node(a)(b) +nodeLeft = node => node(_ => _)(a => b => a) +nodeRight = node => node(_ => _)(a => b => b) +leafValue = leaf => leaf(n => n)(_ => _) +isLeaf = tree => tree(n => tru)(a => b => fls) +isNode = tree => tree(n => fls)(a => b => tru) + +exampleTree = Node(Leaf(1))(Node(Leaf(2))(Leaf(3))) +print(evalBool(isNode(exampleTree))) +print(evalBool(isLeaf(nodeLeft(exampleTree)))) +print(leafValue(nodeLeft(exampleTree))) +print(leafValue(nodeRight(nodeRight(exampleTree)))) + +/** + * Rose, Balanced, binary, finger, etc. trees + */ + +// skipped, see bruijn std +// for example: AVL - can even be used for sets and hashmaps! + +/** + * Strings, chars + */ + +// just a list of numbers/bits/etc. + +/** + * Church numerals + */ + +churchZero = s => z => z +churchSucc = n => s => z => s(n(s)(z)) +churchPred = n => f => x => n(g => h => h(g(f)))(u => x)(u => u) +churchIsZero = n => n(z => fls)(tru) + +print(evalBool(churchIsZero(churchZero))) // true +print(evalBool(churchIsZero(churchSucc(churchZero)))) // false +print(evalBool(churchIsZero(churchPred(churchSucc(churchZero))))) // true + +/** + * Scott numerals + */ + +scottZero = z => s => z +scottSucc = n => z => s => s(n) +scottPred = n => n(scottZero)(x => x) +scottIsZero = n => n(tru)(x => fls) + +print(evalBool(scottIsZero(scottZero))) // true +print(evalBool(scottIsZero(scottSucc(scottZero)))) // false +print(evalBool(scottIsZero(scottPred(scottSucc(scottZero))))) // true + +/** + * Parigot numerals + */ + +parigotZero = n => n +parigotSucc = n => a => b => b(n(a)) +parigotPred = n => a => n(a(x => x)) + +/** + * Wadsworth numerals + */ + +wadsworthZero = n => n(u => k) +wadsworthSucc = n => a => b => n(c => a(b(c))(b)) +wadsworthPred = n => a => n(b => k(a(b)))(x => x) +wadsworthIsZero = n => n(x => x)(k(k(ki))) + +print(evalBool(wadsworthIsZero(wadsworthZero))) // true +print(evalBool(wadsworthIsZero(wadsworthSucc(wadsworthZero)))) // false +print(evalBool(wadsworthIsZero(wadsworthPred(wadsworthSucc(wadsworthZero))))) // true + +/** + * de Bruijn numerals + */ + +bruijnZero = n => n +bruijnSucc = n => a => b => n(a) +bruijnPred = n => a => n(a)(a) +bruijnMult = a => b => a(b) + +/** + * n-ary numerals + */ + +exampleMogensenBinary = end => b1 => b0 => b1(b1(end)) +exampleMogensenTernary = end => tn => tp => t0 => t0(tp(end)) + +/** + * rational, real, complex + */ + +// skipped, see bruijn std + +/** + * Maybe monad + */ + +Nothing = empty => full => empty +Just = v => empty => full => full(v) +isNothing = m => m(tru)(u => fls) +isJust = m => m(fls)(u => tru) +map => f => m => m(nothing)(v => just(f(v))) + +pure = Just +bind = mx => f => mx(mx)(f) +// ------------^^ ^----------------- +// case Nothing case Just (apply) + +evalMaybe = maybe => maybe("Nothing")(v => "Just " + v) +print(evalMaybe(bind(Nothing)(n => pure(n + 1)))) +print(evalMaybe(bind(Just(42))(n => pure(n + 1)))) + +/** + * Either monad + */ + +// data Either a b = Left a | Right b +Left = a => left => right => left(a) +Right = b => left => right => right(b) + +// instance Monad +pure = Right +bind = mx => f => mx(Left)(f) +// ---------^^^^ ^------------------ +// case Left case Right (apply) + +evalEither = either => either(a => "Left " + a)(b => "Right " + b) +print(evalEither(bind(Left(42))(n => pure(n + 1)))) +print(evalEither(bind(Right(42))(n => pure(n + 1)))) + +/** + * Mogensen-Scott meta + */ + +// enc[x] = sym => app => lam => sym(x) +// enc[f(x)] = sym => app => lam => app(enc[f])(enc[x]) +// enc[x => m] = sym => app => lam => lam(x => enc[m]) + +evalMeta = term => term + (x => x) + (f => x => eval(f)(eval(x))) + (m => x => eval(m(x))) + +/** + * Bruijn-Church meta + */ + +// enc[i] = idx => app => lam => church[idx] +// enc[f(x)] = idx => app => lam => app(enc[f])(enc[x]) +// enc[b] = idx => app => lam => lam(enc[b]) + +/** + * Lambda Screen + */ + +// a screen is (s => s(tl)(tr)(bl)(br)), where tl,tr,bl,br in [screen, pixel] +// pixel is (w => b => w) || (w => b => b) |