Data commit

Task/Church-numerals/Nim/church-numerals-1.nim

@@ -0,0 +1,49 @@
+import macros, sugar
+type
+  Fn = proc(p: pointer): pointer{.noSideEffect.}
+  Church = proc(f: Fn): Fn{.noSideEffect.}
+  MetaChurch = proc(c: Church): Church{.noSideEffect.}
+
+#helpers:
+template λfλx(exp): untyped = (f: Fn){.closure.}=>((x: pointer){.closure.}=>exp)
+template λcλf(exp): untyped = (c: Church){.closure.}=>((f: Fn){.closure.}=>exp)
+macro type_erase(body: untyped): untyped =
+  let
+    name = if body[0].kind == nnkPostFix: body[0][1] else: body[0]
+    typ = body[3][0]
+  quote do:
+    `body`
+    proc `name`(p: pointer): pointer =
+      template erased: untyped = cast[ptr `typ`](p)[]
+      erased = erased.`name`
+      p
+macro type_erased(body: untyped): untyped =
+  let (id1, id2, id3) = (body[0][0][0], body[0][0][1], body[0][1])
+  quote do:
+    result = `id3`
+    result = cast[ptr typeof(`id3`)](
+      `id1`(`id2`)(result.addr)
+      )[]
+
+#simple math
+func zero*(): Church = λfλx: x
+func succ*(c: Church): Church = λfλx: f (c f)x
+func `+`*(c, d: Church): Church = λfλx: (c f) (d f)x
+func `*`*(c, d: Church): Church = λfλx: c(d f)x
+
+#exponentiation
+func metazero(): MetaChurch = λcλf: f
+func succ(m: MetaChurch): MetaChurch{.type_erase.} = λcλf: c (m c)f
+converter toMeta*(c: Church): MetaChurch = type_erased: c(succ)(metazero())
+func `^`*(c: Church, d: MetaChurch): Church = d c
+
+#conversions to/from actual numbers
+func incr(x: int): int{.type_erase.} = x+1
+func toInt(c: Church): int = type_erased: c(incr)(0)
+func toChurch*(x: int): Church = return if x <= 0: zero() else: toChurch(x-1).succ
+func `$`*(c: Church): string = $c.toInt
+
+when isMainModule:
+  let three = zero().succ.succ.succ
+  let four = 4.toChurch
+  echo [three+four, three*four, three^four, four^three]

Task/Church-numerals/Nim/church-numerals-2.nim

@@ -0,0 +1,72 @@
+import sugar
+
+type # use a thunk closure as a data type...
+  In = () -> int # a lazy thunk producing an int
+  Func = In -> In
+  Church = Func -> Func
+  MetaChurch = Church -> Church
+  MetaMetaChurch = MetaChurch -> MetaChurch
+  PredChurch = (Func -> In) -> (Func -> In)
+  MetaPredChurch = PredChurch -> PredChurch
+
+type # type Kind to/from conversions...
+  Pun {.union.} = object # does safer casting...
+    normal: Church
+    upone: MetaChurch
+    uptwo: MetaMetaChurch
+    preded: MetaPredChurch
+func lift1(ch: Church): MetaChurch = Pun(normal: ch).upone
+func lift2(ch: Church): MetaMetaChurch = Pun(normal: ch).uptwo
+func liftpred(ch: Church): MetaPredChurch = Pun(normal: ch).preded
+
+let
+  zeroChurch: Church = (_: Func) -> Func => ((x: In) => x)
+  oneChurch: Church = (f: Func) -> Func => f
+  succChurch = (ch: Church) -> Church =>
+    ((f: Func) => ((x: In) => f(ch(f)x)))
+  addChurch = (ach, bch: Church) -> Church =>
+    ((f: Func) => ((x: In) => ((ach f)(bch(f)x))))
+  multChurch = (ach, bch: Church) -> Church => ((f: Func) => ach(bch(f)))
+  expChurch = (basech, expch: Church) -> Church => (expch.lift1() basech)
+  isZeroChurch = (ch: Church) -> Church =>
+    (ch.lift2()((_: Church) => zeroChurch) oneChurch)
+  predChurch = (ch: Church) -> Church =>
+    (func(f: Func): Func =
+      let prd = (gf: Func -> In) => ((hf: In -> In) => (hf(gf(f))))
+      # magic is here, reduces by one function level...
+      ((x: In) => (ch.liftpred())(prd)((_: Func) => x)((t:In) => t)))
+  minusChurch = (ach, bch: Church) -> Church =>
+     (bch.lift2()(predChurch)(ach))
+  # recursively counts times divisor can be subtracted from dividend...
+  divChurch = proc(dvdndch, dvsrch: Church): Church =
+    proc divr(n: Church): Church =
+      (((vch: Church) =>
+        vch.lift2()( # test for zero
+          (_: Church) => (divr(vch).succChurch))( # not zero, loop
+          zeroChurch)) # if zero, return zero
+      )(n.minusChurch(dvsrch)) # subtract one more divisor per loop
+    divr(dvdndch.succChurch)
+
+# conversions to/from Church and int...
+proc toChurch(x: int): Church =
+  result = zeroChurch
+  for _ in 1 .. x: result = result.succChurch
+let incr = (x: In) => (() => x() + 1)
+proc toInt(ch: Church): int = ch(incr)(() => 0)()
+proc `$`(ch: Church): string = $(ch.toInt)
+
+when isMainModule:
+  let threeChurch = 3.toChurch
+  let fourChurch = threeChurch.succChurch
+  let elevenChurch = 11.toChurch
+  let twelveChurch = elevenChurch.succChurch
+  echo [ threeChurch.addChurch(fourChurch)
+       , threeChurch.multChurch(fourChurch)
+       , threeChurch.expChurch(fourChurch)
+       , fourChurch.expChurch(threeChurch)
+       , zeroChurch.isZeroChurch, oneChurch.isZeroChurch
+       , fourChurch.predChurch
+       , elevenChurch.minusChurch(threeChurch)
+       , elevenChurch.divChurch(threeChurch)
+       , twelveChurch.divChurch(threeChurch)
+       ]

