diff --git a/Makefile b/Makefile index 1e50651fc..92e69986f 100644 --- a/Makefile +++ b/Makefile @@ -157,6 +157,8 @@ include examples/examples.mk include examples/pyapp/pyapp.mk include tool/decode/lib/decodelib.mk include tool/decode/decode.mk +include tool/lambda/lib/lib.mk +include tool/lambda/lambda.mk include tool/hash/hash.mk include tool/net/net.mk include tool/viz/viz.mk diff --git a/tool/lambda/asc2bin.c b/tool/lambda/asc2bin.c new file mode 100644 index 000000000..66642a12e --- /dev/null +++ b/tool/lambda/asc2bin.c @@ -0,0 +1,77 @@ +/*-*- mode:c;indent-tabs-mode:nil;c-basic-offset:2;tab-width:8;coding:utf-8 -*-│ +│vi: set net ft=c ts=2 sts=2 sw=2 fenc=utf-8 :vi│ +╞══════════════════════════════════════════════════════════════════════════════╡ +│ Copyright 2022 Justine Alexandra Roberts Tunney │ +│ │ +│ Copying of this file is authorized only if (1) you are Justine Tunney, or │ +│ (2) you make absolutely no changes to your copy. │ +│ │ +│ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES │ +│ WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF │ +│ MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR │ +│ ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES │ +│ WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN │ +│ ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF │ +│ OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. │ +╚─────────────────────────────────────────────────────────────────────────────*/ +#include "third_party/getopt/getopt.h" +#include "tool/lambda/lib/blc.h" + +#define USAGE \ + " [-?h] [FILE...] binary.bin\n\ +Converts ASCII binary to ACTUAL binary, e.g.\n\ +\n\ + $ { printf 'λx.x' | o/lam2bin | o/asc2bin; printf abc; } | o/Blc\n\ + abc\n\ +\n\ + $ printf '\n\ + (00 (01 (01 10 ((01 (00 (01 10 10))\n\ + (00000000 (01 (01 110 ((01 11110 11110)))\n\ + (00 (01 (01 10 11110) 110)))))))\n\ + (0000 10)))\n\ + ' | asc2bin | xxd -b\n\ + 00000000: 00010110 01000110 10000000 00010111 00111110 11110000 .F..>.\n\ + 00000006: 10110111 10110000 01000000 ..@\n\ +\n\ +FLAGS\n\ +\n\ + -h Help\n\ + -? Help\n" + +void LoadFlags(int argc, char *argv[]) { + int i; + const char *prog; + prog = argc ? argv[0] : "asc2bin"; + while ((i = getopt(argc, argv, "?h")) != -1) { + switch (i) { + case '?': + case 'h': + fputs("Usage: ", stdout); + fputs(prog, stdout); + fputs(USAGE, stdout); + exit(0); + default: + fputs("Usage: ", stderr); + fputs(prog, stderr); + fputs(USAGE, stderr); + exit(1); + } + } +} + +int main(int argc, char *argv[]) { + int i, b, c, n; + LoadFlags(argc, argv); + n = c = i = 0; + while ((b = GetBit(stdin)) != -1) { + c |= b << (7 - n); + if (++n == 8) { + fputc(c, stdout); + c = 0; + n = 0; + } + } + if (n) { + fputc(c, stdout); + } +} diff --git a/tool/lambda/blcdump.c b/tool/lambda/blcdump.c new file mode 100644 index 000000000..143f4a13d --- /dev/null +++ b/tool/lambda/blcdump.c @@ -0,0 +1,156 @@ +/*-*- mode:c;indent-tabs-mode:nil;c-basic-offset:2;tab-width:8;coding:utf-8 -*-│ +│vi: set net ft=c ts=2 sts=2 sw=2 fenc=utf-8 :vi│ +╞══════════════════════════════════════════════════════════════════════════════╡ +│ Copyright 2022 Justine Alexandra Roberts Tunney │ +│ │ +│ Copying of this file is authorized only if (1) you are Justine Tunney, or │ +│ (2) you make absolutely no changes to your copy. │ +│ │ +│ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES │ +│ WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF │ +│ MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR │ +│ ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES │ +│ WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN │ +│ ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF │ +│ OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. │ +╚─────────────────────────────────────────────────────────────────────────────*/ +#include "libc/calls/calls.h" +#include "libc/calls/struct/rlimit.h" +#include "libc/sysv/consts/rlimit.h" +#include "libc/unicode/locale.h" +#include "third_party/getopt/getopt.h" +#include "tool/lambda/lib/blc.h" + +/** + * @fileoverview Binary Lambda Calculus Dump Utility, e.g. + * + * $ echo 0000001110 | o//blcdump -b 2>/dev/null + * (λ (λ (λ 2))) + * + * The term rom is printed to stderr along with all skewed overlapping + * perspectives on the in-memory representation. + * + * $ echo 0000001110 | o//blcdump -b >/dev/null + * .long ABS # 0=3: (λ (λ (λ 2))) + * .long ABS # 1=3: (λ (λ 2)) + * .long ABS # 2=3: (λ 2) + * .long VAR # 3=1: 2 + * .long 2 # 4=2: (⋯ ⋯) + */ + +#define USAGE \ + " [-?hbBnNlS] [FILE...] expr.txt 2>memory.txt\n\ +Binary Lambda Calculus Dump Tool\n\ +\n\ +FLAGS\n\ +\n\ + -h Help\n\ + -b 8-bit binary mode\n\ + -B debug print binary\n\ + -l print lambda notation\n\ + -n disables name rewriting rules\n\ + -N disables most unicode symbolism\n" + +void PrintUsage(const char *prog, int rc, FILE *f) { + fputs("Usage: ", f); + fputs(prog, f); + fputs(USAGE, f); + exit(rc); +} + +void LoadFlags(int argc, char *argv[]) { + int i; + const char *prog; + prog = argc ? argv[0] : "blcdump"; + while ((i = getopt(argc, argv, "?hubBnNlS")) != -1) { + switch (i) { + case 'b': + binary = 1; + break; + case 'n': + noname = 1; + break; + case 'N': + asciiname = 1; + break; + case 'l': + style = 1; + break; + case 'B': + style = 2; + break; + case 'S': + safer = 1; + break; + case '?': + case 'h': + PrintUsage(prog, 0, stdout); + default: + PrintUsage(prog, 1, stderr); + } + } +} + +void Expand(int c) { + if (end >= TERMS) Error(5, "OUT OF TERMS"); + mem[end++] = c; +} + +void ExpandBit(int b) { + Expand(ABS); + Expand(ABS); + Expand(VAR); + Expand(b); +} + +void ExpandList(int next) { + Expand(ABS); + Expand(APP); + Expand(next); + Expand(APP); + Expand(2); + Expand(VAR); + Expand(0); +} + +void ExpandItem(int b) { + ExpandList(8); + ExpandBit(b); +} + +void ExpandByte(int b) { + ExpandList(4 + 8 * (7 + 4)); + ExpandItem((b >> 0) & 1); + ExpandItem((b >> 1) & 1); + ExpandItem((b >> 2) & 1); + ExpandItem((b >> 3) & 1); + ExpandItem((b >> 4) & 1); + ExpandItem((b >> 5) & 1); + ExpandItem((b >> 6) & 1); + ExpandItem((b >> 7) & 1); + ExpandBit(0); +} + +int main(int argc, char *argv[]) { + struct Parse p; + struct rlimit rlim = {512 * 1024 * 1024, 512 * 1024 * 1024}; + setrlimit(RLIMIT_AS, &rlim); + setlocale(LC_ALL, ""); + setvbuf(stdout, 0, _IOFBF, 0); + setvbuf(stderr, 0, _IOLBF, 0); + LoadFlags(argc, argv); +#if DEBUG + logh = fopen("o//log", "w"); + fprintf(logh, " IP END HEAP %-*s NOM MESSAGE\n", LOC, "LOC"); + setvbuf(logh, 0, _IOLBF, 0); +#endif + end = 32; + for (; !feof(stdin); ip = end) { + p = Parse(1, stdin); + if (p.n) { + Print(p.i, 1, 0, stdout); + fputc('\n', stdout); + Dump(p.i, p.i + p.n, stderr); + } + } +} diff --git a/tool/lambda/bru2bin.c b/tool/lambda/bru2bin.c new file mode 100644 index 000000000..c1ab2a33c --- /dev/null +++ b/tool/lambda/bru2bin.c @@ -0,0 +1,324 @@ +/*-*- mode:c;indent-tabs-mode:nil;c-basic-offset:2;tab-width:8;coding:utf-8 -*-│ +│vi: set net ft=c ts=2 sts=2 sw=2 fenc=utf-8 :vi│ +╞══════════════════════════════════════════════════════════════════════════════╡ +│ Copyright 2022 Justine Alexandra Roberts Tunney │ +│ │ +│ Permission to use, copy, modify, and/or distribute this software for │ +│ any purpose with or without fee is hereby granted, provided that the │ +│ above copyright notice and this permission notice appear in all copies. │ +│ │ +│ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL │ +│ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED │ +│ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE │ +│ AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL │ +│ DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR │ +│ PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER │ +│ TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR │ +│ PERFORMANCE OF THIS SOFTWARE. │ +╚─────────────────────────────────────────────────────────────────────────────*/ +#include "libc/calls/calls.h" +#include "libc/intrin/kprintf.h" +#include "libc/stdio/stdio.h" +#include "libc/unicode/locale.h" +#include "third_party/getopt/getopt.h" + +#define USAGE \ + " [-?h01] binary.txt\n\ +Converts de Bruijn notation to ASCII binary, e.g.\n\ +\n\ + $ printf 'λ (λ 1 (0 0)) (λ 1 (0 0)))' | lam2bin\n\ + 000100011100110100001110011010\n\ +\n\ +FLAGS\n\ +\n\ + -h Help\n\ + -? Help\n\ + -0 0-based indexing\n\ + -1 1-based indexing\n" + +struct Node { + int t, x; + struct Node *l, *r; +}; + +int sp; +int end; +int unget; +int indexing; +const char *str; + +static void LoadFlags(int argc, char *argv[]) { + int i; + const char *prog; + prog = argc ? argv[0] : "lam2bin"; + while ((i = getopt(argc, argv, "?h01")) != -1) { + switch (i) { + case '0': + indexing = 0; + break; + case '1': + indexing = 1; + break; + case '?': + case 'h': + fputs("Usage: ", stdout); + fputs(prog, stdout); + fputs(USAGE, stdout); + exit(0); + default: + fputs("Usage: ", stderr); + fputs(prog, stderr); + fputs(USAGE, stderr); + exit(1); + } + } +} + +wontreturn static void Error(int rc, const char *s, ...) { + va_list va; + fflush(stdout); + fputs("\33[1;31merror\33[37m: ", stderr); + fflush(stderr); + va_start(va, s); + kvprintf(s, va); + va_end(va); + fputc('\n', stderr); + exit(rc); +} + +static struct Node *NewNode(int t, int x, struct Node *l, struct Node *r) { + struct Node *n; + n = malloc(sizeof(struct Node)); + n->t = t; + n->x = x; + n->l = l; + n->r = r; + return n; +} + +static int Greed(void) { + int c, t; + for (t = 0;;) { + if (unget) { + c = unget; + unget = 0; + } else if (str) { + if (*str) { + c = *str++; + } else { + str = 0; + c = fgetwc(stdin); + } + } else { + c = fgetwc(stdin); + } + if (c == EOF) return c; + if (!t) { + if (c == '#' || c == ';') { + t = 1; + continue; + } + } else { + if (c == '\n') { + t = 0; + } + continue; + } + if (!str) { + switch (c) { + case L'⊥': + str = "(\\ab.b)"; + continue; + case L'⊤': + str = "(\\ab.a)"; + continue; +#if 0 + case L'0': + str = "(\\ab.b)"; + continue; + case L'1': + str = "(\\ab.ab)"; + continue; + case L'2': + str = "(\\ab.a(ab))"; + continue; + case L'3': + str = "(\\ab.a(a(ab)))"; + continue; + case L'4': + str = "(\\ab.a(a(a(ab))))"; + continue; + case L'5': + str = "(\\ab.a(a(a(a(ab)))))"; + continue; + case L'6': + str = "(\\ab.a(a(a(a(a(ab))))))"; + continue; + case L'7': + str = "(\\ab.a(a(a(a(a(a(ab)))))))"; + continue; + case L'8': + str = "(\\ab.a(a(a(a(a(a(a(ab))))))))"; + continue; + case L'9': + str = "(\\ab.a(a(a(a(a(a(a(a(ab)))))))))"; + continue; +#endif + case L'ω': + str = "(\\x.xx)"; + continue; + case L'Ω': + str = "((\\x.xx)(\\x.xx))"; + continue; + case L'Y': + str = "(\\f.(\\x.f(xx))(\\x.f(xx)))"; + continue; + case L'∧': + str = "(\\ab.aba)"; + continue; + case L'∨': + str = "(\\ab.aab)"; + continue; + case L'⊻': + str = "(\\ab.a((\\c.c(\\de.e)(\\de.d))b)b)"; + continue; + case L'¬': + str = "(\\a.a(\\bc.c)(\\bc.b))"; + continue; + case L'+': + str = "(\\abcd.ac(bcd))"; + continue; + case L'*': + str = "(\\abc.a(bc))"; + continue; + case L'^': + str = "(\\ab.ba)"; + continue; + case L'-': + str = "(\\ab.b(\\cde.c(\\fg.g(fd))(\\f.e)(\\f.f))a)"; + continue; + case L'/': + str = "(\\a.(\\b.(\\c.cc)(\\c.b(cc)))(\\bcdef.(\\g.(\\h.h(\\ijk.k)(" + "\\ij.i))g((\\hi.i)ef)(e(bgdef)))((\\gh.h(\\ijk.i(\\lm.m(lj))(" + "\\l.k)(\\l.l))g)cd))((\\bcd.c(bcd))a))"; + continue; + case L'Я': + str = "(\\a.a((\\b.bb)(\\bcde.d(bb)(\\f.fce)))(\\bc.c))"; + continue; + default: + break; + } + } + return c; + } +} + +static int Need(void) { + int c; + if ((c = Greed()) != EOF) return c; + Error(1, "unfinished expression"); +} + +static struct Node *Parse1(void) { + wint_t c; + int i, oldsp; + struct Node *r, *p, *q, *s; + do { + if ((c = Greed()) == EOF) return 0; + } while (iswspace(c)); + if (c == L'λ' || c == '\\') { + oldsp = sp; + p = r = NewNode(0, 0, 0, 0); + ++sp; + for (;;) { + c = Need(); + if (c == L'λ' || c == '\\') { + p = p->l = NewNode(0, 0, 0, 0); + ++sp; + continue; + } else { + unget = c; + break; + } + } + q = Parse1(); + if (!q) Error(4, "lambda needs body"); + p->l = q; + while ((q = Parse1())) { + p->l = NewNode(2, 0, p->l, q); + } + sp = oldsp; + return r; + } else if (c == L'!') { + // intentionally trigger undefined variable + return NewNode(1, sp, 0, 0); + } else if (iswdigit(c)) { + i = 0; + for (;;) { + i *= 10; + i += c - '0'; + c = Greed(); + if (c == EOF) break; + if (!iswdigit(c)) { + unget = c; + break; + } + } + i -= indexing; + if (i < 0) Error(5, "undefined variable: %lc", c); + return NewNode(1, i, 0, 0); + } else if (c == '(') { + p = r = Parse1(); + if (!p) Error(6, "empty parenthesis"); + while ((q = Parse1())) { + r = NewNode(2, 0, r, q); + } + c = Need(); + if (c != ')') Error(7, "expected closing parenthesis"); + return r; + } else if (c == ')') { + unget = c; + return 0; + } else { + Error(8, "unexpected character: 0x%04x %lc", c, c); + } +} + +static struct Node *Parse(void) { + wint_t c; + int i, oldsp; + struct Node *r, *p, *q, *s; + p = r = Parse1(); + if (!p) Error(6, "empty expression"); + while ((q = Parse1())) { + r = NewNode(2, 0, r, q); + } + return r; +} + +static void Print(struct Node *p) { + int i; + if (p->t == 0) { + fputc('0', stdout); + fputc('0', stdout); + Print(p->l); + } else if (p->t == 1) { + for (i = -1; i < p->x; ++i) { + fputc('1', stdout); + } + fputc('0', stdout); + } else if (p->t == 2) { + fputc('0', stdout); + fputc('1', stdout); + Print(p->l); + Print(p->r); + } else { + abort(); + } +} + +int main(int argc, char *argv[]) { + setlocale(LC_ALL, ""); + LoadFlags(argc, argv); + Print(Parse()); +} diff --git a/tool/lambda/lam2bin.c b/tool/lambda/lam2bin.c new file mode 100644 index 000000000..979a08a34 --- /dev/null +++ b/tool/lambda/lam2bin.c @@ -0,0 +1,305 @@ +/*-*- mode:c;indent-tabs-mode:nil;c-basic-offset:2;tab-width:8;coding:utf-8 -*-│ +│vi: set net ft=c ts=2 sts=2 sw=2 fenc=utf-8 :vi│ +╞══════════════════════════════════════════════════════════════════════════════╡ +│ Copyright 2022 Justine Alexandra Roberts Tunney │ +│ │ +│ Permission to use, copy, modify, and/or distribute this software for │ +│ any purpose with or without fee is hereby granted, provided that the │ +│ above copyright notice and this permission notice appear in all copies. │ +│ │ +│ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL │ +│ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED │ +│ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE │ +│ AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL │ +│ DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR │ +│ PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER │ +│ TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR │ +│ PERFORMANCE OF THIS SOFTWARE. │ +╚─────────────────────────────────────────────────────────────────────────────*/ +#include "libc/calls/calls.h" +#include "libc/intrin/kprintf.h" +#include "libc/stdio/stdio.h" +#include "libc/unicode/locale.h" +#include "third_party/getopt/getopt.h" + +#define USAGE \ + " [-?h] binary.txt\n\ +Converts lambda notation to ASCII binary, e.g.\n\ +\n\ + $ printf 'λf.(λx.f(xx))(λx.f(xx))' | lam2bin\n\ + 000100011100110100001110011010\n\ +\n\ +FLAGS\n\ +\n\ + -h Help\n\ + -? Help\n" + +struct Node { + int t, x; + struct Node *l, *r; +}; + +int sp; +int end; +int unget; +int args[1024]; +const char *str; + +static void LoadFlags(int argc, char *argv[]) { + int i; + const char *prog; + prog = argc ? argv[0] : "lam2bin"; + while ((i = getopt(argc, argv, "?h")) != -1) { + switch (i) { + case '?': + case 'h': + fputs("Usage: ", stdout); + fputs(prog, stdout); + fputs(USAGE, stdout); + exit(0); + default: + fputs("Usage: ", stderr); + fputs(prog, stderr); + fputs(USAGE, stderr); + exit(1); + } + } +} + +wontreturn static void Error(int rc, const char *s, ...) { + va_list va; + fflush(stdout); + fputs("\33[1;31merror\33[37m: ", stderr); + fflush(stderr); + va_start(va, s); + kvprintf(s, va); + va_end(va); + fputc('\n', stderr); + exit(rc); +} + +static struct Node *NewNode(int t, int x, struct Node *l, struct Node *r) { + struct Node *n; + n = malloc(sizeof(struct Node)); + n->t = t; + n->x = x; + n->l = l; + n->r = r; + return n; +} + +static int Greed(void) { + int c, t; + for (t = 0;;) { + if (unget) { + c = unget; + unget = 0; + } else if (str) { + if (*str) { + c = *str++; + } else { + str = 0; + c = fgetwc(stdin); + } + } else { + c = fgetwc(stdin); + } + if (c == EOF) return c; + if (!t) { + if (c == '#' || c == ';') { + t = 1; + continue; + } + } else { + if (c == '\n') { + t = 0; + } + continue; + } + if (iswspace(c)) continue; + if (!str) { + switch (c) { + case L'⊥': + str = "(\\ab.b)"; + continue; + case L'⊤': + str = "(\\ab.a)"; + continue; +#if 0 + case L'0': + str = "(\\ab.b)"; + continue; + case L'1': + str = "(\\ab.ab)"; + continue; + case L'2': + str = "(\\ab.a(ab))"; + continue; + case L'3': + str = "(\\ab.a(a(ab)))"; + continue; + case L'4': + str = "(\\ab.a(a(a(ab))))"; + continue; + case L'5': + str = "(\\ab.a(a(a(a(ab)))))"; + continue; + case L'6': + str = "(\\ab.a(a(a(a(a(ab))))))"; + continue; + case L'7': + str = "(\\ab.a(a(a(a(a(a(ab)))))))"; + continue; + case L'8': + str = "(\\ab.a(a(a(a(a(a(a(ab))))))))"; + continue; + case L'9': + str = "(\\ab.a(a(a(a(a(a(a(a(ab)))))))))"; + continue; +#endif + case L'ω': + str = "(\\x.xx)"; + continue; + case L'Ω': + str = "((\\x.xx)(\\x.xx))"; + continue; + case L'Y': + str = "(\\f.(\\x.f(xx))(\\x.f(xx)))"; + continue; + case L'∧': + str = "(\\ab.aba)"; + continue; + case L'∨': + str = "(\\ab.aab)"; + continue; + case L'⊻': + str = "(\\ab.a((\\c.c(\\de.e)(\\de.d))b)b)"; + continue; + case L'¬': + str = "(\\a.a(\\bc.c)(\\bc.b))"; + continue; + case L'+': + str = "(\\abcd.ac(bcd))"; + continue; + case L'*': + str = "(\\abc.a(bc))"; + continue; + case L'^': + str = "(\\ab.ba)"; + continue; + case L'-': + str = "(\\ab.b(\\cde.c(\\fg.g(fd))(\\f.e)(\\f.f))a)"; + continue; + case L'/': + str = "(\\a.(\\b.(\\c.cc)(\\c.b(cc)))(\\bcdef.(\\g.(\\h.h(\\ijk.k)(" + "\\ij.i))g((\\hi.i)ef)(e(bgdef)))((\\gh.h(\\ijk.i(\\lm.m(lj))(" + "\\l.k)(\\l.l))g)cd))((\\bcd.c(bcd))a))"; + continue; + case L'Я': + str = "(\\a.a((\\b.bb)(\\bcde.d(bb)(\\f.fce)))(\\bc.c))"; + continue; + default: + break; + } + } + return c; + } +} + +static int Need(void) { + int c; + if ((c = Greed()) != EOF) return c; + Error(1, "unfinished expression"); +} + +static struct Node *Parse1(void) { + wint_t c; + int i, oldsp; + struct Node *r, *p, *q, *s; + if ((c = Greed()) == EOF) return 0; + if (c == L'λ' || c == '\\') { + oldsp = sp; + c = Need(); + if (!(isalnum(c) || c == '_')) Error(2, "lambda needs argument"); + p = r = NewNode(0, 0, 0, 0); + args[sp++] = c; + while ((c = Need()) != '.') { + if (!(isalnum(c) || c == '_')) Error(3, "lambda needs argument"); + p = p->l = NewNode(0, 0, 0, 0); + args[sp++] = c; + } + q = Parse1(); + if (!q) Error(4, "lambda needs body"); + p->l = q; + while ((q = Parse1())) { + p->l = NewNode(2, 0, p->l, q); + } + sp = oldsp; + return r; + } else if (c == L'!') { + // intentionally trigger undefined variable + return NewNode(1, sp, 0, 0); + } else if (isalnum(c) || c == '_') { + for (i = sp; i--;) { + if (args[i] == c) { + i = sp - 1 - i; + break; + } + } + if (i < 0) Error(5, "undefined variable: %d %lc", c, c); + return NewNode(1, i, 0, 0); + } else if (c == '(') { + p = r = Parse1(); + if (!p) Error(6, "empty parenthesis"); + while ((q = Parse1())) { + r = NewNode(2, 0, r, q); + } + c = Need(); + if (c != ')') Error(7, "expected closing parenthesis"); + return r; + } else if (c == ')') { + unget = c; + return 0; + } else { + Error(8, "unexpected character: 0x%04x %lc", c, c); + } +} + +static struct Node *Parse(void) { + wint_t c; + int i, oldsp; + struct Node *r, *p, *q, *s; + p = r = Parse1(); + if (!p) Error(6, "empty expression"); + while ((q = Parse1())) { + r = NewNode(2, 0, r, q); + } + return r; +} + +static void Print(struct Node *p) { + int i; + if (p->t == 0) { + fputc('0', stdout); + fputc('0', stdout); + Print(p->l); + } else if (p->t == 1) { + for (i = -1; i < p->x; ++i) { + fputc('1', stdout); + } + fputc('0', stdout); + } else if (p->t == 2) { + fputc('0', stdout); + fputc('1', stdout); + Print(p->l); + Print(p->r); + } else { + abort(); + } +} + +int main(int argc, char *argv[]) { + setlocale(LC_ALL, ""); + LoadFlags(argc, argv); + Print(Parse()); +} diff --git a/tool/lambda/lambda.c b/tool/lambda/lambda.c new file mode 100644 index 000000000..70f2f36d4 --- /dev/null +++ b/tool/lambda/lambda.c @@ -0,0 +1,352 @@ +/*-*- mode:c;indent-tabs-mode:nil;c-basic-offset:2;tab-width:8;coding:utf-8 -*-│ +│vi: set net ft=c ts=2 sts=2 sw=2 fenc=utf-8 :vi│ +╞══════════════════════════════════════════════════════════════════════════════╡ +│ Copyright 2022 Justine Alexandra Roberts Tunney │ +│ │ +│ Copying of this file is authorized only if (1) you are Justine Tunney, or │ +│ (2) you make absolutely no changes to your copy. │ +│ │ +│ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES │ +│ WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF │ +│ MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR │ +│ ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES │ +│ WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN │ +│ ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF │ +│ OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. │ +╚─────────────────────────────────────────────────────────────────────────────*/ +#include "libc/assert.h" +#include "libc/calls/calls.h" +#include "libc/calls/struct/rlimit.h" +#include "libc/calls/struct/sigaction.h" +#include "libc/log/log.h" +#include "libc/runtime/runtime.h" +#include "libc/stdio/stdio.h" +#include "libc/sysv/consts/map.h" +#include "libc/sysv/consts/prot.h" +#include "libc/sysv/consts/rlimit.h" +#include "libc/sysv/consts/sig.h" +#include "libc/unicode/locale.h" +#include "third_party/getopt/getopt.h" +#include "tool/lambda/lib/blc.h" + +#define USAGE \ + " [-?hubBdsarvnNlS] expr.txt\n\ +Binary Lambda Calculus Virtual Machine\n\ +\n\ +FLAGS\n\ +\n\ + -h help\n\ + -r rex log\n\ + -b binary 8-bit i/o\n\ + -B debug print binary\n\ + -l print lambda notation\n\ + -a action log [implies -r]\n\ + -v variable log [implies -r]\n\ + -s full machine state logging\n\ + -n disables name rewriting rules\n\ + -N disables most unicode symbolism\n\ + -d dump terms on successful exit\n" + +#define NIL 23 +#define TRUE 27 +#define FALSE 23 + +#define REF(c) (++(c)->refs, c) + +static const char kRom[] = { + APP, 0, // 0 (λ 0 λ 0 (λ 0 wr0 wr1) put) (main gro) + ABS, // 2 λ 0 λ 0 (λ 0 wr0 wr1) put + APP, 0, // 3 + VAR, 0, // 5 + ABS, // 7 + APP, // 8 + ABS, // 9 λ 0 λ 0 wr0 wr1 + APP, 2, // 10 + VAR, // 12 + IOP, // 13 + ABS, // 14 λ 0 wr0 wr1 + APP, 4, // 15 + APP, 1, // 17 + VAR, // 19 + IOP, // 20 wr0 + IOP, 0, // 21 wr1 + ABS, // 23 (λλ 0) a.k.a. nil + ABS, // 24 exit + VAR, // 25 + 0, // 26 exit[0] + ABS, // 27 (λλ 1) a.k.a. true + ABS, // 28 + VAR, 1, // 29 +}; + +static int postdump; +static int kLazy[256]; + +void Quit(int sig) { + Dump(0, end, stderr); + exit(128 + sig); +} + +void PrintUsage(const char *prog, int rc, FILE *f) { + fputs("Usage: ", f); + fputs(prog, f); + fputs(USAGE, f); + exit(rc); +} + +int Backref(int x) { + return x - (end + 1); +} + +static inline void Expand(int c) { + if (end >= TERMS) Error(5, "OUT OF TERMS"); + mem[end++] = c; +} + +void Gc(struct Closure *p) { + struct Closure *t; + while (p && p != &root) { + if (--p->refs) break; + Gc(p->next); + t = p->envp; + p->envp = 0; + p->next = frep; + frep = p; + p = t; + } +} + +void Var(void) { + int i, x; + struct Closure *t, *e; + e = t = envp; + x = mem[ip + 1]; + for (i = 0; i < x && e != &root; ++i) e = e->next; + if (e == &root) Error(10 + x, "UNDEFINED VARIABLE %d", x); + ip = e->term; + envp = REF(e->envp); + Gc(t); +} + +void Gro(void) { + int c = fgetc(stdin); + if (c != -1) { + Expand(ABS); + Expand(APP); + Expand(4); + Expand(APP); + Expand(Backref(binary ? kLazy[c] : c & 1 ? FALSE : TRUE)); + Expand(VAR); + Expand(0); + } else { + Expand(ABS); + Expand(ABS); + Expand(VAR); + Expand(0); + } +} + +void Put(void) { + int bit; + long newip; + if (!binary) { + co = '0' + (ip & 1); + fputc(co, stdout); + newip = 2; + } else if (mem[ip + 1] & 1) { // ip ∈ {6,13} + fputc(co, stdout); + newip = 2; + } else { // ip ∈ {20,21} + newip = 9; // (λ 0 (λ 0 wr1 wr0)) + bit = ip & 1; + co = (co * 2) | bit; + } + if (ferror(stdout)) { + exit(55); + } + ip = newip; +} + +void Bye(void) { + int rc = mem[ip + 2]; // (λ 0) [exitcode] + if (rc) Error(rc, "CONTINUATIONS EXHAUSTED"); + if (postdump && !rc) Dump(0, end, stderr); + exit(0); +} + +// pops continuation and pushes it to environment +void Abs(void) { + if (!contp) Bye(); + struct Closure *t = contp; + contp = t->next; + t->next = envp; + envp = t; + ++ip; +} + +struct Closure *Alloc(void) { + struct Closure *t; + if (!(t = frep)) { + if (!(t = Calloc(1, sizeof(struct Closure)))) { + Error(6, "OUT OF HEAP"); + } + } + frep = t->next; + t->refs = 1; + ++heap; + return t; +} + +// pushes continuation for argument +void App(void) { + int x = mem[ip + 1]; + struct Closure *t = Alloc(); + t->term = ip + 2 + x; + t->envp = t->term > 21 && t->term != end ? REF(envp) : &root; + t->next = contp; + contp = t; + ip += 2; +} + +int LoadByte(int c) { + int i, r = end; + for (i = 7; i >= 0; --i) { + Expand(ABS); + Expand(APP); + Expand(i ? +4 : Backref(NIL)); + Expand(APP); + Expand(Backref(c & (1 << i) ? FALSE : TRUE)); + Expand(VAR); + Expand(0); + } + return r; +} + +void LoadRom(void) { + long i; + for (; end < sizeof(kRom) / sizeof(*kRom); ++end) { + mem[end] = kRom[end]; + } + mem[4] = binary ? 2 : 9; + if (binary) { + for (i = 0; i < 256; ++i) { + kLazy[i] = LoadByte(i); + } + } + mem[1] = end - 2; +} + +void Iop(void) { + if (ip == end) { + Gro(); + } else { + Put(); // ip ∈ {6,13,20,21} + } + Gc(envp); + envp = &root; +} + +static void Rex(void) { + if (slog) PrintMachineState(stderr); + if (rlog && (alog || mem[ip] != APP)) { + PrintExpressions(stderr, alog, vlog); + } + switch (mem[ip]) { + case VAR: + Var(); + break; + case APP: + App(); + break; + case ABS: + Abs(); + break; + case IOP: + Iop(); + break; + default: + Error(7, "CORRUPT TERM"); + } +} + +void Krivine(void) { + int main; + long gotoget; + LoadRom(); + mem[end++] = APP; + gotoget = end++; + main = end; + mem[gotoget] = Parse(1, stdin).n; + if (rlog) { + Print(main, 1, 0, stderr); + fputs("\n", stderr); + if (alog) { + fputs("⟿ wrap[", stderr); + Print(0, 1, 0, stderr); + fputs("]\n", stderr); + } + } + for (;;) Rex(); +} + +void LoadFlags(int argc, char *argv[]) { + int i; + const char *prog; + prog = argc ? argv[0] : "cblc"; + while ((i = getopt(argc, argv, "?hubBdsarvnNlS")) != -1) { + switch (i) { + case 'b': + binary = 1; + break; + case 'S': + safer = 1; + break; + case 'n': + noname = 1; + break; + case 'N': + asciiname = 1; + break; + case 'B': + style = 2; + break; + case 'l': + style = 1; + break; + case 's': + slog = 1; + break; + case 'r': + rlog = 1; + break; + case 'a': + rlog = 1; + alog = 1; + break; + case 'v': + rlog = 1; + vlog = 1; + break; + case 'd': + postdump = 1; + break; + case '?': + case 'h': + PrintUsage(prog, 0, stdout); + default: + PrintUsage(prog, 1, stderr); + } + } +} + +int main(int argc, char *argv[]) { + struct rlimit rlim = {512 * 1024 * 1024, 512 * 1024 * 1024}; + setrlimit(RLIMIT_AS, &rlim); + signal(SIGQUIT, Quit); + signal(SIGPIPE, Quit); + LoadFlags(argc, argv); + setlocale(LC_ALL, ""); + setvbuf(stdout, 0, _IOLBF, 0); + setvbuf(stderr, 0, _IOLBF, 0); + Krivine(); +} diff --git a/tool/lambda/lambda.mk b/tool/lambda/lambda.mk new file mode 100644 index 000000000..c8cfdcc49 --- /dev/null +++ b/tool/lambda/lambda.mk @@ -0,0 +1,59 @@ +#-*-mode:makefile-gmake;indent-tabs-mode:t;tab-width:8;coding:utf-8-*-┐ +#───vi: set et ft=make ts=8 tw=8 fenc=utf-8 :vi───────────────────────┘ + +PKGS += TOOL_LAMBDA + +TOOL_LAMBDA_SRCS := $(wildcard tool/lambda/*.c) + +TOOL_LAMBDA_OBJS = \ + $(TOOL_LAMBDA_SRCS:%.c=o/$(MODE)/%.o) + +TOOL_LAMBDA_COMS := \ + $(TOOL_LAMBDA_SRCS:%.c=o/$(MODE)/%.com) + +TOOL_LAMBDA_BINS = \ + $(TOOL_LAMBDA_COMS) \ + $(TOOL_LAMBDA_COMS:%=%.dbg) + +TOOL_LAMBDA_DIRECTDEPS = \ + LIBC_INTRIN \ + LIBC_LOG \ + LIBC_MEM \ + LIBC_CALLS \ + LIBC_RUNTIME \ + LIBC_UNICODE \ + LIBC_FMT \ + LIBC_STR \ + LIBC_SYSV \ + LIBC_STDIO \ + LIBC_X \ + LIBC_STUBS \ + LIBC_NEXGEN32E \ + TOOL_LAMBDA_LIB \ + THIRD_PARTY_GETOPT + +TOOL_LAMBDA_DEPS := \ + $(call uniq,$(foreach x,$(TOOL_LAMBDA_DIRECTDEPS),$($(x)))) + +o/$(MODE)/tool/lambda/lambda.pkg: \ + $(TOOL_LAMBDA_OBJS) \ + $(foreach x,$(TOOL_LAMBDA_DIRECTDEPS),$($(x)_A).pkg) + +o/$(MODE)/tool/lambda/%.com.dbg: \ + $(TOOL_LAMBDA_DEPS) \ + o/$(MODE)/tool/lambda/%.o \ + o/$(MODE)/tool/lambda/lambda.pkg \ + $(CRT) \ + $(APE) + @$(APELINK) + +o/$(MODE)/tool/lambda/tromp.o: \ + OVERRIDE_CFLAGS += \ + -w + +$(TOOL_LAMBDA_OBJS): \ + $(BUILD_FILES) \ + tool/lambda/lambda.mk + +.PHONY: o/$(MODE)/tool/lambda +o/$(MODE)/tool/lambda: $(TOOL_LAMBDA_BINS) $(TOOL_LAMBDA_CHECKS) diff --git a/tool/lambda/lib/blc.h b/tool/lambda/lib/blc.h new file mode 100644 index 000000000..c31be44f2 --- /dev/null +++ b/tool/lambda/lib/blc.h @@ -0,0 +1,65 @@ +#ifndef COSMOPOLITAN_TOOL_LAMBDA_LIB_BLC_H_ +#define COSMOPOLITAN_TOOL_LAMBDA_LIB_BLC_H_ +#include "libc/stdio/stdio.h" +#if !(__ASSEMBLER__ + __LINKER__ + 0) +COSMOPOLITAN_C_START_ + +#define BUILTINS 4 +#define LOC 12 +#define TERMS 5000000 + +#define IOP 0 // code for gro, wr0, wr1, put +#define VAR 1 // code for variable lookup +#define APP 2 // code for applications +#define ABS 3 // code for abstractions + +struct Parse { + int n; + int i; +}; + +struct Closure { + struct Closure *next; + struct Closure *envp; + int refs; + int term; +}; + +extern char vlog; +extern char slog; +extern char alog; +extern char rlog; +extern char safer; +extern char style; +extern char binary; +extern char noname; +extern char asciiname; +extern int ci; +extern int co; +extern long ip; +extern long end; +extern int heap; +extern FILE *logh; +extern int mem[TERMS]; +extern struct Closure root; +extern struct Closure *envp; +extern struct Closure *frep; +extern struct Closure *contp; + +char GetBit(FILE *); +char NeedBit(FILE *); +struct Parse Parse(int, FILE *); +void Dump(int, int, FILE *); +void Error(int, const char *, ...); +void PrintLambda(int, int, int, int, FILE *); +void PrintBinary(int, int, int, FILE *); +void PrintDebruijn(int, int, int, FILE *); +void PrintMachineState(FILE *); +void PrintExpressions(FILE *, char, char); +void Print(int, int, int, FILE *); +void PrintVar(int, FILE *); +void *Calloc(size_t, size_t); + +COSMOPOLITAN_C_END_ +#endif /* !(__ASSEMBLER__ + __LINKER__ + 0) */ +#endif /* COSMOPOLITAN_TOOL_LAMBDA_LIB_BLC_H_ */ diff --git a/tool/lambda/lib/calloc.c b/tool/lambda/lib/calloc.c new file mode 100644 index 000000000..dfcc039d5 --- /dev/null +++ b/tool/lambda/lib/calloc.c @@ -0,0 +1,43 @@ +/*-*- mode:c;indent-tabs-mode:nil;c-basic-offset:2;tab-width:8;coding:utf-8 -*-│ +│vi: set net ft=c ts=2 sts=2 sw=2 fenc=utf-8 :vi│ +╞══════════════════════════════════════════════════════════════════════════════╡ +│ Copyright 2022 Justine Alexandra Roberts Tunney │ +│ │ +│ Permission to use, copy, modify, and/or distribute this software for │ +│ any purpose with or without fee is hereby granted, provided that the │ +│ above copyright notice and this permission notice appear in all copies. │ +│ │ +│ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL │ +│ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED │ +│ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE │ +│ AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL │ +│ DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR │ +│ PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER │ +│ TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR │ +│ PERFORMANCE OF THIS SOFTWARE. │ +╚─────────────────────────────────────────────────────────────────────────────*/ +#include "libc/runtime/runtime.h" +#include "libc/sysv/consts/map.h" +#include "libc/sysv/consts/prot.h" + +void *Calloc(size_t a, size_t b) { + char *r; + size_t z; + static char *p; + static size_t i; + static size_t n; + z = a * b; + if (!p) { + n = FRAMESIZE; + p = mmap((void *)0x300000000000, FRAMESIZE, PROT_READ | PROT_WRITE, + MAP_ANONYMOUS | MAP_PRIVATE | MAP_FIXED, -1, 0); + } + if (i + z > n) { + mmap(p + i, FRAMESIZE, PROT_READ | PROT_WRITE, + MAP_ANONYMOUS | MAP_PRIVATE | MAP_FIXED, -1, 0); + n += FRAMESIZE; + } + r = p + i; + i += z; + return r; +} diff --git a/tool/lambda/lib/debug.c b/tool/lambda/lib/debug.c new file mode 100644 index 000000000..52764cc6b --- /dev/null +++ b/tool/lambda/lib/debug.c @@ -0,0 +1,154 @@ +/*-*- mode:c;indent-tabs-mode:nil;c-basic-offset:2;tab-width:8;coding:utf-8 -*-│ +│vi: set net ft=c ts=2 sts=2 sw=2 fenc=utf-8 :vi│ +╞══════════════════════════════════════════════════════════════════════════════╡ +│ Copyright 2022 Justine Alexandra Roberts Tunney │ +│ │ +│ Permission to use, copy, modify, and/or distribute this software for │ +│ any purpose with or without fee is hereby granted, provided that the │ +│ above copyright notice and this permission notice appear in all copies. │ +│ │ +│ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL │ +│ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED │ +│ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE │ +│ AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL │ +│ DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR │ +│ PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER │ +│ TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR │ +│ PERFORMANCE OF THIS SOFTWARE. │ +╚─────────────────────────────────────────────────────────────────────────────*/ +#include "libc/fmt/itoa.h" +#include "libc/intrin/kprintf.h" +#include "tool/lambda/lib/blc.h" + +const char *GetOpName(int x) { + switch (x) { + case VAR: + return "var"; + case APP: + return "app"; + case ABS: + return "abs"; + case IOP: + return "iop"; + default: + return "wut"; + } +} + +int GetDepth(struct Closure *env) { + int i; + for (i = 0; env && env != &root; ++i) { + env = env->next; + } + return i; +} + +void PrintClosure(struct Closure *c, const char *name, int indent, FILE *f) { + int i, j; + char ibuf[21]; + while (c && c != &root) { + for (j = 0; j < indent; ++j) { + if (j) { + fputs("│ ", f); + } else { + fputs(" ", f); + } + } + fputs(name, f); + fputs(": ", f); + Print(c->term, 0, GetDepth(c->envp), f); + fputs(" +", f); + int64toarray_radix10(c->refs, ibuf); + fputs(ibuf, f); + fputc('\n', f); + PrintClosure(c->envp, "envp", indent + 1, f); + c = c->next; + } +} + +void PrintMachineState(FILE *f) { + int i; + char buf[256]; + static int op; + struct Closure *c; + fputc('\n', f); + for (i = 0; i < 80; ++i) fputwc(L'─', f); + ksnprintf(buf, sizeof(buf), + "%d\n ip %ld | op %d %s | arg %d | end %ld\n", op++, ip, + mem[ip], GetOpName(mem[ip]), mem[ip + 1], end); + fputs(buf, f); + fputs(" term ", f); + Print(ip, 0, GetDepth(envp), f); + fputc('\n', f); + fputc('\n', f); + PrintClosure(contp, "contp", 1, f); + fputc('\n', f); + PrintClosure(envp, "envp", 1, f); + fputc('\n', f); + PrintClosure(frep, "frep", 1, f); +} + +void PrintExpressions(FILE *f, char alog, char vlog) { + int i, d; + char buf[48]; + struct Closure *p, ps; + ps.term = ip; + ps.next = contp; + ps.envp = envp; + for (p = &ps; p; p = p->next) { + Print(p->term, 1, GetDepth(p->envp), f); + if (p->next) fputc(' ', f); + } + if (alog) { + fputs(" ⟹ ", f); + switch (mem[ip]) { + case VAR: + ksnprintf(buf, sizeof(buf), "var[%d]", mem[ip + 1]); + fputs(buf, f); + break; + case APP: + fputs("app[", f); + Print(ip + 2 + mem[ip + 1], 1, GetDepth(envp), f); + fputc(']', f); + break; + case ABS: + if (contp) { + fputs("abs[", f); + Print(ip + 1, 1, GetDepth(envp), f); + fputc(']', f); + } else { + ksnprintf(buf, sizeof(buf), "bye[%d]", mem[ip + 2]); + fputs(buf, f); + } + break; + case IOP: + if (ip < 22) { + if (!binary) { + ksnprintf(buf, sizeof(buf), "put[%c]", '0' + (int)(ip & 1)); + } else if (mem[ip + 1] & 1) { + ksnprintf(buf, sizeof(buf), "put[0%hho '%c']", co, + isprint(co) ? co : '.'); + } else { + ksnprintf(buf, sizeof(buf), "wr%d[0%hho]", (int)(ip & 1), co); + } + fputs(buf, f); + } else { + fputs("gro", f); + } + break; + default: + break; + } + } + if (vlog) { + d = GetDepth(envp); + for (i = 0, p = envp; p->term != -1; ++i, p = p->next) { + fputc('\n', f); + fputc('\t', f); + PrintVar(style != 1 ? i : d - 1 - i, f); + fputc('=', f); + Print(p->term, 0, GetDepth(p), f); + } + } + fputc('\n', f); +} diff --git a/tool/lambda/lib/dump.c b/tool/lambda/lib/dump.c new file mode 100644 index 000000000..da2917307 --- /dev/null +++ b/tool/lambda/lib/dump.c @@ -0,0 +1,63 @@ +/*-*- mode:c;indent-tabs-mode:nil;c-basic-offset:2;tab-width:8;coding:utf-8 -*-│ +│vi: set net ft=c ts=2 sts=2 sw=2 fenc=utf-8 :vi│ +╞══════════════════════════════════════════════════════════════════════════════╡ +│ Copyright 2022 Justine Alexandra Roberts Tunney │ +│ │ +│ Permission to use, copy, modify, and/or distribute this software for │ +│ any purpose with or without fee is hereby granted, provided that the │ +│ above copyright notice and this permission notice appear in all copies. │ +│ │ +│ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL │ +│ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED │ +│ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE │ +│ AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL │ +│ DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR │ +│ PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER │ +│ TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR │ +│ PERFORMANCE OF THIS SOFTWARE. │ +╚─────────────────────────────────────────────────────────────────────────────*/ +#include "libc/intrin/kprintf.h" +#include "tool/lambda/lib/blc.h" + +void Dumper(int i, int j, FILE *f) { + char buf[64]; + if (i) fputc('\n', f); + for (; i < j; ++i) { + switch (mem[i]) { + case VAR: + ksnprintf(buf, sizeof(buf), " %s,%d,\t// %2d: ", "VAR", mem[i + 1], + i); + fputs(buf, f); + Print(i, 1, 0, f); + fputc('\n', f); + ++i; + break; + case APP: + ksnprintf(buf, sizeof(buf), " %s,%d,\t// %2d: ", "APP", mem[i + 1], + i); + fputs(buf, f); + Print(i, 1, 0, f); + fputc('\n', f); + ++i; + break; + case ABS: + ksnprintf(buf, sizeof(buf), " %s,\t// %2d: ", "ABS", i); + fputs(buf, f); + Print(i, 1, 0, f); + fputc('\n', f); + break; + default: + ksnprintf(buf, sizeof(buf), " %d,\t// %2d: ", mem[i], i); + fputs(buf, f); + Print(i, 1, 0, f); + fputc('\n', f); + break; + } + } +} + +void Dump(int i, int j, FILE *f) { + fputs("\nstatic int kTerm[] = {\n", f); + Dumper(i, j, f); + fputs("};\n", f); +} diff --git a/tool/lambda/lib/error.c b/tool/lambda/lib/error.c new file mode 100644 index 000000000..487bf2be6 --- /dev/null +++ b/tool/lambda/lib/error.c @@ -0,0 +1,37 @@ +/*-*- mode:c;indent-tabs-mode:nil;c-basic-offset:2;tab-width:8;coding:utf-8 -*-│ +│vi: set net ft=c ts=2 sts=2 sw=2 fenc=utf-8 :vi│ +╞══════════════════════════════════════════════════════════════════════════════╡ +│ Copyright 2022 Justine Alexandra Roberts Tunney │ +│ │ +│ Permission to use, copy, modify, and/or distribute this software for │ +│ any purpose with or without fee is hereby granted, provided that the │ +│ above copyright notice and this permission notice appear in all copies. │ +│ │ +│ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL │ +│ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED │ +│ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE │ +│ AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL │ +│ DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR │ +│ PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER │ +│ TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR │ +│ PERFORMANCE OF THIS SOFTWARE. │ +╚─────────────────────────────────────────────────────────────────────────────*/ +#include "libc/intrin/kprintf.h" +#include "tool/lambda/lib/blc.h" + +void Error(int rc, const char* s, ...) { + va_list va; + fflush(stdout); + fputs("\n\33[1;31mERROR\33[37m:\t", stderr); + fflush(stderr); + va_start(va, s); + kvprintf(s, va); + va_end(va); + fputs("\33[0m\n", stderr); + kprintf(" ip:\t%ld\n", ip); + kprintf(" end:\t%ld\n", end); + kprintf(" term:\t"); + PrintExpressions(stderr, 0, 1); + /* Dump(0, end, stderr); */ + exit(rc); +} diff --git a/tool/lambda/lib/getbit.c b/tool/lambda/lib/getbit.c new file mode 100644 index 000000000..f0121db94 --- /dev/null +++ b/tool/lambda/lib/getbit.c @@ -0,0 +1,54 @@ +/*-*- mode:c;indent-tabs-mode:nil;c-basic-offset:2;tab-width:8;coding:utf-8 -*-│ +│vi: set net ft=c ts=2 sts=2 sw=2 fenc=utf-8 :vi│ +╞══════════════════════════════════════════════════════════════════════════════╡ +│ Copyright 2022 Justine Alexandra Roberts Tunney │ +│ │ +│ Permission to use, copy, modify, and/or distribute this software for │ +│ any purpose with or without fee is hereby granted, provided that the │ +│ above copyright notice and this permission notice appear in all copies. │ +│ │ +│ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL │ +│ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED │ +│ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE │ +│ AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL │ +│ DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR │ +│ PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER │ +│ TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR │ +│ PERFORMANCE OF THIS SOFTWARE. │ +╚─────────────────────────────────────────────────────────────────────────────*/ +#include "tool/lambda/lib/blc.h" + +char GetBit(FILE* f) { + wint_t c; + char comment; + static wint_t buf, mask; + if (!binary) { + for (comment = 0;;) { + c = fgetwc(f); + if (c == -1) break; + if (!comment) { + fflush(stdout); + if (c == ';') { + comment = 1; + } else if (!iswspace(c) && c != '(' && c != ')' && c != '[' && + c != ']') { + if (c != -1) c &= 1; + break; + } + } else if (c == '\n') { + comment = 0; + } + } + } else if (mask) { + c = !!(buf & mask); + mask >>= 1; + } else { + c = fgetc(f); + if (c != -1) { + buf = c; + c = (c >> 7) & 1; + mask = 64; + } + } + return c; +} diff --git a/tool/lambda/lib/lib.mk b/tool/lambda/lib/lib.mk new file mode 100644 index 000000000..aaa37939a --- /dev/null +++ b/tool/lambda/lib/lib.mk @@ -0,0 +1,65 @@ +#-*-mode:makefile-gmake;indent-tabs-mode:t;tab-width:8;coding:utf-8-*-┐ +#───vi: set et ft=make ts=8 tw=8 fenc=utf-8 :vi───────────────────────┘ + +PKGS += TOOL_LAMBDA_LIB + +TOOL_LAMBDA_LIB_ARTIFACTS += TOOL_LAMBDA_LIB_A +TOOL_LAMBDA_LIB = $(TOOL_LAMBDA_LIB_A_DEPS) $(TOOL_LAMBDA_LIB_A) +TOOL_LAMBDA_LIB_A = o/$(MODE)/tool/lambda/lib/lambdalib.a +TOOL_LAMBDA_LIB_A_FILES := $(filter-out %/.%,$(wildcard tool/lambda/lib/*)) +TOOL_LAMBDA_LIB_A_HDRS = $(filter %.h,$(TOOL_LAMBDA_LIB_A_FILES)) +TOOL_LAMBDA_LIB_A_SRCS_S = $(filter %.S,$(TOOL_LAMBDA_LIB_A_FILES)) +TOOL_LAMBDA_LIB_A_SRCS_C = $(filter %.c,$(TOOL_LAMBDA_LIB_A_FILES)) + +TOOL_LAMBDA_LIB_A_CHECKS = \ + $(TOOL_LAMBDA_LIB_A_HDRS:%=o/$(MODE)/%.ok) \ + $(TOOL_LAMBDA_LIB_A).pkg + +TOOL_LAMBDA_LIB_A_SRCS = \ + $(TOOL_LAMBDA_LIB_A_SRCS_S) \ + $(TOOL_LAMBDA_LIB_A_SRCS_C) + +TOOL_LAMBDA_LIB_A_OBJS = \ + $(TOOL_LAMBDA_LIB_A_SRCS_S:%.S=o/$(MODE)/%.o) \ + $(TOOL_LAMBDA_LIB_A_SRCS_C:%.c=o/$(MODE)/%.o) + +TOOL_LAMBDA_LIB_A_DIRECTDEPS = \ + LIBC_BITS \ + LIBC_CALLS \ + LIBC_INTRIN \ + LIBC_LOG \ + LIBC_NEXGEN32E \ + LIBC_RAND \ + LIBC_RUNTIME \ + LIBC_UNICODE \ + LIBC_MEM \ + LIBC_FMT \ + LIBC_SOCK \ + LIBC_STDIO \ + LIBC_STR \ + LIBC_STUBS \ + LIBC_SYSV \ + THIRD_PARTY_COMPILER_RT \ + THIRD_PARTY_GETOPT + +TOOL_LAMBDA_LIB_A_DEPS := \ + $(call uniq,$(foreach x,$(TOOL_LAMBDA_LIB_A_DIRECTDEPS),$($(x)))) + +$(TOOL_LAMBDA_LIB_A): \ + $(TOOL_LAMBDA_LIB_A).pkg \ + $(TOOL_LAMBDA_LIB_A_OBJS) + +$(TOOL_LAMBDA_LIB_A).pkg: \ + $(TOOL_LAMBDA_LIB_A_OBJS) \ + $(foreach x,$(TOOL_LAMBDA_LIB_A_DIRECTDEPS),$($(x)_A).pkg) + +TOOL_LAMBDA_LIB_LIBS = $(foreach x,$(TOOL_LAMBDA_LIB_ARTIFACTS),$($(x))) +TOOL_LAMBDA_LIB_SRCS = $(foreach x,$(TOOL_LAMBDA_LIB_ARTIFACTS),$($(x)_SRCS)) +TOOL_LAMBDA_LIB_HDRS = $(foreach x,$(TOOL_LAMBDA_LIB_ARTIFACTS),$($(x)_HDRS)) +TOOL_LAMBDA_LIB_BINS = $(foreach x,$(TOOL_LAMBDA_LIB_ARTIFACTS),$($(x)_BINS)) +TOOL_LAMBDA_LIB_CHECKS = $(foreach x,$(TOOL_LAMBDA_LIB_ARTIFACTS),$($(x)_CHECKS)) +TOOL_LAMBDA_LIB_OBJS = $(foreach x,$(TOOL_LAMBDA_LIB_ARTIFACTS),$($(x)_OBJS)) +TOOL_LAMBDA_LIB_TESTS = $(foreach x,$(TOOL_LAMBDA_LIB_ARTIFACTS),$($(x)_TESTS)) + +.PHONY: o/$(MODE)/tool/lambda/lib +o/$(MODE)/tool/lambda/lib: $(TOOL_LAMBDA_LIB_CHECKS) diff --git a/tool/lambda/lib/needbit.c b/tool/lambda/lib/needbit.c new file mode 100644 index 000000000..85334d040 --- /dev/null +++ b/tool/lambda/lib/needbit.c @@ -0,0 +1,25 @@ +/*-*- mode:c;indent-tabs-mode:nil;c-basic-offset:2;tab-width:8;coding:utf-8 -*-│ +│vi: set net ft=c ts=2 sts=2 sw=2 fenc=utf-8 :vi│ +╞══════════════════════════════════════════════════════════════════════════════╡ +│ Copyright 2022 Justine Alexandra Roberts Tunney │ +│ │ +│ Permission to use, copy, modify, and/or distribute this software for │ +│ any purpose with or without fee is hereby granted, provided that the │ +│ above copyright notice and this permission notice appear in all copies. │ +│ │ +│ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL │ +│ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED │ +│ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE │ +│ AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL │ +│ DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR │ +│ PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER │ +│ TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR │ +│ PERFORMANCE OF THIS SOFTWARE. │ +╚─────────────────────────────────────────────────────────────────────────────*/ +#include "tool/lambda/lib/blc.h" + +char NeedBit(FILE* f) { + char b = GetBit(f); + if (b == -1) Error(9, "UNEXPECTED EOF"); + return b; +} diff --git a/tool/lambda/lib/parse.c b/tool/lambda/lib/parse.c new file mode 100644 index 000000000..df9906692 --- /dev/null +++ b/tool/lambda/lib/parse.c @@ -0,0 +1,55 @@ +/*-*- mode:c;indent-tabs-mode:nil;c-basic-offset:2;tab-width:8;coding:utf-8 -*-│ +│vi: set net ft=c ts=2 sts=2 sw=2 fenc=utf-8 :vi│ +╞══════════════════════════════════════════════════════════════════════════════╡ +│ Copyright 2022 Justine Alexandra Roberts Tunney │ +│ │ +│ Permission to use, copy, modify, and/or distribute this software for │ +│ any purpose with or without fee is hereby granted, provided that the │ +│ above copyright notice and this permission notice appear in all copies. │ +│ │ +│ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL │ +│ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED │ +│ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE │ +│ AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL │ +│ DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR │ +│ PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER │ +│ TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR │ +│ PERFORMANCE OF THIS SOFTWARE. │ +╚─────────────────────────────────────────────────────────────────────────────*/ +#include "tool/lambda/lib/blc.h" + +/** + * Parses binary lambda calculus closed expression from stream. + */ +struct Parse Parse(int ignored, FILE* f) { + int t, start; + char bit, need; + struct Parse p; + for (need = 0, start = end;;) { + if (end + 2 > TERMS) Error(5, "OUT OF TERMS"); + if ((bit = GetBit(f)) == -1) { + if (!need) break; + fflush(stdout); + fputs("---\n", stderr); + Print(start, 0, 0, stderr); + Error(9, "UNFINISHED EXPRESSION"); + } else if (bit) { + for (t = 0; NeedBit(f);) ++t; + mem[end++] = VAR; + mem[end++] = t; + break; + } else if (NeedBit(f)) { + t = end; + end += 2; + mem[t] = APP; + p = Parse(0, f); + mem[t + 1] = p.n; + need = 1; + } else { + mem[end++] = ABS; + } + } + p.i = start; + p.n = end - start; + return p; +} diff --git a/tool/lambda/lib/parserom.c b/tool/lambda/lib/parserom.c new file mode 100644 index 000000000..d0e31edfe --- /dev/null +++ b/tool/lambda/lib/parserom.c @@ -0,0 +1,72 @@ +/*-*- mode:c;indent-tabs-mode:nil;c-basic-offset:2;tab-width:8;coding:utf-8 -*-│ +│vi: set net ft=c ts=2 sts=2 sw=2 fenc=utf-8 :vi│ +╞══════════════════════════════════════════════════════════════════════════════╡ +│ Copyright 2022 Justine Alexandra Roberts Tunney │ +│ │ +│ Permission to use, copy, modify, and/or distribute this software for │ +│ any purpose with or without fee is hereby granted, provided that the │ +│ above copyright notice and this permission notice appear in all copies. │ +│ │ +│ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL │ +│ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED │ +│ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE │ +│ AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL │ +│ DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR │ +│ PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER │ +│ TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR │ +│ PERFORMANCE OF THIS SOFTWARE. │ +╚─────────────────────────────────────────────────────────────────────────────*/ +#include "tool/lambda/lib/blc.h" + +static struct Parse ParseImpl(int tail, int need, FILE *f) { + struct Parse p, q; + int b, i, j, t, start; + for (start = end;;) { + if (end + 2 > TERMS) Error(5, "OUT OF TERMS"); + if ((b = GetBit(f)) == -1) { + if (need) Error(9, "UNFINISHED EXPRESSION"); + break; + } else if (b) { + for (t = 0; NeedBit(f);) ++t; + mem[end++] = VAR; + mem[end++] = t; + break; + } else if (NeedBit(f)) { + t = end; + end += 2; + p = ParseImpl(0, 1, f); + q = ParseImpl(t + 2, 1, f); + mem[t + 0] = APP; + mem[t + 1] = q.i - (t + 2); + break; + } else { + mem[end++] = ABS; + } + } + p.i = start; + p.n = end - start; + if (p.n && tail) { + /* find backwards overlaps within 8-bit displacement */ + i = tail - 32768; + j = start - p.n; + for (i = i < 0 ? 0 : i; i <= j; ++i) { + if (!memcmp(mem + i, mem + p.i, p.n * sizeof(*mem))) { + memset(mem + start, -1, p.n * sizeof(*mem)); + end = start; + p.i = i; + break; + } + } + } + return p; +} + +/** + * Parses binary lambda calculus closed expression from stream. + * + * If `tail` is non-zero then this subroutine will perform expensive + * deduplication so that optimal ROMs may be computed ahead of time. + */ +struct Parse Parse(int tail, FILE *f) { + return ParseImpl(tail, 0, f); +} diff --git a/tool/lambda/lib/print.c b/tool/lambda/lib/print.c new file mode 100644 index 000000000..2dae71695 --- /dev/null +++ b/tool/lambda/lib/print.c @@ -0,0 +1,1289 @@ +/*-*- mode:c;indent-tabs-mode:nil;c-basic-offset:2;tab-width:8;coding:utf-8 -*-│ +│vi: set net ft=c ts=2 sts=2 sw=2 fenc=utf-8 :vi│ +╞══════════════════════════════════════════════════════════════════════════════╡ +│ Copyright 2022 Justine Alexandra Roberts Tunney │ +│ │ +│ Permission to use, copy, modify, and/or distribute this software for │ +│ any purpose with or without fee is hereby granted, provided that the │ +│ above copyright notice and this permission notice appear in all copies. │ +│ │ +│ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL │ +│ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED │ +│ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE │ +│ AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL │ +│ DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR │ +│ PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER │ +│ TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR │ +│ PERFORMANCE OF THIS SOFTWARE. │ +╚─────────────────────────────────────────────────────────────────────────────*/ +#include "libc/fmt/itoa.h" +#include "tool/lambda/lib/blc.h" + +#define FREEBIES u"ɐqɔpǝɟƃɥıɾʞןɯuodbɹsʇnʌʍxʎz" + +/* clang-format off */ +#define ALPHABET \ + u"abcdefghijklmnopqrsuvwxyz" \ + u"αβγδεζηθιμξπρςστυφχψϑϕ" \ + u"ℵℶℷℸ" \ + u"идџжлђ" \ + u"⅄ℏ℘þæߧ£¥₿" \ + u"𝘢𝘣𝘤𝘥𝘦𝘧𝘨𝘩𝘪𝘫𝘬𝘭𝘮𝘯𝘰𝘱𝘲𝘳𝘴𝘵𝘶𝘷𝘸𝘹𝘺𝘻" \ + u"𝕒𝕓𝕔𝕕𝕖𝕗𝕘𝕙𝕚𝕛𝕜𝕝𝕞𝕟𝕠𝕡𝕢𝕣𝕤𝕥𝕦𝕧𝕨𝕩𝕪𝕫" \ + u"𝗮𝗯𝗰𝗱𝗲𝗳𝗴𝗵𝗶𝗷𝗸𝗹𝗺𝗻𝗼𝗽𝗾𝗿𝘀𝘁𝘂𝘃𝘄𝘅𝘆𝘇" +/* clang-format on */ + +static char kFalse[] = { + ABS, // 0: false + ABS, // 1: (λ 0) + VAR, 0, // 2: 0 +}; + +static char kTrue[] = { + ABS, // 0: true + ABS, // 1: (λ 1) + VAR, 1, // 2: 1 +}; + +static char kOne[] = { + ABS, // 4: (λab.ab) + ABS, // 5: (λa.ɐa) + APP, 2, // 6: qɐ + VAR, 1, // 8: q + VAR, 0, // 10: ɐ +}; + +static char kTwo[] = { + ABS, // 12: (λab.a(ab)) + ABS, // 13: (λa.ɐ(ɐa)) + APP, 2, // 14: q(qɐ) + VAR, 1, // 16: q + APP, 2, // 18: qɐ + VAR, 1, // 20: q + VAR, 0, // 22: ɐ +}; + +static char kThree[] = { + ABS, // 24: (λab.a(a(ab))) + ABS, // 25: (λa.ɐ(ɐ(ɐa))) + APP, 2, // 26: q(q(qɐ)) + VAR, 1, // 28: q + APP, 2, // 30: q(qɐ) + VAR, 1, // 32: q + APP, 2, // 34: qɐ + VAR, 1, // 36: q + VAR, 0, // 38: ɐ +}; + +static char kFour[] = { + ABS, // 40: (λab.a(a(a(ab)))) + ABS, // 41: (λa.ɐ(ɐ(ɐ(ɐa)))) + APP, 2, // 42: q(q(q(qɐ))) + VAR, 1, // 44: q + APP, 2, // 46: q(q(qɐ)) + VAR, 1, // 48: q + APP, 2, // 50: q(qɐ) + VAR, 1, // 52: q + APP, 2, // 54: qɐ + VAR, 1, // 56: q + VAR, 0, // 58: ɐ +}; + +static char kFive[] = { + ABS, // 60: (λab.a(a(a(a(ab))))) + ABS, // 61: (λa.ɐ(ɐ(ɐ(ɐ(ɐa))))) + APP, 2, // 62: q(q(q(q(qɐ)))) + VAR, 1, // 64: q + APP, 2, // 66: q(q(q(qɐ))) + VAR, 1, // 68: q + APP, 2, // 70: q(q(qɐ)) + VAR, 1, // 72: q + APP, 2, // 74: q(qɐ) + VAR, 1, // 76: q + APP, 2, // 78: qɐ + VAR, 1, // 80: q + VAR, 0, // 82: ɐ +}; + +static char kSix[] = { + ABS, // 84: (λab.a(a(a(a(a(ab)))))) + ABS, // 85: (λa.ɐ(ɐ(ɐ(ɐ(ɐ(ɐa)))))) + APP, 2, // 86: q(q(q(q(q(qɐ))))) + VAR, 1, // 88: q + APP, 2, // 90: q(q(q(q(qɐ)))) + VAR, 1, // 92: q + APP, 2, // 94: q(q(q(qɐ))) + VAR, 1, // 96: q + APP, 2, // 98: q(q(qɐ)) + VAR, 1, // 100: q + APP, 2, // 102: q(qɐ) + VAR, 1, // 104: q + APP, 2, // 106: qɐ + VAR, 1, // 108: q + VAR, 0, // 110: ɐ +}; + +static char kSeven[] = { + ABS, // 112: (λab.a(a(a(a(a(a(ab))))))) + ABS, // 113: (λa.ɐ(ɐ(ɐ(ɐ(ɐ(ɐ(ɐa))))))) + APP, 2, // 114: q(q(q(q(q(q(qɐ)))))) + VAR, 1, // 116: q + APP, 2, // 118: q(q(q(q(q(qɐ))))) + VAR, 1, // 120: q + APP, 2, // 122: q(q(q(q(qɐ)))) + VAR, 1, // 124: q + APP, 2, // 126: q(q(q(qɐ))) + VAR, 1, // 128: q + APP, 2, // 130: q(q(qɐ)) + VAR, 1, // 132: q + APP, 2, // 134: q(qɐ) + VAR, 1, // 136: q + APP, 2, // 138: qɐ + VAR, 1, // 140: q + VAR, 0, // 142: ɐ +}; + +static char kEight[] = { + ABS, // 144: (λab.a(a(a(a(a(a(a(ab)))))))) + ABS, // 145: (λa.ɐ(ɐ(ɐ(ɐ(ɐ(ɐ(ɐ(ɐa)))))))) + APP, 2, // 146: q(q(q(q(q(q(q(qɐ))))))) + VAR, 1, // 148: q + APP, 2, // 150: q(q(q(q(q(q(qɐ)))))) + VAR, 1, // 152: q + APP, 2, // 154: q(q(q(q(q(qɐ))))) + VAR, 1, // 156: q + APP, 2, // 158: q(q(q(q(qɐ)))) + VAR, 1, // 160: q + APP, 2, // 162: q(q(q(qɐ))) + VAR, 1, // 164: q + APP, 2, // 166: q(q(qɐ)) + VAR, 1, // 168: q + APP, 2, // 170: q(qɐ) + VAR, 1, // 172: q + APP, 2, // 174: qɐ + VAR, 1, // 176: q + VAR, 0, // 178: ɐ +}; + +static char kNine[] = { + ABS, // 180: (λab.a(a(a(a(a(a(a(a(ab))))))))) + ABS, // 181: (λa.ɐ(ɐ(ɐ(ɐ(ɐ(ɐ(ɐ(ɐ(ɐa))))))))) + APP, 2, // 182: q(q(q(q(q(q(q(q(qɐ)))))))) + VAR, 1, // 184: q + APP, 2, // 186: q(q(q(q(q(q(q(qɐ))))))) + VAR, 1, // 188: q + APP, 2, // 190: q(q(q(q(q(q(qɐ)))))) + VAR, 1, // 192: q + APP, 2, // 194: q(q(q(q(q(qɐ))))) + VAR, 1, // 196: q + APP, 2, // 198: q(q(q(q(qɐ)))) + VAR, 1, // 200: q + APP, 2, // 202: q(q(q(qɐ))) + VAR, 1, // 204: q + APP, 2, // 206: q(q(qɐ)) + VAR, 1, // 208: q + APP, 2, // 210: q(qɐ) + VAR, 1, // 212: q + APP, 2, // 214: qɐ + VAR, 1, // 216: q + VAR, 0, // 218: ɐ +}; + +static char kSelf[] = { + ABS, // 0: λa.aa + APP, 2, // 1: ɐɐ + VAR, 0, // 3: ɐ + VAR, 0, // 5: ɐ +}; + +static char kOmega[] = { + APP, 7, // 0: ω ω + ABS, // 2: ω + APP, 2, // 3: ɐ ɐ + VAR, 0, // 5: ɐ + VAR, 0, // 7: ɐ + ABS, // 9: ω + APP, 2, // 10: ɐ ɐ + VAR, 0, // 12: ɐ + VAR, 0, // 14: ɐ +}; + +static char kIf[] = { + ABS, // 0: if + ABS, // 1: (λλ 2 1 0) + ABS, // 2: (λ 2 1 0) + APP, 6, // 3: 2 1 0 + APP, 2, // 5: 2 1 + VAR, 2, // 7: 2 + VAR, 1, // 9: 1 + VAR, 0, // 11: 0 +}; + +static char kOr[] = { + ABS, // 32: λab.bba + ABS, // 33: λa.aaɐ + APP, 6, // 34: ɐɐq + APP, 2, // 36: ɐɐ + VAR, 0, // 38: ɐ + VAR, 0, // 40: ɐ + VAR, 1, // 42: q +}; + +static char kAnd[] = { + ABS, // 32: λab.bab + ABS, // 33: λa.aɐa + APP, 6, // 34: ɐqɐ + APP, 2, // 36: ɐq + VAR, 0, // 38: ɐ + VAR, 1, // 40: q + VAR, 0, // 42: ɐ +}; + +static char kNot[] = { + ABS, // 32: λabc.acb + ABS, // 33: λab.ɐba + ABS, // 34: λa.qaɐ + APP, 6, // 35: ɔɐq + APP, 2, // 37: ɔɐ + VAR, 2, // 39: ɔ + VAR, 0, // 41: ɐ + VAR, 1, // 43: q +}; + +static char kPair[] = { + ABS, // 0: (λλλ 0 2 1) + ABS, // 1: (λλ 0 2 1) + ABS, // 2: (λ 0 2 1) + APP, 6, // 3: 0 2 1 + APP, 2, // 5: 0 2 + VAR, 0, // 7: 0 + VAR, 2, // 9: 2 + VAR, 1, // 11: 1 +}; + +static char kFirst[] = { + ABS, // 0: (λ 0 false) + APP, 2, // 1: 0 false + VAR, 0, // 3: 0 + ABS, // 5: false + ABS, // 6: (λ 0) + VAR, 0, // 7: 0 +}; + +static char kSecond[] = { + ABS, // 0: (λ 0 true) + APP, 2, // 1: 0 true + VAR, 0, // 3: 0 + ABS, // 5: true + ABS, // 6: (λ 1) + VAR, 1, // 7: 1 +}; + +static char kSucc[] = { + ABS, // 0: (λλλ 1 (2 1 0)) + ABS, // 1: (λλ 1 (2 1 0)) + ABS, // 2: (λ 1 (2 1 0)) + APP, 2, // 3: 1 (2 1 0) + VAR, 1, // 5: 1 + APP, 6, // 7: 2 1 0 + APP, 2, // 9: 2 1 + VAR, 2, // 11: 2 + VAR, 1, // 13: 1 + VAR, 0, // 15: 0 +}; + +static char kCompose[] = { + ABS, // 0: (λλλ 2 (1 0)) + ABS, // 1: (λλ 2 (1 0)) + ABS, // 2: (λ 2 (1 0)) + APP, 2, // 3: 2 (1 0) + VAR, 2, // 5: 2 + APP, 2, // 7: 1 0 + VAR, 1, // 9: 1 + VAR, 0, // 11: 0 +}; + +static char kMap[] = { + ABS, // 0: (λλλλ 2 (compose 1 3) 0) + ABS, // 1: (λλλ 2 (compose 1 3) 0) + ABS, // 2: (λλ 2 (compose 1 3) 0) + ABS, // 3: (λ 2 (compose 1 3) 0) + APP, 25, // 4: 2 (compose 1 3) 0 + APP, 2, // 6: 2 (compose 1 3) + VAR, 2, // 8: 2 + APP, 17, // 10: compose 1 3 + APP, 13, // 12: compose 1 + ABS, // 14: compose + ABS, // 15: (λλ 2 (1 0)) + ABS, // 16: (λ 2 (1 0)) + APP, 2, // 17: 2 (1 0) + VAR, 2, // 19: 2 + APP, 2, // 21: 1 0 + VAR, 1, // 23: 1 + VAR, 0, // 25: 0 + VAR, 1, // 27: 1 + VAR, 3, // 29: 3 + VAR, 0, // 31: 0 +}; + +static char kCons[] = { + ABS, // 0: (λλλλ 1 3 (2 1 0)) + ABS, // 1: (λλλ 1 3 (2 1 0)) + ABS, // 2: (λλ 1 3 (2 1 0)) + ABS, // 3: (λ 1 3 (2 1 0)) + APP, 6, // 4: 1 3 (2 1 0) + APP, 2, // 6: 1 3 + VAR, 1, // 8: 1 + VAR, 3, // 10: 3 + APP, 6, // 12: 2 1 0 + APP, 2, // 14: 2 1 + VAR, 2, // 16: 2 + VAR, 1, // 18: 1 + VAR, 0, // 20: 0 +}; + +static char kY[] = { + ABS, // 32: λa.(λb.bb)(λb.a(bb)) + APP, 7, // 33: (λa.aa)(λa.ɐ(aa)) + ABS, // 35: λa.aa + APP, 2, // 36: ɐɐ + VAR, 0, // 38: ɐ + VAR, 0, // 40: ɐ + ABS, // 42: λa.ɐ(aa) + APP, 2, // 43: q(ɐɐ) + VAR, 1, // 45: q + APP, 2, // 47: ɐɐ + VAR, 0, // 49: ɐ + VAR, 0, // 51: ɐ +}; + +static char kYCurry[] = { + ABS, // 0: (λ (λ 1 (0 0)) (λ 1 (0 0))) + APP, 11, // 1: (λ 1 (0 0)) (λ 1 (0 0)) + ABS, // 3: (λ 1 (0 0)) + APP, 2, // 4: 1 (0 0) + VAR, 1, // 6: 1 + APP, 2, // 8: 0 0 + VAR, 0, // 10: 0 + VAR, 0, // 12: 0 + ABS, // 14: (λ 1 (0 0)) + APP, 2, // 15: 1 (0 0) + VAR, 1, // 17: 1 + APP, 2, // 19: 0 0 + VAR, 0, // 21: 0 + VAR, 0, // 23: 0 +}; + +static char kIszero[] = { + ABS, // 32: λabc.a(λd.c)b + ABS, // 33: λab.ɐ(λc.b)a + ABS, // 34: λa.q(λb.a)ɐ + APP, 7, // 35: ɔ(λa.ɐ)q + APP, 2, // 37: ɔ(λa.ɐ) + VAR, 2, // 39: ɔ + ABS, // 41: λa.ɐ + VAR, 1, // 42: q + VAR, 1, // 44: q +}; + +static char kPred[] = { + ABS, // 0: λabc.a(λde.e(db))(λd.c)(λd.d) + ABS, // 1: λab.ɐ(λcd.d(ca))(λc.b)(λc.c) + ABS, // 2: λa.q(λbc.c(bɐ))(λb.a)(λb.b) + APP, 21, // 3: ɔ(λab.b(aq))(λa.ɐ)(λa.a) + APP, 16, // 5: ɔ(λab.b(aq))(λa.ɐ) + APP, 2, // 7: ɔ(λab.b(aq)) + VAR, 2, // 9: ɔ + ABS, // 11: λab.b(aq) + ABS, // 12: λa.a(ɐɔ) + APP, 2, // 13: ɐ(qp) + VAR, 0, // 15: ɐ + APP, 2, // 17: qp + VAR, 1, // 19: q + VAR, 3, // 21: p + ABS, // 23: λa.ɐ + VAR, 1, // 24: q + ABS, // 26: λa.a + VAR, 0, // 27: ɐ +}; + +static char kXor[] = { + ABS, // 32: λab.a(λcd.bdc)b + ABS, // 33: λa.ɐ(λbc.acb)a + APP, 16, // 34: q(λab.ɐba)ɐ + APP, 2, // 36: q(λab.ɐba) + VAR, 1, // 38: q + ABS, // 40: λab.ɐba + ABS, // 41: λa.qaɐ + APP, 6, // 42: ɔɐq + APP, 2, // 44: ɔɐ + VAR, 2, // 46: ɔ + VAR, 0, // 48: ɐ + VAR, 1, // 50: q + VAR, 0, // 52: ɐ +}; + +static char kAdd[] = { + ABS, // 29: λabcd.ac(bcd) + ABS, // 30: λabc.ɐb(abc) + ABS, // 31: λab.qa(ɐab) + ABS, // 32: λa.ɔɐ(qɐa) + APP, 6, // 33: pq(ɔqɐ) + APP, 2, // 35: pq + VAR, 3, // 37: p + VAR, 1, // 39: q + APP, 6, // 41: ɔqɐ + APP, 2, // 43: ɔq + VAR, 2, // 45: ɔ + VAR, 1, // 47: q + VAR, 0, // 49: ɐ +}; + +static char kSub[] = { + ABS, // 51: λab.b(λcde.c(λfg.g(fd))(λf.e)(λf.f))a + ABS, // 52: λa.a(λbcd.b(λef.f(ec))(λe.d)(λe.e))ɐ + APP, 33, // 53: ɐ(λabc.a(λde.e(db))(λd.c)(λd.d))q + APP, 2, // 55: ɐ(λabc.a(λde.e(db))(λd.c)(λd.d)) + VAR, 0, // 57: ɐ + ABS, // 59: λabc.a(λde.e(db))(λd.c)(λd.d) + ABS, // 60: λab.ɐ(λcd.d(ca))(λc.b)(λc.c) + ABS, // 61: λa.q(λbc.c(bɐ))(λb.a)(λb.b) + APP, 21, // 62: ɔ(λab.b(aq))(λa.ɐ)(λa.a) + APP, 16, // 64: ɔ(λab.b(aq))(λa.ɐ) + APP, 2, // 66: ɔ(λab.b(aq)) + VAR, 2, // 68: ɔ + ABS, // 70: λab.b(aq) + ABS, // 71: λa.a(ɐɔ) + APP, 2, // 72: ɐ(qp) + VAR, 0, // 74: ɐ + APP, 2, // 76: qp + VAR, 1, // 78: q + VAR, 3, // 80: p + ABS, // 82: λa.ɐ + VAR, 1, // 83: q + ABS, // 85: λa.a + VAR, 0, // 86: ɐ + VAR, 1, // 88: q +}; + +static char kLe[] = { + ABS, // 0: λab.iszero(- a b) + ABS, // 1: λa.iszero(- ɐ a) + APP, 16, // 2: iszero(- q ɐ) + ABS, // 4: iszero + APP, 9, // 5: ɐ (λabc.c) ⊤ + APP, 2, // 7: ɐ (λabc.c) + VAR, 0, // 9: ɐ + ABS, // 11: λabc.c + ABS, // 12: ⊥ + ABS, // 13: λa.a + VAR, 0, // 14: ɐ + ABS, // 16: ⊤ + ABS, // 17: λa.ɐ + VAR, 1, // 18: q + APP, 43, // 20: - q ɐ + APP, 39, // 22: - q + ABS, // 24: - + ABS, // 25: λa.a dec ɐ + APP, 33, // 26: ɐ dec q + APP, 2, // 28: ɐ dec + VAR, 0, // 30: ɐ + ABS, // 32: dec + ABS, // 33: λab.ɐ (λcd.d(c a)) (λc.b) (λc.c) + ABS, // 34: λa.q (λbc.c(b ɐ)) (λb.a) (λb.b) + APP, 21, // 35: ɔ (λab.b(a q)) (λa.ɐ) (λa.a) + APP, 16, // 37: ɔ (λab.b(a q)) (λa.ɐ) + APP, 2, // 39: ɔ (λab.b(a q)) + VAR, 2, // 41: ɔ + ABS, // 43: λab.b(a q) + ABS, // 44: λa.a(ɐ ɔ) + APP, 2, // 45: ɐ(q p) + VAR, 0, // 47: ɐ + APP, 2, // 49: q p + VAR, 1, // 51: q + VAR, 3, // 53: p + ABS, // 55: λa.ɐ + VAR, 1, // 56: q + ABS, // 58: λa.a + VAR, 0, // 59: ɐ + VAR, 1, // 61: q + VAR, 1, // 63: q + VAR, 0, // 65: ɐ +}; + +static char kEq[] = { + ABS, // 0: λab.∧(≤ a b)(≤ b a) + ABS, // 1: λa.∧(≤ ɐ a)(≤ a ɐ) + APP, 89, // 2: ∧(≤ q ɐ)(≤ ɐ q) + APP, 12, // 4: ∧(≤ q ɐ) + ABS, // 6: ∧ + ABS, // 7: λa.ɐ a ɐ + APP, 6, // 8: q ɐ q + APP, 2, // 10: q ɐ + VAR, 1, // 12: q + VAR, 0, // 14: ɐ + VAR, 1, // 16: q + APP, 71, // 18: ≤ q ɐ + APP, 67, // 20: ≤ q + ABS, // 22: ≤ + ABS, // 23: λa.iszero(- ɐ a) + APP, 16, // 24: iszero(- q ɐ) + ABS, // 26: iszero + APP, 9, // 27: ɐ (λabc.c) ⊤ + APP, 2, // 29: ɐ (λabc.c) + VAR, 0, // 31: ɐ + ABS, // 33: λabc.c + ABS, // 34: ⊥ + ABS, // 35: λa.a + VAR, 0, // 36: ɐ + ABS, // 38: ⊤ + ABS, // 39: λa.ɐ + VAR, 1, // 40: q + APP, 43, // 42: - q ɐ + APP, 39, // 44: - q + ABS, // 46: - + ABS, // 47: λa.a dec ɐ + APP, 33, // 48: ɐ dec q + APP, 2, // 50: ɐ dec + VAR, 0, // 52: ɐ + ABS, // 54: dec + ABS, // 55: λab.ɐ (λcd.d(c a)) (λc.b) (λc.c) + ABS, // 56: λa.q (λbc.c(b ɐ)) (λb.a) (λb.b) + APP, 21, // 57: ɔ (λab.b(a q)) (λa.ɐ) (λa.a) + APP, 16, // 59: ɔ (λab.b(a q)) (λa.ɐ) + APP, 2, // 61: ɔ (λab.b(a q)) + VAR, 2, // 63: ɔ + ABS, // 65: λab.b(a q) + ABS, // 66: λa.a(ɐ ɔ) + APP, 2, // 67: ɐ(q p) + VAR, 0, // 69: ɐ + APP, 2, // 71: q p + VAR, 1, // 73: q + VAR, 3, // 75: p + ABS, // 77: λa.ɐ + VAR, 1, // 78: q + ABS, // 80: λa.a + VAR, 0, // 81: ɐ + VAR, 1, // 83: q + VAR, 1, // 85: q + VAR, 0, // 87: ɐ + VAR, 1, // 89: q + VAR, 0, // 91: ɐ + APP, 71, // 93: ≤ ɐ q + APP, 67, // 95: ≤ ɐ + ABS, // 97: ≤ + ABS, // 98: λa.iszero(- ɐ a) + APP, 16, // 99: iszero(- q ɐ) + ABS, // 101: iszero + APP, 9, // 102: ɐ (λabc.c) ⊤ + APP, 2, // 104: ɐ (λabc.c) + VAR, 0, // 106: ɐ + ABS, // 108: λabc.c + ABS, // 109: ⊥ + ABS, // 110: λa.a + VAR, 0, // 111: ɐ + ABS, // 113: ⊤ + ABS, // 114: λa.ɐ + VAR, 1, // 115: q + APP, 43, // 117: - q ɐ + APP, 39, // 119: - q + ABS, // 121: - + ABS, // 122: λa.a dec ɐ + APP, 33, // 123: ɐ dec q + APP, 2, // 125: ɐ dec + VAR, 0, // 127: ɐ + ABS, // 129: dec + ABS, // 130: λab.ɐ (λcd.d(c a)) (λc.b) (λc.c) + ABS, // 131: λa.q (λbc.c(b ɐ)) (λb.a) (λb.b) + APP, 21, // 132: ɔ (λab.b(a q)) (λa.ɐ) (λa.a) + APP, 16, // 134: ɔ (λab.b(a q)) (λa.ɐ) + APP, 2, // 136: ɔ (λab.b(a q)) + VAR, 2, // 138: ɔ + ABS, // 140: λab.b(a q) + ABS, // 141: λa.a(ɐ ɔ) + APP, 2, // 142: ɐ(q p) + VAR, 0, // 144: ɐ + APP, 2, // 146: q p + VAR, 1, // 148: q + VAR, 3, // 150: p + ABS, // 152: λa.ɐ + VAR, 1, // 153: q + ABS, // 155: λa.a + VAR, 0, // 156: ɐ + VAR, 1, // 158: q + VAR, 1, // 160: q + VAR, 0, // 162: ɐ + VAR, 0, // 164: ɐ + VAR, 1, // 166: q +}; + +static int termcmp(const int* p, const char* q, size_t n) { + int c; + size_t i; + for (i = 0; i < n; ++i) { + if ((c = p[i] - q[i])) { + return c; + } + } + return 0; +} + +void PrintVar(int i, FILE* f) { + char ibuf[22]; + switch (style) { + case 0: + int64toarray_radix10(i, ibuf); + fputs(ibuf, f); + break; + case 1: + if (0 <= i && i < sizeof(ALPHABET) / sizeof(*ALPHABET) - 1) { + fputwc(ALPHABET[i], f); + } else if (i < 0 && ~i < sizeof(FREEBIES) / sizeof(*FREEBIES) - 1) { + fputwc(FREEBIES[~i], f); + } else { + ibuf[0] = '?'; + int64toarray_radix10(i, ibuf + 1); + fputs(ibuf, f); + } + break; + default: + do { + fputc('1', f); + } while (i-- > 0); + fputc('0', f); + break; + } +} + +void PrintDebruijn(int x, int head, int depth, FILE* f) { + char ibuf[22]; + if (0 <= x && x < TERMS) { + if (mem[x] == ABS) { + if (!noname) { + if (x == 14) { + fputs("put", f); + return; + } + if (x + sizeof(kTrue) / sizeof(*kTrue) <= end && + !termcmp(mem + x, kTrue, sizeof(kTrue))) { + if (asciiname) { + fputs("true", f); + } else { + fputs("⊤", f); + } + return; + } + if (x + sizeof(kFalse) / sizeof(*kFalse) <= end && + !termcmp(mem + x, kFalse, sizeof(kFalse))) { + if (asciiname) { + fputs("false", f); + } else { + fputs("⊥", f); + } + return; + } + if (x + sizeof(kOmega) / sizeof(*kOmega) <= end && + !termcmp(mem + x, kOmega, sizeof(kOmega))) { + if (asciiname) { + fputs("omega", f); + } else { + fputs("Ω", f); + } + return; + } + if (x + sizeof(kSelf) / sizeof(*kSelf) <= end && + !termcmp(mem + x, kSelf, sizeof(kSelf))) { + if (asciiname) { + fputs("omega", f); + } else { + fputs("ω", f); + } + return; + } + if (x + sizeof(kY) / sizeof(*kY) <= end && + !termcmp(mem + x, kY, sizeof(kY))) { + fputs("Y", f); + return; + } + if (x + sizeof(kYCurry) / sizeof(*kYCurry) <= end && + !termcmp(mem + x, kYCurry, sizeof(kYCurry))) { + fputs("Y", f); + return; + } + if (x + sizeof(kIf) / sizeof(*kIf) <= end && + !termcmp(mem + x, kIf, sizeof(kIf))) { + fputs("if", f); + return; + } + if (x + sizeof(kPair) / sizeof(*kPair) <= end && + !termcmp(mem + x, kPair, sizeof(kPair))) { + fputs("pair", f); + return; + } + if (x + sizeof(kNot) / sizeof(*kNot) <= end && + !termcmp(mem + x, kNot, sizeof(kNot))) { + if (asciiname) { + fputs("not", f); + } else { + fputwc(L'¬', f); + } + return; + } + if (x + sizeof(kOr) / sizeof(*kOr) <= end && + !termcmp(mem + x, kOr, sizeof(kOr))) { + if (asciiname) { + fputs("or", f); + } else { + fputwc(L'∨', f); + } + return; + } + if (x + sizeof(kAnd) / sizeof(*kAnd) <= end && + !termcmp(mem + x, kAnd, sizeof(kAnd))) { + if (asciiname) { + fputs("and", f); + } else { + fputwc(L'∧', f); + } + return; + } + if (x + sizeof(kXor) / sizeof(*kXor) <= end && + !termcmp(mem + x, kXor, sizeof(kXor))) { + if (asciiname) { + fputs("xor", f); + } else { + fputwc(L'⊻', f); + } + return; + } + if (x + sizeof(kLe) / sizeof(*kLe) <= end && + !termcmp(mem + x, kLe, sizeof(kLe))) { + if (asciiname) { + fputs("le", f); + } else { + fputwc(L'≤', f); + } + return; + } + if (x + sizeof(kEq) / sizeof(*kEq) <= end && + !termcmp(mem + x, kEq, sizeof(kEq))) { + fputwc(L'=', f); + return; + } + if (x + sizeof(kAdd) / sizeof(*kAdd) <= end && + !termcmp(mem + x, kAdd, sizeof(kAdd))) { + fputs("+", f); + return; + } + if (x + sizeof(kSub) / sizeof(*kSub) <= end && + !termcmp(mem + x, kSub, sizeof(kSub))) { + fputs("-", f); + return; + } + if (x + sizeof(kCompose) / sizeof(*kCompose) <= end && + !termcmp(mem + x, kCompose, sizeof(kCompose))) { + fputs("∘", f); + return; + } + if (x + sizeof(kSucc) / sizeof(*kSucc) <= end && + !termcmp(mem + x, kSucc, sizeof(kSucc))) { + fputs("inc", f); + return; + } + if (x + sizeof(kPred) / sizeof(*kPred) <= end && + !termcmp(mem + x, kPred, sizeof(kPred))) { + fputs("dec", f); + return; + } + if (x + sizeof(kSecond) / sizeof(*kSecond) <= end && + !termcmp(mem + x, kSecond, sizeof(kSecond))) { + fputs("second", f); + return; + } + if (x + sizeof(kFirst) / sizeof(*kFirst) <= end && + !termcmp(mem + x, kFirst, sizeof(kFirst))) { + fputs("first", f); + return; + } + if (x + sizeof(kMap) / sizeof(*kMap) <= end && + !termcmp(mem + x, kMap, sizeof(kMap))) { + fputs("map", f); + return; + } + if (x + sizeof(kIszero) / sizeof(*kIszero) <= end && + !termcmp(mem + x, kIszero, sizeof(kIszero))) { + fputs("iszero", f); + return; + } + if (x + sizeof(kCons) / sizeof(*kCons) <= end && + !termcmp(mem + x, kCons, sizeof(kCons))) { + fputs("cons", f); + return; + } + if (x + sizeof(kOne) / sizeof(*kOne) <= end && + !termcmp(mem + x, kOne, sizeof(kOne))) { + fputs("one", f); + return; + } + if (x + sizeof(kTwo) / sizeof(*kTwo) <= end && + !termcmp(mem + x, kTwo, sizeof(kTwo))) { + fputs("two", f); + return; + } + if (x + sizeof(kThree) / sizeof(*kThree) <= end && + !termcmp(mem + x, kThree, sizeof(kThree))) { + fputs("three", f); + return; + } + if (x + sizeof(kFour) / sizeof(*kFour) <= end && + !termcmp(mem + x, kFour, sizeof(kFour))) { + fputs("four", f); + return; + } + if (x + sizeof(kFive) / sizeof(*kFive) <= end && + !termcmp(mem + x, kFive, sizeof(kFive))) { + fputs("five", f); + return; + } + if (x + sizeof(kSix) / sizeof(*kSix) <= end && + !termcmp(mem + x, kSix, sizeof(kSix))) { + fputs("six", f); + return; + } + if (x + sizeof(kSeven) / sizeof(*kSeven) <= end && + !termcmp(mem + x, kSeven, sizeof(kSeven))) { + fputs("seven", f); + return; + } + if (x + sizeof(kEight) / sizeof(*kEight) <= end && + !termcmp(mem + x, kEight, sizeof(kEight))) { + fputs("eight", f); + return; + } + if (x + sizeof(kNine) / sizeof(*kNine) <= end && + !termcmp(mem + x, kNine, sizeof(kNine))) { + fputs("nine", f); + return; + } + } + do { + ++x; + if (asciiname) { + fputc('\\', f); + } else { + fputwc(L'λ', f); + } + if (!(0 <= x && x < TERMS)) goto Overflow; + } while (mem[x] == ABS); + fputc(' ', f); + } + if (!(0 <= (x + 1) && (x + 1) < TERMS)) goto Overflow; + if (mem[x] == APP) { + fputc('[', f); + PrintDebruijn(x + 2, 1, depth, f); + fputc(' ', f); + PrintDebruijn(x + 2 + mem[x + 1], 0, depth, f); + fputc(']', f); + } else if (mem[x] == VAR) { + if (0 <= x + 1 && x + 1 < TERMS) { + PrintVar(mem[x + 1], f); + } else { + fputc(L'‼', f); + int64toarray_radix10(x, ibuf); + fputs(ibuf, f); + } + } else if (mem[x] == IOP) { + if (x < 22) { + if (mem[x + 1] & 1) { + fputs("put", f); + } else if (x & 1) { + fputs("wr1", f); + } else { + fputs("wr0", f); + } + } else if (x == end) { + fputs(asciiname ? "gro" : "⋯", f); + } else { + fputc(L'!', f); + int64toarray_radix10(x, ibuf); + fputs(ibuf, f); + } + } else { + fputc(L'!', f); + int64toarray_radix10(x, ibuf); + fputs(ibuf, f); + } + return; + } +Overflow: + fputc(L'‼', f); + int64toarray_radix10(x, ibuf); + fputs(ibuf, f); +} + +void PrintLambda(int x, int head, int depth, int apps, FILE* f) { + int close = 0; + char ibuf[22]; + if (0 <= x && x < TERMS) { + if (mem[x] == ABS) { + if (!noname) { + if (x == 14) { + if (asciiname) { + fputs("put", f); + } else { + fputs("⍆", f); + } + return; + } + if (x + sizeof(kTrue) / sizeof(*kTrue) <= end && + !termcmp(mem + x, kTrue, sizeof(kTrue))) { + if (asciiname) { + fputs("true", f); + } else { + fputs("⊤", f); + } + return; + } + if (x + sizeof(kFalse) / sizeof(*kFalse) <= end && + !termcmp(mem + x, kFalse, sizeof(kFalse))) { + if (asciiname) { + fputs("false", f); + } else { + fputs("⊥", f); + } + return; + } + if (x + sizeof(kY) / sizeof(*kY) <= end && + !termcmp(mem + x, kY, sizeof(kY))) { + fputs("Y", f); + return; + } + if (x + sizeof(kYCurry) / sizeof(*kYCurry) <= end && + !termcmp(mem + x, kYCurry, sizeof(kYCurry))) { + fputs("Y", f); + return; + } + if (x + sizeof(kOmega) / sizeof(*kOmega) <= end && + !termcmp(mem + x, kOmega, sizeof(kOmega))) { + if (asciiname) { + fputs("OMEGA", f); + } else { + fputs("Ω", f); + } + return; + } + if (x + sizeof(kSelf) / sizeof(*kSelf) <= end && + !termcmp(mem + x, kSelf, sizeof(kSelf))) { + if (asciiname) { + fputs("omega", f); + } else { + fputs("ω", f); + } + return; + } + if (x + sizeof(kNot) / sizeof(*kNot) <= end && + !termcmp(mem + x, kNot, sizeof(kNot))) { + if (asciiname) { + fputs("not", f); + } else { + fputwc(L'¬', f); + } + return; + } + if (x + sizeof(kOr) / sizeof(*kOr) <= end && + !termcmp(mem + x, kOr, sizeof(kOr))) { + if (asciiname) { + fputs("or", f); + } else { + fputwc(L'∨', f); + } + return; + } + if (x + sizeof(kXor) / sizeof(*kXor) <= end && + !termcmp(mem + x, kXor, sizeof(kXor))) { + if (asciiname) { + fputs("xor", f); + } else { + fputwc(L'⊻', f); + } + return; + } + if (x + sizeof(kLe) / sizeof(*kLe) <= end && + !termcmp(mem + x, kLe, sizeof(kLe))) { + if (asciiname) { + fputs("le", f); + } else { + fputwc(L'≤', f); + } + return; + } + if (x + sizeof(kEq) / sizeof(*kEq) <= end && + !termcmp(mem + x, kEq, sizeof(kEq))) { + fputwc(L'=', f); + return; + } + if (x + sizeof(kAnd) / sizeof(*kAnd) <= end && + !termcmp(mem + x, kAnd, sizeof(kAnd))) { + if (asciiname) { + fputs("and", f); + } else { + fputwc(L'∧', f); + } + return; + } + if (x + sizeof(kAdd) / sizeof(*kAdd) <= end && + !termcmp(mem + x, kAdd, sizeof(kAdd))) { + fputs("+", f); + return; + } + if (x + sizeof(kSub) / sizeof(*kSub) <= end && + !termcmp(mem + x, kSub, sizeof(kSub))) { + fputs("-", f); + return; + } + if (x + sizeof(kCompose) / sizeof(*kCompose) <= end && + !termcmp(mem + x, kCompose, sizeof(kCompose))) { + if (asciiname) { + fputs("compose", f); + } else { + fputs("∘", f); + } + return; + } + if (x + sizeof(kOne) / sizeof(*kOne) <= end && + !termcmp(mem + x, kOne, sizeof(kOne))) { + fputc('1', f); + return; + } + if (x + sizeof(kTwo) / sizeof(*kTwo) <= end && + !termcmp(mem + x, kTwo, sizeof(kTwo))) { + fputc('2', f); + return; + } + if (x + sizeof(kThree) / sizeof(*kThree) <= end && + !termcmp(mem + x, kThree, sizeof(kThree))) { + fputc('3', f); + return; + } + if (x + sizeof(kFour) / sizeof(*kFour) <= end && + !termcmp(mem + x, kFour, sizeof(kFour))) { + fputc('4', f); + return; + } + if (x + sizeof(kFive) / sizeof(*kFive) <= end && + !termcmp(mem + x, kFive, sizeof(kFive))) { + fputc('5', f); + return; + } + if (x + sizeof(kSix) / sizeof(*kSix) <= end && + !termcmp(mem + x, kSix, sizeof(kSix))) { + fputc('6', f); + return; + } + if (x + sizeof(kSeven) / sizeof(*kSeven) <= end && + !termcmp(mem + x, kSeven, sizeof(kSeven))) { + fputc('7', f); + return; + } + if (x + sizeof(kEight) / sizeof(*kEight) <= end && + !termcmp(mem + x, kEight, sizeof(kEight))) { + fputc('8', f); + return; + } + if (x + sizeof(kNine) / sizeof(*kNine) <= end && + !termcmp(mem + x, kNine, sizeof(kNine))) { + fputc('9', f); + return; + } + if (x + sizeof(kIf) / sizeof(*kIf) <= end && + !termcmp(mem + x, kIf, sizeof(kIf))) { + fputs("if", f); + return; + } + if (x + sizeof(kPair) / sizeof(*kPair) <= end && + !termcmp(mem + x, kPair, sizeof(kPair))) { + fputs("pair", f); + return; + } + if (x + sizeof(kSucc) / sizeof(*kSucc) <= end && + !termcmp(mem + x, kSucc, sizeof(kSucc))) { + fputs("inc", f); + return; + } + if (x + sizeof(kPred) / sizeof(*kPred) <= end && + !termcmp(mem + x, kPred, sizeof(kPred))) { + fputs("dec", f); + return; + } + if (x + sizeof(kSecond) / sizeof(*kSecond) <= end && + !termcmp(mem + x, kSecond, sizeof(kSecond))) { + fputs("second", f); + return; + } + if (x + sizeof(kFirst) / sizeof(*kFirst) <= end && + !termcmp(mem + x, kFirst, sizeof(kFirst))) { + fputs("first", f); + return; + } + if (x + sizeof(kMap) / sizeof(*kMap) <= end && + !termcmp(mem + x, kMap, sizeof(kMap))) { + fputs("map", f); + return; + } + if (x + sizeof(kIszero) / sizeof(*kIszero) <= end && + !termcmp(mem + x, kIszero, sizeof(kIszero))) { + fputs("iszero", f); + return; + } + if (x + sizeof(kCons) / sizeof(*kCons) <= end && + !termcmp(mem + x, kCons, sizeof(kCons))) { + fputs("cons", f); + return; + } + } + if (apps) { + fputc('(', f); + close = 1; + } + if (asciiname) { + fputc('\\', f); + } else { + fputwc(L'λ', f); + } + if (safer) { + fputwc(ALPHABET[depth++], f); + fputc('.', f); + PrintLambda(x + 1, head, depth, apps + 1, f); + if (close) { + fputc(')', f); + } + return; + } + do { + ++x; + fputwc(ALPHABET[depth++], f); + if (!(0 <= x && x < TERMS)) goto Overflow; + } while (mem[x] == ABS); + fputc('.', f); + } + if (!(0 <= (x + 1) && (x + 1) < TERMS)) goto Overflow; + if (mem[x] == VAR) { + if (0 <= x + 1 && x + 1 < TERMS) { + PrintVar(depth - 1 - mem[x + 1], f); + } else { + fputc(L'‼', f); + int64toarray_radix10(x, ibuf); + fputs(ibuf, f); + } + } else if (mem[x] == APP) { + if (!close && !head) { + fputc('(', f); + close = 1; + } + PrintLambda(x + 2, 1, depth, apps + 1, f); + if (!(x + 2 + mem[x + 1] < TERMS && mem[x + 2 + mem[x + 1]] == APP)) { + if (safer || !noname) fputc(' ', f); + } + PrintLambda(x + 2 + mem[x + 1], 0, depth, apps + 1, f); + } else if (mem[x] == IOP) { + if (x < 22) { + if (mem[x + 1] & 1) { + fputs(asciiname ? "put" : "⍆", f); + } else if (x & 1) { + fputs(asciiname ? "wr1" : "⍆₁", f); + } else { + fputs(asciiname ? "wr0" : "⍆₀", f); + } + } else if (x == end) { + fputs(asciiname ? "gro" : "⋯", f); + } else { + fputc(L'!', f); + int64toarray_radix10(x, ibuf); + fputs(ibuf, f); + } + } else { + fputc(L'!', f); + int64toarray_radix10(x, ibuf); + fputs(ibuf, f); + } + if (close) { + fputc(')', f); + } + return; + } +Overflow: + fputc(L'‼', f); + int64toarray_radix10(x, ibuf); + fputs(ibuf, f); +} + +void PrintBinary(int x, int head, int depth, FILE* f) { + char ibuf[22]; + if (0 <= x && x < TERMS) { + if (mem[x] == ABS) { + if (x == 14) { + fputs("⍆", f); + return; + } + do { + ++x; + ++depth; + fputc('0', f); + fputc('0', f); + if (!(0 <= x && x < TERMS)) goto Overflow; + } while (mem[x] == ABS); + } + if (!(0 <= (x + 1) && (x + 1) < TERMS)) goto Overflow; + if (mem[x] == VAR) { + if (0 <= x + 1 && x + 1 < TERMS) { + PrintVar(mem[x + 1], f); + } else { + fputc(L'‼', f); + int64toarray_radix10(x, ibuf); + fputs(ibuf, f); + } + } else if (mem[x] == APP) { + fputc('0', f); + fputc('1', f); + PrintBinary(x + 2, 0, 0, f); + PrintBinary(x + 2 + mem[x + 1], 0, 0, f); + } else if (mem[x] == IOP) { + if (x < 22) { + if (mem[x + 1] & 1) { + fputs("⍆", f); + } else if (x & 1) { + fputs("⍆₁", f); + } else { + fputs("⍆₀", f); + } + } else { + fputwc(L'⋯', f); + } + } else if (mem[x] == -1) { + fputwc(L'⋯', f); + } else { + fputc(L'!', f); + int64toarray_radix10(x, ibuf); + fputs(ibuf, f); + } + return; + } +Overflow: + fputc(L'‼', f); + int64toarray_radix10(x, ibuf); + fputs(ibuf, f); +} + +void Print(int x, int head, int depth, FILE* f) { + switch (style) { + case 0: + PrintDebruijn(x, head, depth, f); + break; + case 1: + PrintLambda(x, head, depth, 0, f); + break; + default: + PrintBinary(x, head, depth, f); + break; + } +} diff --git a/tool/lambda/lib/vars.c b/tool/lambda/lib/vars.c new file mode 100644 index 000000000..906050888 --- /dev/null +++ b/tool/lambda/lib/vars.c @@ -0,0 +1,40 @@ +/*-*- mode:c;indent-tabs-mode:nil;c-basic-offset:2;tab-width:8;coding:utf-8 -*-│ +│vi: set net ft=c ts=2 sts=2 sw=2 fenc=utf-8 :vi│ +╞══════════════════════════════════════════════════════════════════════════════╡ +│ Copyright 2022 Justine Alexandra Roberts Tunney │ +│ │ +│ Permission to use, copy, modify, and/or distribute this software for │ +│ any purpose with or without fee is hereby granted, provided that the │ +│ above copyright notice and this permission notice appear in all copies. │ +│ │ +│ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL │ +│ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED │ +│ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE │ +│ AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL │ +│ DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR │ +│ PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER │ +│ TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR │ +│ PERFORMANCE OF THIS SOFTWARE. │ +╚─────────────────────────────────────────────────────────────────────────────*/ +#include "tool/lambda/lib/blc.h" + +char binary; // 8-bit +char safer; // safer +char style; // notation +char asciiname; // <3 ascii +char noname; // rewriting +char rlog; // redex log +char slog; // state log +char alog; // action log +char vlog; // variable log +int co; // output character +int heap; // heap usage counter +long ip; // instruction pointer +long end; // end of code pointer +FILE *logh; // log file stdio stream +struct Closure *frep; // freed closures list +struct Closure *contp; // continuations stack +int mem[TERMS]; // bss memory for terms + +struct Closure root = {.refs = 100000, .term = -1, .next = 0}; +struct Closure *envp = &root; diff --git a/tool/lambda/tromp.c b/tool/lambda/tromp.c new file mode 100644 index 000000000..b9dfbd32b --- /dev/null +++ b/tool/lambda/tromp.c @@ -0,0 +1,37 @@ +// Public Domain +// Author: John Tromp +// Source: IOCCC 2012 +#include "libc/runtime/runtime.h" +#include "tool/lambda/lib/blc.h" + +#define A 500000 +#define X 8 +#define Int long + +// clang-format off + + Int L[A],m,b,*D=A, + *c,*a=L,C,*U=L,u;s + (_){u--&&s(a=*a);} + char*B,I,O;S(){b=b + --?b:m|read(0,&I,1 + )-1;return~I>>b&1; + }k(l,u){for(;l<=u; + U-L