mirrors/cosmopolitan
1
0
Fork 0
mirror of https://github.com/jart/cosmopolitan.git synced 2025-01-31 03:27:39 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Add SectorLambda

Browse source
This commit is contained in:
Justine Tunney 2022-03-17 14:12:41 -07:00
parent 741c836e9d
commit f5831a62fa
21 changed files with 3275 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Makefile
View file

@ -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

77
tool/lambda/asc2bin.c Normal file
View file

@ -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.txt >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);
}
}

156
tool/lambda/blcdump.c Normal file
View file

@ -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...] <stdin >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);
}
}
}

324
tool/lambda/bru2bin.c Normal file
View file

@ -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] <lambda.txt >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());
}

305
tool/lambda/lam2bin.c Normal file
View file

@ -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] <lambda.txt >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());
}

352
tool/lambda/lambda.c Normal file
View file

@ -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] <stdin >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();
}

59
tool/lambda/lambda.mk Normal file
View file

@ -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)

65
tool/lambda/lib/blc.h Normal file
View file

@ -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_ */

43
tool/lambda/lib/calloc.c Normal file
View file

@ -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;
}

154
tool/lambda/lib/debug.c Normal file
View file

@ -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);
}

63
tool/lambda/lib/dump.c Normal file
View file

@ -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);
}

37
tool/lambda/lib/error.c Normal file
View file

@ -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);
}

54
tool/lambda/lib/getbit.c Normal file
View file

@ -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;
}

65
tool/lambda/lib/lib.mk Normal file
View file

@ -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)

25
tool/lambda/lib/needbit.c Normal file
View file

@ -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;
}

55
tool/lambda/lib/parse.c Normal file
View file

@ -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;
}

72
tool/lambda/lib/parserom.c Normal file
View file

@ -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);
}

1289
tool/lambda/lib/print.c Normal file
View file

File diff suppressed because it is too large Load diff

40
tool/lambda/lib/vars.c Normal file
View file

@ -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;

37
tool/lambda/tromp.c Normal file
View file

@ -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<A?*U++=46^l++[
"-,&,,/.--/,:-,'/"
".-,-,,/.-,*,//..,"
]:exit(5));}p(Int*m){
return!*U?*m=S()?U++,!S
()?m[1]=p(++U),2:3:1,p(U)
:S()?U+=2:p(U[1]++),U-m;}x(
c){k(7*!b,9);*U++=b&&S();c&&x
(b);}d(Int*l){--l[1]||d(l[d(*l),
*l=B,B=l,2]);}main(e){for(k(10,33
),a[4]-=m=e-2&7,a[23]=p(U),b=0;;e-2
?e?e-3?s(D=a),C=a [3],++1[a=a[2]],d(
D):c?D=c,c=*D,*D= a,a=D:exit(L[C+1])
:C--<23?C=u+m&1?O =O+O|C&1,9:write(m
||(O=C+28),&O,1)+ 1:(S(),x(0<b++?k(0,
6),U[-5]=96:0)):( D=B?B:Calloc(4,X))
?B=*D,*D=c,c=D,D[ 2]=a,a[++D[1]]++,D
[3]=++C+u:exit(6) )e=L[C++],u=L[C];}

1
tool/tool.mk
View file

@ -6,5 +6,6 @@ o/$(MODE)/tool: \
o/$(MODE)/tool/build \
o/$(MODE)/tool/decode \
o/$(MODE)/tool/hash \
o/$(MODE)/tool/lambda \
o/$(MODE)/tool/net \
o/$(MODE)/tool/viz