Task/Church-numerals/Nim/church-numerals-3.nim

@@ -0,0 +1,90 @@
+import sugar
+
+type
+  Tag = enum tgChurch, tgArityZero
+  Church = ref object
+    case tag: Tag
+    of tgChurch: church: Church -> Church
+    of tgArityZero: value: int
+func makeCChurch(chf: Church -> Church): Church =
+  Church(tag: tgChurch, church: chf)
+proc applyChurch(ch, charg: Church): Church =
+  case ch.tag
+  of tgChurch: ch.church(charg)
+  of tgArityZero: charg # never happens!
+func composeChurch(chl, chr: Church): Church =
+  case chl.tag
+  of tgChurch:
+    case chr.tag
+    of tgChurch: makeCChurch((f: Church) => chl.church(chr.church(f)))
+    of tgArityZero: chl # never happens!
+  of tgArityZero: chl # never happens!
+
+let churchZero = makeCChurch((f: Church) => makeCChurch((x) => x))
+let churchOne = makeCChurch((x) => x)
+proc succChurch(ch: Church): Church =
+  makeCChurch((f) => composeChurch(f, applyChurch(ch, f)))
+proc addChurch(cha, chb: Church): Church =
+  makeCChurch((f) =>
+    composeChurch(applyChurch(cha, f), applyChurch(chb, f)))
+proc multChurch(cha, chb: Church): Church = composeChurch(cha, chb)
+proc expChurch(chbs, chexp: Church): Church = applyChurch(chexp, chbs)
+proc isZeroChurch(ch: Church): Church =
+  applyChurch(applyChurch(ch, Church(tag: tgChurch,
+                                     church: (_: Church) => churchZero)),
+              churchOne)
+proc predChurch(ch: Church): Church =
+  proc ff(f: Church): Church =
+    proc xf(x: Church): Church =
+      let prd = makeCChurch((g) => makeCChurch((h) =>
+                  applyChurch(h, applyChurch(g, f))))
+      let frstch = makeCChurch((_) => x)
+      let idch = makeCChurch((a) => a)
+      applyChurch(applyChurch(applyChurch(ch, prd), frstch), idch)
+    makeCChurch(xf)
+  makeCChurch(ff)
+proc subChurch(cha, chb: Church): Church =
+  applyChurch(applyChurch(chb, makeCChurch(predChurch)), cha)
+proc divChurch(chdvdnd, chdvsr: Church): Church =
+  proc divr(chn: Church): Church =
+    proc tst(chv: Church): Church =
+      let loopr = makeCChurch((_) => succChurch(divr(chv)))
+      applyChurch(applyChurch(chv, loopr), churchZero)
+    tst(subChurch(chn, chdvsr))
+  divr(succChurch(chdvdnd))
+
+# converters...
+converter intToChurch(i: int): Church =
+  func loop(n: int, rch: Church): Church = # recursive function call
+    if n <= 0: rch else: loop(n - 1, succChurch(rch))
+  loop(i, churchZero)
+#  result = churchZero # imperative non recursive way...
+#  for _ in 1 .. i: result = succChurch(result)
+converter churchToInt(ch: Church): int =
+  func succInt(chv: Church): Church =
+    case chv.tag
+    of tgArityZero: Church(tag: tgArityZero, value: chv.value + 1)
+    of tgChurch: chv
+  let rslt = applyChurch(applyChurch(ch, Church(tag: tgChurch, church: succInt)),
+                         Church(tag: tgArityZero, value: 0))
+  case rslt.tag
+  of tgArityZero: rslt.value
+  of tgChurch: -1
+proc `$`(ch: Church): string = $ch.int
+
+# test it...
+when isMainModule:
+  let c3: Church = 3
+  let c4 = succChurch c3
+  let c11: Church = 11
+  let c12 = succChurch c11
+  echo addChurch(c3, c4), " ",
+       multChurch(c3, c4), " ",
+       expChurch(c3, c4), " ",
+       expChurch(c4, c3), " ",
+       isZeroChurch(churchZero), " ",
+       isZeroChurch(c3), " ",
+       predChurch(c4), " ",
+       subChurch(c11, c3), " ",
+       divChurch(c11, c3), " ",
+       divChurch(c12, c3)