diff --git a/Makefile b/Makefile index 9f8b04ac5..b9809ad06 100644 --- a/Makefile +++ b/Makefile @@ -164,6 +164,9 @@ include tool/decode/lib/decodelib.mk include tool/decode/decode.mk include tool/lambda/lib/lib.mk include tool/lambda/lambda.mk +include tool/plinko/lib/lib.mk +include tool/plinko/plinko.mk +include test/tool/plinko/test.mk include tool/hash/hash.mk include tool/net/net.mk include tool/viz/viz.mk diff --git a/test/tool/plinko/algebra_test.lisp b/test/tool/plinko/algebra_test.lisp new file mode 100644 index 000000000..5f4c157c6 --- /dev/null +++ b/test/tool/plinko/algebra_test.lisp @@ -0,0 +1,99 @@ +#| plinko - a really fast lisp tarpit + | 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. + |# + +(TEST '(A B C) (SUBST '(A B C) NIL)) +(TEST '(X B C) (SUBST '(A B C) '((A . X)))) +(TEST '(X B Z) (SUBST '(A B C) '((A . X) (C . Z)))) +(TEST '((X) B Z) (SUBST '((A) B C) '((A . X) (C . Z)))) + +(TEST '(ADD B C) (RIGHTEN '(ADD C B))) +(TEST '(ADD C (ADD A B)) (RIGHTEN '(ADD C (ADD A B)))) +(TEST '(ADD C (* A B)) (RIGHTEN '(ADD (* A B) C))) +(TEST '(ADD C (ADD A B)) (RIGHTEN '(ADD (ADD A B) C))) +(TEST '(ADD A (ADD B (ADD C D))) (RIGHTEN '(ADD (ADD (ADD D C) B) A))) + +(TEST 'DOG (SIMPTREE 'DOG '((* ((* A 0) 0))))) +(TEST '(NOT X) (SIMPTREE '(NOT X) '((* ((* A 0) 0))))) +(TEST '0 (SIMPTREE '(* Z 0) '((* ((* A 0) 0))))) +(TEST '0 (SIMPTREE '(* (* Z 0) (* Z 0)) + '((* ((* A 0) 0) + ((* A 0) 0))))) + +(TEST '(A) (PERMCOMM 'A)) +(TEST '((SUB A B)) (PERMCOMM '(SUB A B))) +(TEST '((ADD B A) (ADD A B)) (PERMCOMM '(ADD A B))) +(TEST '((ADD C (* A B)) (ADD (* A B) C) (ADD C (* B A)) (ADD (* B A) C)) (PERMCOMM '(ADD (* A B) C))) + +(TEST '0 (SIMPLIFY '(AND P (NOT P)))) +(TEST '0 (SIMPLIFY '(NOT (OR P (NOT P))))) +(TEST 'A (SIMPLIFY '(* (SQRT A) (SQRT A)))) +(TEST 'A (SIMPLIFY '(SQRT (POW 4 (LOGN A 2))))) +(TEST '(* (ABS A) (POW 2 (DIV 1 2))) (SIMPLIFY '(HYPOT A A))) +(TEST '1 (SIMPLIFY '(POW (SQR A) 0))) +(TEST '(POW A (* B C)) (SIMPLIFY '(POW (POW A B) C))) +(TEST '(POW A (ADD B C)) (SIMPLIFY '(* (POW A B) (POW A C)))) +(TEST 'B (SIMPLIFY '(LOGN (POW A B) A))) +(TEST '(DIV (LOG (DIV A B)) (LOG C)) (SIMPLIFY '(SUB (LOGN A C) (LOGN B C)))) +;; (TEST '(DIV (* P (LOG X)) (LOG A)) (SIMPLIFY '(LOGN (POW X P) A))) ;; LITTLE WEIRD +(TEST '(* B C) (SIMPLIFY '(LOGN (POW (POW A B) C) A))) +(TEST 'A (SIMPLIFY '(DIV A 1))) +(TEST '0 (SIMPLIFY '(DIV 0 A))) +(TEST ':DBZERO (SIMPLIFY '(DIV A 0))) +(TEST ':DBZERO (SIMPLIFY '(LOGN A 1))) +(TEST '(DIV A B) (SIMPLIFY '(DIV (SUB 0 A) (SUB 0 B)))) +(TEST '1 (SIMPLIFY '(DIV A A))) +(TEST '(DIV B C) (SIMPLIFY '(DIV (* A B) (* A C)))) +(TEST '(DIV A C) (SIMPLIFY '(* (DIV A B) (DIV B C)))) +(TEST '(DIV C B) (SIMPLIFY '(* (DIV A B) (DIV C A)))) +(TEST 'B (SIMPLIFY '(* (DIV B A) A))) +(TEST '(DIV (ADD A C) B) (SIMPLIFY '(ADD (DIV A B) (DIV C B)))) +(TEST '(DIV (SUB A C) B) (SIMPLIFY '(SUB (DIV A B) (DIV C B)))) +;; (TEST '(DIV (* A D) (* B C)) (SIMPLIFY '(DIV (DIV A B) (DIV C D)))) +(TEST '(DIV 1 A) (SIMPLIFY '(* (POW A (SUB B 1)) (POW A (SUB 0 B))))) +(TEST '(* C (POW A 2)) (SIMPLIFY '(* (ABS A) (* (ABS A) C)))) +(TEST '(OR B (NOT A)) (SIMPLIFY '(SUB (ADD (SUB 0 A) (AND A B)) 1))) +(TEST '(NOT (XOR A B)) (SIMPLIFY '(SUB (ADD (SUB (SUB 0 A) B) (* 2 (AND A B))) 1))) +(TEST '(ADD Z (SUB X Y)) (SIMPLIFY '(ADD (OR (SUB (AND X (NOT Y)) (AND (NOT X) Y)) Z) (AND (SUB (AND X (NOT Y)) (AND (NOT X) Y)) Z)))) +(TEST '(* (ADD A B) (SUB A B)) (SIMPLIFY '(SUB (SQR A) (SQR B)))) +(TEST '(* (ADD A B) (SUB A B)) (SIMPLIFY '(SUB (SUB (* A (ADD B A)) (* A B)) (POW B 2)))) +(TEST '(ADD X Y) (SIMPLIFY '(ADD (XOR X Y) (* (AND X Y) 2)))) + +(TEST (DERIV '(* X 1) 'X) '(ADD (* X 0) (* 1 1))) +(TEST (DERIV '(* X Y) 'X) '(ADD (* X 0) (* 1 Y))) +(TEST (DERIV '(* (* X Y) (ADD X 3)) 'X) '(ADD (* (* X Y) (ADD 1 0)) (* (ADD (* X 0) (* 1 Y)) (ADD X 3)))) +(TEST '(ADD (* (POW X 2) (* (LOG X) 0)) (* 2 (* (POW X (SUB 2 1)) 1))) (DERIV '(POW X 2) 'X)) + +(TEST '0 (DERIVATIVE '(* X 0) 'X)) +(TEST '1 (DERIVATIVE '(* X 1) 'X)) +(TEST 'Y (DERIVATIVE '(* X Y) 'X)) +(TEST '(* 2 X) (DERIVATIVE '(* X X) 'X)) +(TEST '(* 4 (POW X 3)) (DERIVATIVE '(* (* (* X X) X) X) 'X)) +(TEST '(* Y (ADD 3 (* 2 X))) (DERIVATIVE '(* (* X Y) (ADD X 3)) 'X)) +(TEST '(* 3 (POW X 2)) (DERIVATIVE '(POW X 3) 'X)) +(TEST '(* 4 (POW X 3)) (DERIVATIVE '(POW (* X X) 2) 'X)) +(TEST '(* Y (* 3 (POW X 2))) (DERIVATIVE '(* (* (* X Y) X) X) 'X)) +(TEST '(DIV 1 X) (DERIVATIVE '(LOG X) 'X)) +(TEST '(DIV Y X) (DERIVATIVE '(LOG (POW X Y)) 'X)) +(TEST '(COS X) (DERIVATIVE '(SIN X) 'X)) +(TEST '(* Y (COS (* X Y))) (DERIVATIVE '(SIN (* X Y)) 'X)) +(TEST '(SUB 0 (SIN X)) (DERIVATIVE '(COS X) 'X)) +(TEST '(SUB 0 (* Y (SIN (* X Y)))) (DERIVATIVE '(COS (* X Y)) 'X)) +(TEST '(DIV 1 (* 2 (POW X (DIV 1 2)))) (DERIVATIVE '(SQRT X) 'X)) +(TEST '(* Y (DIV X (ABS X))) (DERIVATIVE '(* Y (ABS X)) 'X)) +(TEST '1 (DERIVATIVE '(SUB X Y) 'X)) +(TEST '(SUB 0 1) (DERIVATIVE '(SUB X Y) 'Y)) +(TEST '(* Y (POW X (SUB Y 1))) (DERIVATIVE '(POW X Y) 'X)) diff --git a/test/tool/plinko/library_test.lisp b/test/tool/plinko/library_test.lisp new file mode 100644 index 000000000..0661f9b32 --- /dev/null +++ b/test/tool/plinko/library_test.lisp @@ -0,0 +1,222 @@ +#| plinko - a really fast lisp tarpit + | 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. + |# + +(test nil (cmp 'a 'a)) +(test '(nil) (cmp 'a 'b)) +(test t (cmp 'b 'a)) +(test '(nil) (cmp 'a 'aa)) +(test t (cmp 'aa 'a)) +(test '(nil) (cmp 'a '(a))) +(test t (cmp '(a) 'a)) +(test nil (cmp '(a) '(a))) +(test '(nil) (cmp '(a) '(a b))) +(test nil (cmp '(a a) '(a a))) +(test '(nil) (cmp '(a a) '(a aa))) +(test '(nil) (cmp '(a a) '((a) a))) +(test '(nil) (cmp '(a a) '(a a b))) +(test 'hello ((macro (x) (cons (quote quote) (cons x))) hello)) +(test 'hello ((closure (macro (x) (cons (quote quote) (cons x)))) hello)) +(test '(quoth hello) ((macro (x) (cons (quote quote) (cons (cons (quote quoth) (cons x))))) hello)) +(test (quote (macro (x) (cons (quote quote) (cons x)))) (car (cdr (macro (x) (cons (quote quote) (cons x)))))) + +(test 'b ((closure (lambda () a) (a . b)))) +(test 'b (eval 'a '((a . b)))) + +(test nil (reverse)) +(test '(c b a) (reverse '(a b c))) + +(test '(a b c) + (akeys '((a x) + (b y) + (c z)))) + +(test '(x y z) + (avals '((a x) + (b y) + (c z)))) + +(test t (and)) +(test nil (and nil)) +(test t (and t)) +(test nil (and nil nil)) +(test nil (and t nil)) +(test nil (and nil t)) +(test t (and t t)) +(test 'a (and 'a)) +(test 'b (and 'a 'b)) +(test 'c (and 'a 'b 'c)) + +(test nil (or)) +(test nil (or nil)) +(test t (or t)) +(test nil (or nil nil)) +(test t (or t nil)) +(test t (or nil t)) +(test t (or t t)) +(test 'a (or 'a)) +(test 'a (or 'a 'b)) +(test 'a (or 'a 'b 'c)) + +(test t (not)) +(test t (not nil)) +(test nil (not t)) +(test '(eq x) (expand '(not x))) + +(test '(abc . def) + (let ((x 'abc) + (y 'def)) + (cons x y))) + +(test '((lambda (x y) + (cons x y)) + 'abc + 'def) + (expand '(let ((x 'abc) + (y 'def)) + (cons x y)))) + +(test '(abc def (abc . def)) + (let* ((x 'abc) + (y 'def) + (z (cons x y))) + (cons x (cons y (cons z))))) + +(test '((lambda (x) + ((lambda (y) + ((lambda (z) + (list x y z)) + (cons x y))) + 'def)) + 'abc) + (expand '(let* ((x 'abc) + (y 'def) + (z (cons x y))) + (list x y z)))) + +(test nil (last nil)) +(test 'a (last '(a))) +(test 'b (last '(a b))) +(test '(c) (last '(a b (c)))) + +(test nil (copy nil)) +(test t (copy t)) +(test '(a b) (copy '(a b))) +(test '(a . b) (copy '(a . b))) + +(test nil (assoc 'a ())) +(test nil (assoc 'd '((a b) (c d)))) +(test '(a b) (assoc 'a '((a b) (c d)))) +(test '(c d) (assoc 'c '((a b) (c d)))) +(test '((foo bar) d) (assoc '(foo bar) '((a b) ((foo bar) d)))) + +(test '(a) (addset 'a)) +(test '(a) (addset 'a '(a))) +(test '(b a) (addset 'b '(a))) +(test '(a b) (addset 'b '(a b))) + +(test '(a) (peel 'a)) +(test '(a) (peel 'a '(a))) +(test '(b a) (peel 'b '(a))) +(test '(b a b) (peel 'b '(a b))) + +(test nil (reverse (reverse-mapcar cons nil))) +(test '((a) (b) (c)) (reverse (reverse-mapcar cons '(a b c)))) +(test '(a b a) (reverse (reverse-mapcar car '((a . x) (b . y) (a . z))))) +(test '(a b a c) (reverse (reverse-mapcar car '((a . x) (b . y) (a . z) (c . z))))) +(test '((a . a) (b . b) (a . a)) (reverse (reverse-mapcar (lambda (x) (cons x x)) '(a b a)))) + +(test nil (mapcar cons nil)) +(test '((a) (b) (c)) (mapcar cons '(a b c))) +(test '(a b a) (mapcar car '((a . x) (b . y) (a . z)))) +(test '(a b a c) (mapcar car '((a . x) (b . y) (a . z) (c . z)))) +(test '((a . a) (b . b) (a . a)) (mapcar (lambda (x) (cons x x)) '(a b a))) + +(test nil (mapset cons nil)) +(test '((a) (b) (c)) (mapset cons '(a b c))) +(test '(a b) (mapset car '((a . x) (b . y) (a . z)))) +(test '((a . a) (b . b)) (mapset (lambda (x) (cons x x)) '(a b a))) + +(test 'a (reduce list '(a))) +(test '(((a b) c) d) (reduce list '(a b c d))) + +(test '(a b c d) (append '(a b) '(c d))) + +(test t (all ())) +(test nil (all '(a b nil d))) +(test 'd (all '(a b c d))) + +(test nil (any ())) +(test 'a (any '(a b nil d))) +(test 'b (any '(nil b c d))) +(test nil (any '(nil nil))) + +(test '((a . b) (c . d)) (pairwise '(a b c d))) +(test '((a . a) (b . b) (c . c)) (dolist (x '(a b c)) (cons x x))) +(test '((a . a) (b . b) (c . c)) (reverse (reverse-dolist (x '(a b c)) (cons x x)))) +(test '((a . a) (c . c)) (reverse (reverse-dolist (x '(a a c) peel) (cons x x)))) + +(test '((abs ((abs k) k)) + (log ((log 1) 0)) + (add ((add 1 2) 3) + ((add 1 3) 4) + ((add 1 4) 5)) + (sub ((sub 1 1) 0) + ((sub 2 1) 1) + ((sub 3 1) 2))) + (GroupBy (lambda (x) (caar x)) + '(((abs k) k) + ((log 1) 0) + ((add 1 2) 3) + ((add 1 3) 4) + ((add 1 4) 5) + ((sub 1 1) 0) + ((sub 2 1) 1) + ((sub 3 1) 2)))) + +(progn + (cond ((eq 'b (car (cdr '(a b c d))))) ((error '(cadr failed)))) + (cond ((eq 'c (car (cdr (cdr '(a b c d)))))) ((error '(caddr failed)))) + (cond ((eq 'c (car (cdr (car '(((a . b) . (c . d)))))))) ((error '(cadar failed)))) + (cond ((eq 'a (car (car '((a . b) . (c . d)))))) ((error '(caar failed)))) + (cond ((eq 'b (cdr (car '((a . b) . (c . d)))))) ((error '(cdar failed)))) + (cond ((eq 'c (car (cdr '((a . b) . (c . d)))))) ((error '(cadr failed)))) + (cond ((eq 'd (cdr (cdr '((a . b) . (c . d)))))) ((error '(cddr failed)))) + (cond ((eq 'a ((lambda ((x )) x) (cons 'a 'b)))) ((error '(lambda car failed)))) + (cond ((eq 'b ((lambda ((nil . x)) x) (cons 'a 'b)))) ((error '(lambda cdr failed)))) + (ignore)) + +(progn + (cond ((eq (quote a) + ((lambda (f) + (f f (quote ((a) b c)))) + (lambda (f a) + (cond ((atom a) a) + ((f f (car a)))))))) + ((error (quote (test failed)) + (quote (find first atom))))) + (ignore)) + +(progn + (cond ((equal (cons 'a 'b) + (((lambda (f) + (f (cons 'a 'b))) + (lambda (x) + (lambda () + x)))))) + ((error '(enclosed memory failed to propogate upward)))) + (ignore)) + diff --git a/test/tool/plinko/plinko_test.c b/test/tool/plinko/plinko_test.c new file mode 100644 index 000000000..2be11ee2d --- /dev/null +++ b/test/tool/plinko/plinko_test.c @@ -0,0 +1,118 @@ +/*-*- 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/calls/sigbits.h" +#include "libc/calls/struct/sigaction.h" +#include "libc/errno.h" +#include "libc/macros.internal.h" +#include "libc/mem/io.h" +#include "libc/mem/mem.h" +#include "libc/runtime/runtime.h" +#include "libc/sysv/consts/o.h" +#include "libc/sysv/consts/sig.h" +#include "libc/testlib/testlib.h" + +STATIC_YOINK("zip_uri_support"); +STATIC_YOINK("plinko.com"); +STATIC_YOINK("library.lisp"); +STATIC_YOINK("library_test.lisp"); +STATIC_YOINK("binarytrees.lisp"); +STATIC_YOINK("algebra.lisp"); +STATIC_YOINK("algebra_test.lisp"); +STATIC_YOINK("infix.lisp"); +STATIC_YOINK("ok.lisp"); + +static const char *const kSauces[] = { + "/zip/library.lisp", // + "/zip/library_test.lisp", // + "/zip/binarytrees.lisp", // + "/zip/algebra.lisp", // + "/zip/algebra_test.lisp", // + "/zip/infix.lisp", // + "/zip/ok.lisp", // +}; + +char testlib_enable_tmp_setup_teardown_once; + +void SetUpOnce(void) { + int fdin, fdout; + ASSERT_NE(-1, mkdir("bin", 0755)); + ASSERT_NE(-1, (fdin = open("/zip/plinko.com", O_RDONLY))); + ASSERT_NE(-1, (fdout = creat("bin/plinko.com", 0755))); + ASSERT_NE(-1, _copyfd(fdin, fdout, -1)); + EXPECT_EQ(0, close(fdout)); + EXPECT_EQ(0, close(fdin)); +} + +TEST(plinko, worksOrPrintsNiceError) { + ssize_t rc; + char buf[16], drain[64]; + sigset_t chldmask, savemask; + int i, pid, fdin, wstatus, pfds[2][2]; + struct sigaction ignore, saveint, savequit, savepipe; + bzero(buf, sizeof(buf)); + ignore.sa_flags = 0; + ignore.sa_handler = SIG_IGN; + EXPECT_EQ(0, sigemptyset(&ignore.sa_mask)); + EXPECT_EQ(0, sigaction(SIGINT, &ignore, &saveint)); + EXPECT_EQ(0, sigaction(SIGQUIT, &ignore, &savequit)); + EXPECT_EQ(0, sigaction(SIGPIPE, &ignore, &savepipe)); + EXPECT_EQ(0, sigemptyset(&chldmask)); + EXPECT_EQ(0, sigaddset(&chldmask, SIGCHLD)); + EXPECT_EQ(0, sigprocmask(SIG_BLOCK, &chldmask, &savemask)); + ASSERT_NE(-1, pipe2(pfds[0], O_CLOEXEC)); + ASSERT_NE(-1, pipe2(pfds[1], O_CLOEXEC)); + ASSERT_NE(-1, (pid = vfork())); + if (!pid) { + close(0), dup(pfds[0][0]); + close(1), dup(pfds[1][1]); + close(2), dup(pfds[1][1]); + sigaction(SIGINT, &saveint, 0); + sigaction(SIGQUIT, &savequit, 0); + sigaction(SIGQUIT, &savepipe, 0); + sigprocmask(SIG_SETMASK, &savemask, 0); + execve("bin/plinko.com", (char *const[]){"bin/plinko.com", 0}, + (char *const[]){0}); + _exit(127); + } + EXPECT_NE(-1, close(pfds[0][0])); + EXPECT_NE(-1, close(pfds[1][1])); + for (i = 0; i < ARRAYLEN(kSauces); ++i) { + EXPECT_NE(-1, (fdin = open(kSauces[i], O_RDONLY))); + rc = _copyfd(fdin, pfds[0][1], -1); + if (rc == -1) EXPECT_EQ(EPIPE, errno); + EXPECT_NE(-1, close(fdin)); + } + EXPECT_NE(-1, close(pfds[0][1])); + EXPECT_NE(-1, read(pfds[1][0], buf, sizeof(buf) - 1)); + while (read(pfds[1][0], drain, sizeof(drain)) > 0) donothing; + EXPECT_NE(-1, close(pfds[1][0])); + EXPECT_NE(-1, waitpid(pid, &wstatus, 0)); + EXPECT_TRUE(WIFEXITED(wstatus)); + if (!startswith(buf, "error: ")) { + EXPECT_STREQ("OKCOMPUTER\n", buf); + EXPECT_EQ(0, WEXITSTATUS(wstatus)); + } else { + EXPECT_EQ(1, WEXITSTATUS(wstatus)); + } + EXPECT_EQ(0, sigaction(SIGINT, &saveint, 0)); + EXPECT_EQ(0, sigaction(SIGQUIT, &savequit, 0)); + EXPECT_EQ(0, sigaction(SIGPIPE, &savepipe, 0)); + EXPECT_EQ(0, sigprocmask(SIG_SETMASK, &savemask, 0)); +} diff --git a/test/tool/plinko/test.mk b/test/tool/plinko/test.mk new file mode 100644 index 000000000..c247d780a --- /dev/null +++ b/test/tool/plinko/test.mk @@ -0,0 +1,91 @@ +#-*-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 += TEST_TOOL_PLINKO + +TEST_TOOL_PLINKO = $(TOOL_PLINKO_A_DEPS) $(TOOL_PLINKO_A) +TEST_TOOL_PLINKO_A = o/$(MODE)/test/tool/plinko/plinkolib.a +TEST_TOOL_PLINKO_FILES := $(wildcard test/tool/plinko/*) +TEST_TOOL_PLINKO_SRCS = $(filter %.c,$(TEST_TOOL_PLINKO_FILES)) +TEST_TOOL_PLINKO_SRCS_TEST = $(filter %_test.c,$(TEST_TOOL_PLINKO_SRCS)) +TEST_TOOL_PLINKO_HDRS = $(filter %.h,$(TEST_TOOL_PLINKO_FILES)) +TEST_TOOL_PLINKO_COMS = $(TEST_TOOL_PLINKO_OBJS:%.o=%.com) + +TEST_TOOL_PLINKO_OBJS = \ + $(TEST_TOOL_PLINKO_SRCS:%.c=o/$(MODE)/%.o) \ + o/$(MODE)/tool/plinko/plinko.com.zip.o \ + o/$(MODE)/tool/plinko/lib/library.lisp.zip.o \ + o/$(MODE)/tool/plinko/lib/binarytrees.lisp.zip.o \ + o/$(MODE)/tool/plinko/lib/algebra.lisp.zip.o \ + o/$(MODE)/tool/plinko/lib/infix.lisp.zip.o \ + o/$(MODE)/tool/plinko/lib/ok.lisp.zip.o \ + o/$(MODE)/test/tool/plinko/library_test.lisp.zip.o \ + o/$(MODE)/test/tool/plinko/algebra_test.lisp.zip.o + +TEST_TOOL_PLINKO_COMS = \ + $(TEST_TOOL_PLINKO_SRCS:%.c=o/$(MODE)/%.com) + +TEST_TOOL_PLINKO_BINS = \ + $(TEST_TOOL_PLINKO_COMS) \ + $(TEST_TOOL_PLINKO_COMS:%=%.dbg) + +TEST_TOOL_PLINKO_TESTS = \ + $(TEST_TOOL_PLINKO_SRCS_TEST:%.c=o/$(MODE)/%.com.ok) + +TEST_TOOL_PLINKO_CHECKS = \ + $(TEST_TOOL_PLINKO_HDRS:%=o/$(MODE)/%.ok) \ + $(TEST_TOOL_PLINKO_SRCS_TEST:%.c=o/$(MODE)/%.com.runs) + +TEST_TOOL_PLINKO_DIRECTDEPS = \ + LIBC_CALLS \ + LIBC_FMT \ + LIBC_INTRIN \ + LIBC_LOG \ + LIBC_MEM \ + LIBC_NEXGEN32E \ + LIBC_RUNTIME \ + LIBC_STDIO \ + LIBC_STR \ + LIBC_STUBS \ + LIBC_SYSV \ + LIBC_TESTLIB \ + LIBC_UNICODE \ + LIBC_X \ + LIBC_ZIPOS \ + THIRD_PARTY_COMPILER_RT \ + THIRD_PARTY_XED + +TEST_TOOL_PLINKO_DEPS := \ + $(call uniq,$(foreach x,$(TEST_TOOL_PLINKO_DIRECTDEPS),$($(x)))) + +$(TEST_TOOL_PLINKO_A): \ + test/tool/plinko/ \ + $(TEST_TOOL_PLINKO_A).pkg \ + $(TEST_TOOL_PLINKO_OBJS) + +$(TEST_TOOL_PLINKO_A).pkg: \ + $(TEST_TOOL_PLINKO_OBJS) \ + $(foreach x,$(TEST_TOOL_PLINKO_DIRECTDEPS),$($(x)_A).pkg) + +o/$(MODE)/test/tool/plinko/%.com.dbg: \ + $(TEST_TOOL_PLINKO_DEPS) \ + $(TEST_TOOL_PLINKO_A) \ + o/$(MODE)/test/tool/plinko/%.o \ + $(TEST_TOOL_PLINKO_A).pkg \ + $(LIBC_TESTMAIN) \ + $(CRT) \ + $(APE) + @$(APELINK) + +o/$(MODE)/test/tool/plinko/plinko_test.com.runs: \ + QUOTA = -M100g + +o/$(MODE)/test/tool/plinko/algebra_test.lisp.zip.o \ +o/$(MODE)/test/tool/plinko/library_test.lisp.zip.o: \ + ZIPOBJ_FLAGS += \ + -B + +.PHONY: o/$(MODE)/test/tool/plinko +o/$(MODE)/test/tool/plinko: \ + $(TEST_TOOL_PLINKO_BINS) \ + $(TEST_TOOL_PLINKO_CHECKS) diff --git a/test/tool/test.mk b/test/tool/test.mk index fa224a841..4b5f57a02 100644 --- a/test/tool/test.mk +++ b/test/tool/test.mk @@ -4,5 +4,6 @@ .PHONY: o/$(MODE)/test/tool o/$(MODE)/test/tool: \ o/$(MODE)/test/tool/build \ + o/$(MODE)/test/tool/plinko \ o/$(MODE)/test/tool/net \ o/$(MODE)/test/tool/viz diff --git a/tool/plinko/README.txt b/tool/plinko/README.txt new file mode 100644 index 000000000..2c30be53a --- /dev/null +++ b/tool/plinko/README.txt @@ -0,0 +1,35 @@ +DESCRIPTION + + plinko is a simple lisp interpreter that takes advantage of advanced + operating system features irrespective of their practicality such as + using the nsa instruction popcount for mark sweep garbage collection + overcommit memory, segment registers, and other dirty hacks that the + popular interpreters cannot do; this lets plinko gain a considerable + performance edge while retaining an event greater edge in simplicity + + We hope you find these sources informative, eductional, and possibly + useful too. Lisp source code, written in its dialect is included too + under //tool/plinko/lib and unit tests which clarify their usage can + be found in //test/tool/plinko. + +BENCHMARK + + binary trees (n=21) + + - sbcl: 200 ms (native jit; simulated arithmetic) + - plinko: 400 ms (interpreted; simulated arithmetic) + - python3: 800 ms (interpreted; native arithmetic) + - racket: 1200 ms (interpreted; simulated arithmetic) + +AUTHOR + + Justine Alexandra Roberts Tunney + +LICENSE + + ISC + +SEE ALSO + + SectorLISP + SectorLambda diff --git a/tool/plinko/lib/algebra.lisp b/tool/plinko/lib/algebra.lisp new file mode 100644 index 000000000..73a5e56c2 --- /dev/null +++ b/tool/plinko/lib/algebra.lisp @@ -0,0 +1,483 @@ +#| plinko - a really fast lisp tarpit + | 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. + |# + +(DEFINE EXPLAIN NIL) + +(DEFUN SUBST (X A) + (AND X (IF (ATOM X) + (LET ((R (ASSOC X A))) + (IF R (CDR R) X)) + (CONS (SUBST (CAR X) A) + (SUBST (CDR X) A))))) + +(DEFUN ISCONSTANT (X) + (EQ X 'K)) + +(DEFUN ISVARIABLE (X) + (OR (EQ X 'A) + (EQ X 'B) + (EQ X 'C) + (EQ X 'TODO))) + +(DEFUN ISDIGLET (X) + (AND (>= X '0) + (<= X '9))) + +(DEFUN ISCOMMUTATIVE (X) + (OR (EQ X 'ADD) + (EQ X '*) + (EQ X 'XOR) + (EQ X 'OR) + (EQ X 'AND) + (EQ X 'NAND) + (EQ X 'EQ) + (EQ X 'EQUAL) + (EQ X 'MIN) + (EQ X 'MAX))) + +(DEFUN RIGHTEN (X) + (IF (ATOM X) X + (KEEP X (CONS (CAR X) + (LET ((A (RIGHTEN (CADR X)))) + (IF (CDDR X) + (LET ((B (RIGHTEN (CADDR X)))) + (IF (AND (ISCOMMUTATIVE (CAR X)) + (< B A)) + (LIST B A) + (LIST A B))) + (LIST A))))))) + +(DEFUN MATCHES (X P A) + (COND ((ATOM P) + (IF (AND P (OR (ISVARIABLE P) + (AND (ISCONSTANT P) + (ISDIGLET X)))) + (LET ((Y (ASSOC P A))) + (IF Y (AND (EQUAL X (CDR Y)) A) + (CONS (CONS P X) A))) + (AND (EQ P X) A))) + ((NOT (ATOM X)) + (LET ((R (MATCHES (CAR X) (CAR P) A))) + (AND R (MATCHES (CDR X) (CDR P) R)))))) + +(DEFUN -SIMPNODE (X P) + (AND P (LET ((R (MATCHES X (CAAR P) '(NIL)))) + (IF R (IF EXPLAIN + (PRINT 'REDUCE X + 'BECAUSE (CAAR P) 'IS (CADAR P) + 'THEREFORE (RIGHTEN (SUBST (CADAR P) R))) + (SUBST (CADAR P) R)) + (-SIMPNODE X (CDR P)))))) + +(DEFUN SIMPNODE (X P) + (AND P (LET ((R (AND (EQ (CAR X) (CAAR P)) + (-SIMPNODE X (CDAR P))))) + (OR R (SIMPNODE X (CDR P)))))) + +(DEFUN SIMPTREE (X P H) + (IF (ATOM X) X + (IF (NOT (MEMBER X H)) + (LET* ((H (CONS X H)) + (B (SIMPTREE (CADDR X) P H)) + (C (CONS (CAR X) + (CONS (SIMPTREE (CADR X) P H) + (AND B (CONS B))))) + (D (SIMPNODE C P))) + (IF D + (SIMPTREE D P H) + (KEEP X C))) + (ERROR 'SIMPTREE 'CYCLE X 'HISTORY H)))) + +(DEFUN PERMCOMB (OP ARG1 ARG2 RES) + (IF ARG2 + (PERMCOMB + OP ARG1 (CDR ARG2) + (PEEL + (LIST OP (CAR ARG2) ARG1) + (PEEL + (LIST OP ARG1 (CAR ARG2)) + RES))) + RES)) + +(DEFUN PERMCOMA (OP ARG1 ARG2 RES) + (IF ARG1 + (PERMCOMA + OP (CDR ARG1) ARG2 + (PERMCOMB + OP (CAR ARG1) ARG2 RES)) + RES)) + +(DEFUN PERMCOMM (X) + (IF (AND (NOT (ATOM X)) + (ISCOMMUTATIVE (CAR X))) + (PERMCOMA + (CAR X) + (PERMCOMM (CADR X)) + (PERMCOMM (CADDR X))) + (CONS X))) + +(DEFUN -RULES (((A B) . P) R) + (IF A (-RULES P (CONS (REVERSE-DOLIST (E (PERMCOMM (RIGHTEN A))) (LIST E B)) R)) + (REDUCE APPEND (REVERSE R)))) + +(DEFUN RULES (L R) + (GROUPBY + (LAMBDA (X) (CAAR X)) + (-RULES L R))) + +(DEFINE LOLGEBRA + (RULES + '(((ADD 1 2) 3) + ((ADD 1 3) 4) + ((ADD 1 4) 5) + ((ADD A 0) A) + ((ADD (SUB A B) B) A) ;; COMMUTATIVE PROPERTY + ((ADD A A) (* 2 A)) + ((ADD A (SUB B A)) B) + ((ADD (SUB A B) B) A) + ((ADD (ADD A B) (SUB C A)) (ADD C B)) + ((ADD (SUB A B) (SUB C A)) (SUB C B)) + ((ADD (* A B) (* A B)) (* 2 (* A B))) + ((ADD (* A B) (* B (ADD A C))) (* B (ADD (* 2 A) C))) + ((ADD (POW A 2) (* (POW A 2) B)) (* (POW A 2) (ADD B 1))) + ((ADD A (* A K)) (* A (ADD K 1))) + ((ADD A (ADD K B)) (ADD K (ADD A B))) + ((ADD A (SUB K B)) (ADD K (SUB A B))) + ((ADD (* B A) (* C A)) (* A (ADD B C))) + ((ADD (SUB 0 A) B) (SUB B A)) + ((ADD A (SUB 0 B)) (SUB A B)) + ((ADD (NOT A) 1) (SUB 0 A)) + ((ADD (* (SUB 0 B) C) A) (SUB A (* B C))) + ((ADD (XOR A (NOT B)) (* 2 (OR A B))) (SUB (ADD A B) 1)) + ((ADD (ADD (ADD A B) 1) (NOT (OR A B))) (OR A B)) + ((ADD (SUB A B) (AND (NOT (* 2 A)) (* 2 B))) (XOR A B)) + ((ADD (SUB 0 B) (AND (NOT (* 2 A)) (* 2 B))) (SUB (XOR A B) A)) + ((ADD (SUB 0 B) (* 2 (AND (NOT A) B))) (SUB (XOR A B) A)) + ((ADD (SUB A B) (* 2 (AND (NOT A) B))) (XOR A B)) + ((ADD (AND A B) (OR A B)) (ADD A B)) + ((ADD (XOR A B) (* 2 (AND A B))) (ADD A B)) + ((ADD (SUB (SUB 0 A) B) (* 2 (OR A B))) (XOR A B)) + ((ADD (* (SUB 0 2) (AND (NOT A) B)) B) (ADD (SUB 0 (XOR A B)) A)) + ((ADD (ADD A B) (NOT (AND A B))) (SUB (AND A B) 1)) + ((ADD (ADD A B) (* 2 (NOT (OR A B)))) (SUB (XOR A B) 2)) + ((ADD (DIV A C) (DIV B C)) (DIV (ADD A B) C)) + ((ADD (AND A B) (XOR A B)) (OR A B)) + ((ADD (AND A B) (OR A B)) (ADD A B)) + ((ADD (SUB (ADD A B) (* 2 (OR A B))) (XOR A B)) 0) + ((ADD (NOT A) A) (SUB 0 1)) + ((ADD (AND A (NOT B)) (AND (NOT A) B)) (XOR A B)) + ((ADD (SUB (AND A (NOT B)) (AND (NOT A) B)) C) (ADD (SUB A B) C)) + ((ADD (POW A 2) + (ADD (* 2 (* A B)) + (POW B 2))) + (POW (ADD A B) 2)) ;; BINOMIAL THEOREM + ((ADD (ADD (POW A 3) + (ADD (* 3 (* B (POW A 2))) + (* 3 (* A (POW B 2))))) + (POW B 3)) + (POW (ADD A B) 3)) ;; BINOMIAL THEOREM + + ((SUB 1 1) 0) + ((SUB 2 1) 1) + ((SUB 3 1) 2) + ((SUB 4 1) 3) + ((SUB 5 1) 4) + ((SUB 1 2) (SUB 0 1)) + ((SUB 2 2) 0) + ((SUB 3 2) 1) + ((SUB 4 2) 2) + ((SUB 5 2) 3) + ((SUB A A) 0) ;; UNSAFE WITH NANS + ((SUB A 0) A) + ((SUB (ADD A B) B) A) ;; COMMUTATIVE PROPERTY + ((SUB 0 (ADD A 1)) (NOT A)) + ((SUB (POW A 2) (POW B 2)) (* (ADD A B) (SUB A B))) ;; DIFFERENCE OF TWO SQUARES + ((SUB (SUB (* A (ADD B A)) (* A B)) (POW B 2)) (* (ADD A B) (SUB A B))) ;; DIFFERENCE OF TWO SQUARES + ((SUB (ADD A B) A) B) + ((SUB (ADD A B) B) A) + ((SUB A (SUB A B)) B) + ((SUB A (ADD B A)) (SUB 0 B)) + ((SUB A (ADD A B)) (SUB 0 B)) + ((SUB (SUB A B) A) (SUB 0 B)) + ((SUB (SUB A B) A) (SUB 0 B)) + ((SUB (ADD A B) (SUB A C)) (ADD B C)) + ((SUB (DIV 1 2) 1) (SUB 0 (DIV 1 2))) ;; SQRT DERIVATIVE HACK + ((SUB A (SUB K B)) (SUB (ADD A B) K)) + ((SUB (ADD K A) B) (ADD K (SUB A B))) + ((SUB (DIV (LOG A) (LOG C)) (DIV (LOG B) (LOG C))) (DIV (LOG (DIV A B)) (LOG C))) ;; DOMAIN IS 01 + ((SUB 0 (NOT A)) (ADD A 1)) + ((SUB 0 (SUB A B)) (SUB B A)) + ((SUB A (XOR 0 1)) (SUB A 1)) + ((SUB (SUB 0 1) A) (NOT A)) + ((SUB (OR A B) (AND A (NOT B))) B) + ((SUB (SUB 0 (XOR A (NOT B))) (* 2 (OR A B))) (ADD (SUB (SUB 0 A) B) 1)) + ((SUB (SUB 0 A) (AND (NOT (* 2 A)) (* 2 B))) (SUB (SUB 0 (XOR A B)) B)) + ((SUB (ADD A B) (* 2 (AND A B))) (XOR A B)) + ((SUB (ADD A B) (OR A B)) (AND A B)) + ((SUB (AND A B) (OR (NOT A) B)) (ADD A 1)) + ((SUB (OR A B) (AND A B)) (XOR A B)) + ((SUB (AND (* 2 (NOT A)) (* 2 B)) B) (SUB (XOR A B) A)) + ((SUB (DIV A C) (DIV B C)) (DIV (SUB A B) C)) + ;; ((SUB A (* (DIV A B) B)) (REM A B)) ;; ONLY FOR INTEGER ARITHMETIC + ((SUB (ADD A B) (OR A B)) (AND A B)) + ((SUB (ADD A B) (AND A B)) (OR A B)) + ((SUB (OR A B) (XOR A B)) (AND A B)) + ((SUB (OR A B) (AND A B)) (XOR A B)) + ((SUB B (AND A B)) (AND (NOT A) B)) + ((SUB A (AND A B)) (AND A (NOT B))) + ((SUB (SUB 0 (AND A B)) 1) (NOT (AND A B))) + ((SUB (SUB (AND A B) A) 1) (OR (NOT A) B)) + ((SUB (SUB (AND A B) B) 1) (OR A (NOT B))) + ((SUB (ADD (SUB (SUB 0 A) B) (AND A B)) 1) (NOT (OR A B))) + ((SUB (ADD (SUB (SUB 0 A) B) (* 2 (AND A B))) 1) (NOT (XOR A B))) + ((SUB (SUB 0 A) 1) (NOT A)) + ((SUB (AND A (NOT B)) (AND A B)) (SUB (XOR A B) B)) + ((SUB (AND A B) (AND A (NOT B))) (SUB B (XOR A B))) + ((SUB (AND A B) (AND A (NOT B))) (SUB B (XOR A B))) + + ((POW A 0) 1) + ((POW 0 A) 0) + ((POW 1 A) 1) + ((POW A 1) A) + ((POW 2 2) 4) + ((POW 3 2) 9) + ((POW 4 (DIV 1 2)) 2) + ((POW 8 (DIV 1 3)) 2) + ((POW A (SUB 0 1)) (DIV 1 A)) + ((POW (ABS A) B) (POW A B)) + ((POW A (SUB 0 B) 1) (DIV 1 (POW A B))) ;; THIS NORMALIZATION + ((POW (POW K A) (DIV 1 B)) (POW (POW K (DIV 1 B)) A)) ;; COMES BEFORE NEXT + ((POW (POW A B) C) (POW A (* B C))) ;; COMES AFTER PREV + ((POW B (DIV (LOG A) (LOG B))) A) + ((POW (* K K) (DIV 1 2)) K) + ((POW (POW A 2) (DIV 1 2)) (ABS A)) + ((POW (* K (POW A 2)) (DIV 1 2)) (* (ABS A) (POW K (DIV 1 2)))) ;; DOMAIN K≥0 + + ((DIV A 0) :DBZERO) + ((DIV A A) 1) + ((DIV A 1) A) + ((DIV 0 (- 0 K)) (- 0 0)) ;; SIGNED ZERO LOL + ((DIV 0 A) 0) + ((DIV (SUB 0 A) A) (SUB 0 1)) + ((DIV A (SUB 0 1)) (SUB 0 A)) + ((DIV (DIV A B) C) (DIV A (* B C))) + ((DIV A (DIV B C)) (* (DIV A B) C)) + ((DIV A (SUB 0 B)) (DIV (SUB 0 A) B)) ;; SHOULD WE? + ((DIV (* A 2) 2) A) + ((DIV (SIN A) (TAN A)) (COS A)) + ((DIV (SIN A) (COS A)) (TAN A)) + ((DIV (COS A) (SIN A)) (DIV 1 (TAN A))) + ((DIV (TAN A) (SIN A)) (DIV 1 (COS A))) + ((DIV (POW A C) (POW A B)) (POW A (SUB C B))) ;; EXPONENT RULE + ((DIV (POW A B) (POW A C)) (POW A (SUB C B))) ;; EXPONENT RULE + ((DIV (* B (POW A (SUB B 1))) (POW A B)) (DIV B A)) ;; UGLY + ;; ((DIV A (POW B C)) (* A (POW B (SUB 0 C)))) ;; EXPONENT RULE [CYCLIC] + ((DIV (POW A B) (POW C B)) (POW (DIV A C) B)) ;; DOMAIN IS APPROXIMATELY ABC≥1 + ((DIV (LOG (POW B A)) (LOG B)) A) + ((DIV (LOG (POW A B)) (LOG C)) (* B (DIV (LOG A) (LOG C)))) + ((DIV (* A B) (* A C)) (DIV B C)) ;; CANCELLATION + ((DIV (POW A (DIV 1 2)) (POW B (DIV 1 2))) (POW (DIV A B) (DIV 1 2))) ;; DOMAIN >0 + + ((* A 0) 0) ;; UNSAFE WITH NANS + ((* A 1) A) + ((* A A) (POW A 2)) + ((* A (SUB 0 1)) (SUB 0 A)) + ((* A (DIV 1 B)) (DIV A B)) + ((* (POW A 2) A) (POW A 3)) + ((* (* K A) (* K B)) (* (* 2 K) (* A B))) + ((* (* B A) A) (* (POW A 2) B)) ;; SHOULD NOT BE NEEDED + ((* (* (POW A 2) B) A) (* (* (POW A 2) A) B)) + ;; ((* B (* K (POW A 2))) (* K (* B (POW A 2)))) + ((* (* C (* A B)) A) (* (* C (POW A 2)) B)) + ((* (POW A B) (POW A C)) (POW A (ADD B C))) ;; EXPONENT RULE + ((* (* TODO (POW A B)) (POW A C)) (* TODO (POW A (ADD B C)))) ;; EXPONENT RULE + ((* (POW A B) (POW C B)) (POW (* A C) B)) ;; DOMAIN IS APPROXIMATELY ABC≥0 + ((* A (POW A K)) (POW A (ADD K 1))) ;; NOTE: A=0∧K<0 IS DIVIDE ERROR + ((* (DIV A B) (DIV B C)) (DIV A C)) ;; CANCELLATION + ((* (DIV B A) A) B) ;; CANCELLATION + ((* (POW A (DIV 1 2)) (POW A (DIV 1 2))) A) + ((* (POW A (DIV 1 2)) (POW B (DIV 1 2))) (POW (* A B) (DIV 1 2))) ;; DOMAIN ≥0 + ((* (POW C A) (POW C B)) (POW C (ADD A B))) + ;; ((* (DIV A 2) 2) (AND A (NOT 1))) ;; ONLY FOR UNSIGNED INTEGER ARITHMETIC + ;; ((* (DIV A B) C) (DIV (* A C) B)) ;; EVIL + + ((REM 0 A) 0) + ((REM A A) 0) + ((REM A 1) 0) ;; INTEGER ONLY + ((REM A (SUB 0 1)) 0) + ((REM (REM A B) B) (REM A B)) + ((REM A (SUB 0 B)) (REM A B)) ;; REMAINDER ONLY; NOT MODULUS + + ((AND A A) A) + ((AND (LT A B) (LT B C)) (LT A C)) ;; TRANSITIVE PROPERTY + ((AND A 0) 0) + ((AND A (NOT A)) 0) + ((AND (ADD (* 2 A) 1) (* 2 B)) (AND (* 2 A) (* B 2))) + ((AND (NOT A) (NOT B)) (NOT (AND A B))) ;; DE MORGAN'S LAW + ((AND A (NOT 0)) A) + ((AND A (NOT (AND A B))) (AND A (NOT B))) + ((AND (OR A B) (NOT A)) (AND B (NOT A))) + ((AND (OR A B) (NOT (AND A B))) (XOR A B)) + ((AND (OR A B) (XOR (NOT A) B)) (AND A B)) + ((AND (OR (NOT A) B) (OR A (NOT B))) (NOT (XOR A B))) + ((AND (NOT A) (NOT B)) (NOT (OR A B))) + ((AND (XOR A B) B) (AND (NOT A) B)) + ((AND (AND A B) B) (AND A B)) + ((AND (AND A B) (AND A C)) (AND (AND A B) C)) + ((AND (OR A B) (NOT (XOR A B))) (AND A B)) + + ((OR A A) A) + ((OR A 0) A) + ((OR (NOT A) (NOT B)) (NOT (OR A B))) ;; DE MORGAN'S LAW + ((OR A (NOT (OR A B))) (OR A (NOT B))) + ((OR (AND (NOT A) B) (NOT (OR A B))) (NOT A)) + ((OR (AND A B) (NOT (OR A B))) (NOT (XOR A B))) + ((OR (XOR A B) (NOT (OR A B))) (NOT (AND A B))) + ((OR (AND A B) (NOT A)) (OR B (NOT A))) + ((OR (AND A B) (XOR A B)) (OR A B)) + ((OR (NOT A) (NOT B)) (NOT (AND A B))) + ((OR (OR A B) B) (OR A B)) + ((OR (OR A B) (OR A C)) (OR (OR A B) C)) + ((OR (NOT A) A) (SUB 0 1)) + ((OR A (NOT 0)) (NOT 0)) + ((OR (AND A (NOT B)) (AND (NOT A) B)) (XOR A B)) + ((OR (XOR A B) A) (OR A B)) + ((OR A (NOT (XOR A B))) (OR A (NOT B))) + ((OR (AND A B) (NOT (XOR A B))) (NOT (XOR A B))) + ((OR (OR A B) (AND A B)) (OR A B)) + ((OR (OR A B) (XOR A B)) (OR A B)) + + ((XOR A A) 0) + ((XOR (OR A B) (OR A (NOT B))) (NOT A)) + ((XOR (OR (NOT A) B) (XOR A B)) (OR A (NOT B))) + ((XOR (XOR A B) (OR A B)) (AND A B)) + ((XOR (AND A B) (XOR A B)) (OR A B)) + ((XOR (AND A B) (OR A B)) (XOR A B)) + ((XOR (OR (NOT A) B) (OR A (NOT B))) (XOR A B)) + ((XOR (OR A B) A) (AND B (NOT A))) + ((XOR (NOT A) (NOT B)) (XOR A B)) + ((XOR (NOT A) B) (XOR A (NOT B))) + ((XOR (AND A B) B) (AND (NOT A) B)) + ((XOR (XOR A B) B) A) + ((XOR (XOR A B) (XOR A C)) (XOR B C)) + ((XOR A (NOT 0)) (NOT A)) + ((XOR (NOT A) A) (SUB 0 1)) + ((XOR (AND A (NOT B)) (AND (NOT A) B)) (XOR A B)) + ((XOR (AND A (NOT B)) (NOT A)) (NOT (AND A B))) + + ((NOT (SAR (NOT A) B)) (SAR A B)) + ((NOT (SUB 0 A)) (SUB A 1)) + ((NOT (ADD A (SUB 0 1))) (SUB 0 A)) + ((NOT (ADD (NOT A) B)) (SUB A B)) + ((NOT (AND (NOT A) B)) (OR A (NOT B))) + ((NOT (OR (NOT A) B)) (AND A (NOT B))) + ((NOT (ROR (NOT A) B)) (ROR A B)) + ((NOT (ROL (NOT A) B)) (ROL A B)) + + ((MIN A A) A) + ((MIN (MAX A B) B) B) + ((MIN A (SUB 0 A)) (SUB 0 (ABS A))) + ((MIN (NOT A) (NOT B)) (NOT (MAX A B))) + + ((MAX A A) A) + ((MAX (MIN A B) B) B) + ((MAX A (SUB 0 A)) (ABS A)) + ((MAX (NOT A) (NOT B)) (NOT (MIN A B))) + + ((SIN (ATAN A)) (DIV A (POW (ADD (POW A 2) 1) (DIV 1 2)))) + ((SIN (ASIN A)) A) + ((COS (SUB 0 A)) (COS A)) + ((COS (ABS A)) (COS A)) + ((COS (ABS A)) (COS A)) + ((COS (ATAN A)) (DIV 1 (POW (ADD (POW A 2) 1) (DIV 1 2)))) + ((COS (ACOS A)) A) + ((COS (ASIN A)) (POW (SUB 1 (POW A 2)) (DIV 1 2))) + ((TAN (ATAN A)) A) + ((SINH (ATANH A)) (DIV A (POW (* (SUB 1 A) (ADD 1 A)) (DIV 1 2)))) + ((COSH (ATANH A)) (DIV 1 (POW (* (SUB 1 A) (ADD 1 A)) (DIV 1 2)))) + ((CONJ (CONJ A)) A) + + ((ABS K) K) + ((LOG 1) 0) + ((SHL A 0) A) + ((SAR A 0) A) + ((SHR A 0) A) + ((ROR A 0) A) + ((ROL A 0) A) + ((NEG A) (SUB 0 A)) + ((PLUS A B) (ADD A B)) + ((TIMES A B) (* A B)) + ((SQR A) (POW A 2)) + ((EXP A) (POW E A)) + ((EXP2 A) (POW 2 A)) + ((EXPT A B) (POW A B)) + ((LN A) (LOG A)) + ((LOG2 A) (DIV (LOG A) (LOG 2))) + ((LOG10 A) (DIV (LOG A) (LOG 10))) + ((LOGN A B) (DIV (LOG A) (LOG B))) + ((HYPOT A B) (POW (ADD (POW A 2) (POW B 2)) (DIV 1 2))) + ((ACOSH A) (DIV (LOG (ADD A (POW (SUB (POW A 2) 1) (DIV 1 2)))) (LOG E))) + ((ASINH A) (DIV (LOG (ADD A (POW (ADD (POW A 2) 1) (DIV 1 2)))) (LOG E))) + ((ACOSH A) (DIV (LOG (ADD A (POW (SUB (POW A 2) 1) (DIV 1 2)))) (LOG E))) ;; DOMAIN A≥1 + ;; ((ATANH A) (LOGN (* (DIV 1 2) (LOGN (DIV (ADD 1 A) (SUB 1 A)) E)))) + ;; ((DIV A (SHL 1 B)) (SAR A B)) ;; ONLY FOR UNSIGNED INTEGER A + ((SQRT A) (POW A (DIV 1 2))) + ((CBRT A) (POW A (DIV 1 3))) + ((ROOT A B) (POW A (DIV 1 B)))))) + +(DEFUN SIMPLIFY (X RULES) + (RIGHTEN (SIMPTREE (IF EXPLAIN + (PRINT 'SIMPLIFY (RIGHTEN X)) + (RIGHTEN X)) + (OR RULES LOLGEBRA)))) + +(DEFUN DERIV (X WRT) + (COND ((EQ X WRT) '1) + ((ATOM X) '0) + ((LET ((OP (CAR X)) + (X (CADR X)) + (Y (CADDR X))) + (COND ((OR (EQ OP 'ADD) + (EQ OP 'SUB)) + `(,OP ,(DERIV X WRT) + ,(DERIV Y WRT))) + ((EQ OP '*) + `(ADD (* ,X ,(DERIV Y WRT)) + (* ,(DERIV X WRT) ,Y))) + ((EQ OP 'DIV) + `(SUB (DIV ,(DERIV X WRT) ,Y) + (DIV (* ,X ,(DERIV Y WRT)) (POW ,Y 2)))) + ((EQ OP 'POW) + `(ADD (* (POW ,X ,Y) + (* (LOG ,X) ,(DERIV Y WRT))) + (* ,Y (* (POW ,X (SUB ,Y 1)) + ,(DERIV X WRT))))) + ((EQ OP 'LOG) `(DIV ,(DERIV X WRT) ,X)) + ((EQ OP 'SIN) `(* ,(DERIV X WRT) (COS ,X))) + ((EQ OP 'COS) `(SUB 0 (* ,(DERIV X WRT) (SIN ,X)))) + ((EQ OP 'ABS) `(DIV (* ,X ,(DERIV X WRT)) (ABS ,X))) + ((ERROR 'HOW (LIST 'DERIV (LIST OP X Y) WRT)))))))) + +(DEFUN DERIVATIVE (X Y RULES) + (SIMPLIFY + (LET ((X (SIMPLIFY X))) + (IF EXPLAIN + (PRINT 'DIFFERENTIATE X + 'WRT Y + 'IS (DERIV X Y)) + (DERIV X Y))) + RULES)) diff --git a/tool/plinko/lib/assoc.c b/tool/plinko/lib/assoc.c new file mode 100644 index 000000000..332360606 --- /dev/null +++ b/tool/plinko/lib/assoc.c @@ -0,0 +1,96 @@ +/*-*- 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/plinko/lib/histo.h" +#include "tool/plinko/lib/index.h" +#include "tool/plinko/lib/plinko.h" +#include "tool/plinko/lib/tree.h" + +/** + * Performs lookup of binding. + * + * We perform lookups into an association list, e.g. + * + * ┌───┬───┐ ┌───┬───┐ ┌───┬───┐ + * │ 𝑘₀│ 𝑣₀│ │ 𝑘₁│ 𝑣₁│ │ 𝑘₂│ 𝑣₂│ + * └─┬─┴───┘ └─┬─┴───┘ └─┬─┴───┘ + * ┌─│─┬───┐ ┌─│─┬───┐ ┌─│─┬───┐ + * 𝑎=│ ┴ │ ├───┤ ┴ │ ├───┤ ┴ │ 0 │ + * └───┴───┘ └───┴───┘ └───┴───┘ + * + * For example, if 𝑘₁ is queried then we return: + * + * ┌───┬───┐ + * │ 𝑘₁│ 𝑣₁│ + * └───┴───┘ + * + * However there's a twist: the association is allowed to turn into a + * red-black tree. That would look like this: + * + * ┌───┬───┐ ┌───┬───┐ + * │ 𝑘₀│ 𝑣₀│ │ 𝑘₁│ 𝑣₁│ + * └─┬─┴───┘ └─┬─┴───┘ + * ┌─│─┬───┐ ┌─│─┬───┐ ┌───┬───┐ + * 𝑎=│ ┴ │ ├───┤ ┴ │ ├───│ ┬ │ 𝑐 │ + * └───┴───┘ └───┴───┘ └─│─┴───┘ + * ┌─┴─┬───┐ + * │ ┬ │ ┬ │ + * └─│─┴─│─┘ + * ┌───┬──┴┐ ┌┴──┬───┐ + * │ 𝑘₂│ 𝑣₂│ │ L │ R │ + * └───┴───┘ └───┴───┘ + * + * We're able to tell a tree node apart from an association list node + * because we make the assumption that 𝑘ᵢ is an atom. On the other hand + * 𝑣ᵢ can be anything. + * + * @param k is an atom + * @param a is an association list and/or red-black tree + * @return entry cons cell or 0 if not found + */ +int Assoc(int k, int a) { + int i, j, e, c, r; + DCHECK_GE(k, 0); + i = a; + r = 0; + if (k && k != 1) { + for (c = 0; i;) { + e = Head(i); + i = Cdr(i); + j = Head(e); + ++c; + if (j == k) { + r = e; + break; + } else if (j < 0 && (j = +#if HISTO_ASSOC + GetTreeCount(k, e, &c) +#else + GetTree(k, e) +#endif + )) { + r = Ent(j); + break; + } + } +#if HISTO_ASSOC + HISTO(g_assoc_histogram, c); +#endif + } + return r; +} diff --git a/tool/plinko/lib/binarytrees.lisp b/tool/plinko/lib/binarytrees.lisp new file mode 100644 index 000000000..d2d221a05 --- /dev/null +++ b/tool/plinko/lib/binarytrees.lisp @@ -0,0 +1,93 @@ +#| plinko - a really fast lisp tarpit + | 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. + |# + +(DEFUN OCT (X R) + (COND (X (OCT (CDR (CDR (CDR X))) + (COND ((CAR (CDR (CDR X))) + (COND ((CAR (CDR X)) + (COND ((CAR X) (CONS '7 R)) + ((CONS '6 R)))) + ((CAR X) (CONS '5 R)) + ((CONS '4 R)))) + ((CAR (CDR X)) + (COND ((CAR X) (CONS '3 R)) + ((CONS '2 R)))) + ((CAR X) (CONS '1 R)) + ((CDR (CDR (CDR X))) + (CONS '0 R)) + (R)))) + ((CONS '0 R)))) + +(DEFUN + (A B C) + (COND (C (COND (A (COND (B (COND ((CAR A) (COND ((CAR B) (CONS T (+ (CDR A) (CDR B) T))) + ((CONS NIL (+ (CDR A) (CDR B) T))))) + ((CAR B) (CONS NIL (+ (CDR A) (CDR B) T))) + ((CONS T (+ (CDR A) (CDR B)))))) + ((CAR A) (CONS NIL (+ (CDR A) NIL T))) + ((CONS T (CDR A))))) + (B (COND ((CAR B) (CONS NIL (+ NIL (CDR B) T))) + ((CONS T (CDR B))))) + ((CONS C)))) + (A (COND (B (COND ((CAR A) (COND ((CAR B) (CONS NIL (+ (CDR A) (CDR B) T))) + ((CONS T (+ (CDR A) (CDR B)))))) + ((CAR B) (CONS T (+ (CDR A) (CDR B)))) + ((CONS NIL (+ (CDR A) (CDR B)))))) + (A))) + (B))) + +(DEFUN ++ (A) + (COND ((CAR A) (CONS NIL (++ (CDR A)))) + ((CONS T (CDR A))))) + +(DEFUN MAKE-TREE (DEPTH) + (COND (DEPTH + (LET ((D (CDR DEPTH))) + (CONS (MAKE-TREE D) + (MAKE-TREE D)))) + ('(NIL NIL)))) + +(DEFUN CHECK-TREE (N R) + (COND ((CAR N) + (CHECK-TREE + (CDR N) + (CHECK-TREE + (CAR N) + (++ R)))) + ((++ R)))) + +;; ;; binary trees benchmark game +;; ;; goes 2x faster than python even though it rolls its own arithmetic. +;; ;; goes 2x faster than racket but not sbcl since, since plinko is an +;; ;; interpreter and doesn't jit native instructions currently. +;; (TEST +;; '(0 1 7 7 7 7 7 7 7) +;; (OCT +;; (CHECK-TREE +;; (MAKE-TREE +;; '(NIL NIL NIL NIL NIL NIL NIL +;; NIL NIL NIL NIL NIL NIL NIL +;; NIL NIL NIL NIL NIL NIL NIL))))) + +;; use reasonably small size so tests go fast +(TEST + '(0 3 7 7 7 7 7 7) + (OCT + (CHECK-TREE + (MAKE-TREE + '(NIL NIL NIL NIL NIL NIL NIL + NIL NIL NIL NIL NIL NIL + NIL NIL NIL NIL NIL NIL))))) diff --git a/tool/plinko/lib/bind.c b/tool/plinko/lib/bind.c new file mode 100644 index 000000000..eef2f6d61 --- /dev/null +++ b/tool/plinko/lib/bind.c @@ -0,0 +1,56 @@ +/*-*- 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/plinko/lib/cons.h" +#include "tool/plinko/lib/plinko.h" + +struct Binding Bind(int x, int y, int a, int u, dword p1, dword p2) { + int k, v, w; + dword a1 = 0; + while (x) { + if (x < 0) { + if (y <= 0) { + k = Car(x), x = Cdr(x); + v = Car(y), y = Cdr(y); + if (k) { + if (k > 0) { + if (!a1) { + a1 = MAKE(k, FasterRecurse(v, a, p1, p2)); + } else { + u = Alist(k, FasterRecurse(v, a, p1, p2), u); + } + } else { + u = pairlis(k, FasterRecurse(v, a, p1, p2), u); + } + } + } else { + u = pairlis(x, FasterRecurse(y, a, p1, p2), u); + y = 0; + break; + } + } else { + u = Alist(x, evlis(y, a, p1, p2), u); + y = 0; + break; + } + } + if (y < 0) { + Error("bind: too many arguments x=%S y=%S", x, y); + } + return (struct Binding){u, a1}; +} diff --git a/tool/plinko/lib/char.c b/tool/plinko/lib/char.c new file mode 100644 index 000000000..893cb7e69 --- /dev/null +++ b/tool/plinko/lib/char.c @@ -0,0 +1,59 @@ +/*-*- 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/plinko/lib/char.h" + +pureconst bool IsHex(int c) { + return ((L'0' <= c && c <= L'9') || (L'A' <= c && c <= L'F') || + (L'a' <= c && c <= L'f')); +} + +pureconst int GetDiglet(int c) { + if (IsDigit(c)) return c - L'0'; + if (IsUpper(c)) return c - L'A' + 10; + if (IsLower(c)) return c - L'a' + 10; + return -1; +} + +pureconst bool IsSpace(int c) { + switch (c) { + case L' ': + case L'\t': + case L'\n': + case L'\f': + case L'\v': + case L'\r': + return true; + default: + return false; + } +} + +pureconst bool IsParen(int c) { + switch (c) { + case L'(': + case L')': + case L'[': + case L']': + case L'{': + case L'}': + return true; + default: + return false; + } +} diff --git a/tool/plinko/lib/char.h b/tool/plinko/lib/char.h new file mode 100644 index 000000000..e1cb4d93c --- /dev/null +++ b/tool/plinko/lib/char.h @@ -0,0 +1,43 @@ +#ifndef COSMOPOLITAN_TOOL_PLINKO_LIB_CHAR_H_ +#define COSMOPOLITAN_TOOL_PLINKO_LIB_CHAR_H_ +#if !(__ASSEMBLER__ + __LINKER__ + 0) +COSMOPOLITAN_C_START_ + +static inline pureconst bool IsC0(int c) { + return (0 <= c && c < 32) || c == 0177; +} + +static inline pureconst bool IsDigit(int c) { + return L'0' <= c && c <= L'9'; +} + +static inline pureconst bool IsUpper(int c) { + return L'A' <= c && c <= L'Z'; +} + +static inline pureconst bool IsLower(int c) { + return L'a' <= c && c <= L'z'; +} + +static inline pureconst bool IsMathAlnum(int c) { + return 0x1d400 <= c && c <= 0x1d7ff; +} + +static inline pureconst bool IsControl(int c) { + return (0 <= c && c <= 0x1F) || (0x7F <= c && c <= 0x9F); +} + +static noinstrument pureconst inline int ToUpper(int c) { + return 'a' <= c && c <= 'z' ? 'A' - 'a' + c : c; +} + +int GetDiglet(int) pureconst; +bool IsHex(int) pureconst; +bool IsParen(int) pureconst; +bool IsSpace(int) pureconst; +int GetMonospaceCharacterWidth(int) pureconst; +bool IsWide(int) pureconst; + +COSMOPOLITAN_C_END_ +#endif /* !(__ASSEMBLER__ + __LINKER__ + 0) */ +#endif /* COSMOPOLITAN_TOOL_PLINKO_LIB_CHAR_H_ */ diff --git a/tool/plinko/lib/cmp.c b/tool/plinko/lib/cmp.c new file mode 100644 index 000000000..131700343 --- /dev/null +++ b/tool/plinko/lib/cmp.c @@ -0,0 +1,74 @@ +/*-*- 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/plinko/lib/plinko.h" + +/** + * Compares LISP data structures. + * + * (cmp 𝑥 𝑥) ⟹ eq everything's equal to itself + * (≡ 𝑥 𝑦) ⟶ (≡ (cmp 𝑥 𝑦) 'eq) (eq) and (cmp) agree if (eq) returns t + * (≡ (cmp 𝑥 𝑦) 'eq) ⟺ (equal 𝑥 𝑦) (cmp) returns eq iff (equal) returns t + * (cmp (ℶ x 𝑦) (ℶ x 𝑦)) ⟹ eq i.e. this does deep comparisons + * (cmp ⊥ 𝑥) ⟹ lt nil is less than everything non-nil + * (cmp 𝑥 ⊥) ⟹ t comparisons are always symmetric + * (cmp 𝑖 𝑗) ⟹ lt atom vs. atom compares unicodes + * (cmp 𝑖𝑗 𝑘𝑙) ⟺ (cmp (𝑖 𝑗) (𝑘 𝑙)) atom characters treated like lists + * (cmp 𝑖 (x . 𝑦)) ⟹ lt atom vs. cons is always less than + * (cmp (x . 𝑦) (x . 𝑦)) ⟹ eq cons vs. cons just recurses + * (cmp (𝑥) (⊥ 𝑦)) ⟹ t e.g. cmp returns gt because 𝑥 > ⊥ + * (cmp (𝑥) (𝑧 𝑦)) ⟹ lt e.g. cmp returns lt because ⊥ < (𝑦) + * (cmp (x . 𝑦) (x 𝑦)) ⟹ lt e.g. cmp returns lt because 𝑦 < (𝑦) + * + * @return -1, 0, +1 + */ +int Cmp(int x, int y) { + int c; + dword t, u; + if (x == y) return 0; + if (x > 1 && y > 1) { + if (LO(Get(x)) < LO(Get(x))) return -1; + if (LO(Get(x)) > LO(Get(x))) return +1; + } + for (;; x = Cdr(x), y = Cdr(y)) { + if (x == y) return 0; + if (!x) return -1; + if (!y) return +1; + if (x < 0) { + if (y >= 0) return +1; + if ((c = Cmp(Car(x), Car(y)))) return c; + } else { + if (y < 0) return -1; + for (;;) { + t = x != 1 ? Get(x) : MAKE(L'T', TERM); + u = y != 1 ? Get(y) : MAKE(L'T', TERM); + if (LO(t) != LO(u)) { + return LO(t) < LO(u) ? -1 : +1; + } + x = HI(t); + y = HI(u); + if (x == y) return 0; + if (x == TERM) return -1; + if (y == TERM) return +1; + } + if (Car(x) != Car(y)) { + return Car(x) < Car(y) ? -1 : +1; + } + } + } +} diff --git a/tool/plinko/lib/config.h b/tool/plinko/lib/config.h new file mode 100644 index 000000000..109823f73 --- /dev/null +++ b/tool/plinko/lib/config.h @@ -0,0 +1,38 @@ +#ifndef COSMOPOLITAN_TOOL_PLINKO_LIB_CONFIG_H_ +#define COSMOPOLITAN_TOOL_PLINKO_LIB_CONFIG_H_ +#include "libc/dce.h" + +#define HISTO_ASSOC 0 +#define HISTO_GARBAGE 0 +#define DEBUG_TREE 0 +#define DEBUG_CLOSURE 0 +#define DEBUG_GARBAGE 0 +#define DEBUG_MATCHER 0 +#define EXPLAIN_GARBAGE 0 +#define AVERSIVENESS 15 + +#define NEED_GC 1 +#define NEED_TMC 2 +#define NEED_POP 4 + +#define STACK 65536 + +// we want a two power that's large enough for emoji but not +// not so large that we're drowning in virtual memory pages! +#define TERM 0x20000 + +#if !(__ASSEMBLER__ + __LINKER__ + 0) +COSMOPOLITAN_C_START_ + +#if IsModeDbg() +#define inline dontinline +#undef forceinline +#define forceinline static dontinline +#endif + +#define BANE INT_MIN +#define DWBITS (sizeof(dword) * CHAR_BIT) + +COSMOPOLITAN_C_END_ +#endif /* !(__ASSEMBLER__ + __LINKER__ + 0) */ +#endif /* COSMOPOLITAN_TOOL_PLINKO_LIB_CONFIG_H_ */ diff --git a/tool/plinko/lib/cons.c b/tool/plinko/lib/cons.c new file mode 100644 index 000000000..64cffce98 --- /dev/null +++ b/tool/plinko/lib/cons.c @@ -0,0 +1,66 @@ +/*-*- 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/plinko/lib/char.h" +#include "tool/plinko/lib/cons.h" + +int List(int x, int y) { + return Cons(x, Cons(y, -0)); +} + +int List3(int x, int y, int z) { + return Cons(x, List(y, z)); +} + +int List4(int a, int b, int c, int d) { + return Cons(a, List3(b, c, d)); +} + +int Shadow(int p, int s) { + int t = GetCommonCons(p, s); + return t ? t : Cons(p, s); +} + +int GetCommonCons(int x, int y) { + if (!y) { + if (!x) return -1; + if (x > 0 && cFrost < -1 && IsUpper(LO(Get(x))) && HI(Get(x)) == TERM) { + return kConsAlphabet[LO(Get(x)) - L'A']; + } + } + return 0; +} + +int ShareCons(int x, int y) { + dword t; + int i, n; + if ((i = GetCommonCons(x, y))) return i; +#if 0 + t = MAKE(x, y); + for (i = cx, n = MIN(0, i + 64); i < n; ++i) { + if (t == Get(i)) { + return i; + } + } +#endif + return Cons(x, y); +} + +int ShareList(int x, int y) { + return ShareCons(x, ShareCons(y, -0)); +} diff --git a/tool/plinko/lib/cons.h b/tool/plinko/lib/cons.h new file mode 100644 index 000000000..7dfd0ad44 --- /dev/null +++ b/tool/plinko/lib/cons.h @@ -0,0 +1,67 @@ +#ifndef COSMOPOLITAN_TOOL_PLINKO_LIB_CONS_H_ +#define COSMOPOLITAN_TOOL_PLINKO_LIB_CONS_H_ +#include "tool/plinko/lib/error.h" +#include "tool/plinko/lib/plinko.h" +#include "tool/plinko/lib/types.h" +#if !(__ASSEMBLER__ + __LINKER__ + 0) +COSMOPOLITAN_C_START_ + +forceinline void Set(int i, dword t) { +#ifndef NDEBUG + DCHECK_NE(0, i); + DCHECK_LT(i, TERM); + DCHECK_LT(LO(t), TERM); + DCHECK_LE(HI(t), TERM); + if (i < 0) { + DCHECK_LT(i, LO(t), "topology compromised"); + DCHECK_LT(i, HI(t), "topology compromised"); + } else { + DCHECK_GE(LO(t), 0); + DCHECK_GE(HI(t), 0); + } +#endif + g_mem[i & (BANE | MASK(BANE))] = t; + ++cSets; +} + +forceinline int Alloc(dword t) { + int c = cx; + if (!__builtin_sub_overflow(c, 1, &c)) { + Set(c, t); + return cx = c; + } + OutOfMemory(); +} + +forceinline void SetShadow(int i, dword t) { +#ifndef NDEBUG + DCHECK_GE(i, cx); + DCHECK_LT(i, TERM); + DCHECK_GE(LO(t), 0); + /* if (i < 0) DCHECK_GE(HI(t), i, "topology compromised"); */ +#endif + ((__seg_fs dword *)((uintptr_t)g_mem))[i & (BANE | MASK(BANE))] = t; +} + +forceinline int Cons(int x, int y) { + int c; + c = Alloc(MAKE(x, y)); + SetShadow(c, DF(DispatchPlan)); + return c; +} + +forceinline int Alist(int x, int y, int z) { + return Cons(Cons(x, y), z); +} + +int List(int, int); +int List3(int, int, int); +int List4(int, int, int, int); +int Shadow(int, int); +int GetCommonCons(int, int); +int ShareCons(int, int); +int ShareList(int, int); + +COSMOPOLITAN_C_END_ +#endif /* !(__ASSEMBLER__ + __LINKER__ + 0) */ +#endif /* COSMOPOLITAN_TOOL_PLINKO_LIB_CONS_H_ */ diff --git a/tool/plinko/lib/countatoms.c b/tool/plinko/lib/countatoms.c new file mode 100644 index 000000000..a7d394072 --- /dev/null +++ b/tool/plinko/lib/countatoms.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/plinko/lib/plinko.h" + +nosideeffect int CountAtoms(int x, int max, int res) { + if (!x || res >= max) return res; + if (x > 0) return res + 1; + return CountAtoms(Cdr(x), max, CountAtoms(Car(x), max, res)); +} diff --git a/tool/plinko/lib/countreferences.c b/tool/plinko/lib/countreferences.c new file mode 100644 index 000000000..99c90ad56 --- /dev/null +++ b/tool/plinko/lib/countreferences.c @@ -0,0 +1,71 @@ +/*-*- 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/log/check.h" +#include "tool/plinko/lib/index.h" +#include "tool/plinko/lib/plinko.h" + +/** + * Counts references to variable. + * + * @param v is atom name of variable + * @param m is count after which we should stop counting + * @param e is expression + * @return number of counted references greater than zero + * @note this produces garbage when recursing into let + */ +int CountReferences(int v, int m, int e) { + int f, r; + DCHECK_GT(v, 0); + if (e >= 0) { + r = e == v; + } else { + f = Car(e); + if (f == kQuote || f == kClosure) { + r = 0; + } else if (f == kLambda || f == kMacro) { + if (m > 0 && !HasAtom(v, Cadr(e))) { + r = CountReferences(v, m, Caddr(e)); + } else { + r = 0; + } + } else if (f == kCond) { + for (r = 0; (e = Cdr(e)) < 0 && r < m;) { + if ((f = Car(e)) < 0) { + r += CountReferences(v, m - r, Car(f)); + if ((f = Cdr(f)) < 0) { + r += CountReferences(v, m - r, Car(f)); + } + } + } + } else { + for (r = 0; e && r < m;) { + if (e < 0) { + f = Car(e); + e = Cdr(e); + } else { + f = e; + e = 0; + } + r += CountReferences(v, m - r, f); + } + } + } + DCHECK_GE(r, 0); + return r; +} diff --git a/tool/plinko/lib/define.c b/tool/plinko/lib/define.c new file mode 100644 index 000000000..cb9c4da1f --- /dev/null +++ b/tool/plinko/lib/define.c @@ -0,0 +1,108 @@ +/*-*- 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/log/check.h" +#include "tool/plinko/lib/cons.h" +#include "tool/plinko/lib/gc.h" +#include "tool/plinko/lib/index.h" +#include "tool/plinko/lib/plinko.h" +#include "tool/plinko/lib/print.h" +#include "tool/plinko/lib/printf.h" +#include "tool/plinko/lib/tree.h" + +void GetName(int *x) { + int t; + if (*x < 0) { + if ((t = GetTree(*x, revglob))) { + *x = Val(Ent(t)); + } + } +} + +int Define(int e, int a) { + struct Gc *G; + int k, v, x, r, o; + DCHECK_EQ(kDefine, Car(e)); + if (Cdr(e) >= 0) Error("bad define: %S", e); + if (Cadr(e) <= 0) Error("scheme define: %S", e); + if (Cddr(e) >= 0 || Caddr(e) == kLambda) { + /* + * compatibility with sectorlisp friendly branch, e.g. + * + * (DEFINE 𝑘 . 𝑣) + * (DEFINE 𝑘 . (LAMBDA ⋯)) + * + * are equivalent to the following + * + * (DEFINE 𝑘 (QUOTE 𝑣)) + * (DEFINE 𝑘 (QUOTE (LAMBDA ⋯))) + */ + e = Cdr(e); + k = Car(e); + } else if (!Cdddr(e)) { + k = Cadr(e); + v = Caddr(e); + x = eval(v, a); + e = Cons(k, x); + } else { + Error("too many args: %S", e); + } + a = Cons(PutTree(e, Car(a), 0), 0); + r = PutTree(Cons(Cdr(e), Car(e)), revglob, 0); + o = Cons(k, ordglob); + G = NewGc(cFrost); + Mark(G, a); + Mark(G, r); + Mark(G, o); + Census(G); + a = Relocate(G, a); + r = Relocate(G, r); + o = Relocate(G, o); + Sweep(G); + revglob = r; + ordglob = o; + return a; +} + +/** + * Prints stuff declared by Define(). + * + * The output is primarily intended for describing the internal machine + * state, with a focus on readability. If closures are printed, with -c + * then each nugget can be copied back into the machine on its own, b/c + * each definition is a transitive closure that totally defines all its + * dependencies. However it's quite verbose, so the normal mode is just + * readable and can be finessed back into a good program with some work + * although one thing that's really cool is it peels away macros in the + * hope it can help demystify amazingly dense recreational abstractions + * + * @param t is symbol to use for DEFINE + * @param a is an association list and/or red-black tree + * @param o is ordering of names + * @see Assoc() for documentation on structure of 𝑎 + */ +int DumpDefines(int t, int a, int o) { + int e; + bool nn; + nn = noname; + noname = true; + for (; o; o = Cdr(o)) { + e = Assoc(Car(o), a); + Printf("%n%p%n", Cons(t, Cons(Car(e), Cons(Cdr(e), -0)))); + } + noname = nn; + return 0; +} diff --git a/tool/plinko/lib/desymbolize.c b/tool/plinko/lib/desymbolize.c new file mode 100644 index 000000000..9682f816a --- /dev/null +++ b/tool/plinko/lib/desymbolize.c @@ -0,0 +1,75 @@ +/*-*- 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/build/lib/case.h" +#include "tool/plinko/lib/plinko.h" + +pureconst int Desymbolize(int c) { + return -1; + switch (c) { + CASE(L'⊥', return 0); + CASE(L'⊤', return 1); + CASE(L'≡', return kEq); + CASE(L'⍅', return kCar); + CASE(L'⊷', return kCar); + CASE(L'⍆', return kCdr); + CASE(L'⊶', return kCdr); + CASE(L'α', return kAtom); + CASE(L'ζ', return kCond); + CASE(L'ℶ', return kCons); + CASE(L'β', return kBeta); + CASE(L'ψ', return kMacro); + CASE(L'λ', return kLambda); + CASE(L'⅄', return kClosure); + CASE(L'∂', return kPartial); + CASE(L'║', return kAppend); + CASE(L'≷', return kCmp); + CASE(L'∧', return kAnd); + CASE(L'∨', return kOr); + CASE(L'⋔', return kFork); + CASE(L'Λ', return kDefun); + CASE(L'≝', return kDefine); + CASE(L'ə', return kExpand); + CASE(L'Ψ', return kDefmacro); + CASE(L'𝑓', return kFunction); + CASE(L'∫', return kIntegrate); + CASE(L'∅', return kImpossible); + CASE(L'𝕐', return kYcombinator); + CASE(L'∩', return kIntersection); + CASE(L'ℒ', return kList); + CASE(L'∊', return kMember); + CASE(L'¬', return kNot); + CASE(L'Ω', return kQuote); + CASE(L'Я', return kReverse); + CASE(L'√', return kSqrt); + CASE(L'⊂', return kSubset); + CASE(L'⊃', return kSuperset); + CASE(L'∵', return kBecause); + CASE(L'∴', return kTherefore); + CASE(L'∪', return kUnion); + CASE(L'⟶', return kImplies); + CASE(L'⊼', return kNand); + CASE(L'⊽', return kNor); + CASE(L'⊻', return kXor); + CASE(L'⟺', return kIff); + CASE(L'⟳', return kCycle); + CASE(L'⊙', return kOrder); + default: + return -1; + } +} diff --git a/tool/plinko/lib/dispatchycombine.c b/tool/plinko/lib/dispatchycombine.c new file mode 100644 index 000000000..dfcd4012f --- /dev/null +++ b/tool/plinko/lib/dispatchycombine.c @@ -0,0 +1,81 @@ +/*-*- 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/plinko/lib/cons.h" +#include "tool/plinko/lib/index.h" +#include "tool/plinko/lib/plinko.h" +#include "tool/plinko/lib/stack.h" + +struct T DispatchRecur(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + struct Binding bz; + bz = bind_(Car(Car(HI(d))), Cdr(LO(ea)), HI(ea), Cdr(HI(d)), p1, p2); + return TailCall(MAKE(Cdr(Car(HI(d))), bz.u), tm, r, bz.p1, 0); +} + +struct T DispatchRecur1(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + return TailCall( + MAKE(Car(HI(d) + 5), Cdr(HI(d) + 1)), tm, r, + MAKE(Car(HI(d) + 4), FasterRecurse(Car(Cdr(LO(ea))), HI(ea), p1, p2)), 0); +} + +struct T DispatchRecur2(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + return TailCall( + MAKE(Car(HI(d) + 6), Cdr(HI(d))), tm, r, + MAKE(Car(HI(d) + 4), FasterRecurse(Car(Cdr(LO(ea))), HI(ea), p1, p2)), + MAKE(Car(HI(d) + 5), + FasterRecurse(Car(Cdr(Cdr(LO(ea)))), HI(ea), p1, p2))); +} + +struct T DispatchYcombine(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + int ycomb, z, u, t, p, b, name, lambda, closure; + SetFrame(r, LO(ea)); + r |= NEED_GC; + ycomb = recurse(MAKE(Car(LO(ea)), HI(ea)), p1, p2); + DCHECK(IsYcombinator(ycomb)); + ycomb = Cadr(ycomb); + lambda = recurse(MAKE(Cadr(ea), HI(ea)), p1, p2); + closure = + recurse(MAKE(Caddr(ycomb), Alist(Car(Cadr(ycomb)), lambda, 0)), 0, 0); + if (Car(lambda) == kClosure) lambda = Car(Cdr(lambda)); + DCHECK_EQ(kClosure, Car(closure)); + DCHECK_EQ(kLambda, Car(lambda)); + DCHECK_EQ(kLambda, Car(Car(Cdr(closure)))); + name = Car(Cadr(lambda)); + lambda = Cadr(closure); + closure = Enclose(lambda, Cddr(closure)); + closure = Preplan(closure, Cddr(closure), 0); + lambda = Cadr(closure); + if ((p = CountSimpleParameters(Cadr(lambda))) == 1 || p == 2) { + if (p == 1) { + PlanFuncalls(name, MAKE(DF(DispatchRecur1), closure), Caddr(lambda)); + } else { + PlanFuncalls(name, MAKE(DF(DispatchRecur2), closure), Caddr(lambda)); + } + } else { + PlanFuncalls(name, + MAKE(DF(DispatchRecur), + Cons(Cons(Cadr(Cadr(closure)), Caddr(Cadr(closure))), + Cddr(closure))), + Caddr(lambda)); + } + return Ret(MAKE(closure, 0), tm, r); +} diff --git a/tool/plinko/lib/enclose.c b/tool/plinko/lib/enclose.c new file mode 100644 index 000000000..5c51f61c0 --- /dev/null +++ b/tool/plinko/lib/enclose.c @@ -0,0 +1,76 @@ +/*-*- 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/plinko/lib/config.h" +#include "tool/plinko/lib/cons.h" +#include "tool/plinko/lib/error.h" +#include "tool/plinko/lib/gc.h" +#include "tool/plinko/lib/index.h" +#include "tool/plinko/lib/plinko.h" +#include "tool/plinko/lib/printf.h" +#include "tool/plinko/lib/stack.h" + +static void CheckClosureFullyDefined(int e, int a, int s) { + int f; + Push(e); + if (e >= 0) { + if (!IsPrecious(e) && !HasAtom(e, s) && !Assoc(e, a)) { + Error("crash binding in closure"); + } + } else if ((f = Car(e)) != kQuote && f != kClosure) { + if (f == kLambda || f == kMacro) { + CheckClosureFullyDefined(Caddr(e), a, Cons(Cadr(e), s)); + } else if (f == kCond) { + while ((e = Cdr(e)) < 0) { + if ((f = Car(e)) < 0) { + CheckClosureFullyDefined(Car(f), a, s); + if ((f = Cdr(f)) < 0) { + CheckClosureFullyDefined(Car(f), a, s); + } + } + } + } else { + do { + if (e < 0) { + CheckClosureFullyDefined(Car(e), a, s); + e = Cdr(e); + } else { + CheckClosureFullyDefined(e, a, s); + e = 0; + } + } while (e); + } + } + Pop(); +} + +static void CheckClosure(int e, int a) { + int A; + if (DEBUG_CLOSURE && logc) { + A = cx; + CheckClosureFullyDefined(e, a, 0); + MarkSweep(A, 0); + } +} + +int Enclose(int e, int a) { + int x; + dword w; + CheckClosure(e, a); + return Cons(kClosure, Cons(e, a)); +} diff --git a/tool/plinko/lib/error.c b/tool/plinko/lib/error.c new file mode 100644 index 000000000..4a269a544 --- /dev/null +++ b/tool/plinko/lib/error.c @@ -0,0 +1,57 @@ +/*-*- 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/log/log.h" +#include "libc/runtime/runtime.h" +#include "tool/plinko/lib/error.h" +#include "tool/plinko/lib/plinko.h" +#include "tool/plinko/lib/printf.h" +#include "tool/plinko/lib/stack.h" + +relegated wontreturn void Raise(int x) { + Flush(1); + Flush(2); + longjmp(crash, ~x); +} + +relegated wontreturn void Error(const char *f, ...) { + int n; + va_list va; + Flush(1); + Flush(2); + va_start(va, f); + n = Fprintf(2, "\e[1;31merror\e[0m: "); + n = Vfnprintf(f, va, 2, n); + Fprintf(2, "%n"); + va_end(va); + Raise(kError); +} + +relegated wontreturn void OutOfMemory(void) { + Error("out of memory"); +} + +relegated wontreturn void StackOverflow(void) { + Error("stack overflow"); +} + +relegated wontreturn void React(int e, int x, int k) { + if (!sp || e != LO(GetCurrentFrame())) Push(e); + Push(x); + Raise(k); +} diff --git a/tool/plinko/lib/error.h b/tool/plinko/lib/error.h new file mode 100644 index 000000000..fb05e48f2 --- /dev/null +++ b/tool/plinko/lib/error.h @@ -0,0 +1,14 @@ +#ifndef COSMOPOLITAN_TOOL_PLINKO_LIB_ERROR_H_ +#define COSMOPOLITAN_TOOL_PLINKO_LIB_ERROR_H_ +#if !(__ASSEMBLER__ + __LINKER__ + 0) +COSMOPOLITAN_C_START_ + +void Raise(int) relegated wontreturn; +void Error(const char *, ...) relegated wontreturn; +void OutOfMemory(void) relegated wontreturn; +void StackOverflow(void) relegated wontreturn; +void React(int, int, int) relegated wontreturn; + +COSMOPOLITAN_C_END_ +#endif /* !(__ASSEMBLER__ + __LINKER__ + 0) */ +#endif /* COSMOPOLITAN_TOOL_PLINKO_LIB_ERROR_H_ */ diff --git a/tool/plinko/lib/evlis.c b/tool/plinko/lib/evlis.c new file mode 100644 index 000000000..db8fe70bf --- /dev/null +++ b/tool/plinko/lib/evlis.c @@ -0,0 +1,27 @@ +/*-*- 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/plinko/lib/cons.h" +#include "tool/plinko/lib/plinko.h" + +int Evlis(int x, int a, dword p1, dword p2) { + if (!x) return x; + if (x > 0) return FasterRecurse(x, a, p1, p2); + int y = FasterRecurse(Car(x), a, p1, p2); + return Cons(y, Evlis(Cdr(x), a, p1, p2)); +} diff --git a/tool/plinko/lib/expand.c b/tool/plinko/lib/expand.c new file mode 100644 index 000000000..f56682068 --- /dev/null +++ b/tool/plinko/lib/expand.c @@ -0,0 +1,80 @@ +/*-*- 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/log/check.h" +#include "tool/plinko/lib/config.h" +#include "tool/plinko/lib/cons.h" +#include "tool/plinko/lib/gc.h" +#include "tool/plinko/lib/index.h" +#include "tool/plinko/lib/plinko.h" +#include "tool/plinko/lib/trace.h" + +int Exlis(int x, int a) { + int y; + if (!x) return x; + if (x > 0) return expand(x, a); + y = expand(Car(x), a); + return Keep(x, Cons(y, Exlis(Cdr(x), a))); +} + +static int Expander(int e, int a) { + int f, u, x, y, s; + for (s = 0;;) { + DCHECK_LT(e, TERM); + DCHECK_LE(a, 0); + if (e >= 0) return e; + if ((f = Car(e)) > 0) { + if (f == kQuote) return e; + if (f == kClosure) return e; + if (f == kTrace) { + START_TRACE; + x = Cadr(e); + y = expand(x, a); + e = x == y ? e : List(Car(e), y); + END_TRACE; + return e; + } + if (HasAtom(f, s)) return e; + s = Cons(f, s); + } + e = Exlis(e, a); + if (f >= 0) { + if (!(f = Assoc(f, a))) return e; + f = Cdr(f); + if (f >= 0) return e; + } + if (Car(f) == kClosure) { + u = Cddr(f); + f = Cadr(f); + } else { + u = a; + } + if (Head(f) != kMacro) return e; + e = eval(Caddr(f), pairlis(Cadr(f), Cdr(e), u)); + } +} + +int Expand(int e, int a) { + int r, A; + A = cx; + Push(List(kExpand, e)); + r = Keep(e, Expander(e, a)); + Pop(); + r = MarkSweep(A, r); + return r; +} diff --git a/tool/plinko/lib/findfreevariables.c b/tool/plinko/lib/findfreevariables.c new file mode 100644 index 000000000..13785e6e1 --- /dev/null +++ b/tool/plinko/lib/findfreevariables.c @@ -0,0 +1,68 @@ +/*-*- 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/plinko/lib/cons.h" +#include "tool/plinko/lib/index.h" +#include "tool/plinko/lib/plinko.h" + +/** + * Finds free variables in expression. + * + * @param e is expression + * @param r is atom list result accumulator + * @param s is atom tree of shadowed bindings + * @return atom list of crash bindings without duplicates + * @note this produces garbage when recursing into let + */ +int FindFreeVariables(int e, int r, int s) { + int f, t; + if (e >= 0) { + if (!IsConstant(e) && !HasAtom(e, s) && !HasAtom(e, r)) { + t = GetCommonCons(e, r); + r = t ? t : Cons(e, r); + } + } else { + f = Car(e); + if (f != kQuote && f != kClosure) { + if (f == kLambda || f == kMacro) { + r = FindFreeVariables(Caddr(e), r, Shadow(Cadr(e), s)); + } else if (f == kCond) { + while ((e = Cdr(e)) < 0) { + if ((f = Car(e)) < 0) { + r = FindFreeVariables(Car(f), r, s); + if ((f = Cdr(f)) < 0) { + r = FindFreeVariables(Car(f), r, s); + } + } + } + } else { + while (e) { + if (e < 0) { + f = Car(e); + e = Cdr(e); + } else { + f = e; + e = 0; + } + r = FindFreeVariables(f, r, s); + } + } + } + } + return r; +} diff --git a/tool/plinko/lib/flush.c b/tool/plinko/lib/flush.c new file mode 100644 index 000000000..8e240cf73 --- /dev/null +++ b/tool/plinko/lib/flush.c @@ -0,0 +1,38 @@ +/*-*- 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/errno.h" +#include "libc/runtime/runtime.h" +#include "libc/str/str.h" +#include "tool/plinko/lib/plinko.h" +#include "tool/plinko/lib/printf.h" + +void Flush(int fd) { + int n, i = 0; + while (i < bp[fd]) { + if ((n = write(fd, g_buffer[fd] + i, bp[fd] - i)) > 0) { + i += n; + } else if (errno != EINTR) { + ++fails; + Fprintf(2, "error: write() %s%n", strerror(errno)); + longjmp(exiter, 1); + } + } + bp[fd] = 0; +} diff --git a/tool/plinko/lib/gc.c b/tool/plinko/lib/gc.c new file mode 100644 index 000000000..0b270d740 --- /dev/null +++ b/tool/plinko/lib/gc.c @@ -0,0 +1,155 @@ +/*-*- 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/assert.h" +#include "libc/bits/popcnt.h" +#include "libc/limits.h" +#include "libc/log/check.h" +#include "libc/log/countbranch.h" +#include "libc/log/log.h" +#include "libc/macros.internal.h" +#include "libc/mem/mem.h" +#include "libc/nexgen32e/bsf.h" +#include "tool/plinko/lib/cons.h" +#include "tool/plinko/lib/gc.h" +#include "tool/plinko/lib/histo.h" +#include "tool/plinko/lib/plinko.h" +#include "tool/plinko/lib/print.h" +#include "tool/plinko/lib/printf.h" +#include "tool/plinko/lib/stack.h" + +forceinline void SetBit(dword M[], unsigned i) { + M[i / DWBITS] |= (dword)1 << (i % DWBITS); +} + +forceinline nosideeffect bool HasBit(const dword M[], unsigned i) { + return (M[i / DWBITS] >> (i % DWBITS)) & 1; +} + +struct Gc *NewGc(int A) { + int B = cx; + unsigned n; + struct Gc *G; + DCHECK_LE(B, A); + DCHECK_LE(A, 0); + if (B < cHeap) cHeap = B; + n = ROUNDUP(A - B, DWBITS) / DWBITS; + G = Addr(BANE); + memset(G->M, 0, n * sizeof(G->M[0])); + G->n = n; + G->A = A; + G->B = B; + G->P = (unsigned *)(G->M + n); + *G->P++ = 0; + return G; +} + +void Marker(const dword M[], int A, int x) { + int i; + dword t; + do { + i = ~(x - A); + if (HasBit(M, i)) return; + SetBit(M, i); + if (HI(GetShadow(x)) < A) { + Marker(M, A, HI(GetShadow(x))); + } + t = Get(x); + if (LO(t) < A) { + Marker(M, A, LO(t)); + } + } while ((x = HI(t)) < A); +} + +int Census(struct Gc *G) { + int n, t, l; + unsigned i, j; + i = G->A - G->B; + n = i / DWBITS; + for (j = t = 0; j < n; ++j) { + G->P[j] = t += popcnt(G->M[j]); + } + if (i % DWBITS) { + t += popcnt(G->M[j]); + } + G->noop = t == i; + for (l = j = 0; j < G->n; ++j) { + if (!~G->M[j]) { + l += DWBITS; + } else { + l += bsfl(~G->M[j]); + break; + } + } + G->C = G->A - l; +#if HISTO_GARBAGE + HISTO(g_gc_marks_histogram, t); + HISTO(g_gc_discards_histogram, i - t); + HISTO(g_gc_lop_histogram, l); +#endif + return t; +} + +int Relocater(const dword M[], const unsigned P[], int A, int x) { + long n; + unsigned i, r; + i = ~(x - A); + n = i / DWBITS; + r = i % DWBITS; + return A + ~(P[n - 1] + popcnt(M[n] & (((dword)1 << r) - 1))); +} + +void Sweep(struct Gc *G) { + dword m; + int a, b, d, i, j; + if (G->noop) return; + i = 0; + b = d = G->A; + for (; i < G->n; ++i) { + m = G->M[i]; + if (~m) { + j = bsfl(~m); + m >>= j; + m <<= j; + d -= j; + break; + } else { + b -= DWBITS; + d -= DWBITS; + } + } + for (; i < G->n; b -= DWBITS, m = G->M[++i]) { + for (; m; m &= ~((dword)1 << j)) { + a = b + ~(j = bsfl(m)); + Set(--d, MAKE(Relocate(G, LO(Get(a))), Relocate(G, HI(Get(a))))); + SetShadow(d, MAKE(LO(GetShadow(a)), Relocate(G, HI(GetShadow(a))))); + } + } + cx = d; +} + +int MarkSweep(int A, int x) { + struct Gc *G; + if (x >= A) return cx = A, x; + G = NewGc(A); + Mark(G, x); + Census(G); + x = Relocate(G, x); + Sweep(G); + return x; +} diff --git a/tool/plinko/lib/gc.h b/tool/plinko/lib/gc.h new file mode 100644 index 000000000..14c50e06a --- /dev/null +++ b/tool/plinko/lib/gc.h @@ -0,0 +1,34 @@ +#ifndef COSMOPOLITAN_TOOL_PLINKO_LIB_GC_H_ +#define COSMOPOLITAN_TOOL_PLINKO_LIB_GC_H_ +#include "tool/plinko/lib/types.h" +#if !(__ASSEMBLER__ + __LINKER__ + 0) +COSMOPOLITAN_C_START_ + +struct Gc { + int A, B, C; + unsigned n; + unsigned noop; + unsigned *P; + dword M[]; +}; + +int MarkSweep(int, int); +struct Gc *NewGc(int); +int Census(struct Gc *); +void Sweep(struct Gc *); +void Marker(const dword[], int, int); +int Relocater(const dword[], const unsigned[], int, int); + +forceinline int Relocate(const struct Gc *G, int x) { + if (x >= G->C) return x; + return Relocater(G->M, G->P, G->A, x); +} + +forceinline void Mark(struct Gc *G, int x) { + if (x >= G->A) return; + Marker(G->M, G->A, x); +} + +COSMOPOLITAN_C_END_ +#endif /* !(__ASSEMBLER__ + __LINKER__ + 0) */ +#endif /* COSMOPOLITAN_TOOL_PLINKO_LIB_GC_H_ */ diff --git a/tool/plinko/lib/getlongsum.c b/tool/plinko/lib/getlongsum.c new file mode 100644 index 000000000..7842a38c2 --- /dev/null +++ b/tool/plinko/lib/getlongsum.c @@ -0,0 +1,32 @@ +/*-*- 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/limits.h" +#include "tool/plinko/lib/histo.h" + +long GetLongSum(const long *h, size_t n) { + long t; + size_t i; + for (t = i = 0; i < n; ++i) { + if (__builtin_add_overflow(t, h[i], &t)) { + t = LONG_MAX; + break; + } + } + return t; +} diff --git a/tool/plinko/lib/hasatom.c b/tool/plinko/lib/hasatom.c new file mode 100644 index 000000000..45ea3255e --- /dev/null +++ b/tool/plinko/lib/hasatom.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/plinko/lib/plinko.h" + +nosideeffect bool HasAtom(int v, int x) { + if (!x) return false; + if (x > 0) return v == x; + return HasAtom(v, Car(x)) || HasAtom(v, Cdr(x)); +} diff --git a/tool/plinko/lib/histo.c b/tool/plinko/lib/histo.c new file mode 100644 index 000000000..d12039f10 --- /dev/null +++ b/tool/plinko/lib/histo.c @@ -0,0 +1,50 @@ +/*-*- 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/assert.h" +#include "tool/plinko/lib/histo.h" +#include "tool/plinko/lib/plinko.h" +#include "tool/plinko/lib/printf.h" + +void PrintHistogram(int fd, const char *s, const long *h, size_t n) { + long t; + bool islast; + int j, p, m; + char buf[101]; + size_t i, logos; + if (!(t = GetLongSum(h, n))) return; + Fprintf(fd, "%s%n", s); + for (i = 0; i < n; ++i) { + if (!h[i]) continue; + p = h[i] * 1000000 / t; + assert(0 <= p && p <= 1000000); + for (j = 0, m = p / 10000; j < m; ++j) { + buf[j] = '#'; + } + buf[j] = 0; + if (i) { + logos = 1; + logos <<= i - 1; + } else { + logos = 0; + } + islast = i == n - 1; + Fprintf(fd, "%'16lu%s %'*ld %3d.%04d%% %s%n", logos, islast ? "+" : "", + 16 - islast, h[i], p / 10000, p % 10000, buf); + } +} diff --git a/tool/plinko/lib/histo.h b/tool/plinko/lib/histo.h new file mode 100644 index 000000000..232f04d64 --- /dev/null +++ b/tool/plinko/lib/histo.h @@ -0,0 +1,20 @@ +#ifndef COSMOPOLITAN_TOOL_PLINKO_LIB_HISTO_H_ +#define COSMOPOLITAN_TOOL_PLINKO_LIB_HISTO_H_ +#include "libc/macros.internal.h" +#include "libc/nexgen32e/bsr.h" +#if !(__ASSEMBLER__ + __LINKER__ + 0) +COSMOPOLITAN_C_START_ + +#define HISTO(H, X) \ + do { \ + uint64_t x_ = X; \ + x_ = x_ ? bsrl(x_) + 1 : x_; \ + ++H[MIN(x_, ARRAYLEN(H) - 1)]; \ + } while (0) + +void PrintHistogram(int, const char *, const long *, size_t); +long GetLongSum(const long *, size_t); + +COSMOPOLITAN_C_END_ +#endif /* !(__ASSEMBLER__ + __LINKER__ + 0) */ +#endif /* COSMOPOLITAN_TOOL_PLINKO_LIB_HISTO_H_ */ diff --git a/tool/plinko/lib/index.c b/tool/plinko/lib/index.c new file mode 100644 index 000000000..a4588400f --- /dev/null +++ b/tool/plinko/lib/index.c @@ -0,0 +1,53 @@ +/*-*- 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/plinko/lib/index.h" + +#define INDEXER(NAME, EVAL) \ + struct T NAME(dword ea, dword tm, dword r, dword p1, dword p2, dword d) { \ + return Ret(MAKE(EVAL(FasterRecurse(HI(d), HI(ea), p1, p2)), 0), tm, r); \ + } + +INDEXER(DispatchCaar, Caar); +INDEXER(DispatchCadr, Cadr); +INDEXER(DispatchCdar, Cdar); +INDEXER(DispatchCddr, Cddr); +INDEXER(DispatchCaaar, Caaar); +INDEXER(DispatchCaadr, Caadr); +INDEXER(DispatchCadar, Cadar); +INDEXER(DispatchCaddr, Caddr); +INDEXER(DispatchCdaar, Cdaar); +INDEXER(DispatchCdadr, Cdadr); +INDEXER(DispatchCddar, Cddar); +INDEXER(DispatchCdddr, Cdddr); +INDEXER(DispatchCaaaar, Caaaar); +INDEXER(DispatchCaaadr, Caaadr); +INDEXER(DispatchCaadar, Caadar); +INDEXER(DispatchCaaddr, Caaddr); +INDEXER(DispatchCadaar, Cadaar); +INDEXER(DispatchCadadr, Cadadr); +INDEXER(DispatchCaddar, Caddar); +INDEXER(DispatchCadddr, Cadddr); +INDEXER(DispatchCdaaar, Cdaaar); +INDEXER(DispatchCdaadr, Cdaadr); +INDEXER(DispatchCdadar, Cdadar); +INDEXER(DispatchCdaddr, Cdaddr); +INDEXER(DispatchCddaar, Cddaar); +INDEXER(DispatchCddadr, Cddadr); +INDEXER(DispatchCdddar, Cdddar); +INDEXER(DispatchCddddr, Cddddr); diff --git a/tool/plinko/lib/index.h b/tool/plinko/lib/index.h new file mode 100644 index 000000000..2da6d5de4 --- /dev/null +++ b/tool/plinko/lib/index.h @@ -0,0 +1,135 @@ +#ifndef COSMOPOLITAN_TOOL_PLINKO_LIB_INDEX_H_ +#define COSMOPOLITAN_TOOL_PLINKO_LIB_INDEX_H_ +#include "tool/plinko/lib/error.h" +#include "tool/plinko/lib/plinko.h" +#include "tool/plinko/lib/stack.h" +#if !(__ASSEMBLER__ + __LINKER__ + 0) +COSMOPOLITAN_C_START_ + +forceinline nosideeffect int Head(int x) { + if (x <= 0) return LO(Get(x)); + Push(x); + Raise(kCar); +} + +forceinline nosideeffect int Tail(int x) { + if (x <= 0) return HI(Get(x)); + Push(x); + Raise(kCdr); +} + +forceinline nosideeffect int Cadr(int x) { + return Head(Tail(x)); +} + +forceinline nosideeffect int Caddr(int x) { + return Head(Tail(Tail(x))); +} + +static inline nosideeffect int Caar(int X) { + return Head(Head(X)); +} + +static inline nosideeffect int Cdar(int X) { + return Tail(Head(X)); +} + +static inline nosideeffect int Cddr(int X) { + return Tail(Tail(X)); +} + +static inline nosideeffect int Caaar(int X) { + return Head(Head(Head(X))); +} + +static inline nosideeffect int Caadr(int X) { + return Head(Head(Tail(X))); +} + +static inline nosideeffect int Cadar(int X) { + return Head(Tail(Head(X))); +} + +static inline nosideeffect int Cdaar(int X) { + return Tail(Head(Head(X))); +} + +static inline nosideeffect int Cdadr(int X) { + return Tail(Head(Tail(X))); +} + +static inline nosideeffect int Cddar(int X) { + return Tail(Tail(Head(X))); +} + +static inline nosideeffect int Cdddr(int X) { + return Tail(Tail(Tail(X))); +} + +static inline nosideeffect int Caaaar(int X) { + return Head(Head(Head(Head(X)))); +} + +static inline nosideeffect int Caaadr(int X) { + return Head(Head(Head(Tail(X)))); +} + +static inline nosideeffect int Caadar(int X) { + return Head(Head(Tail(Head(X)))); +} + +static inline nosideeffect int Caaddr(int X) { + return Head(Head(Tail(Tail(X)))); +} + +static inline nosideeffect int Cadaar(int X) { + return Head(Tail(Head(Head(X)))); +} + +static inline nosideeffect int Cadadr(int X) { + return Head(Tail(Head(Tail(X)))); +} + +static inline nosideeffect int Caddar(int X) { + return Head(Tail(Tail(Head(X)))); +} + +static inline nosideeffect int Cadddr(int X) { + return Head(Tail(Tail(Tail(X)))); +} + +static inline nosideeffect int Cdaaar(int X) { + return Tail(Head(Head(Head(X)))); +} + +static inline nosideeffect int Cdaadr(int X) { + return Tail(Head(Head(Tail(X)))); +} + +static inline nosideeffect int Cdadar(int X) { + return Tail(Head(Tail(Head(X)))); +} + +static inline nosideeffect int Cdaddr(int X) { + return Tail(Head(Tail(Tail(X)))); +} + +static inline nosideeffect int Cddaar(int X) { + return Tail(Tail(Head(Head(X)))); +} + +static inline nosideeffect int Cddadr(int X) { + return Tail(Tail(Head(Tail(X)))); +} + +static inline nosideeffect int Cdddar(int X) { + return Tail(Tail(Tail(Head(X)))); +} + +static inline nosideeffect int Cddddr(int X) { + return Tail(Tail(Tail(Tail(X)))); +} + +COSMOPOLITAN_C_END_ +#endif /* !(__ASSEMBLER__ + __LINKER__ + 0) */ +#endif /* COSMOPOLITAN_TOOL_PLINKO_LIB_INDEX_H_ */ diff --git a/tool/plinko/lib/infix.lisp b/tool/plinko/lib/infix.lisp new file mode 100644 index 000000000..e46c3aa47 --- /dev/null +++ b/tool/plinko/lib/infix.lisp @@ -0,0 +1,180 @@ +#| plinko - a really fast lisp tarpit + | 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. + |# + +(DEFUN UNARY-INFIX (INFIX I) + (COND ((ATOM (CAR I)) + (COND ((EQ (CAR I) "+") + (UNARY-INFIX INFIX (CDR I))) + ((EQ (CAR I) "-") + (LET ((X (UNARY-INFIX INFIX (CDR I)))) + (CONS (LIST 'SUB '0 (CAR X)) (CDR X)))) + ((EQ (CAR I) "~") + (LET ((X (UNARY-INFIX INFIX (CDR I)))) + (CONS (LIST 'NOT (CAR X)) (CDR X)))) + ((EQ (CAR I) "!") + (LET ((X (UNARY-INFIX INFIX (CDR I)))) + (CONS (LIST 'NOT (LIST 'EQ '0 (CAR X))) (CDR X)))) + (I))) + ((CONS (INFIX (CAR I)) (CDR I))))) + +(DEFUN POW-INFIX (INFIX I) + (LET ((X (UNARY-INFIX INFIX I))) + (COND ((EQ (CADR X) "**") + (LET ((Y (POW-INFIX INFIX (CDDR X)))) + (CONS (LIST 'POW (CAR X) (CAR Y)) (CDR Y)))) + (X)))) + +(DEFUN -MUL-INFIX (INFIX X) + (COND ((EQ (CADR X) "*") + (LET ((Y (POW-INFIX INFIX (CDDR X)))) + (-MUL-INFIX INFIX (CONS (LIST 'MUL (CAR X) (CAR Y)) (CDR Y))))) + ((EQ (CADR X) "/") + (LET ((Y (POW-INFIX INFIX (CDDR X)))) + (-MUL-INFIX INFIX (CONS (LIST 'DIV (CAR X) (CAR Y)) (CDR Y))))) + ((EQ (CADR X) "%") + (LET ((Y (POW-INFIX INFIX (CDDR X)))) + (-MUL-INFIX INFIX (CONS (LIST 'REM (CAR X) (CAR Y)) (CDR Y))))) + (X))) + +(DEFUN MUL-INFIX (INFIX I) + (-MUL-INFIX INFIX (POW-INFIX INFIX I))) + +(DEFUN -ADD-INFIX (INFIX X) + (COND ((EQ (CADR X) "+") + (LET ((Y (MUL-INFIX INFIX (CDDR X)))) + (-ADD-INFIX INFIX (CONS (LIST 'ADD (CAR X) (CAR Y)) (CDR Y))))) + ((EQ (CADR X) "-") + (LET ((Y (MUL-INFIX INFIX (CDDR X)))) + (-ADD-INFIX INFIX (CONS (LIST 'SUB (CAR X) (CAR Y)) (CDR Y))))) + (X))) + +(DEFUN ADD-INFIX (INFIX I) + (-ADD-INFIX INFIX (MUL-INFIX INFIX I))) + +(DEFUN -SHIFT-INFIX (INFIX X) + (COND ((EQ (CADR X) "<<") + (LET ((Y (ADD-INFIX INFIX (CDDR X)))) + (-SHIFT-INFIX INFIX (CONS (LIST 'SHL (CAR X) (CAR Y)) (CDR Y))))) + ((EQ (CADR X) ">>") + (LET ((Y (ADD-INFIX INFIX (CDDR X)))) + (-SHIFT-INFIX INFIX (CONS (LIST 'SAR (CAR X) (CAR Y)) (CDR Y))))) + ((EQ (CADR X) ">>>") + (LET ((Y (ADD-INFIX INFIX (CDDR X)))) + (-SHIFT-INFIX INFIX (CONS (LIST 'SHR (CAR X) (CAR Y)) (CDR Y))))) + (X))) + +(DEFUN SHIFT-INFIX (INFIX I) + (-SHIFT-INFIX INFIX (ADD-INFIX INFIX I))) + +(DEFUN -RELATIONAL-INFIX (INFIX X) + (COND ((EQ (CADR X) "<") + (LET ((Y (SHIFT-INFIX INFIX (CDDR X)))) + (-RELATIONAL-INFIX INFIX (CONS (LIST 'LT (CAR X) (CAR Y)) (CDR Y))))) + ((EQ (CADR X) ">") + (LET ((Y (SHIFT-INFIX INFIX (CDDR X)))) + (-RELATIONAL-INFIX INFIX (CONS (LIST 'GT (CAR X) (CAR Y)) (CDR Y))))) + ((EQ (CADR X) ">=") + (LET ((Y (SHIFT-INFIX INFIX (CDDR X)))) + (-RELATIONAL-INFIX INFIX (CONS (LIST 'GE (CAR X) (CAR Y)) (CDR Y))))) + ((EQ (CADR X) "<=") + (LET ((Y (SHIFT-INFIX INFIX (CDDR X)))) + (-RELATIONAL-INFIX INFIX (CONS (LIST 'LE (CAR X) (CAR Y)) (CDR Y))))) + (X))) + +(DEFUN RELATIONAL-INFIX (INFIX I) + (-RELATIONAL-INFIX INFIX (SHIFT-INFIX INFIX I))) + +(DEFUN -EQUALITY-INFIX (INFIX X) + (COND ((EQ (CADR X) "==") + (LET ((Y (RELATIONAL-INFIX INFIX (CDDR X)))) + (-EQUALITY-INFIX INFIX (CONS (LIST 'EQ (CAR X) (CAR Y)) (CDR Y))))) + ((EQ (CADR X) "!=") + (LET ((Y (RELATIONAL-INFIX INFIX (CDDR X)))) + (-EQUALITY-INFIX INFIX (CONS (LIST 'NOT (LIST 'EQ (CAR X) (CAR Y))) (CDR Y))))) + (X))) + +(DEFUN EQUALITY-INFIX (INFIX I) + (-EQUALITY-INFIX INFIX (RELATIONAL-INFIX INFIX I))) + +(DEFUN -AND-INFIX (INFIX X) + (COND ((EQ (CADR X) "&") + (LET ((Y (EQUALITY-INFIX INFIX (CDDR X)))) + (-AND-INFIX INFIX (CONS (LIST 'AND (CAR X) (CAR Y)) (CDR Y))))) + (X))) + +(DEFUN AND-INFIX (INFIX I) + (-AND-INFIX INFIX (EQUALITY-INFIX INFIX I))) + +(DEFUN -XOR-INFIX (INFIX X) + (COND ((EQ (CADR X) "^") + (LET ((Y (AND-INFIX INFIX (CDDR X)))) + (-XOR-INFIX INFIX (CONS (LIST 'XOR (CAR X) (CAR Y)) (CDR Y))))) + (X))) + +(DEFUN XOR-INFIX (INFIX I) + (-XOR-INFIX INFIX (AND-INFIX INFIX I))) + +(DEFUN -OR-INFIX (INFIX X) + (COND ((EQ (CADR X) "|") + (LET ((Y (XOR-INFIX INFIX (CDDR X)))) + (-OR-INFIX INFIX (CONS (LIST 'OR (CAR X) (CAR Y)) (CDR Y))))) + (X))) + +(DEFUN OR-INFIX (INFIX I) + (-OR-INFIX INFIX (XOR-INFIX INFIX I))) + +(DEFUN -LOGAND-INFIX (INFIX X) + (COND ((EQ (CADR X) "&&") + (LET ((Y (OR-INFIX INFIX (CDDR X)))) + (-LOGAND-INFIX + INFIX (CONS (LIST 'AND + (LIST 'NOT (LIST 'EQ '0 (CAR X))) + (LIST 'NOT (LIST 'EQ '0 (CAR Y)))) + (CDR Y))))) + (X))) + +(DEFUN LOGAND-INFIX (INFIX I) + (-LOGAND-INFIX INFIX (OR-INFIX INFIX I))) + +(DEFUN -LOGOR-INFIX (INFIX X) + (COND ((EQ (CADR X) "||") + (LET ((Y (LOGAND-INFIX INFIX (CDDR X)))) + (-LOGOR-INFIX + INFIX (CONS (LIST 'OR + (LIST 'NOT (LIST 'EQ '0 (CAR X))) + (LIST 'NOT (LIST 'EQ '0 (CAR Y)))) + (CDR Y))))) + (X))) + +(DEFUN LOGOR-INFIX (INFIX I) + (-LOGOR-INFIX INFIX (LOGAND-INFIX INFIX I))) + +(DEFUN CONDITIONAL-INFIX (INFIX I) + (LET ((X (LOGOR-INFIX INFIX I))) + (COND ((EQ (CADR X) "?") + (LET ((Y (LOGOR-INFIX INFIX (CDDR X)))) + (COND ((EQ (CADR Y) ":") + (LET ((Z (CONDITIONAL-INFIX INFIX (CDDR Y)))) + (CONS (LIST 'IF (CAR X) (CAR Y) (CAR Z)) (CDR Z)))) + (X)))) + (X)))) + +(DEFUN INFIX (I) + (LET ((X (CONDITIONAL-INFIX INFIX I))) + (IF (CDR X) + (ERROR 'UNINFIXD (CDR X)) + (CAR X)))) diff --git a/tool/plinko/lib/intern.c b/tool/plinko/lib/intern.c new file mode 100644 index 000000000..184deaff0 --- /dev/null +++ b/tool/plinko/lib/intern.c @@ -0,0 +1,48 @@ +/*-*- 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/plinko/lib/cons.h" +#include "tool/plinko/lib/plinko.h" + +static inline int Probe(unsigned h, unsigned p) { + return (h + p * p) & MASK(TERM); +} + +static inline int Hash(unsigned h, unsigned x) { + return MAX(2, ((h * 0xdeaadead) ^ x) & MASK(TERM)); +} + +static int Interner(dword t, int h, int p) { + dword u; + if ((u = Get(h))) { + if (u != t) { + h = Interner(t, Probe(h, p), p + 1); + } + return h; + } else if (++cAtoms < TERM / 2) { + Set(h, t); + SetShadow(h, DF(DispatchLookup)); + return h; + } else { + Error("too many atoms"); + } +} + +int Intern(int x, int y) { + return Interner(MAKE(x, y), (ax = Hash(x, ax)), 1); +} diff --git a/tool/plinko/lib/iscar.c b/tool/plinko/lib/iscar.c new file mode 100644 index 000000000..8c0124674 --- /dev/null +++ b/tool/plinko/lib/iscar.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 "tool/plinko/lib/plinko.h" + +/** + * Matches + * + * (⍅ X) + * + * @return X on success, or 0 on mismatch + * @note ⍅ means CAR + */ +int IsCar(int x_) { + dword w_; + if (x_ >= 0) return 0; + w_ = Get(x_); // (⍅ X) + int ax_ = LO(w_); + int dx_ = HI(w_); + if (ax_ != kCar) return 0; + if (dx_ >= 0) return 0; + w_ = Get(dx_); // (X) + int adx_ = LO(w_); + int ddx_ = HI(w_); + int X = adx_; + if (ddx_) return 0; + return X; +} diff --git a/tool/plinko/lib/iscdr.c b/tool/plinko/lib/iscdr.c new file mode 100644 index 000000000..e136cb0f6 --- /dev/null +++ b/tool/plinko/lib/iscdr.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 "tool/plinko/lib/plinko.h" + +/** + * Matches + * + * (⍆ X) + * + * @return X on success, or 0 on mismatch + * @note ⍆ means CDR + */ +int IsCdr(int x_) { + dword w_; + if (x_ >= 0) return 0; + w_ = Get(x_); // (⍆ X) + int ax_ = LO(w_); + int dx_ = HI(w_); + if (ax_ != kCdr) return 0; + if (dx_ >= 0) return 0; + w_ = Get(dx_); // (X) + int adx_ = LO(w_); + int ddx_ = HI(w_); + int X = adx_; + if (ddx_) return 0; + return X; +} diff --git a/tool/plinko/lib/isconstant.c b/tool/plinko/lib/isconstant.c new file mode 100644 index 000000000..223ea4c77 --- /dev/null +++ b/tool/plinko/lib/isconstant.c @@ -0,0 +1,28 @@ +/*-*- 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 2021 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/plinko/lib/plinko.h" + +pureconst bool IsConstant(int e) { + unsigned f = LO(GetShadow(e)); + if (f == EncodeDispatchFn(DispatchNil)) return true; + if (f == EncodeDispatchFn(DispatchTrue)) return true; + if (f == EncodeDispatchFn(DispatchPrecious)) return true; + if (f == EncodeDispatchFn(DispatchQuote)) return true; + return false; +} diff --git a/tool/plinko/lib/isdelegate.c b/tool/plinko/lib/isdelegate.c new file mode 100644 index 000000000..b0ba017e3 --- /dev/null +++ b/tool/plinko/lib/isdelegate.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 2021 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/plinko/lib/plinko.h" + +/** + * Matches + * + * (λ V (F . V) . Q) + * + * @return F on success, or 0 on mismatch + * @note Q is ignored + * @note V must be a non-nil atom + * @note λ means LAMBDA + */ +int IsDelegate(int x_) { + dword w_; + if (x_ >= 0) return 0; + w_ = Get(x_); // (λ V (F . V) . Q) + int ax_ = LO(w_); + int dx_ = HI(w_); + if (ax_ != kLambda) return 0; + if (dx_ >= 0) return 0; + w_ = Get(dx_); // (V (F . V) . Q) + int adx_ = LO(w_); + int ddx_ = HI(w_); + int V = adx_; + if (V <= 0) return 0; + if (ddx_ >= 0) return 0; + w_ = Get(ddx_); // ((F . V) . Q) + int addx_ = LO(w_); + int dddx_ = HI(w_); + if (addx_ >= 0) return 0; + w_ = Get(addx_); // (F . V) + int aaddx_ = LO(w_); + int daddx_ = HI(w_); + int F = aaddx_; + if (daddx_ != V) return 0; + return F; +} diff --git a/tool/plinko/lib/isif.c b/tool/plinko/lib/isif.c new file mode 100644 index 000000000..83406f122 --- /dev/null +++ b/tool/plinko/lib/isif.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 2021 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/plinko/lib/plinko.h" + +/** + * Matches + * + * (ζ (X Y) (Z)) + * + * @return MAKE4(X,Y,Z,0) on success, or ZERO4 on mismatch + * @note ζ means COND + */ +struct qword IsIf(int x_) { + dword w_; + if (x_ >= 0) return ZERO4; + w_ = Get(x_); // (ζ (X Y) (Z)) + int ax_ = LO(w_); + int dx_ = HI(w_); + if (ax_ != kCond) return ZERO4; + if (dx_ >= 0) return ZERO4; + w_ = Get(dx_); // ((X Y) (Z)) + int adx_ = LO(w_); + int ddx_ = HI(w_); + if (adx_ >= 0) return ZERO4; + w_ = Get(adx_); // (X Y) + int aadx_ = LO(w_); + int dadx_ = HI(w_); + if (ddx_ >= 0) return ZERO4; + w_ = Get(ddx_); // ((Z)) + int addx_ = LO(w_); + int dddx_ = HI(w_); + int X = aadx_; + if (addx_ >= 0) return ZERO4; + w_ = Get(addx_); // (Z) + int aaddx_ = LO(w_); + int daddx_ = HI(w_); + if (dadx_ >= 0) return ZERO4; + w_ = Get(dadx_); // (Y) + int adadx_ = LO(w_); + int ddadx_ = HI(w_); + if (dddx_) return ZERO4; + int Y = adadx_; + int Z = aaddx_; + if (ddadx_) return ZERO4; + if (daddx_) return ZERO4; + return MAKE4(X, Y, Z, 0); +} diff --git a/tool/plinko/lib/iswide.c b/tool/plinko/lib/iswide.c new file mode 100644 index 000000000..1f6c33288 --- /dev/null +++ b/tool/plinko/lib/iswide.c @@ -0,0 +1,343 @@ +/*-*- 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/bits/midpoint.h" +#include "libc/macros.internal.h" +#include "tool/plinko/lib/char.h" + +static const unsigned short kWides[][2] = { + {0x1100, 0x115F}, // HANGUL CHOSEONG KIYEOK..HANGUL CHOSEONG FILLER + {0x231A, 0x231B}, // WATCH..HOURGLASS + {0x2329, 0x2329}, // LEFT-POINTING ANGLE BRACKET + {0x232A, 0x232A}, // RIGHT-POINTING ANGLE BRACKET + {0x23E9, 0x23EC}, // BLACK RIGHT-POINTING DOUBLE TRIANGLE... + {0x23F0, 0x23F0}, // ALARM CLOCK + {0x23F3, 0x23F3}, // HOURGLASS WITH FLOWING SAND + {0x25FD, 0x25FE}, // WHITE MEDIUM SMALL SQUARE..BLACK MEDIUM SMALL SQUARE + {0x2614, 0x2615}, // UMBRELLA WITH RAIN DROPS..HOT BEVERAGE + {0x2648, 0x2653}, // ARIES..PISCES + {0x267F, 0x267F}, // WHEELCHAIR SYMBOL + {0x2693, 0x2693}, // ANCHOR + {0x26A1, 0x26A1}, // HIGH VOLTAGE SIGN + {0x26AA, 0x26AB}, // MEDIUM WHITE CIRCLE..MEDIUM BLACK CIRCLE + {0x26BD, 0x26BE}, // SOCCER BALL..BASEBALL + {0x26C4, 0x26C5}, // SNOWMAN WITHOUT SNOW..SUN BEHIND CLOUD + {0x26CE, 0x26CE}, // OPHIUCHUS + {0x26D4, 0x26D4}, // NO ENTRY + {0x26EA, 0x26EA}, // CHURCH + {0x26F2, 0x26F3}, // FOUNTAIN..FLAG IN HOLE + {0x26F5, 0x26F5}, // SAILBOAT + {0x26FA, 0x26FA}, // TENT + {0x26FD, 0x26FD}, // FUEL PUMP + {0x2705, 0x2705}, // WHITE HEAVY CHECK MARK + {0x270A, 0x270B}, // RaiseD FIST..RaiseD HAND + {0x2728, 0x2728}, // SPARKLES + {0x274C, 0x274C}, // CROSS MARK + {0x274E, 0x274E}, // NEGATIVE SQUARED CROSS MARK + {0x2753, 0x2755}, // BLACK QUESTION MARK ORNAMENT..WHITE EXCLAMATION MARK + {0x2757, 0x2757}, // HEAVY EXCLAMATION MARK SYMBOL + {0x2795, 0x2797}, // HEAVY PLUS SIGN..HEAVY DIVISION SIGN + {0x27B0, 0x27B0}, // CURLY LOOP + {0x27BF, 0x27BF}, // DOUBLE CURLY LOOP + {0x2B1B, 0x2B1C}, // BLACK LARGE SQUARE..WHITE LARGE SQUARE + {0x2B50, 0x2B50}, // WHITE MEDIUM STAR + {0x2B55, 0x2B55}, // HEAVY LARGE CIRCLE + {0x2E80, 0x2E99}, // CJK RADICAL REPEAT..CJK RADICAL RAP + {0x2E9B, 0x2EF3}, // CJK RADICAL CHOKE..CJK RADICAL C-SIMPLIFIED TURTLE + {0x2F00, 0x2FD5}, // KANGXI RADICAL ONE..KANGXI RADICAL FLUTE + {0x2FF0, 0x2FFB}, // IDEOGRAPHIC DESCRIPTION CHARACTER LTR..OVERLAID + {0x3000, 0x3000}, // IDEOGRAPHIC SPACE + {0x3001, 0x3003}, // IDEOGRAPHIC COMMA..DITTO MARK + {0x3004, 0x3004}, // JAPANESE INDUSTRIAL STANDARD SYMBOL + {0x3005, 0x3005}, // IDEOGRAPHIC ITERATION MARK + {0x3006, 0x3006}, // IDEOGRAPHIC CLOSING MARK + {0x3007, 0x3007}, // IDEOGRAPHIC NUMBER ZERO + {0x3008, 0x3008}, // LEFT ANGLE BRACKET + {0x3009, 0x3009}, // RIGHT ANGLE BRACKET + {0x300A, 0x300A}, // LEFT DOUBLE ANGLE BRACKET + {0x300B, 0x300B}, // RIGHT DOUBLE ANGLE BRACKET + {0x300C, 0x300C}, // LEFT CORNER BRACKET + {0x300D, 0x300D}, // RIGHT CORNER BRACKET + {0x300E, 0x300E}, // LEFT WHITE CORNER BRACKET + {0x300F, 0x300F}, // RIGHT WHITE CORNER BRACKET + {0x3010, 0x3010}, // LEFT BLACK LENTICULAR BRACKET + {0x3011, 0x3011}, // RIGHT BLACK LENTICULAR BRACKET + {0x3012, 0x3013}, // POSTAL MARK..GETA MARK + {0x3014, 0x3014}, // LEFT TORTOISE SHELL BRACKET + {0x3015, 0x3015}, // RIGHT TORTOISE SHELL BRACKET + {0x3016, 0x3016}, // LEFT WHITE LENTICULAR BRACKET + {0x3017, 0x3017}, // RIGHT WHITE LENTICULAR BRACKET + {0x3018, 0x3018}, // LEFT WHITE TORTOISE SHELL BRACKET + {0x3019, 0x3019}, // RIGHT WHITE TORTOISE SHELL BRACKET + {0x301A, 0x301A}, // LEFT WHITE SQUARE BRACKET + {0x301B, 0x301B}, // RIGHT WHITE SQUARE BRACKET + {0x301C, 0x301C}, // WAVE DASH + {0x301D, 0x301D}, // REVERSED DOUBLE PRIME QUOTATION MARK + {0x301E, 0x301F}, // DOUBLE PRIME QUOTATION MARK..LOW DOUBLE PRIME + {0x3020, 0x3020}, // POSTAL MARK FACE + {0x3021, 0x3029}, // HANGZHOU NUMERAL ONE..HANGZHOU NUMERAL NINE + {0x302A, 0x302D}, // IDEOGRAPHIC LEVEL TONE MARK..ENTERING TONE MARK + {0x302E, 0x302F}, // HANGUL SINGLE DOT TONE MARK..DOUBLE DOT TONE MARK + {0x3030, 0x3030}, // WAVY DASH + {0x3031, 0x3035}, // VERTICAL KANA REPEAT MARK..KANA REPEAT MARK LOWER + {0x3036, 0x3037}, // CIRCLED POSTAL MARK..IDEOGRAPHIC TELEGRAPH LF SYMBOL + {0x3038, 0x303A}, // HANGZHOU NUMERAL TEN..HANGZHOU NUMERAL THIRTY + {0x303B, 0x303B}, // VERTICAL IDEOGRAPHIC ITERATION MARK + {0x303C, 0x303C}, // MASU MARK + {0x303D, 0x303D}, // PART ALTERNATION MARK + {0x303E, 0x303E}, // IDEOGRAPHIC VARIATION INDICATOR + {0x3041, 0x3096}, // HIRAGANA LETTER SMALL A..HIRAGANA LETTER SMALL KE + {0x3099, 0x309A}, // COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK... + {0x309B, 0x309C}, // KATAKANA-HIRAGANA VOICED SOUND MARK... + {0x309D, 0x309E}, // HIRAGANA ITERATION MARK..VOICED ITERATION MARK + {0x309F, 0x309F}, // HIRAGANA DIGRAPH YORI + {0x30A0, 0x30A0}, // KATAKANA-HIRAGANA DOUBLE HYPHEN + {0x30A1, 0x30FA}, // KATAKANA LETTER SMALL A..KATAKANA LETTER VO + {0x30FB, 0x30FB}, // KATAKANA MIDDLE DOT + {0x30FC, 0x30FE}, // KATAKANA-HIRAGANA PROLONGED SOUND MARK..ITERATION + {0x30FF, 0x30FF}, // KATAKANA DIGRAPH KOTO + {0x3105, 0x312F}, // BOPOMOFO LETTER B..BOPOMOFO LETTER NN + {0x3131, 0x318E}, // HANGUL LETTER KIYEOK..HANGUL LETTER ARAEAE + {0x3190, 0x3191}, // IDEOGRAPHIC ANNOTATION LINKING MARK..REVERSE + {0x3192, 0x3195}, // IDEOGRAPHIC ANNOTATION ONE MARK..FOUR + {0x3196, 0x319F}, // IDEOGRAPHIC ANNOTATION TOP MARK..MAN + {0x31A0, 0x31BF}, // BOPOMOFO LETTER BU..BOPOMOFO LETTER AH + {0x31C0, 0x31E3}, // CJK STROKE T..CJK STROKE Q + {0x31F0, 0x31FF}, // KATAKANA LETTER SMALL KU..KATAKANA LETTER SMALL RO + {0x3200, 0x321E}, // PARENTHESIZED HANGUL KIYEOK..CHARACTER O HU + {0x3220, 0x3229}, // PARENTHESIZED IDEOGRAPH ONE..TEN + {0x322A, 0x3247}, // PARENTHESIZED IDEOGRAPH MOON..CIRCLED IDEOGRAPH KOTO + {0x3250, 0x3250}, // PARTNERSHIP SIGN + {0x3251, 0x325F}, // CIRCLED NUMBER TWENTY ONE..CIRCLED 35 + {0x3260, 0x327F}, // CIRCLED HANGUL KIYEOK..KOREAN STANDARD SYMBOL + {0x3280, 0x3289}, // CIRCLED IDEOGRAPH ONE..CIRCLED IDEOGRAPH TEN + {0x328A, 0x32B0}, // CIRCLED IDEOGRAPH MOON..CIRCLED IDEOGRAPH NIGHT + {0x32B1, 0x32BF}, // CIRCLED NUMBER THIRTY SIX..CIRCLED NUMBER FIFTY + {0x32C0, 0x32FF}, // TELEGRAPH SYMBOL FOR JANUARY..SQUARE ERA NAME REIWA + {0x3300, 0x33FF}, // SQUARE APAATO..SQUARE GAL + {0x3400, 0x4DBF}, // CJK UNIFIED IDEOGRAPH + {0x4E00, 0x9FFF}, // CJK UNIFIED IDEOGRAPH + {0xA000, 0xA014}, // YI SYLLABLE IT..YI SYLLABLE E + {0xA015, 0xA015}, // YI SYLLABLE WU + {0xA016, 0xA48C}, // YI SYLLABLE BIT..YI SYLLABLE YYR + {0xA490, 0xA4C6}, // YI RADICAL QOT..YI RADICAL KE + {0xA960, 0xA97C}, // HANGUL CHOSEONG TIKEUT-MIEUM..SSANGYEORINHIEUH + {0xAC00, 0xD7A3}, // HANGUL SYLLABLE GA..HANGUL SYLLABLE HIH + {0xF900, 0xFA6D}, // CJK COMPATIBILITY IDEOGRAPH + {0xFA6E, 0xFA6F}, // RESERVED + {0xFA70, 0xFAD9}, // CJK COMPATIBILITY IDEOGRAPH + {0xFADA, 0xFAFF}, // RESERVED + {0xFE10, 0xFE16}, // PRESENTATION FORM FOR VERTICAL COMMA..QUESTION + {0xFE17, 0xFE17}, // VERTICAL LEFT WHITE LENTICULAR BRACKET + {0xFE18, 0xFE18}, // VERTICAL RIGHT WHITE LENTICULAR BRAKCET + {0xFE19, 0xFE19}, // PRESENTATION FORM FOR VERTICAL HORIZONTAL ELLIPSIS + {0xFE30, 0xFE30}, // PRESENTATION FORM FOR VERTICAL TWO DOT LEADER + {0xFE31, 0xFE32}, // VERTICAL EM DASH..VERTICAL EN DASH + {0xFE33, 0xFE34}, // VERTICAL LOW LINE..VERTICAL WAVY LOW LINE + {0xFE35, 0xFE35}, // PRESENTATION FORM FOR VERTICAL LEFT PARENTHESIS + {0xFE36, 0xFE36}, // PRESENTATION FORM FOR VERTICAL RIGHT PARENTHESIS + {0xFE37, 0xFE37}, // PRESENTATION FORM FOR VERTICAL LEFT CURLY BRACKET + {0xFE38, 0xFE38}, // PRESENTATION FORM FOR VERTICAL RIGHT CURLY BRACKET + {0xFE39, 0xFE39}, // VERTICAL LEFT TORTOISE SHELL BRACKET + {0xFE3A, 0xFE3A}, // VERTICAL RIGHT TORTOISE SHELL BRACKET + {0xFE3B, 0xFE3B}, // VERTICAL LEFT BLACK LENTICULAR BRACKET + {0xFE3C, 0xFE3C}, // VERTICAL RIGHT BLACK LENTICULAR BRACKET + {0xFE3D, 0xFE3D}, // VERTICAL LEFT DOUBLE ANGLE BRACKET + {0xFE3E, 0xFE3E}, // VERTICAL RIGHT DOUBLE ANGLE BRACKET + {0xFE3F, 0xFE3F}, // VERTICAL LEFT ANGLE BRACKET + {0xFE40, 0xFE40}, // VERTICAL RIGHT ANGLE BRACKET + {0xFE41, 0xFE41}, // VERTICAL LEFT CORNER BRACKET + {0xFE42, 0xFE42}, // VERTICAL RIGHT CORNER BRACKET + {0xFE43, 0xFE43}, // VERTICAL LEFT WHITE CORNER BRACKET + {0xFE44, 0xFE44}, // VERTICAL RIGHT WHITE CORNER BRACKET + {0xFE45, 0xFE46}, // SESAME DOT..WHITE SESAME DOT + {0xFE47, 0xFE47}, // VERTICAL LEFT SQUARE BRACKET + {0xFE48, 0xFE48}, // VERTICAL RIGHT SQUARE BRACKET + {0xFE49, 0xFE4C}, // DASHED OVERLINE..DOUBLE WAVY OVERLINE + {0xFE4D, 0xFE4F}, // DASHED LOW LINE..WAVY LOW LINE + {0xFE50, 0xFE52}, // SMALL COMMA..SMALL FULL STOP + {0xFE54, 0xFE57}, // SMALL SEMICOLON..SMALL EXCLAMATION MARK + {0xFE58, 0xFE58}, // SMALL EM DASH + {0xFE59, 0xFE59}, // SMALL LEFT PARENTHESIS + {0xFE5A, 0xFE5A}, // SMALL RIGHT PARENTHESIS + {0xFE5B, 0xFE5B}, // SMALL LEFT CURLY BRACKET + {0xFE5C, 0xFE5C}, // SMALL RIGHT CURLY BRACKET + {0xFE5D, 0xFE5D}, // SMALL LEFT TORTOISE SHELL BRACKET + {0xFE5E, 0xFE5E}, // SMALL RIGHT TORTOISE SHELL BRACKET + {0xFE5F, 0xFE61}, // SMALL NUMBER SIGN..SMALL ASTERISK + {0xFE62, 0xFE62}, // SMALL PLUS SIGN + {0xFE63, 0xFE63}, // SMALL HYPHEN-MINUS + {0xFE64, 0xFE66}, // SMALL LESS-THAN SIGN..SMALL EQUALS SIGN + {0xFE68, 0xFE68}, // SMALL REVERSE SOLIDUS + {0xFE69, 0xFE69}, // SMALL DOLLAR SIGN + {0xFE6A, 0xFE6B}, // SMALL PERCENT SIGN..SMALL COMMERCIAL AT + {0xFF01, 0xFF03}, // EXCLAMATION MARK..NUMBER SIGN + {0xFF04, 0xFF04}, // DOLLAR SIGN + {0xFF05, 0xFF07}, // PERCENT SIGN..APOSTROPHE + {0xFF08, 0xFF08}, // LEFT PARENTHESIS + {0xFF09, 0xFF09}, // RIGHT PARENTHESIS + {0xFF0A, 0xFF0A}, // ASTERISK + {0xFF0B, 0xFF0B}, // PLUS SIGN + {0xFF0C, 0xFF0C}, // COMMA + {0xFF0D, 0xFF0D}, // HYPHEN-MINUS + {0xFF0E, 0xFF0F}, // FULL STOP..SOLIDUS + {0xFF10, 0xFF19}, // DIGIT ZERO..DIGIT NINE + {0xFF1A, 0xFF1B}, // COLON..SEMICOLON + {0xFF1C, 0xFF1E}, // LESS-THAN..GREATER-THAN + {0xFF1F, 0xFF20}, // QUESTION MARK..COMMERCIAL AT + {0xFF21, 0xFF3A}, // LATIN CAPITAL LETTER A..Z + {0xFF3B, 0xFF3B}, // LEFT SQUARE BRACKET + {0xFF3C, 0xFF3C}, // REVERSE SOLIDUS + {0xFF3D, 0xFF3D}, // RIGHT SQUARE BRACKET + {0xFF3E, 0xFF3E}, // CIRCUMFLEX ACCENT + {0xFF3F, 0xFF3F}, // LOW LINE + {0xFF40, 0xFF40}, // GRAVE ACCENT + {0xFF41, 0xFF5A}, // LATIN SMALL LETTER A..Z + {0xFF5B, 0xFF5B}, // LEFT CURLY BRACKET + {0xFF5C, 0xFF5C}, // VERTICAL LINE + {0xFF5D, 0xFF5D}, // RIGHT CURLY BRACKET + {0xFF5E, 0xFF5E}, // TILDE + {0xFF5F, 0xFF5F}, // LEFT WHITE PARENTHESIS + {0xFF60, 0xFF60}, // RIGHT WHITE PARENTHESIS + {0xFFE0, 0xFFE1}, // CENT SIGN..POUND SIGN + {0xFFE2, 0xFFE2}, // NOT SIGN + {0xFFE3, 0xFFE3}, // MACRON + {0xFFE4, 0xFFE4}, // BROKEN BAR + {0xFFE5, 0xFFE6}, // YEN SIGN..WON SIGN +}; + +static const int kAstralWides[][2] = { + {0x16FE0, 0x16FE1}, // TANGUT ITERATION MARK..NUSHU ITERATION MARK + {0x16FE2, 0x16FE2}, // OLD CHINESE HOOK MARK + {0x16FE3, 0x16FE3}, // OLD CHINESE ITERATION MARK + {0x16FE4, 0x16FE4}, // KHITAN SMALL SCRIPT FILLER + {0x16FF0, 0x16FF1}, // VIETNAMESE ALTERNATE READING MARK CA..NHAY + {0x17000, 0x187F7}, // TANGUT IDEOGRAPH + {0x18800, 0x18AFF}, // TANGUT COMPONENT + {0x18B00, 0x18CD5}, // KHITAN SMALL SCRIPT CHARACTER + {0x18D00, 0x18D08}, // TANGUT IDEOGRAPH + {0x1AFF0, 0x1AFF3}, // KATAKANA LETTER MINNAN TONE-2..5 + {0x1AFF5, 0x1AFFB}, // KATAKANA LETTER MINNAN TONE-7..5 + {0x1AFFD, 0x1AFFE}, // KATAKANA LETTER MINNAN NASALIZED TONE-7..8 + {0x1B000, 0x1B0FF}, // KATAKANA LETTER ARCHAIC E..HENTAIGANA LETTER RE-2 + {0x1B100, 0x1B122}, // HENTAIGANA LETTER RE-3..KATAKANA LETTER ARCHAIC WU + {0x1B150, 0x1B152}, // HIRAGANA LETTER SMALL WI..HIRAGANA LETTER SMALL WO + {0x1B164, 0x1B167}, // KATAKANA LETTER SMALL WI..KATAKANA LETTER SMALL N + {0x1B170, 0x1B2FB}, // NUSHU CHARACTER-1B170..NUSHU CHARACTER-1B2FB + {0x1F004, 0x1F004}, // MAHJONG TILE RED DRAGON + {0x1F0CF, 0x1F0CF}, // PLAYING CARD BLACK JOKER + {0x1F18E, 0x1F18E}, // NEGATIVE SQUARED AB + {0x1F191, 0x1F19A}, // SQUARED CL..SQUARED VS + {0x1F200, 0x1F202}, // SQUARE HIRAGANA HOKA..SQUARED KATAKANA SA + {0x1F210, 0x1F23B}, // SQUARED CJK UNIFIED IDEOGRAPH + {0x1F240, 0x1F248}, // TORTOISE SHELL BRACKETED CJK UNIFIED IDEOGRAPH + {0x1F250, 0x1F251}, // CIRCLED IDEOGRAPH ADVANTAGE..ACCEPT + {0x1F260, 0x1F265}, // ROUNDED SYMBOL FOR FU..ROUNDED SYMBOL FOR CAI + {0x1F300, 0x1F320}, // CYCLONE..SHOOTING STAR + {0x1F32D, 0x1F335}, // HOT DOG..CACTUS + {0x1F337, 0x1F37C}, // TULIP..BABY BOTTLE + {0x1F37E, 0x1F393}, // BOTTLE WITH POPPING CORK..GRADUATION CAP + {0x1F3A0, 0x1F3CA}, // CAROUSEL HORSE..SWIMMER + {0x1F3CF, 0x1F3D3}, // CRICKET BAT AND BALL..TABLE TENNIS PADDLE AND BALL + {0x1F3E0, 0x1F3F0}, // HOUSE BUILDING..EUROPEAN CASTLE + {0x1F3F4, 0x1F3F4}, // WAVING BLACK FLAG + {0x1F3F8, 0x1F3FA}, // BADMINTON RACQUET AND SHUTTLECOCK..AMPHORA + {0x1F3FB, 0x1F3FF}, // EMOJI MODIFIER FITZPATRICK TYPE-1-2..6 + {0x1F400, 0x1F43E}, // RAT..PAW PRINTS + {0x1F440, 0x1F440}, // EYES + {0x1F442, 0x1F4FC}, // EAR..VIDEOCASSETTE + {0x1F4FF, 0x1F53D}, // PRAYER BEADS..DOWN-POINTING SMALL RED TRIANGLE + {0x1F54B, 0x1F54E}, // KAABA..MENORAH WITH NINE BRANCHES + {0x1F550, 0x1F567}, // CLOCK FACE ONE OCLOCK..CLOCK FACE TWELVE-THIRTY + {0x1F57A, 0x1F57A}, // MAN DANCING + {0x1F595, 0x1F596}, // REVERSED HAND WITH MIDDLE FINGER EXTENDED..FINGERS + {0x1F5A4, 0x1F5A4}, // BLACK HEART + {0x1F5FB, 0x1F5FF}, // MOUNT FUJI..MOYAI + {0x1F600, 0x1F64F}, // GRINNING FACE..PERSON WITH FOLDED HANDS + {0x1F680, 0x1F6C5}, // ROCKET..LEFT LUGGAGE + {0x1F6CC, 0x1F6CC}, // SLEEPING ACCOMMODATION + {0x1F6D0, 0x1F6D2}, // PLACE OF WORSHIP..SHOPPING TROLLEY + {0x1F6D5, 0x1F6D7}, // HINDU TEMPLE..ELEVATOR + {0x1F6DD, 0x1F6DF}, // PLAYGROUND SLIDE..RING BUOY + {0x1F6EB, 0x1F6EC}, // AIRPLANE DEPARTURE..AIRPLANE ARRIVING + {0x1F6F4, 0x1F6FC}, // SCOOTER..ROLLER SKATE + {0x1F7E0, 0x1F7EB}, // LARGE ORANGE CIRCLE..LARGE BROWN SQUARE + {0x1F7F0, 0x1F7F0}, // HEAVY EQUALS SIGN + {0x1F90C, 0x1F93A}, // PINCHED FINGERS..FENCER + {0x1F93C, 0x1F945}, // WRESTLERS..GOAL NET + {0x1F947, 0x1F9FF}, // FIRST PLACE MEDAL..NAZAR AMULET + {0x1FA70, 0x1FA74}, // BALLET SHOES..THONG SANDAL + {0x1FA78, 0x1FA7C}, // DROP OF BLOOD..CRUTCH + {0x1FA80, 0x1FA86}, // YO-YO..NESTING DOLLS + {0x1FA90, 0x1FAAC}, // RINGED PLANET..HAMSA + {0x1FAB0, 0x1FABA}, // FLY..NEST WITH EGGS + {0x1FAC0, 0x1FAC5}, // ANATOMICAL HEART..PERSON WITH CROWN + {0x1FAD0, 0x1FAD9}, // BLUEBERRIES..JAR + {0x1FAE0, 0x1FAE7}, // MELTING FACE..BUBBLES + {0x1FAF0, 0x1FAF6}, // HAND WITH INDEX FINGER THUMB CROSSED..HEART HANDS + {0x20000, 0x2A6DF}, // CJK UNIFIED IDEOGRAPH + {0x2A6E0, 0x2A6FF}, // RESERVED + {0x2A700, 0x2B738}, // CJK UNIFIED IDEOGRAPH + {0x2B739, 0x2B73F}, // RESERVED + {0x2B740, 0x2B81D}, // CJK UNIFIED IDEOGRAPH + {0x2B81E, 0x2B81F}, // RESERVED + {0x2B820, 0x2CEA1}, // CJK UNIFIED IDEOGRAPH + {0x2CEA2, 0x2CEAF}, // RESERVED + {0x2CEB0, 0x2EBE0}, // CJK UNIFIED IDEOGRAPH + {0x2EBE1, 0x2F7FF}, // RESERVED + {0x2F800, 0x2FA1D}, // CJK COMPATIBILITY IDEOGRAPH + {0x2FA1E, 0x2FA1F}, // RESERVED + {0x2FA20, 0x2FFFD}, // RESERVED + {0x30000, 0x3134A}, // CJK UNIFIED IDEOGRAPH + {0x3134B, 0x3FFFD}, // RESERVED +}; + +pureconst bool IsWide(int c) { + int m, l, r, n; + if (c < 0x1100) { + return false; + } else if (c < 0x10000) { + l = 0; + r = n = sizeof(kWides) / sizeof(kWides[0]); + while (l < r) { + m = _midpoint(l, r); + if (kWides[m][1] < c) { + l = m + 1; + } else { + r = m; + } + } + return l < n && kWides[l][0] <= c && c <= kWides[l][1]; + } else { + l = 0; + r = n = sizeof(kAstralWides) / sizeof(kAstralWides[0]); + while (l < r) { + m = _midpoint(l, r); + if (kAstralWides[m][1] < c) { + l = m + 1; + } else { + r = m; + } + } + return l < n && kAstralWides[l][0] <= c && c <= kAstralWides[l][1]; + } +} + +pureconst int GetMonospaceCharacterWidth(int c) { + return !IsControl(c) + IsWide(c); +} diff --git a/tool/plinko/lib/isycombinator.c b/tool/plinko/lib/isycombinator.c new file mode 100644 index 000000000..9ddebec88 --- /dev/null +++ b/tool/plinko/lib/isycombinator.c @@ -0,0 +1,172 @@ +/*-*- 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/plinko/lib/plinko.h" + +/** + * Matches + * + * (⅄ (λ (N) ((λ (W) (W W)) (λ (V) (N (λ M ((V V) . M)))))) . Q) + * + * @return true if matches, otherwise false + * @note M must be a non-nil atom + * @note N must be a non-nil atom + * @note Q is ignored + * @note V must be a non-nil atom + * @note W must be a non-nil atom + * @note λ means LAMBDA + * @note ⅄ means CLOSURE + */ +bool IsYcombinator(int x_) { + dword w_; + if (x_ >= 0) return false; + w_ = Get(x_); + int ax_ = LO(w_); + int dx_ = HI(w_); + if (ax_ != kClosure) return false; + if (dx_ >= 0) return false; + w_ = Get(dx_); // ((λ (N) ((λ (W) (W W)) (λ (V) (N (λ M ((V V) . M)))))) . Q) + int adx_ = LO(w_); + int ddx_ = HI(w_); + if (adx_ >= 0) return false; + w_ = Get(adx_); // (λ (N) ((λ (W) (W W)) (λ (V) (N (λ M ((V V) . M)))))) + int aadx_ = LO(w_); + int dadx_ = HI(w_); + if (aadx_ != kLambda) return false; + if (dadx_ >= 0) return false; + w_ = Get(dadx_); // ((N) ((λ (W) (W W)) (λ (V) (N (λ M ((V V) . M)))))) + int adadx_ = LO(w_); + int ddadx_ = HI(w_); + if (adadx_ >= 0) return false; + w_ = Get(adadx_); // (N) + int aadadx_ = LO(w_); + int dadadx_ = HI(w_); + if (ddadx_ >= 0) return false; + w_ = Get(ddadx_); // (((λ (W) (W W)) (λ (V) (N (λ M ((V V) . M)))))) + int addadx_ = LO(w_); + int dddadx_ = HI(w_); + int N = aadadx_; + if (N <= 0) return false; + if (addadx_ >= 0) return false; + w_ = Get(addadx_); // ((λ (W) (W W)) (λ (V) (N (λ M ((V V) . M))))) + int aaddadx_ = LO(w_); + int daddadx_ = HI(w_); + if (dadadx_) return false; + if (dddadx_) return false; + if (aaddadx_ >= 0) return false; + w_ = Get(aaddadx_); // (λ (W) (W W)) + int aaaddadx_ = LO(w_); + int daaddadx_ = HI(w_); + if (daddadx_ >= 0) return false; + w_ = Get(daddadx_); // ((λ (V) (N (λ M ((V V) . M))))) + int adaddadx_ = LO(w_); + int ddaddadx_ = HI(w_); + if (aaaddadx_ != kLambda) return false; + if (adaddadx_ >= 0) return false; + w_ = Get(adaddadx_); // (λ (V) (N (λ M ((V V) . M)))) + int aadaddadx_ = LO(w_); + int dadaddadx_ = HI(w_); + if (daaddadx_ >= 0) return false; + w_ = Get(daaddadx_); // ((W) (W W)) + int adaaddadx_ = LO(w_); + int ddaaddadx_ = HI(w_); + if (ddaddadx_) return false; + if (adaaddadx_ >= 0) return false; + w_ = Get(adaaddadx_); // (W) + int aadaaddadx_ = LO(w_); + int dadaaddadx_ = HI(w_); + if (aadaddadx_ != kLambda) return false; + if (ddaaddadx_ >= 0) return false; + w_ = Get(ddaaddadx_); // ((W W)) + int addaaddadx_ = LO(w_); + int dddaaddadx_ = HI(w_); + if (dadaddadx_ >= 0) return false; + w_ = Get(dadaddadx_); // ((V) (N (λ M ((V V) . M)))) + int adadaddadx_ = LO(w_); + int ddadaddadx_ = HI(w_); + int W = aadaaddadx_; + if (W <= 0) return false; + if (adadaddadx_ >= 0) return false; + w_ = Get(adadaddadx_); // (V) + int aadadaddadx_ = LO(w_); + int dadadaddadx_ = HI(w_); + if (addaaddadx_ >= 0) return false; + w_ = Get(addaaddadx_); // (W W) + int aaddaaddadx_ = LO(w_); + int daddaaddadx_ = HI(w_); + if (ddadaddadx_ >= 0) return false; + w_ = Get(ddadaddadx_); // ((N (λ M ((V V) . M)))) + int addadaddadx_ = LO(w_); + int dddadaddadx_ = HI(w_); + if (dadaaddadx_) return false; + int V = aadadaddadx_; + if (V <= 0) return false; + if (dddaaddadx_) return false; + if (addadaddadx_ >= 0) return false; + w_ = Get(addadaddadx_); // (N (λ M ((V V) . M))) + int aaddadaddadx_ = LO(w_); + int daddadaddadx_ = HI(w_); + if (aaddaaddadx_ != W) return false; + if (dadadaddadx_) return false; + if (daddaaddadx_ >= 0) return false; + w_ = Get(daddaaddadx_); // (W) + int adaddaaddadx_ = LO(w_); + int ddaddaaddadx_ = HI(w_); + if (dddadaddadx_) return false; + if (adaddaaddadx_ != W) return false; + if (aaddadaddadx_ != N) return false; + if (ddaddaaddadx_) return false; + if (daddadaddadx_ >= 0) return false; + w_ = Get(daddadaddadx_); // ((λ M ((V V) . M))) + int adaddadaddadx_ = LO(w_); + int ddaddadaddadx_ = HI(w_); + if (adaddadaddadx_ >= 0) return false; + w_ = Get(adaddadaddadx_); // (λ M ((V V) . M)) + int aadaddadaddadx_ = LO(w_); + int dadaddadaddadx_ = HI(w_); + if (ddaddadaddadx_) return false; + if (aadaddadaddadx_ != kLambda) return false; + if (dadaddadaddadx_ >= 0) return false; + w_ = Get(dadaddadaddadx_); // (M ((V V) . M)) + int adadaddadaddadx_ = LO(w_); + int ddadaddadaddadx_ = HI(w_); + int M = adadaddadaddadx_; + if (M <= 0) return false; + if (ddadaddadaddadx_ >= 0) return false; + w_ = Get(ddadaddadaddadx_); // (((V V) . M)) + int addadaddadaddadx_ = LO(w_); + int dddadaddadaddadx_ = HI(w_); + if (addadaddadaddadx_ >= 0) return false; + w_ = Get(addadaddadaddadx_); // ((V V) . M) + int aaddadaddadaddadx_ = LO(w_); + int daddadaddadaddadx_ = HI(w_); + if (dddadaddadaddadx_) return false; + if (aaddadaddadaddadx_ >= 0) return false; + w_ = Get(aaddadaddadaddadx_); // (V V) + int aaaddadaddadaddadx_ = LO(w_); + int daaddadaddadaddadx_ = HI(w_); + if (daddadaddadaddadx_ != M) return false; + if (aaaddadaddadaddadx_ != V) return false; + if (daaddadaddadaddadx_ >= 0) return false; + w_ = Get(daaddadaddadaddadx_); // (V) + int adaaddadaddadaddadx_ = LO(w_); + int ddaaddadaddadaddadx_ = HI(w_); + if (adaaddadaddadaddadx_ != V) return false; + if (ddaaddadaddadaddadx_) return false; + return true; +} diff --git a/tool/plinko/lib/ktpenc.c b/tool/plinko/lib/ktpenc.c new file mode 100644 index 000000000..20d061a46 --- /dev/null +++ b/tool/plinko/lib/ktpenc.c @@ -0,0 +1,24 @@ +/*-*- 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. │ +╚─────────────────────────────────────────────────────────────────────────────*/ + +const short kTpEnc[25] = {0140001, 0140001, 0140001, 0140001, 0160002, + 0160002, 0160002, 0160002, 0160002, 0170003, + 0170003, 0170003, 0170003, 0170003, 0174004, + 0174004, 0174004, 0174004, 0174004, 0176005, + 0176005, 0176005, 0176005, 0176005, 0176005}; diff --git a/tool/plinko/lib/ktpenc.h b/tool/plinko/lib/ktpenc.h new file mode 100644 index 000000000..3c8a1d366 --- /dev/null +++ b/tool/plinko/lib/ktpenc.h @@ -0,0 +1,10 @@ +#ifndef COSMOPOLITAN_TOOL_PLINKO_LIB_KTPENC_H_ +#define COSMOPOLITAN_TOOL_PLINKO_LIB_KTPENC_H_ +#if !(__ASSEMBLER__ + __LINKER__ + 0) +COSMOPOLITAN_C_START_ + +extern const short kTpEnc[25]; + +COSMOPOLITAN_C_END_ +#endif /* !(__ASSEMBLER__ + __LINKER__ + 0) */ +#endif /* COSMOPOLITAN_TOOL_PLINKO_LIB_KTPENC_H_ */ diff --git a/tool/plinko/lib/lib.mk b/tool/plinko/lib/lib.mk new file mode 100644 index 000000000..58c546f32 --- /dev/null +++ b/tool/plinko/lib/lib.mk @@ -0,0 +1,74 @@ +#-*-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_PLINKO_LIB + +TOOL_PLINKO_LIB_ARTIFACTS += TOOL_PLINKO_LIB_A +TOOL_PLINKO_LIB = $(TOOL_PLINKO_LIB_A_DEPS) $(TOOL_PLINKO_LIB_A) +TOOL_PLINKO_LIB_A = o/$(MODE)/tool/plinko/lib/plinkolib.a +TOOL_PLINKO_LIB_A_FILES := $(filter-out %/.%,$(wildcard tool/plinko/lib/*)) +TOOL_PLINKO_LIB_A_HDRS = $(filter %.h,$(TOOL_PLINKO_LIB_A_FILES)) +TOOL_PLINKO_LIB_A_SRCS_S = $(filter %.S,$(TOOL_PLINKO_LIB_A_FILES)) +TOOL_PLINKO_LIB_A_SRCS_C = $(filter %.c,$(TOOL_PLINKO_LIB_A_FILES)) + +TOOL_PLINKO_LIB_A_CHECKS = \ + $(TOOL_PLINKO_LIB_A_HDRS:%=o/$(MODE)/%.ok) \ + $(TOOL_PLINKO_LIB_A).pkg + +TOOL_PLINKO_LIB_A_SRCS = \ + $(TOOL_PLINKO_LIB_A_SRCS_S) \ + $(TOOL_PLINKO_LIB_A_SRCS_C) + +TOOL_PLINKO_LIB_A_OBJS = \ + $(TOOL_PLINKO_LIB_A_SRCS_S:%.S=o/$(MODE)/%.o) \ + $(TOOL_PLINKO_LIB_A_SRCS_C:%.c=o/$(MODE)/%.o) + +TOOL_PLINKO_LIB_A_DIRECTDEPS = \ + LIBC_BITS \ + LIBC_CALLS \ + LIBC_FMT \ + LIBC_INTRIN \ + LIBC_LOG \ + LIBC_MEM \ + LIBC_NEXGEN32E \ + LIBC_RAND \ + LIBC_RUNTIME \ + LIBC_SOCK \ + LIBC_STDIO \ + LIBC_STR \ + LIBC_STUBS \ + LIBC_SYSV \ + THIRD_PARTY_COMPILER_RT \ + THIRD_PARTY_GETOPT + +TOOL_PLINKO_LIB_A_DEPS := \ + $(call uniq,$(foreach x,$(TOOL_PLINKO_LIB_A_DIRECTDEPS),$($(x)))) + +$(TOOL_PLINKO_LIB_A): \ + $(TOOL_PLINKO_LIB_A).pkg \ + $(TOOL_PLINKO_LIB_A_OBJS) + +$(TOOL_PLINKO_LIB_A).pkg: \ + $(TOOL_PLINKO_LIB_A_OBJS) \ + $(foreach x,$(TOOL_PLINKO_LIB_A_DIRECTDEPS),$($(x)_A).pkg) + +ifeq ($(MODE),) +$(TOOL_PLINKO_LIB_A_OBJS): OVERRIDE_CFLAGS += -fno-inline +endif + +ifeq ($(MODE),dbg) +$(TOOL_PLINKO_LIB_A_OBJS): OVERRIDE_CFLAGS += -fno-inline +endif + +$(TOOL_PLINKO_LIB_A_OBJS): OVERRIDE_CFLAGS += -ffast-math -foptimize-sibling-calls -O2 + +TOOL_PLINKO_LIB_LIBS = $(foreach x,$(TOOL_PLINKO_LIB_ARTIFACTS),$($(x))) +TOOL_PLINKO_LIB_SRCS = $(foreach x,$(TOOL_PLINKO_LIB_ARTIFACTS),$($(x)_SRCS)) +TOOL_PLINKO_LIB_HDRS = $(foreach x,$(TOOL_PLINKO_LIB_ARTIFACTS),$($(x)_HDRS)) +TOOL_PLINKO_LIB_BINS = $(foreach x,$(TOOL_PLINKO_LIB_ARTIFACTS),$($(x)_BINS)) +TOOL_PLINKO_LIB_CHECKS = $(foreach x,$(TOOL_PLINKO_LIB_ARTIFACTS),$($(x)_CHECKS)) +TOOL_PLINKO_LIB_OBJS = $(foreach x,$(TOOL_PLINKO_LIB_ARTIFACTS),$($(x)_OBJS)) +TOOL_PLINKO_LIB_TESTS = $(foreach x,$(TOOL_PLINKO_LIB_ARTIFACTS),$($(x)_TESTS)) + +.PHONY: o/$(MODE)/tool/plinko/lib +o/$(MODE)/tool/plinko/lib: $(TOOL_PLINKO_LIB_CHECKS) diff --git a/tool/plinko/lib/library.lisp b/tool/plinko/lib/library.lisp new file mode 100644 index 000000000..911c45d87 --- /dev/null +++ b/tool/plinko/lib/library.lisp @@ -0,0 +1,570 @@ +#| plinko - a really fast lisp tarpit + | 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. + |# + +(DEFINE YCOMBINATOR + (LAMBDA (F) + ((LAMBDA (G) + (G G)) + (LAMBDA (G) + (F (LAMBDA A + ((G G) . A))))))) + +(DEFINE REVERSE + (YCOMBINATOR + (LAMBDA (REVERSE) + (LAMBDA (X Y) + (COND (X (REVERSE (CDR X) (CONS (CAR X) Y))) + (Y)))))) + +(DEFINE COPY + (YCOMBINATOR + (LAMBDA (COPY) + (LAMBDA (X R) + (COND ((ATOM X) X) + ((CONS (COPY (CAR X)) + (COPY (CDR X))))))))) + +(DEFINE ISPRECIOUS + (LAMBDA (X) + (COND ((EQ X NIL)) + ((EQ X T)) + ((EQ X EQ)) + ((EQ X CMP)) + ((EQ X CAR)) + ((EQ X CDR)) + ((EQ X BETA)) + ((EQ X ATOM)) + ((EQ X COND)) + ((EQ X CONS)) + ((EQ X FORK)) + ((EQ X QUOTE)) + ((EQ X MACRO)) + ((EQ X LAMBDA)) + ((EQ X DEFINE)) + ((EQ X EXPAND)) + ((EQ X CLOSURE)) + ((EQ X PARTIAL)) + ((EQ X FUNCTION)) + ((EQ X INTEGRATE)) + ((EQ X GC)) + ((EQ X READ)) + ((EQ X DUMP)) + ((EQ X EXIT)) + ((EQ X PROGN)) + ((EQ X QUIET)) + ((EQ X ERROR)) + ((EQ X TRACE)) + ((EQ X PRINT)) + ((EQ X PRINC)) + ((EQ X FLUSH)) + ((EQ X GENSYM)) + ((EQ X PPRINT)) + ((EQ X IGNORE)) + ((EQ X MTRACE)) + ((EQ X FTRACE)) + ((EQ X GTRACE)) + ((EQ X PRINTHEAP)) + ((EQ X IMPOSSIBLE))))) + +(DEFINE QUOTH + (MACRO (X) + (CONS QUOTE (CONS X)))) + +(DEFINE ISQUOTE + (LAMBDA (X) + (COND (X (COND ((ATOM X) NIL) + ((EQ (CAR X) QUOTE)))) + (T)))) + +(DEFINE QUOTECONS + (LAMBDA (A B) + (COND ((COND ((ISQUOTE A) + (ISQUOTE B))) + (CONS QUOTE (CONS (CONS (CAR (CDR A)) + (CAR (CDR B)))))) + ((CONS CONS (CONS A (COND (B (CONS B))))))))) + +(DEFINE BACKQUOTER + (YCOMBINATOR + (LAMBDA (BACKQUOTER) + (LAMBDA (X) + (COND ((ATOM X) + (COND ((ISPRECIOUS X) X) + ((CONS QUOTE (CONS X NIL))))) + ((EQ (CAR X) 'COMMA_) (CAR (CDR X))) + ((COND ((ATOM (CAR X)) NIL) + ((EQ (CAR (CAR X)) 'SPLICE_))) + (CAR (CDR (CAR X)))) + ((QUOTECONS + (BACKQUOTER (CAR X)) + (BACKQUOTER (CDR X))))))))) + +(DEFINE CURLY_ QUOTH) +(DEFINE STRING_ QUOTH) +(DEFINE SQUARE_ QUOTH) +(DEFINE BACKQUOTE_ (MACRO (X) (BACKQUOTER X))) + +(DEFINE > + (MACRO (X Y) + `(EQ (CMP ,X ,Y) T))) + +(DEFINE <= + (MACRO (X Y) + `(EQ (EQ (CMP ,X ,Y) T)))) + +(DEFINE >= + (MACRO (X Y) + `(ATOM (CMP ,X ,Y)))) + +(DEFINE < + (MACRO (X Y) + `(EQ (ATOM (CMP ,X ,Y))))) + +(DEFINE NOT + (MACRO (P) + `(EQ ,P))) + +(DEFINE IMPLIES + ((LAMBDA (IMPLIES) + (MACRO A (IMPLIES A))) + (YCOMBINATOR + (LAMBDA (IMPLIES) + (LAMBDA (A) + (COND (A `(COND (,(CAR A) + ,(COND ((CDR (CDR A)) + (IMPLIES (CDR A))) + ((CAR (CDR A))))) + (T))) + (T))))))) + +(DEFINE AND + ((LAMBDA (AND) + (MACRO A + (IMPLIES A (AND A)))) + (YCOMBINATOR + (LAMBDA (AND) + (LAMBDA (A) + (COND ((CDR A) + (CONS COND (CONS (CONS (CAR A) (CONS (AND (CDR A))))))) + ((CAR A)))))))) + +(DEFINE OR + ((LAMBDA (OR) + (MACRO A + (COND (A (COND ((CDR A) + (CONS COND (OR A))) + ((CAR A))))))) + (YCOMBINATOR + (LAMBDA (OR) + (LAMBDA (A) + (COND (A (CONS (CONS (CAR A)) + (OR (CDR A)))))))))) + +(DEFINE IFF + (MACRO (P Q) + ((LAMBDA (S) + `((LAMBDA (,S) + (COND (,P ,S) + (,S NIL) + (T))) + ,Q)) + (GENSYM)))) + +(DEFINE ISUPPER + (AND (>= 'A) + (<= 'Z))) + +(DEFINE ISLOWER + (AND (>= "A") + (<= "Z"))) + +(DEFINE CONDISTRIVIAL + (YCOMBINATOR + (LAMBDA (CONDISTRIVIAL) + (LAMBDA (ISTRIVIAL) + (LAMBDA (X) + (OR (EQ X) + (AND (AND (ISTRIVIAL (CAR (CAR X))) + (OR (EQ (CDR (CAR X))) + (ISTRIVIAL (CAR (CDR (CAR X)))))) + ((CONDISTRIVIAL ISTRIVIAL) (CDR X))))))))) + +(DEFINE ISTRIVIAL + (YCOMBINATOR + (LAMBDA (ISTRIVIAL) + (LAMBDA (X) + (COND ((ATOM X)) + ((EQ (CAR X) QUOTE)) + ((OR (EQ (CAR X) CAR) + (EQ (CAR X) CDR) + (EQ (CAR X) ATOM)) + (ISTRIVIAL (CAR (CDR X)))) + ((OR (EQ (CAR X) EQ) + (EQ (CAR X) CMP)) + (AND (ISTRIVIAL (CAR (CDR X))) + (ISTRIVIAL (CAR (CDR (CDR X)))))) + ((EQ (CAR X) COND) + ((CONDISTRIVIAL ISTRIVIAL) (CDR X)))))))) + +(DEFINE EQUAL + ((LAMBDA (EQUAL) + (MACRO X + (COND ((NOT X) + (ERROR '(NEED ARGUMENTS))) + ((NOT (CDR X)) + `(EQ ,(CAR X))) + ((NOT (CDR (CDR X))) + `(EQ (CMP ,(CAR X) ,(CAR (CDR X))))) + ((ATOM (CAR X)) + (EQUAL (CAR X) (CDR X))) + (((LAMBDA (S) + `((LAMBDA (,S) + ,(EQUAL S (CDR X))) + ,(CAR X))) + (GENSYM)))))) + (YCOMBINATOR + (LAMBDA (EQUAL) + (LAMBDA (S X) + (COND ((CDR X) + `(COND ((EQ (CMP ,S ,(CAR X))) + ,(EQUAL S (CDR X))))) + (`(EQ (CMP ,S ,(CAR X)))))))))) + +(DEFINE LIST + (LAMBDA A + A)) + +(DEFINE IF + (MACRO (X A B) + (COND (B `(COND (,X ,A) + (,B))) + ((ERROR (LIST (LIST 'CONSIDER (LIST 'AND X A)) + (LIST 'INSTEAD 'OF (LIST 'IF X A)))))))) + +(DEFINE CURRY + (LAMBDA (F X) + (LAMBDA A + (F X . A)))) + +(DEFINE APPEND + (LAMBDA (X Y) + (COND (Y ((LAMBDA (F) + (F F X)) + (LAMBDA (F X) + (COND (X (CONS (CAR X) (F F (CDR X)))) + (Y))))) + (X)))) + +(DEFINE -APPEND + (YCOMBINATOR + (LAMBDA (-APPEND) + (LAMBDA (Y X) + (COND (X (CONS (CAR X) (-APPEND Y (CDR X)))) + (Y)))))) + +(DEFINE APPEND + (LAMBDA (X Y) + (COND (Y (-APPEND Y X)) + (X)))) + +(DEFINE KEEP + (LAMBDA (X Y) + (COND ((EQUAL X Y) X) + (Y)))) + +(DEFINE PEEL + (LAMBDA (X Y) + (COND ((EQUAL X (CAR Y)) Y) + ((CONS X Y))))) + +(DEFINE AKEYS + (YCOMBINATOR + (LAMBDA (AKEYS) + (LAMBDA (X) + (COND (X (CONS (CAR (CAR X)) + (AKEYS (CDR X))))))))) + +(DEFINE EVAL + (LAMBDA (X A) + ((CONS CLOSURE (CONS (CONS LAMBDA (CONS () (CONS X))) A))))) + +(DEFINE HASATOM + (YCOMBINATOR + (LAMBDA (HASATOM) + (LAMBDA (V Z) + (COND ((EQ V Z)) + ((ATOM Z) NIL) + ((HASATOM V (CAR Z))) + ((HASATOM V (CDR Z)))))))) + +(DEFINE COND-FREEVARS + (YCOMBINATOR + (LAMBDA (COND-FREEVARS) + (LAMBDA (FREEVARS X R S) + (COND ((ATOM X) R) + ((COND-FREEVARS + FREEVARS + (CDR X) + (FREEVARS (CAR (CAR X)) + (COND ((CDR (CAR X)) + (FREEVARS (CAR (CDR (CAR X))) R S)) + (R)) + S) + S))))))) + +(DEFINE LIST-FREEVARS + (YCOMBINATOR + (LAMBDA (LIST-FREEVARS) + (LAMBDA (FREEVARS X R S) + (COND ((ATOM X) + (FREEVARS X R S)) + (((LAMBDA (Y) + (LIST-FREEVARS FREEVARS (CDR X) Y S)) + (FREEVARS (CAR X) R S)))))))) + +(DEFINE FREEVARS + (YCOMBINATOR + (LAMBDA (FREEVARS) + (LAMBDA (X R S) + (COND ((ATOM X) + (COND ((ISPRECIOUS X) R) + ((HASATOM X S) R) + ((CONS X R)))) + ((EQ (CAR X) QUOTE) R) + ((EQ (CAR X) CLOSURE) R) + ((EQ (CAR X) LAMBDA) + (FREEVARS (CAR (CDR (CDR X))) R (CONS (CAR (CDR X)) S))) + ((EQ (CAR X) COND) + (COND-FREEVARS FREEVARS (CDR X) R S)) + ((LIST-FREEVARS FREEVARS X R S))))))) + +(DEFINE DEFUN + (MACRO (F A B) + (COND ((HASATOM F (FREEVARS B)) + `(DEFINE ,F + (YCOMBINATOR + (LAMBDA (,F) + (LAMBDA ,A + ,B))))) + (`(DEFINE ,F + (LAMBDA ,A + ,B)))))) + +(DEFINE DEFMACRO + (MACRO (F A B) + (COND ((HASATOM F (FREEVARS B)) + `(DEFINE ,F + (MACRO A + ((YCOMBINATOR + (LAMBDA (,F) + (LAMBDA ,A + ,B))) + . A)))) + (`(DEFINE ,F + (MACRO ,A + ,B)))))) + +(DEFUN -REQUIRED (XS) + (ERROR 'PARAMETER (LIST XS) 'IS 'REQUIRED)) + +(DEFMACRO REQUIRED (X) + `(COND (,X) ((-REQUIRED ',X)))) + +(DEFUN -TEST1 (X XS) + (OR (EQ X T) + (ERROR (LIST (LIST 'ERROR (LIST 'TEST XS)) + (LIST 'WANT T) + (LIST 'GOT X))))) + +(DEFUN -TEST2 (X XS Y YS) + (OR (EQUAL X Y) + (IF (EQUAL X XS) + (ERROR (LIST (LIST 'ERROR 'FAILED (LIST 'TEST XS YS)) + (LIST 'WANT X) + (LIST 'GOT Y))) + (ERROR (LIST (LIST 'ERROR 'FAILED (LIST 'TEST XS YS)) + (LIST 'GOT Y)))))) + +(DEFMACRO TEST A + (COND ((EQ A) + (ERROR '(NEED ARGUMENTS))) + ((EQ (CDR A)) + `(IGNORE (-TEST1 (QUIET ,(CAR A)) ',(CAR A)))) + ((EQ (CDR (CDR A))) + `(IGNORE (-TEST2 (QUIET ,(CAR A)) ',(CAR A) + (QUIET ,(CAR (CDR A))) ',(CAR (CDR A))))) + ((EQ A) + (ERROR '(TOO MANY ARGUMENTS))))) + +(DEFMACRO ASSERT (A) + `(PROGN (-TEST T ,A T ',A) NIL)) + +(DEFUN MEMBER (X Y) + (COND (Y (COND ((EQUAL X (CAR Y)) Y) + ((MEMBER X (CDR Y))))))) + +(DEFUN SUBSET (X Y) + (IMPLIES X (AND (MEMBER (CAR X) Y) + (SUBSET (CDR X) Y)))) + +(DEFUN INTERSECTION (X Y) + (AND X (OR (AND (CAR X) (MEMBER (CAR X) Y) + (INTERSECTION (CDR X) Y)) + (INTERSECTION (CDR X) Y)))) + +(DEFUN UNION (X Y) + (COND (X (COND ((MEMBER (CAR X) Y) + (UNION (CDR X) Y)) + ((CONS (CAR X) (UNION (CDR X) Y))))) + (Y))) + +(DEFUN AKEYS (X) + (COND (X (CONS (CAR (CAR X)) + (AKEYS (CDR X)))))) + +(DEFUN AVALS (X) + (COND (X (CONS (CAR (CDR (CAR X))) + (AVALS (CDR X)))))) + +(DEFMACRO CAAR (X) `(CAR (CAR ,X))) +(DEFMACRO CADR (X) `(CAR (CDR ,X))) +(DEFMACRO CDAR (X) `(CDR (CAR ,X))) +(DEFMACRO CDDR (X) `(CDR (CDR ,X))) +(DEFMACRO CAAAR (X) `(CAR (CAR (CAR ,X)))) +(DEFMACRO CAADR (X) `(CAR (CAR (CDR ,X)))) +(DEFMACRO CADAR (X) `(CAR (CDR (CAR ,X)))) +(DEFMACRO CADDR (X) `(CAR (CDR (CDR ,X)))) +(DEFMACRO CDAAR (X) `(CDR (CAR (CAR ,X)))) +(DEFMACRO CDADR (X) `(CDR (CAR (CDR ,X)))) +(DEFMACRO CDDAR (X) `(CDR (CDR (CAR ,X)))) +(DEFMACRO CDDDR (X) `(CDR (CDR (CDR ,X)))) +(DEFMACRO CAAAAR (X) `(CAR (CAR (CAR (CAR ,X))))) +(DEFMACRO CAAADR (X) `(CAR (CAR (CAR (CDR ,X))))) +(DEFMACRO CAADAR (X) `(CAR (CAR (CDR (CAR ,X))))) +(DEFMACRO CAADDR (X) `(CAR (CAR (CDR (CDR ,X))))) +(DEFMACRO CADAAR (X) `(CAR (CDR (CAR (CAR ,X))))) +(DEFMACRO CADADR (X) `(CAR (CDR (CAR (CDR ,X))))) +(DEFMACRO CADDAR (X) `(CAR (CDR (CDR (CAR ,X))))) +(DEFMACRO CADDDR (X) `(CAR (CDR (CDR (CDR ,X))))) +(DEFMACRO CDAAAR (X) `(CDR (CAR (CAR (CAR ,X))))) +(DEFMACRO CDAADR (X) `(CDR (CAR (CAR (CDR ,X))))) +(DEFMACRO CDADAR (X) `(CDR (CAR (CDR (CAR ,X))))) +(DEFMACRO CDADDR (X) `(CDR (CAR (CDR (CDR ,X))))) +(DEFMACRO CDDAAR (X) `(CDR (CDR (CAR (CAR ,X))))) +(DEFMACRO CDDADR (X) `(CDR (CDR (CAR (CDR ,X))))) +(DEFMACRO CDDDAR (X) `(CDR (CDR (CDR (CAR ,X))))) +(DEFMACRO CDDDDR (X) `(CDR (CDR (CDR (CDR ,X))))) +(DEFMACRO CADDDDR (X) `(CAR (CDR (CDR (CDR (CDR ,X)))))) + +(DEFUN ISCONST (P) + (COND ((EQ P NIL)) + ((EQ P T)))) + +(DEFMACRO NAND (P Q) + (COND ((COND ((ISCONST P) + (ISCONST Q))) + (IMPLIES P (IMPLIES Q NIL))) + (`(IMPLIES ,P (IMPLIES ,Q NIL))))) + +(DEFMACRO XOR (P Q) + (COND ((COND ((ISCONST P) + (ISCONST Q))) + (COND (P (NOT Q)) + (Q))) + (P `((LAMBDA (A B) + (COND (A (COND (B NIL) (A))) + (B (COND (A NIL) (B))))) + ,P + ,Q)))) + +(DEFMACRO LET (VARS EXPR) + `((LAMBDA ,(AKEYS VARS) ,EXPR) + ,@(AVALS VARS))) + +(DEFMACRO LET* (((A B) . C) E) + (IF A `((LAMBDA (,A) ,(LET* C E)) ,B) E)) + +(DEFUN LAST (X R) + (IF X (LAST (CDR X) (CAR X)) R)) + +(DEFUN ASSOC (X Y D) + (AND Y (IF (EQUAL X (CAR (CAR Y))) + (CAR Y) + (ASSOC X (CDR Y))))) + +(DEFUN ADDSET (X Y) + (IF (MEMBER X Y) Y (CONS X Y))) + +(DEFUN REVERSE-MAPCAR (F X C R) + (IF X (REVERSE-MAPCAR F (CDR X) C ((OR C CONS) (F (CAR X)) R)) R)) + +(DEFUN MAPCAR (F X) + (AND X (CONS (F (CAR X)) (MAPCAR F (CDR X))))) + +(DEFUN MAPSET (F X R) + (IF X (MAPSET F (CDR X) (ADDSET (F (CAR X)) R)) (REVERSE R))) + +(DEFINE REDUCE + ((LAMBDA (G) + (LAMBDA (F X) + (IF (CDR X) (G F (CDR X) (CAR X)) (CAR X)))) + (YCOMBINATOR + (LAMBDA (G) + (LAMBDA (F X A) + (IF X (G F (CDR X) (F A (CAR X))) A)))))) + +(DEFUN ALL (X) + (IMPLIES X (REDUCE AND X))) + +(DEFUN ANY (X) + (REDUCE OR X)) + +(DEFUN PAIRWISE (X R) + (IF X + (PAIRWISE (CDDR X) (CONS (CONS (CAR X) (CADR X)) R)) + (REVERSE R))) + +(DEFMACRO DOLIST ((A B) F) + `(MAPCAR (LAMBDA (,A) ,F) ,B)) + +(DEFMACRO REVERSE-DOLIST ((A B C R) F) + `(REVERSE-MAPCAR (LAMBDA (,A) ,F) ,B ,C ,R)) + +(DEFUN PAIRLIS (X Y A) + (COND ((EQ X) A) + ((ATOM X) (CONS (CONS X (CONS Y)) A)) + ((ATOM Y) (ERROR '(ARGUMENT STRUCTURE) X Y)) + ((LET ((A (PAIRLIS (CDR X) (CDR Y) A))) + (COND ((CAR X) (PAIRLIS (CAR X) (CAR Y) A)) + (A)))))) + +(DEFUN JOIN (S X) + (COND ((EQ X) NIL) + ((EQ (CDR X) NIL) (CONS (CAR X))) + ((CONS (CAR X) (CONS S (JOIN S (CDR X))))))) + +(DEFUN GETVAR (V A) + (AND A (COND ((EQ V (CAAR A)) (CAR A)) + ((GETVAR V (CDR A)))))) + +(DEFUN GROUPBY (F X K G R) + (IF X (LET ((J (F (CAR X)))) + (IF (EQUAL J K) + (GROUPBY F (CDR X) K (CONS (CAR X) G) R) + (GROUPBY F (CDR X) J (CONS (CAR X)) + (OR (AND G (CONS (CONS K (REVERSE G)) R)) R)))) + (REVERSE (OR (AND G (CONS (CONS K (REVERSE G)) R)) R)))) diff --git a/tool/plinko/lib/makesclosures.c b/tool/plinko/lib/makesclosures.c new file mode 100644 index 000000000..e01f4f6b0 --- /dev/null +++ b/tool/plinko/lib/makesclosures.c @@ -0,0 +1,49 @@ +/*-*- 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/plinko/lib/plinko.h" + +bool MakesClosures(int x) { + int h; + if (x < 0 && (h = Car(x)) != kQuote && h != kClosure) { + if (h == kMacro) return true; + if (h == kLambda) return true; + if (h == kCond) { + while ((x = Cdr(x)) < 0) { + if ((h = Car(x)) < 0) { + if (MakesClosures(Car(h))) return true; + if ((h = Cdr(h)) < 0) { + if (MakesClosures(Car(h))) return true; + } + } + } + } else { + while (x) { + if (x < 0) { + h = Car(x); + x = Cdr(x); + } else { + h = x; + x = 0; + } + MakesClosures(h); + } + } + } + return false; +} diff --git a/tool/plinko/lib/ok.lisp b/tool/plinko/lib/ok.lisp new file mode 100644 index 000000000..a16ed8abd --- /dev/null +++ b/tool/plinko/lib/ok.lisp @@ -0,0 +1,18 @@ +#| plinko - a really fast lisp tarpit + | 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. + |# + +(QUOTE OKCOMPUTER) diff --git a/tool/plinko/lib/pairlis.c b/tool/plinko/lib/pairlis.c new file mode 100644 index 000000000..7f871916f --- /dev/null +++ b/tool/plinko/lib/pairlis.c @@ -0,0 +1,35 @@ +/*-*- 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/plinko/lib/cons.h" +#include "tool/plinko/lib/error.h" +#include "tool/plinko/lib/plinko.h" + +int Pairlis(int x, int y, int a) { + if (!x) return a; + if (x > 0) return Alist(x, y, a); + if (y <= 0) { + a = pairlis(Cdr(x), Cdr(y), a); + return Car(x) ? pairlis(Car(x), Car(y), a) : a; + } else { + Error("argument structure%n" + " want: %S%n" + " got: %S", + x, y); + } +} diff --git a/tool/plinko/lib/plan.c b/tool/plinko/lib/plan.c new file mode 100644 index 000000000..da9816c57 --- /dev/null +++ b/tool/plinko/lib/plan.c @@ -0,0 +1,374 @@ +/*-*- 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/log/countbranch.h" +#include "tool/plinko/lib/cons.h" +#include "tool/plinko/lib/error.h" +#include "tool/plinko/lib/index.h" +#include "tool/plinko/lib/plinko.h" +#include "tool/plinko/lib/printf.h" +#include "tool/plinko/lib/stack.h" +#include "tool/plinko/lib/types.h" + +nosideeffect int CountSimpleParameters(int x) { + int i; + for (i = 0; x; ++i, x = Cdr(x)) { + if (x > 0) return -1; // variadic args aren't simple + if (!Car(x)) return -1; // nil parameters aren't simple + if (Car(x) < 0) return -1; // destructured parameters aren't simple + } + return i; +} + +nosideeffect int CountSimpleArguments(int x) { + int i; + for (i = 0; x; ++i, x = Cdr(x)) { + if (x > 0) return -1; // apply isn't simple + } + return i; +} + +static dword PlanQuote(int e, int a, int s) { + if (Cdr(e) >= 0) React(e, e, kQuote); // one normal parameter required + return MAKE(DF(DispatchQuote), Cadr(e)); // >1 prms is sectorlisp comment +} + +static dword PlanCar(int e, int a, int s) { + if (!Cdr(e)) return DF(DispatchNil); // (⍅) ⟺ (⍅ ⊥) + if (Cddr(e)) React(e, e, kCar); // too many args + if (!Cadr(e)) return DF(DispatchNil); + return MAKE(DF(DispatchCar), Cadr(e)); +} + +static dword PlanCdr(int e, int a, int s) { + if (!Cdr(e)) return DF(DispatchNil); // (⍆) ⟺ (⍆ ⊥) + if (Cddr(e)) React(e, e, kCdr); // too many args + if (!ARG1(e)) return DF(DispatchNil); + return MAKE(DF(DispatchCdr), Cadr(e)); +} + +static dword PlanAtom(int e, int a, int s) { + if (CountSimpleArguments(Cdr(e)) != 1) React(e, e, kAtom); + return MAKE(DF(DispatchAtom), Cadr(e)); +} + +static dword PlanEq(int e, int a, int s) { + int n = CountSimpleArguments(Cdr(e)); + if (n != 2 && n != 1) React(e, e, kAtom); // (≡ 𝑥) is our (null 𝑥) + return MAKE(DF(DispatchEq), Caddr(e)); +} + +static dword PlanCmp(int e, int a, int s) { + if (CountSimpleArguments(Cdr(e)) != 2) React(e, e, kCmp); + return MAKE(DF(DispatchCmp), Caddr(e)); +} + +static dword PlanOrder(int e, int a, int s) { + if (CountSimpleArguments(Cdr(e)) != 2) React(e, e, kOrder); + return MAKE(DF(DispatchOrder), Caddr(e)); +} + +static dword PlanCons(int e, int a, int s) { + int p = CountSimpleArguments(Cdr(e)); + if (p == -1) Error("cons dot arg"); + if (p > 2) Error("too many args"); + return MAKE(DF(DispatchCons), Caddr(e)); +} + +static dword PlanLambda(int e, int a, int s) { + if (CountSimpleArguments(Cdr(e)) == -1) Error("bad lambda: %S", e); + return DF(DispatchLambda); +} + +static dword PlanCond(int e, int a, int s) { + int x, b; + if (!Cdr(e)) return DF(DispatchNil); // (ζ) ⟺ ⊥ + for (x = e; (x = Cdr(x));) { + if (x > 0) React(e, e, kCond); // (ζ . 𝑣) not allowed + if (Car(x) >= 0) React(e, e, kCond); // (ζ 𝑣) not allowed + if (Cdr(Car(x)) > 0) React(e, e, kCond); // (ζ (𝑥 . 𝑣)) not allowed + } + return MAKE(DF(DispatchCond), Cdr(e)); +} + +static dword PlanProgn(int e, int a, int s) { + int x; + if (!Cdr(e)) return DF(DispatchNil); // (progn) ⟺ ⊥ + if (CountSimpleArguments(Cdr(e)) == -1) React(e, e, kProgn); + return MAKE(DF(DispatchProgn), Cdr(e)); +} + +static dword PlanQuiet(int e, int a, int s) { + if (Cdr(e) > 0) React(e, e, kQuiet); // apply not allowed + if (!Cdr(e)) React(e, e, kQuiet); // zero args not allowed + if (Cdr(Cdr(e))) React(e, e, kQuiet); // >1 args not allowed + return DF(DispatchQuiet); +} + +static dword PlanTrace(int e, int a, int s) { + if (Cdr(e) > 0) React(e, e, kTrace); // apply not allowed + if (!Cdr(e)) React(e, e, kTrace); // zero args not allowed + if (Cdr(Cdr(e))) React(e, e, kTrace); // >1 args not allowed + return DF(DispatchTrace); +} + +static dword PlanFtrace(int e, int a, int s) { + if (Cdr(e) > 0) React(e, e, kFtrace); // apply not allowed + if (!Cdr(e)) React(e, e, kFtrace); // zero args not allowed + if (Cdr(Cdr(e))) React(e, e, kFtrace); // >1 args not allowed + return DF(DispatchFtrace); +} + +static dword PlanFunction(int e, int a, int s) { + if (CountSimpleArguments(Cdr(e)) != 1) Raise(kFunction); + return MAKE(DF(DispatchFunction), Cadr(e)); +} + +static dword PlanBeta(int e, int a, int s) { + if (CountSimpleArguments(Cdr(e)) != 1) Raise(kBeta); + return MAKE(DF(DispatchBeta), Cadr(e)); +} + +static dword PlanIgnore(int e, int a, int s) { + if (!Cdr(e)) return DF(DispatchIgnore0); + if (Cdr(e) > 0) React(e, e, kIgnore); // apply not allowed + if (!Cdr(e)) React(e, e, kIgnore); // zero args not allowed + if (Cdr(Cdr(e))) React(e, e, kIgnore); // >1 args not allowed + return DF(DispatchIgnore1); +} + +static dword PlanExpand(int e, int a, int s) { + if (CountSimpleArguments(Cdr(e)) != 1) React(e, e, kExpand); + return MAKE(DF(DispatchExpand), Cadr(e)); +} + +static dword PlanPrint(int e, int a, int s) { + if (CountSimpleArguments(Cdr(e)) == -1) React(e, e, kPrint); + return DF(DispatchPrint); +} + +static dword PlanGensym(int e, int a, int s) { + if (CountSimpleArguments(Cdr(e))) React(e, e, kGensym); + return DF(DispatchGensym); +} + +static dword PlanPprint(int e, int a, int s) { + if (CountSimpleArguments(Cdr(e)) == -1) React(e, e, kPprint); + return DF(DispatchPprint); +} + +static dword PlanPrintheap(int e, int a, int s) { + int p = CountSimpleArguments(Cdr(e)); + if (p != 0 && p != 1) React(e, e, kPrintheap); + return DF(DispatchPrintheap); +} + +static dword PlanGc(int e, int a, int s) { + if (CountSimpleArguments(Cdr(e)) != 1) React(e, e, kGc); + return MAKE(DF(DispatchGc), Cadr(e)); +} + +static dword PlanPrinc(int e, int a, int s) { + if (CountSimpleArguments(Cdr(e)) == -1) React(e, e, kPrinc); + return DF(DispatchPrinc); +} + +static dword PlanFlush(int e, int a, int s) { + if (CountSimpleArguments(Cdr(e)) == -1) React(e, e, kFlush); + return DF(DispatchFlush); +} + +static dword PlanError(int e, int a, int s) { + return DF(DispatchError); +} + +static dword PlanExit(int e, int a, int s) { + if (Cdr(e)) React(e, e, kExit); + return DF(DispatchExit); +} + +static dword PlanRead(int e, int a, int s) { + if (Cdr(e)) React(e, e, kRead); + return DF(DispatchRead); +} + +static dword PlanDefine(int e, int a, int s) { + return DF(DispatchIdentity); +} + +static dword PlanClosure(int e, int a, int s) { + return DF(DispatchIdentity); +} + +static dword PlanLet(int e, int a, int s) { + int p, n; + if ((n = CountSimpleArguments(Cdr(e))) == -1) return DF(DispatchFuncall); + if (CountSimpleArguments(Car(e)) < 3) React(e, e, kLambda); // need (λ 𝑥 𝑦) + switch (CountSimpleParameters(Cadr(Car(e)))) { + case -1: + return DF(DispatchFuncall); + case 0: + if (n != 0) Error("let argument count mismatch: %S", e); + return MAKE(DF(DispatchShortcut), Caddr(Car(e))); // ((λ ⊥ 𝑦)) becomes 𝑦 + case 1: + if (n != 1) Error("let argument count mismatch: %S", e); + return MAKE(DF(DispatchLet1), Cdar(e)); + default: + return MAKE(DF(DispatchFuncall), 0); + } +} + +static dontinline dword PlanPrecious(int e, int a, int s, int f) { + int x; + DCHECK_GT(f, 0); + if (f == kCar) return PlanCar(e, a, s); + if (f == kCdr) return PlanCdr(e, a, s); + if (f == kGc) return PlanGc(e, a, s); + if (f == kEq) return PlanEq(e, a, s); + if (f == kCmp) return PlanCmp(e, a, s); + if (f == kBeta) return PlanBeta(e, a, s); + if (f == kCond) return PlanCond(e, a, s); + if (f == kAtom) return PlanAtom(e, a, s); + if (f == kCons) return PlanCons(e, a, s); + if (f == kExit) return PlanExit(e, a, s); + if (f == kRead) return PlanRead(e, a, s); + if (f == kOrder) return PlanOrder(e, a, s); + if (f == kQuote) return PlanQuote(e, a, s); + if (f == kProgn) return PlanProgn(e, a, s); + if (f == kQuiet) return PlanQuiet(e, a, s); + if (f == kTrace) return PlanTrace(e, a, s); + if (f == kPrint) return PlanPrint(e, a, s); + if (f == kPrinc) return PlanPrinc(e, a, s); + if (f == kFlush) return PlanFlush(e, a, s); + if (f == kError) return PlanError(e, a, s); + if (f == kMacro) return PlanLambda(e, a, s); + if (f == kFtrace) return PlanFtrace(e, a, s); + if (f == kLambda) return PlanLambda(e, a, s); + if (f == kGensym) return PlanGensym(e, a, s); + if (f == kPprint) return PlanPprint(e, a, s); + if (f == kIgnore) return PlanIgnore(e, a, s); + if (f == kExpand) return PlanExpand(e, a, s); + if (f == kDefine) return PlanDefine(e, a, s); + if (f == kClosure) return PlanClosure(e, a, s); + if (f == kFunction) return PlanFunction(e, a, s); + if (f == kPrintheap) return PlanPrintheap(e, a, s); + if (!a) { + Push(e); + Push(f); + Raise(kFunction); + } + return DF(DispatchFuncall); +} + +dontinline dword Plan(int e, int a, int s) { + int c, f, p, x1, x2, x3, x4; + DCHECK_LT(e, 0); + + if ((x1 = IsCar(e))) { + if ((x2 = IsCar(x1))) { + if ((x3 = IsCar(x2))) { + if ((x4 = IsCar(x3))) return MAKE(DF(DispatchCaaaar), x4); + if ((x4 = IsCdr(x3))) return MAKE(DF(DispatchCaaadr), x4); + return MAKE(DF(DispatchCaaar), x3); + } + if ((x3 = IsCdr(x2))) { + if ((x4 = IsCar(x3))) return MAKE(DF(DispatchCaadar), x4); + if ((x4 = IsCdr(x3))) return MAKE(DF(DispatchCaaddr), x4); + return MAKE(DF(DispatchCaaar), x3); + } + return MAKE(DF(DispatchCaar), x2); + } + if ((x2 = IsCdr(x1))) { + if ((x3 = IsCar(x2))) { + if ((x4 = IsCar(x3))) return MAKE(DF(DispatchCadaar), x4); + if ((x4 = IsCdr(x3))) return MAKE(DF(DispatchCadadr), x4); + return MAKE(DF(DispatchCadar), x3); + } + if ((x3 = IsCdr(x2))) { + if ((x4 = IsCar(x3))) return MAKE(DF(DispatchCaddar), x4); + if ((x4 = IsCdr(x3))) return MAKE(DF(DispatchCadddr), x4); + return MAKE(DF(DispatchCaddr), x3); + } + return MAKE(DF(DispatchCadr), x2); + } + return MAKE(DF(DispatchCar), x1); + } + + if ((x1 = IsCdr(e))) { + if ((x2 = IsCar(x1))) { + if ((x3 = IsCar(x2))) { + if ((x4 = IsCar(x3))) return MAKE(DF(DispatchCdaaar), x4); + if ((x4 = IsCdr(x3))) return MAKE(DF(DispatchCdaadr), x4); + return MAKE(DF(DispatchCdaar), x3); + } + if ((x3 = IsCdr(x2))) { + if ((x4 = IsCar(x3))) return MAKE(DF(DispatchCdadar), x4); + if ((x4 = IsCdr(x3))) return MAKE(DF(DispatchCdaddr), x4); + return MAKE(DF(DispatchCdadr), x3); + } + return MAKE(DF(DispatchCdar), x2); + } + if ((x2 = IsCdr(x1))) { + if ((x3 = IsCar(x2))) { + if ((x4 = IsCar(x3))) return MAKE(DF(DispatchCddaar), x4); + if ((x4 = IsCdr(x3))) return MAKE(DF(DispatchCddadr), x4); + return MAKE(DF(DispatchCddar), x3); + } + if ((x3 = IsCdr(x2))) { + if ((x4 = IsCar(x3))) return MAKE(DF(DispatchCdddar), x4); + if ((x4 = IsCdr(x3))) return MAKE(DF(DispatchCddddr), x4); + return MAKE(DF(DispatchCdddr), x3); + } + return MAKE(DF(DispatchCddr), x2); + } + return MAKE(DF(DispatchCdr), x1); + } + + if ((f = Car(e)) > 0) { + if (LO(GetShadow(f)) == EncodeDispatchFn(DispatchPrecious)) { + return PlanPrecious(e, a, s, f); + } + if (!HasAtom(f, s) && (f = Assoc(f, a))) { + f = Cdr(f); + if (IsYcombinator(f)) { + return DF(DispatchYcombine); + } else if (f < 0 && Car(f) == kClosure && f > e) { + if (Car(Cadr(f)) == kLambda) { + c = CountSimpleArguments(Cdr(e)); + p = CountSimpleParameters(Cadr(Cadr(f))); + if (c == 1 && p == 1) { + return MAKE(DF(DispatchCall1), f); + } else if (c == 2 && p == 2) { + return MAKE(DF(DispatchCall2), f); + } + } + return MAKE(DF(DispatchFuncall), f); + } + } + } else if (Car(f) == kLambda) { + return PlanLet(e, a, s); + } + + return DF(DispatchFuncall); +} + +struct T DispatchPlan(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + SetShadow(LO(ea), (d = Plan(LO(ea), HI(ea), 0))); + return DecodeDispatchFn(d)(ea, tm, r, p1, p2, d); +} diff --git a/tool/plinko/lib/planfuncalls.c b/tool/plinko/lib/planfuncalls.c new file mode 100644 index 000000000..4d29d0961 --- /dev/null +++ b/tool/plinko/lib/planfuncalls.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/plinko/lib/cons.h" +#include "tool/plinko/lib/index.h" +#include "tool/plinko/lib/plinko.h" + +void PlanFuncalls(int n, dword p, int x) { + int h; + if (x < 0 && (h = Car(x)) != kQuote && h != kClosure && h != kMacro) { + if (h == kLambda) { + if (!HasAtom(n, Cadr(x))) { + PlanFuncalls(n, p, Caddr(x)); + } + } else if (h == kCond) { + while ((x = Cdr(x)) < 0) { + if ((h = Car(x)) < 0) { + PlanFuncalls(n, p, Car(h)); + if ((h = Cdr(h)) < 0) { + PlanFuncalls(n, p, Car(h)); + } + } + } + } else { + if (h == n) { + SetShadow(x, p); + } + while (x) { + if (x < 0) { + h = Car(x); + x = Cdr(x); + } else { + h = x; + x = 0; + } + PlanFuncalls(n, p, h); + } + } + } +} diff --git a/tool/plinko/lib/plinko.c b/tool/plinko/lib/plinko.c new file mode 100644 index 000000000..2b52131a0 --- /dev/null +++ b/tool/plinko/lib/plinko.c @@ -0,0 +1,1062 @@ +/*-*- 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/bits/likely.h" +#include "libc/calls/calls.h" +#include "libc/calls/strace.internal.h" +#include "libc/calls/struct/sigaction.h" +#include "libc/intrin/kprintf.h" +#include "libc/log/countbranch.h" +#include "libc/log/countexpr.h" +#include "libc/log/log.h" +#include "libc/macros.internal.h" +#include "libc/nexgen32e/rdtsc.h" +#include "libc/runtime/runtime.h" +#include "libc/runtime/stack.h" +#include "libc/runtime/symbols.internal.h" +#include "libc/str/str.h" +#include "libc/sysv/consts/map.h" +#include "libc/sysv/consts/o.h" +#include "libc/sysv/consts/prot.h" +#include "libc/sysv/consts/sig.h" +#include "third_party/getopt/getopt.h" +#include "tool/build/lib/case.h" +#include "tool/plinko/lib/char.h" +#include "tool/plinko/lib/error.h" +#include "tool/plinko/lib/gc.h" +#include "tool/plinko/lib/histo.h" +#include "tool/plinko/lib/index.h" +#include "tool/plinko/lib/plinko.h" +#include "tool/plinko/lib/print.h" +#include "tool/plinko/lib/printf.h" +#include "tool/plinko/lib/stack.h" +#include "tool/plinko/lib/time.h" +#include "tool/plinko/lib/trace.h" +#include "tool/plinko/lib/tree.h" + +STATIC_STACK_SIZE(0x100000); + +#define PUTS(f, s) write(f, s, strlen(s)) + +#define DISPATCH(ea, tm, r, p1, p2) \ + GetDispatchFn(LO(ea))(ea, tm, r, p1, p2, GetShadow(LO(ea))) + +static void Unwind(int S) { + int s; + dword t; + while (sp > S) { + s = --sp & MASK(STACK); + if ((t = g_stack[s])) { + g_stack[s] = 0; + cx = ~HI(t); + } + } +} + +static void Backtrace(int S) { + int i; + dword f; + for (i = 0; sp > S && i < STACK; ++i) { + f = Pop(); + Fprintf(2, "%d %p%n", ~HI(f), LO(f)); + g_stack[sp & MASK(STACK)] = 0; + } +} + +forceinline bool ShouldIgnoreGarbage(int A) { + static unsigned cadence; + if (DEBUG_GARBAGE) return false; + if (!(++cadence & AVERSIVENESS)) return false; + return true; +} + +static inline bool ShouldPanicAboutGarbage(int A) { + return false; +} + +static inline bool ShouldAbort(int A) { + return cx <= A + BANE / STACK * 3; // hacked thrice permitted memory +} + +static relegated dontinline int ErrorExpr(void) { + Raise(kError); +} + +static int Order(int x, int y) { + if (x < y) return -1; + if (x > y) return +1; + return 0; +} + +static int Append(int x, int y) { + if (!x) return y; + return Cons(Car(x), Append(Cdr(x), y)); +} + +static int ReconstructAlist(int a) { + int r; + for (r = 0; a < 0; a = Cdr(a)) { + if (Car(a) == kClosure) { + return Reverse(r, a); + } + if (Caar(a) < 0) { + r = Reverse(r, a); + } else if (!Assoc(Caar(a), r)) { + r = Cons(Car(a), r); + } + } + return Reverse(r, 0); +} + +static bool AtomEquals(int x, const char *s) { + dword t; + do { + if (!*s) return false; + t = Get(x); + if (LO(t) != *s++) return false; // xxx: ascii + } while ((x = HI(t)) != TERM); + return !*s; +} + +static pureconst int LastCons(int x) { + while (Cdr(x)) x = Cdr(x); + return x; +} + +static pureconst int LastChar(int x) { + dword e; + do e = Get(x); + while ((x = HI(e)) != TERM); + return LO(e); +} + +forceinline pureconst bool IsClosure(int x) { + return x < 0 && Car(x) == kClosure; +} + +forceinline pureconst bool IsQuote(int x) { + return x < 0 && Car(x) == kQuote; +} + +static int Quote(int x) { + if (IsClosure(x)) return x; + if (IsPrecious(x)) return x; + return List(kQuote, x); +} + +static int QuoteList(int x) { + if (!x) return x; + return Cons(Quote(Car(x)), QuoteList(Cdr(x))); +} + +static int GetAtom(const char *s) { + int x, y, t, u; + ax = y = TERM; + x = *s++ & 255; + if (*s) y = GetAtom(s); + return Intern(x, y); +} + +static int Gensym(void) { + char B[16], t; + static unsigned g; + unsigned a, b, x, n; + n = 0; + x = g++; + B[n++] = L'G'; + do B[n++] = L'0' + (x & 7); + while ((x >>= 3)); + B[n] = 0; + for (a = 1, b = n - 1; a < b; ++a, --b) { + t = B[a]; + B[a] = B[b]; + B[b] = t; + } + return GetAtom(B); +} + +static nosideeffect bool Member(int v, int x) { + while (x) { + if (x > 0) return v == x; + if (v == Car(x)) return true; + x = Cdr(x); + } + return false; +} + +static int GetBindings(int x, int a) { + int r, b; + for (r = 0; x < 0; x = Cdr(x)) { + if ((b = Assoc(Car(x), a))) { + r = Cons(b, r); + } else { + Error("could not find dependency %S in %p", Car(x), a); + } + } + return r; +} + +static int Lambda(int e, int a, dword p1, dword p2) { + int u; + if (p1) a = Alist(LO(p1), HI(p1), a); + if (p2) a = Alist(LO(p2), HI(p2), a); + if (DEBUG_CLOSURE || logc) { + u = FindFreeVariables(e, 0, 0); + a = GetBindings(u, a); + } + return Enclose(e, a); +} + +static int Function(int e, int a, dword p1, dword p2) { + int u; + if (e < 0 && Car(e) == kLambda) e = Lambda(e, a, p1, p2); + if (e >= 0 || Car(e) != kClosure) Error("not a closure"); + a = Cddr(e); + e = Cadr(e); + u = FindFreeVariables(e, 0, 0); + a = GetBindings(u, a); + return Enclose(e, a); +} + +static int Simplify(int e, int a) { + return Function(e, a, 0, 0); +} + +static int PrintFn(int x) { + int y; + DCHECK_LT(x, TERM); + y = Car(x); + while ((x = Cdr(x))) { + if (!quiet) { + Print(1, y); + PrintSpace(1); + } + y = Car(x); + } + if (!quiet) { + Print(1, y); + PrintNewline(1); + } + return y; +} + +static int PprintFn(int x) { + int y, n; + DCHECK_LT(x, TERM); + n = 0; + y = Car(x); + while ((x = Cdr(x))) { + if (!quiet) { + n += Print(1, y); + n += PrintSpace(1); + } + y = Car(x); + } + if (!quiet) { + PrettyPrint(1, y, n); + PrintNewline(1); + } + Flush(1); + return y; +} + +static relegated struct T DispatchRetImpossible(dword ea, dword tm, dword r) { + Fprintf(2, "ERROR: \e[7;31mIMPOSSIBLE RETURN\e[0m NO %d%n"); + Raise(LO(ea)); +} + +static relegated struct T DispatchTailImpossible(dword ea, dword tm, dword r, + dword p1, dword p2) { + Fprintf(2, "ERROR: \e[7;31mIMPOSSIBLE TAIL\e[0m NO %d%n"); + Raise(LO(ea)); +} + +static struct T DispatchRet(dword ea, dword tm, dword r) { + return (struct T){LO(ea)}; +} + +static struct T DispatchLeave(dword ea, dword tm, dword r) { + Pop(); + return (struct T){LO(ea)}; +} + +static struct T DispatchLeaveGc(dword ea, dword tm, dword r) { + int A, e; + e = LO(ea); + A = GetFrameCx(); + if (e < A && cx < A && UNLIKELY(!ShouldIgnoreGarbage(A))) { + e = MarkSweep(A, e); + } + Pop(); + return (struct T){e}; +} + +static struct T DispatchLeaveTmcGc(dword ea, dword tm, dword r) { + int A, e; + A = GetFrameCx(); + e = Reverse(LO(tm), LO(ea)); + if (!ShouldIgnoreGarbage(A)) { + e = MarkSweep(A, e); + } + Pop(); + return (struct T){e}; +} + +RetFn *const kRet[] = { + DispatchRet, // + DispatchRetImpossible, // + DispatchRetImpossible, // + DispatchRetImpossible, // + DispatchLeave, // + DispatchLeaveGc, // + DispatchRetImpossible, // + DispatchLeaveTmcGc, // +}; + +struct T DispatchTail(dword ea, dword tm, dword r, dword p1, dword p2) { + return DISPATCH(ea, tm, r, p1, p2); +} + +struct T DispatchTailGc(dword ea, dword tm, dword r, dword p1, dword p2) { + int A; + struct Gc *G; + A = GetFrameCx(); + if (cx < A && UNLIKELY(!ShouldIgnoreGarbage(A))) { + if (ShouldPanicAboutGarbage(A)) { + if (!ShouldAbort(A)) { + ea = MAKE(LO(ea), ReconstructAlist(HI(ea))); + } else { + Raise(kCycle); + } + } + G = NewGc(A); + Mark(G, LO(ea)); + Mark(G, HI(ea)); + Mark(G, HI(p1)); + Mark(G, HI(p2)); + Census(G); + p1 = MAKE(LO(p1), Relocate(G, HI(p1))); + p2 = MAKE(LO(p2), Relocate(G, HI(p2))); + ea = MAKE(Relocate(G, LO(ea)), Relocate(G, HI(ea))); + Sweep(G); + } + return DISPATCH(ea, tm, r, p1, p2); +} + +struct T DispatchTailTmcGc(dword ea, dword tm, dword r, dword p1, dword p2) { + int A; + struct Gc *G; + A = GetFrameCx(); + if (UNLIKELY(!ShouldIgnoreGarbage(A))) { + if (ShouldPanicAboutGarbage(A)) { + if (!ShouldAbort(A)) { + ea = MAKE(LO(ea), ReconstructAlist(HI(ea))); + } else { + Raise(kCycle); + } + } + G = NewGc(A); + Mark(G, LO(tm)); + Mark(G, LO(ea)); + Mark(G, HI(ea)); + Mark(G, HI(p1)); + Mark(G, HI(p2)); + Census(G); + p1 = MAKE(LO(p1), Relocate(G, HI(p1))); + p2 = MAKE(LO(p2), Relocate(G, HI(p2))); + ea = MAKE(Relocate(G, LO(ea)), Relocate(G, HI(ea))); + tm = MAKE(Relocate(G, LO(tm)), Relocate(G, HI(tm))); + Sweep(G); + } + return DISPATCH(ea, tm, r, p1, p2); +} + +struct T DispatchNil(dword ea, dword tm, dword r, dword p1, dword p2, dword d) { + return Ret(0, tm, r); // 𝑥 ⟹ ⊥ +} + +struct T DispatchTrue(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + return Ret(1, tm, r); // 𝑥 ⟹ ⊤ +} + +struct T DispatchPrecious(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + return Ret(ea, tm, r); // 𝑘 ⟹ 𝑘 +} + +struct T DispatchIdentity(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + return Ret(ea, tm, r); // e.g. (⅄ (λ 𝑥 𝑦) 𝑎) ⟹ (⅄ (λ 𝑥 𝑦) 𝑎) +} + +struct T DispatchShortcut(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + return Ret(MAKE(HI(d), 0), tm, r); +} + +struct T DispatchLookup(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + int e, a, kv; + e = LO(ea); + a = HI(ea); + DCHECK(!IsPrecious(e)); + DCHECK_GT(e, 0); + DCHECK_LE(a, 0); + if (LO(p1) == LO(ea)) return Ret(MAKE(HI(p1), 0), tm, r); + if (LO(p2) == LO(ea)) return Ret(MAKE(HI(p2), 0), tm, r); + if ((kv = Assoc(e, a))) { + return Ret(MAKE(Cdr(kv), 0), tm, r); // (eval 𝑘 (…(𝑘 𝑣)…)) ⟹ 𝑣 + } else { + Error("crash variable %S%n", e); + } +} + +struct T DispatchQuote(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + return Ret(MAKE(HI(d), 0), tm, r); // (Ω 𝑥) ⟹ 𝑥 +} + +struct T DispatchAtom(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + int x = FasterRecurse(HI(d), HI(ea), p1, p2); + return Ret(MAKE(x >= 0, 0), tm, r); // (α (𝑥 . 𝑦)) ⟹ ⊥, (α 𝑘) ⟹ ⊤ +} + +struct T DispatchCar(dword ea, dword tm, dword r, dword p1, dword p2, dword d) { + int x = FasterRecurse(HI(d), HI(ea), p1, p2); + return Ret(MAKE(Head(x), 0), tm, r); // (⍅ (𝑥 . 𝑦)) ⟹ 𝑥 +} + +struct T DispatchCdr(dword ea, dword tm, dword r, dword p1, dword p2, dword d) { + int x = FasterRecurse(HI(d), HI(ea), p1, p2); + return Ret(MAKE(Tail(x), 0), tm, r); // (⍆ (𝑥 . 𝑦)) ⟹ 𝑦 +} + +struct T DispatchEq(dword ea, dword tm, dword r, dword p1, dword p2, dword d) { + int x = FasterRecurse(ARG1(LO(ea)), HI(ea), p1, p2); + int y = FasterRecurse(HI(d), HI(ea), p1, p2); + return Ret(MAKE(x == y, 0), tm, r); // (≡ 𝑥 𝑥) ⟹ ⊤, (≡ 𝑥 𝑦) ⟹ ⊥ +} + +struct T DispatchCmp(dword ea, dword tm, dword r, dword p1, dword p2, dword d) { + int x = FasterRecurse(ARG1(LO(ea)), HI(ea), p1, p2); + int y = FasterRecurse(HI(d), HI(ea), p1, p2); + return Ret(MAKE(Cmp(x, y), 0), tm, r); // (≷ 𝑥 𝑦) ⟹ (⊥) | ⊥ | ⊤ +} + +struct T DispatchOrder(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + int x = FasterRecurse(ARG1(LO(ea)), HI(ea), p1, p2); + int y = FasterRecurse(HI(d), HI(ea), p1, p2); + return Ret(MAKE(Order(x, y), 0), tm, r); // (⊙ 𝑥 𝑦) ⟹ (⊥) | ⊥ | ⊤ +} + +struct T DispatchCons(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + int x; + if (cx < cHeap) cHeap = cx; + x = Car(Cdr(LO(ea))); + x = FasterRecurse(x, HI(ea), p1, p2); + if (!HI(d)) return Ret(MAKE(Cons(x, 0), 0), tm, r); + if (~r & NEED_POP) { + r |= NEED_POP; + Push(LO(ea)); + } + r |= NEED_GC | NEED_TMC; + tm = MAKE(Cons(x, LO(tm)), 0); + return TailCall(MAKE(HI(d), HI(ea)), tm, r, p1, p2); // (ℶ x 𝑦) ↩ (tm 𝑥′ . 𝑦) +} + +struct T DispatchLambda(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + // (eval (𝑘 𝑥 𝑦) 𝑎) ⟹ (⅄ (𝑘 𝑥 𝑦) . 𝑎) + SetFrame(r, LO(ea)); + r |= NEED_GC; + return Ret(MAKE(Lambda(LO(ea), HI(ea), p1, p2), 0), tm, r); +} + +struct T DispatchCond(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + int y, z, c = HI(d); + if (r & NEED_POP) { + Repush(LO(ea)); + } + do { + if (!Cdr(c) && !Cdr(Car(c))) { + // (ζ …(𝑝)) ↩ 𝑝 + return TailCall(MAKE(Car(Car(c)), HI(ea)), tm, r, p1, p2); + } + if (~r & NEED_POP) { + r |= NEED_POP; + Push(LO(ea)); + } + if ((y = FasterRecurse(Car(Car(c)), HI(ea), p1, p2))) { + if ((z = Cdr(Car(c))) < 0) { + // (ζ …(𝑝 𝑏)…) ↩ 𝑏 if 𝑝′ + return TailCall(MAKE(Car(z), HI(ea)), tm, r, p1, p2); + } else { + // (ζ …(𝑝)…) ⟹ 𝑝′ if 𝑝′ + return Ret(MAKE(y, 0), tm, r); + } + } + } while ((c = Cdr(c))); + return Ret(MAKE(c, 0), tm, r); // (ζ) ⟹ ⊥ +} + +struct T DispatchIf(dword ea, dword tm, dword r, dword p1, dword p2, dword d) { + return TailCall( + MAKE(Get(LO(ea) + 4 + !FasterRecurse(Get(LO(ea) + 3), HI(ea), p1, p2)), + HI(ea)), + tm, r, p1, p2); +} + +struct T DispatchPrinc(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + bool b; + int x, e, A; + e = LO(ea); + SetFrame(r, e); + b = literally; + literally = true; + e = recurse(MAKE(Head(Tail(e)), HI(ea)), p1, p2); + Print(1, e); + literally = b; + return Ret(MAKE(e, 0), tm, r); +} + +struct T DispatchFlush(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + int x, A; + SetFrame(r, LO(ea)); + Flush(1); + return Ret(MAKE(kIgnore0, 0), tm, r); +} + +struct T DispatchPrint(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + int a, f, x, A; + f = LO(ea); + a = HI(ea); + SetFrame(r, f); + for (;;) { + f = Cdr(f); + if (!Cdr(f)) { + if (quiet) { + return TailCall(MAKE(Car(f), a), tm, r, p1, p2); + } else { + x = recurse(MAKE(Car(f), a), p1, p2); + Print(1, x); + PrintNewline(1); + return Ret(MAKE(x, 0), tm, r); + } + } + if (!quiet) { + A = cx; + x = recurse(MAKE(Car(f), a), p1, p2); + Print(1, x); + PrintSpace(1); + MarkSweep(A, 0); + } + } +} + +struct T DispatchPprint(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + int a, f, x, n, A; + f = LO(ea); + a = HI(ea); + SetFrame(r, f); + for (n = 0;;) { + f = Cdr(f); + if (!Cdr(f)) { + if (quiet) { + return TailCall(MAKE(Car(f), a), tm, r, p1, p2); + } else { + x = recurse(MAKE(Car(f), a), p1, p2); + PrettyPrint(1, x, n); + PrintNewline(1); + return Ret(MAKE(x, 0), tm, r); + } + } + if (!quiet) { + A = cx; + x = recurse(MAKE(Car(f), a), p1, p2); + n += Print(1, x); + n += PrintSpace(1); + MarkSweep(A, 0); + } + } +} + +struct T DispatchPrintheap(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + int x, A; + SetFrame(r, LO(ea)); + if (Cdr(LO(ea))) { + A = cx; + x = recurse(MAKE(Cadr(LO(ea)), HI(ea)), p1, p2); + PrintHeap(A); + } else { + PrintHeap(0); + x = 0; + } + return Ret(x, tm, r); +} + +struct T DispatchGc(dword ea, dword tm, dword r, dword p1, dword p2, dword d) { + int A, e; + SetFrame(r, LO(ea)); + A = GetFrameCx(); + e = recurse(MAKE(HI(d), HI(ea)), p1, p2); + if (e < A && cx < A && !ShouldIgnoreGarbage(A)) { + e = MarkSweep(A, e); + } + return Ret(MAKE(e, 0), tm, r); +} + +struct T DispatchProgn(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + int A, y, x = HI(d); + for (;;) { + y = Car(x); + x = Cdr(x); + if (!x) { + if (r & NEED_POP) { + Repush(y); + } + return TailCall(MAKE(y, HI(ea)), tm, r, p1, p2); // (progn ⋯ 𝑥) ↩ 𝑥 + } + A = cx; + recurse(MAKE(y, HI(ea)), p1, p2); // evaluate for effect + MarkSweep(A, 0); + } +} + +struct T DispatchGensym(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + return Ret(MAKE(Gensym(), 0), tm, r); +} + +struct T DispatchQuiet(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + SAVE(quiet, true); + ea = MAKE(recurse(MAKE(Cadr(LO(ea)), HI(ea)), p1, p2), 0); + RESTORE(quiet); + return Ret(ea, tm, r); +} + +struct T DispatchTrace(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + START_TRACE; + ea = MAKE(recurse(MAKE(Cadr(LO(ea)), HI(ea)), p1, p2), 0); + END_TRACE; + return Ret(ea, tm, r); +} + +struct T DispatchFtrace(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + ftrace_install(); + ++g_ftrace; + ea = MAKE(recurse(MAKE(Cadr(LO(ea)), HI(ea)), p1, p2), 0); + --g_ftrace; + return Ret(ea, tm, r); +} + +struct T DispatchBeta(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + SetFrame(r, LO(ea)); + r |= NEED_GC; + return Ret(MAKE(Simplify(recurse(MAKE(HI(d), HI(ea)), p1, p2), HI(ea)), 0), + tm, r); +} + +struct T DispatchFunction(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + // (eval (𝑓 (𝑘 𝑥 𝑦)) 𝑎) ⟹ (⅄ (𝑘 𝑥 𝑦) . prune 𝑎 wrt (𝑘 𝑥 𝑦)) + SetFrame(r, LO(ea)); + r |= NEED_GC; + return Ret( + MAKE(Function(recurse(MAKE(HI(d), HI(ea)), p1, p2), HI(ea), p1, p2), 0), + tm, r); +} + +struct T DispatchIgnore0(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + return Ret(MAKE(kIgnore0, 0), tm, r); +} + +struct T DispatchIgnore1(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + int x = recurse(MAKE(Car(Cdr(LO(ea))), HI(ea)), p1, p2); + return Ret(MAKE(List(kIgnore, x), 0), tm, r); +} + +struct T DispatchExpand(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + int x; + SetFrame(r, LO(ea)); + r |= NEED_GC; + x = HI(d); + x = recurse(MAKE(x, HI(ea)), p1, p2); + return Ret(MAKE(expand(x, HI(ea)), 0), tm, r); +} + +static int GrabArgs(int x, int a, dword p1, dword p2) { + if (x >= 0) return x; + return Cons(recurse(MAKE(Car(x), a), p1, p2), GrabArgs(Cdr(x), a, p1, p2)); +} + +struct T DispatchError(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + int e, x; + e = LO(ea); + SetFrame(r, e); + r |= NEED_GC; + x = GrabArgs(Cdr(e), HI(ea), p1, p2); + Raise(Cons(Car(e), x)); +} + +struct T DispatchExit(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + longjmp(exiter, 1); +} + +struct T DispatchRead(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + return Ret(MAKE(Read(0), 0), tm, r); +} + +struct T DispatchFuncall(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + int a, b, e, f, t, u, y, p, z; + e = LO(ea); + a = HI(ea); + DCHECK_LT(e, 0); + SetFrame(r, e); + r |= NEED_GC; + f = Car(e); + z = Cdr(e); + y = HI(d) ? HI(d) : FasterRecurse(f, a, p1, p2); +Delegate: + if (y < 0) { + t = Car(y); + if (t == kClosure) { + // (eval ((⅄ (λ 𝑥 𝑦) 𝑏) 𝑧) 𝑎) ↩ (eval ((λ 𝑥 𝑦) 𝑧) 𝑏) + y = Cdr(y); // ((λ 𝑥 𝑦) 𝑏) + u = Cdr(y); // 𝑏 + y = Car(y); // (λ 𝑥 𝑦) + t = Car(y); // λ + } else { + u = a; + } + p = Car(Cdr(y)); + b = Car(Cdr(Cdr(y))); + if (t == kLambda) { + if (!(p > 0 && b < 0 && Cdr(b) == p)) { + struct Binding bz = bind_(p, z, a, u, p1, p2); + return TailCall(MAKE(b, bz.u), tm, r, bz.p1, 0); + } else { + // fast path ((lambda 𝑣 (𝑦 . 𝑣)) 𝑧) ↩ (𝑦′ 𝑧) + y = recurse(MAKE(Car(b), u), 0, 0); + goto Delegate; + } + } else if (t == kMacro) { + // (eval ((ψ 𝑥 𝑦) 𝑥) 𝑎) ↩ (eval (eval 𝑦 ((𝑥ᵢ 𝑥ᵢ) 𝑎)) 𝑎) + return TailCall(MAKE(eval(b, pairlis(p, Exlis(z, a), u)), a), tm, r, 0, + 0); + } + } else if (y > 1 && y != f && IsPrecious(y)) { + // unplanned builtin calls + // e.g. ((cond (p car) (cdr)) x) + return TailCall(MAKE(Cons(y, z), a), tm, r, p1, p2); + } + React(e, y, kFunction); +} + +struct T DispatchCall1(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + int a, b, e, f, t, u, y, p, z; + e = LO(ea); + a = HI(ea); + DCHECK_LT(e, 0); + SetFrame(r, e); + f = Car(e); + z = Cdr(e); + y = HI(d); + t = Car(y); + // (eval ((⅄ (λ 𝑥 𝑦) 𝑏) 𝑧) 𝑎) ↩ (eval ((λ 𝑥 𝑦) 𝑧) 𝑏) + y = Cdr(y); // ((λ 𝑥 𝑦) 𝑏) + u = Cdr(y); // 𝑏 + y = Car(y); // (λ 𝑥 𝑦) + p = Car(Cdr(y)); + b = Car(Cdr(Cdr(y))); + return TailCall(MAKE(b, u), tm, r, + MAKE(Car(p), FasterRecurse(Car(Cdr(LO(ea))), HI(ea), p1, p2)), + 0); +} + +struct T DispatchCall2(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + int a, b, e, f, t, u, y, p, z; + e = LO(ea); + a = HI(ea); + DCHECK_LT(e, 0); + SetFrame(r, e); + f = Car(e); + z = Cdr(e); + y = HI(d); + t = Car(y); + // (eval ((⅄ (λ 𝑥 𝑦) 𝑏) 𝑧) 𝑎) ↩ (eval ((λ 𝑥 𝑦) 𝑧) 𝑏) + y = Cdr(y); // ((λ 𝑥 𝑦) 𝑏) + u = Cdr(y); // 𝑏 + y = Car(y); // (λ 𝑥 𝑦) + p = Car(Cdr(y)); + b = Car(Cdr(Cdr(y))); + return TailCall( + MAKE(b, u), tm, r, + MAKE(Car(p), FasterRecurse(Car(Cdr(LO(ea))), HI(ea), p1, p2)), + MAKE(Car(Cdr(p)), FasterRecurse(Car(Cdr(Cdr(LO(ea)))), HI(ea), p1, p2))); +} + +struct T DispatchLet1(dword ea, dword tm, dword r, dword p1, dword p2, + dword d) { + // Fast path DispatchFuncall() for ((λ (𝑣) 𝑦) 𝑧₀) expressions + // HI(d) contains ((𝑣) 𝑦) + if (UNLIKELY(trace)) + Fprintf(2, "%J╟─%s[%p @ %d] δ %'Rns%n", "DispatchLet1", LO(ea), LO(ea)); + int v = Car(Car(HI(d))); + int y = Car(Cdr(HI(d))); + int z = FasterRecurse(Car(Cdr(LO(ea))), HI(ea), p1, p2); + int a = HI(ea); + if (!LO(p1) || LO(p1) == v) { + p1 = MAKE(v, z); + } else if (!LO(p2) || LO(p2) == v) { + p2 = MAKE(v, z); + } else { + a = Alist(LO(p2), HI(p2), a); + p2 = p1; + p1 = MAKE(v, z); + } + return TailCall(MAKE(y, a), tm, r, p1, p2); +} + +int Eval(int e, int a) { + return ((ForceIntTailDispatchFn *)GetDispatchFn(e))(MAKE(e, a), 0, 0, 0, 0, + GetShadow(e)); +} + +static void ResetStats(void) { + cHeap = cx; + cGets = 0; + cSets = 0; +} + +static void PrintStats(long usec) { + Fprintf(2, + ";; heap %'16ld nsec %'16ld%n" + ";; gets %'16ld sets %'16ld%n" + ";; atom %'16ld frez %'16ld%n", + -cHeap - -cFrost, usec, cGets, cSets, cAtoms, -cFrost); +} + +static wontreturn Exit(void) { + exit(0 <= fails && fails <= 255 ? fails : 255); +} + +static wontreturn void PrintUsage(void) { + PUTS(!!fails + 1, "Usage: "); + PUTS(!!fails + 1, program_invocation_name); + PUTS(!!fails + 1, " [-MNSacdfgqstz?h] errput.lisp\n\ + -d dump global defines, on success\n\ + -s print statistics upon each eval\n\ + -z uses alternative unicode glyphs\n\ + -f print log of all function calls\n\ + -S avoid pretty printing most case\n\ + -c dont conceal transitive closure\n\ + -a log name bindings in the traces\n\ + -t hyper verbose jump table traces\n\ + -M enable tracing of macro expands\n\ + -N disable define name substitutes\n\ + -g will log garbage collector pass\n\ + -q makes (print) and (pprint) noop\n\ +"); + Exit(); +} + +int Plinko(int argc, char *argv[]) { + long *p; + bool trace; + int S, x, u, j; + uint64_t t1, t2; + tick = kStartTsc; +#ifndef NDEBUG + ShowCrashReports(); +#endif + signal(SIGPIPE, SIG_DFL); + + depth = -1; + trace = false; + while ((x = getopt(argc, argv, "MNSacdfgqstz?h")) != -1) { + switch (x) { + CASE(L'd', dump = true); + CASE(L's', stats = true); + CASE(L'z', symbolism = true); + CASE(L'f', ftrace = true); + CASE(L'S', simpler = true); + CASE(L'c', logc = true); + CASE(L'a', loga = true); + CASE(L't', trace = true); + CASE(L'g', gtrace = true); + CASE(L'q', quiet = true); + CASE(L'M', mtrace = true); + CASE(L'N', noname = true); + CASE(L'?', PrintUsage()); + CASE(L'h', PrintUsage()); + default: + ++fails; + PrintUsage(); + } + } + + if (arch_prctl(ARCH_SET_FS, 0x200000000000) == -1 || + arch_prctl(ARCH_SET_GS, (intptr_t)DispatchPlan) == -1) { + kprintf("error: %m%nyour operating system doesn't allow you change both " + "the %%fs and %%gs registers in your processor which is a shame " + "since they're crucial for performance and thread-local storage%n"); + exit(1); + } + + if (mmap((void *)0x200000000000, + ROUNDUP((TERM + 1) * sizeof(g_mem[0]), FRAMESIZE), + PROT_READ | PROT_WRITE, MAP_ANONYMOUS | MAP_PRIVATE | MAP_FIXED, -1, + 0) == MAP_FAILED || + mmap((void *)(0x200000000000 + + (BANE & (BANE | MASK(BANE))) * sizeof(g_mem[0])), + (BANE & (BANE | MASK(BANE))) * sizeof(g_mem[0]), + PROT_READ | PROT_WRITE, MAP_ANONYMOUS | MAP_PRIVATE | MAP_FIXED, -1, + 0) == MAP_FAILED || + mmap((void *)0x400000000000, + ROUNDUP((TERM + 1) * sizeof(g_mem[0]), FRAMESIZE), + PROT_READ | PROT_WRITE, MAP_ANONYMOUS | MAP_PRIVATE | MAP_FIXED, -1, + 0) == MAP_FAILED || + mmap((void *)(0x400000000000 + + (BANE & (BANE | MASK(BANE))) * sizeof(g_mem[0])), + (BANE & (BANE | MASK(BANE))) * sizeof(g_mem[0]), + PROT_READ | PROT_WRITE, MAP_ANONYMOUS | MAP_PRIVATE | MAP_FIXED, -1, + 0) == MAP_FAILED) { + kprintf("error: %m%nyour operating system doesn't allow you to allocate " + "outrageous amounts of overcommit memory, which is a shame, since " + "the pml4t feature in your processor was intended to give you that " + "power since it's crucial for sparse data applications and lisp. " + "for instance, the way racket works around this problem is by " + "triggering thousands of segmentation faults as part of normal " + "operation%n"); + exit(1); + } + + g_mem = (void *)0x200000000000; + + inputs = argv + optind; + if (*inputs) { + close(0); + DCHECK_NE(-1, open(*inputs++, O_RDONLY)); + } + + eval = Eval; + bind_ = Bind; + evlis = Evlis; + expand = Expand; + recurse = Recurse; + pairlis = Pairlis; + kTail[0] = DispatchTail; + kTail[1] = DispatchTailImpossible; + kTail[2] = DispatchTailImpossible; + kTail[3] = DispatchTailImpossible; + kTail[4] = DispatchTail; + kTail[5] = DispatchTailGc; + kTail[6] = DispatchTailImpossible; + kTail[7] = DispatchTailTmcGc; + if (trace) EnableTracing(); + + cx = -1; + cFrost = cx; + Setup(); + cFrost = cx; + + if (!setjmp(exiter)) { + for (;;) { + S = sp; + DCHECK_EQ(0, S); + DCHECK_EQ(cx, cFrost); + if (!(x = setjmp(crash))) { + x = Read(0); + x = expand(x, globals); + if (stats) ResetStats(); + if (x < 0 && Car(x) == kDefine) { + globals = Define(x, globals); + cFrost = cx; + } else { + t1 = rdtsc(); + x = eval(x, globals); + if (x < 0 && Car(x) == kIgnore) { + MarkSweep(cFrost, 0); + } else { + Fprintf(1, "%p%n", x); + MarkSweep(cFrost, 0); + if (stats) { + t2 = rdtsc(); + PrintStats(ClocksToNanos(t1, t2)); + } + } + } + } else { + x = ~x; + ++fails; + eval = Eval; + expand = Expand; + Fprintf(2, "?%p%s%n", x, cx == BANE ? " [HEAP OVERFLOW]" : ""); + Backtrace(S); + Exit(); + Unwind(S); + MarkSweep(cFrost, 0); + } + } + } + +#if HISTO_ASSOC + PrintHistogram(2, "COMPARES PER ASSOC", g_assoc_histogram, + ARRAYLEN(g_assoc_histogram)); +#endif +#if HISTO_GARBAGE + PrintHistogram(2, "GC MARKS PER COLLECTION", g_gc_marks_histogram, + ARRAYLEN(g_gc_marks_histogram)); + PrintHistogram(2, "GC DISCARDS PER COLLECTION", g_gc_discards_histogram, + ARRAYLEN(g_gc_discards_histogram)); + PrintHistogram(2, "GC MARKS / DISCARDS FOR DENSE COLLECTIONS", + g_gc_dense_histogram, ARRAYLEN(g_gc_dense_histogram)); + PrintHistogram(2, "GC DISCARDS / MARKS FOR SPARSE COLLECTIONS", + g_gc_sparse_histogram, ARRAYLEN(g_gc_sparse_histogram)); + PrintHistogram(2, "GC LOP", g_gc_lop_histogram, ARRAYLEN(g_gc_lop_histogram)); +#endif + + if (dump && !fails) { + DumpDefines(kDefine, globals, Reverse(ordglob, 0)); + } + Exit(); +} diff --git a/tool/plinko/lib/plinko.h b/tool/plinko/lib/plinko.h new file mode 100644 index 000000000..e94708ded --- /dev/null +++ b/tool/plinko/lib/plinko.h @@ -0,0 +1,337 @@ +#ifndef COSMOPOLITAN_TOOL_PLINKO_LIB_PLINKO_H_ +#define COSMOPOLITAN_TOOL_PLINKO_LIB_PLINKO_H_ +#include "libc/limits.h" +#include "libc/log/check.h" +#include "libc/runtime/runtime.h" +#include "tool/plinko/lib/config.h" +#include "tool/plinko/lib/types.h" +#if !(__ASSEMBLER__ + __LINKER__ + 0) +COSMOPOLITAN_C_START_ + +#define LO(x) (int)(x) +#define HI(x) (int)((x) >> 32) +#define MASK(x) ((x)-1u) +#define ROR(x, k) ((unsigned)(x) >> k | ((unsigned)(x) << (32 - k))) +#define MAKE(l, h) (((unsigned)(l)) | (dword)(h) << 32) +#define SHAD(i) g_dispatch[(i) & (BANE | MASK(BANE))] +#define DF(f) EncodeDispatchFn(f) +#define CAR(x) LO(Get(x)) +#define CDR(x) HI(Get(x)) +#define ARG1(e) Cadr(e) +#define __(c) (assert(IsUpper(c)), kAlphabet[c - 'A']) +#define _(s) __(STRINGIFY(s)[0]) + +#define ZERO4 MAKE4(0, 0, 0, 0) +#define MAKE4(a, b, c, d) \ + (struct qword) { \ + MAKE(a, b), MAKE(c, d) \ + } + +#define Equal(x, y) !Cmp(x, y) + +#define RESTORE(s) s = save_##s +#define SAVE(s, x) \ + typeof(s) save_##s = s; \ + s = x + +#define PROG(d, k, s) \ + SetInput(s); \ + k = Read(0); \ + d(k) + +#define GetFrameCx() ~HI(GetCurrentFrame()) +#define GetDispatchFn(x) DecodeDispatchFn(GetShadow(x)) +#define DecodeDispatchFn(x) ((DispatchFn *)(uintptr_t)(unsigned)(x)) +#define GetShadow(i) \ + ((__seg_fs const dword *)((uintptr_t)g_mem))[(i) & (BANE | MASK(BANE))] + +struct T { + int res; +}; + +struct Binding { + int u; + dword p1; +}; + +typedef int EvalFn(int, int); +typedef int PairFn(int, int, int); +typedef int RecurseFn(dword, dword, dword); +typedef struct T RetFn(dword, dword, dword); +typedef int EvlisFn(int, int, dword, dword); +typedef struct Binding BindFn(int, int, int, int, dword, dword); +typedef struct T TailFn(dword, dword, dword, dword, dword); +typedef struct T DispatchFn(dword, dword, dword, dword, dword, dword); +typedef int ForceIntTailDispatchFn(dword, dword, dword, dword, dword, dword); + +BindFn Bind, BindTrace; +RecurseFn RecurseTrace; +EvlisFn Evlis, EvlisTrace; +PairFn Pairlis, PairlisTrace; +EvalFn Eval, EvalTrace, ExpandTrace, Exlis; +TailFn DispatchTail, DispatchTailGc, DispatchTailTmcGc; +TailFn DispatchTailTrace, DispatchTailGcTrace, DispatchTailTmcGcTrace; + +DispatchFn DispatchNil, DispatchTrue, DispatchPlan, DispatchQuote, + DispatchLookup, DispatchBuiltin, DispatchFuncall, DispatchRecursive, + DispatchYcombine, DispatchPrecious, DispatchIgnore0, DispatchAdd, + DispatchShortcut, DispatchCar, DispatchCdr, DispatchAtom, DispatchEq, + DispatchCmp, DispatchOrder, DispatchLambda, DispatchCond, DispatchCons, + DispatchProgn, DispatchQuiet, DispatchTrace, DispatchFtrace, + DispatchFunction, DispatchBeta, DispatchGensym, DispatchPrinc, + DispatchPrintheap, DispatchGc, DispatchFlush, DispatchError, DispatchExit, + DispatchRead, DispatchIdentity, DispatchLet, DispatchLet1, DispatchLet2, + DispatchIgnore1, DispatchExpand, DispatchPprint, DispatchPrint, + DispatchEnclosedLetegatinator, DispatchEnclosedLetegate, DispatchIf, + DispatchCall1, DispatchCall2; + +DispatchFn DispatchEnclosedLet, DispatchCaar, DispatchCadr, DispatchCdar, + DispatchCddr, DispatchCaaar, DispatchCaadr, DispatchCadar, DispatchCaddr, + DispatchCdaar, DispatchCdadr, DispatchCddar, DispatchCdddr, DispatchCaaaar, + DispatchCaaadr, DispatchCaadar, DispatchCaaddr, DispatchCadaar, + DispatchCadadr, DispatchCaddar, DispatchCadddr, DispatchCdaaar, + DispatchCdaadr, DispatchCdadar, DispatchCdaddr, DispatchCddaar, + DispatchCddadr, DispatchCdddar, DispatchCddddr; + +#ifndef __llvm__ +register dword cGets asm("r12"); +register dword *g_mem asm("rbx"); +#else +extern dword cGets; +extern dword *g_mem; +#endif + +extern unsigned short sp; +extern bool loga; +extern bool logc; +extern bool dump; +extern bool quiet; +extern bool stats; +extern bool simpler; +extern bool trace; +extern bool ftrace; +extern bool mtrace; +extern bool gtrace; +extern bool noname; +extern bool literally; +extern bool symbolism; + +extern int cHeap; +extern int cAtoms; +extern int cFrost; +extern int globals; +extern int revglob; +extern int ordglob; +extern int ax; +extern int cx; +extern int dx; +extern int ex; +extern int pdp; +extern int bp[4]; +extern int fails; +extern int depth; +extern int kTrace; +extern int kMtrace; +extern int kFtrace; +extern int kGtrace; +extern int kEq; +extern int kGc; +extern int kCmp; +extern int kCar; +extern int kBackquote; +extern int kDefun; +extern int kDefmacro; +extern int kAppend; +extern int kBeta; +extern int kAnd; +extern int kCdr; +extern int kRead; +extern int kDump; +extern int kQuote; +extern int kProgn; +extern int kLambda; +extern int kDefine; +extern int kMacro; +extern int kQuiet; +extern int kSplice; +extern int kPrinc; +extern int kPrint; +extern int kPprint; +extern int kIgnore; +extern int kExpand; +extern int kCond; +extern int kAtom; +extern int kOr; +extern int kCons; +extern int kIntegrate; +extern int kString; +extern int kSquare; +extern int kCurly; +extern int kFork; +extern int kGensym; +extern int kTrench; +extern int kYcombinator; +extern int kBecause; +extern int kTherefore; +extern int kUnion; +extern int kImplies; +extern int kNand; +extern int kNor; +extern int kXor; +extern int kIff; +extern int kPartial; +extern int kError; +extern int kExit; +extern int kClosure; +extern int kFunction; +extern int kCycle; +extern int kFlush; +extern int kIgnore0; +extern int kComma; +extern int kIntersection; +extern int kList; +extern int kMember; +extern int kNot; +extern int kReverse; +extern int kSqrt; +extern int kSubset; +extern int kSuperset; +extern int kPrintheap; +extern int kImpossible; +extern int kUnchanged; +extern int kOrder; + +extern jmp_buf crash; +extern jmp_buf exiter; + +extern RetFn *const kRet[8]; +extern char g_buffer[4][512]; +extern unsigned short g_depths[128][3]; + +extern dword tick; +extern dword cSets; +extern dword *g_dis; +extern EvalFn *eval; +extern BindFn *bind_; +extern char **inputs; +extern EvalFn *expand; +extern EvlisFn *evlis; +extern PairFn *pairlis; +extern TailFn *kTail[8]; +extern RecurseFn *recurse; + +extern int g_copy[256]; +extern int g_print[256]; +extern int kAlphabet[26]; +extern dword g_stack[STACK]; +extern int kConsAlphabet[26]; + +extern long g_assoc_histogram[12]; +extern long g_gc_lop_histogram[30]; +extern long g_gc_marks_histogram[30]; +extern long g_gc_dense_histogram[30]; +extern long g_gc_sparse_histogram[30]; +extern long g_gc_discards_histogram[30]; + +bool HasAtom(int, int) nosideeffect; +bool IsConstant(int) pureconst; +bool IsYcombinator(int); +bool MakesClosures(int); +dword Plan(int, int, int); +int Assoc(int, int); +int Cmp(int, int); +int CountAtoms(int, int, int) nosideeffect; +int CountReferences(int, int, int); +int CountSimpleArguments(int) nosideeffect; +int CountSimpleParameters(int) nosideeffect; +int Define(int, int); +int DumpDefines(int, int, int); +int Desymbolize(int) pureconst; +int Enclose(int, int); +int Expand(int, int); +int FindFreeVariables(int, int, int); +int Intern(int, int); +int IsCar(int); +int IsCdr(int); +int IsDelegate(int); +int Plinko(int, char *[]); +int Preplan(int, int, int); +int Read(int); +int ReadByte(int); +int ReadChar(int); +int ReadSpaces(int); +int ReadString(int, unsigned); +int Reverse(int, int); +int Symbolize(int) pureconst; +struct qword IsIf(int); +void Flush(int); +void PlanFuncalls(int, dword, int); +void Setup(void); + +forceinline dword Get(int i) { +#ifndef NDEBUG + DCHECK_LT(i, TERM); +#endif + ++cGets; + return g_mem[i & (BANE | MASK(BANE))]; +} + +forceinline int Car(int i) { +#ifndef NDEBUG + DCHECK_LE(i, 0); +#endif + return LO(Get(i)); +} + +forceinline int Cdr(int i) { +#ifndef NDEBUG + DCHECK_LE(i, 0); +#endif + return HI(Get(i)); +} + +forceinline unsigned EncodeDispatchFn(DispatchFn *f) { + DCHECK_LE((uintptr_t)f, UINT_MAX); + return (uintptr_t)f; +} + +forceinline pureconst bool IsPrecious(int x) { + return LO(GetShadow(x)) == EncodeDispatchFn(DispatchPrecious); +} + +forceinline pureconst bool IsVariable(int x) { + return LO(GetShadow(x)) == EncodeDispatchFn(DispatchLookup); +} + +forceinline nosideeffect void *Addr(int i) { + return g_mem + (i & (BANE | MASK(BANE))); +} + +forceinline struct T Ret(dword ea, dword tm, dword r) { + return kRet[r](ea, tm, r); +} + +static inline int FasterRecurse(int v, int a, dword p1, dword p2) { + if (v == LO(p1)) return HI(p1); + if (v == LO(p2)) return HI(p2); + /* if (IsPrecious(v)) return v; */ + /* if (v < 0 && Car(v) == kQuote) return Car(Cdr(v)); */ + return recurse(MAKE(v, a), p1, p2); +} + +forceinline int Recurse(dword ea, dword p1, dword p2) { + return ((ForceIntTailDispatchFn *)GetDispatchFn(LO(ea)))(ea, 0, 0, p1, p2, + GetShadow(LO(ea))); +} + +forceinline struct T TailCall(dword ea, dword tm, dword r, dword p1, dword p2) { + return kTail[r](ea, tm, r, p1, p2); +} + +static inline int Keep(int x, int y) { + return Equal(x, y) ? x : y; +} + +COSMOPOLITAN_C_END_ +#endif /* !(__ASSEMBLER__ + __LINKER__ + 0) */ +#endif /* COSMOPOLITAN_TOOL_PLINKO_LIB_PLINKO_H_ */ diff --git a/tool/plinko/lib/preplan.c b/tool/plinko/lib/preplan.c new file mode 100644 index 000000000..19911a2f0 --- /dev/null +++ b/tool/plinko/lib/preplan.c @@ -0,0 +1,109 @@ +/*-*- 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/log/countbranch.h" +#include "libc/runtime/runtime.h" +#include "tool/plinko/lib/cons.h" +#include "tool/plinko/lib/index.h" +#include "tool/plinko/lib/plinko.h" +#include "tool/plinko/lib/printf.h" + +static int CopyTree(int x) { + int a, b; + if (x >= 0) return x; + b = CopyTree(Cdr(x)); + a = CopyTree(Car(x)); + return Cons(a, b); +} + +static int PreplanCond(int e, int a, int s) { + int f, g; + if (!(e = Cdr(e))) return 0; + if ((f = Car(e)) < 0) { + if ((g = Cdr(f)) < 0) { + f = List(Preplan(Car(f), a, s), Preplan(Car(g), a, s)); + } else { + f = Cons(Preplan(Car(f), a, s), 0); + } + } + return Cons(f, PreplanCond(e, a, s)); +} + +static int PreplanList(int e, int a, int s) { + if (e >= 0) return e; + return Cons(Preplan(Car(e), a, s), PreplanList(Cdr(e), a, s)); +} + +int Preplan(int e, int a, int s) { + int f, x; + struct qword q; + if (e >= 0) return e; + f = Car(e); + if (f != kQuote) { + if (f == kClosure) { + /* + * (CLOSURE (LAMBDA (X Y) Z) . A) + * -1 = ( Z, -0) c[6] + * -2 = ( Y, -0) c[5] + * -3 = ( X, -2) c[4] + * -4 = ( -3, -1) c[3] + * -5 = (LAMB, -4) c[2] + * -6 = ( -5, A) c[1] + * -7 = (CLOS, -5) c[0] + */ + e = Cons(kClosure, Cons(Preplan(Cadr(e), Cddr(e), 0), Cddr(e))); + } else if (f == kCond) { + e = Cons(kCond, PreplanCond(e, a, s)); + } else if (f == kLambda || f == kMacro) { + /* + * (LAMBDA (X Y) Z) + * -1 = ( Z, -0) l[4] + * -2 = ( Y, -0) l[3] + * -3 = ( X, -2) l[2] + * -4 = ( -3, -1) l[1] + * -5 = (LAMB, -4) l[0] + */ + x = Preplan(Caddr(e), a, Shadow(Cadr(e), s)); + x = Cons(x, 0); + x = Cons(CopyTree(Cadr(e)), x); + e = Cons(f, x); + } else { + e = PreplanList(e, a, s); + } + } + if (LO(GetShadow(e)) == EncodeDispatchFn(DispatchPlan)) { + if ((q = IsIf(e)).ax) { + /* x = Cons(LO(q.ax), Cons(HI(q.ax), LO(q.dx))); */ + /* + * guarantees this order + * -1 = ( Z, -0) if[5] + * -2 = ( Y, -0) if[4] + * -3 = ( X, -2) if[3] + * -4 = ( -1, -0) if[2] + * -5 = ( -3, -4) if[1] + * -6 = (COND, -5) if[0] + */ + e = Cons(LO(q.dx), 0); + e = List3(kCond, List(LO(q.ax), HI(q.ax)), e); + SetShadow(e, MAKE(DF(DispatchIf), 0)); + } else { + SetShadow(e, Plan(e, a, s)); + } + } + return e; +} diff --git a/tool/plinko/lib/prettyprint.c b/tool/plinko/lib/prettyprint.c new file mode 100644 index 000000000..60fa738fa --- /dev/null +++ b/tool/plinko/lib/prettyprint.c @@ -0,0 +1,130 @@ +/*-*- 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/log/check.h" +#include "libc/nt/struct/size.h" +#include "tool/plinko/lib/plinko.h" +#include "tool/plinko/lib/print.h" +#include "tool/plinko/lib/tree.h" + +static void PrettyPrintList(int fd, int x, int n) { + int i, y, once, func, mode, argwidth, funcwidth, forcedot; + DCHECK_GE(n, 0); + DCHECK_LE(x, 0); + if (x < cx) { + n += PrintChar(fd, L'!'); + n += PrintInt(fd, x, 0, 0, 0, 10, true); + } else { + if (ShouldConcealClosure(x)) { + x = Car(Cdr(x)); + } + PrintChar(fd, L'('); + if (x < 0) { + func = Car(x); + funcwidth = PrettyPrint(fd, func, ++n); + if (func == kDefine) { + PrintSpace(fd); + PrettyPrint(fd, Car(Cdr(x)), n); + forcedot = 0; + x = Cdr(x); + mode = Cdr(x) < 0; + once = 1; + n += 1; + } else if ((func == kLambda || func == kMacro) && + (Cdr(x) < 0 && Cdr(Cdr(x)) < 0)) { + PrintSpace(fd); + if (!Car(Cdr(x))) { + PrintChar(fd, L'('); + PrintChar(fd, L')'); + } else { + PrettyPrint(fd, Car(Cdr(x)), n); + } + x = Cdr(x); + mode = 1; + forcedot = 0; + once = 1; + n += 1; + } else { + if (func >= 0) { + n += funcwidth + 1; + } + mode = func < 0 && Car(func) != kQuote; + once = mode; + forcedot = 0; + } + if (!forcedot && ShouldForceDot(x)) { + forcedot = true; + n += 2; + } + while ((x = Cdr(x))) { + y = x; + argwidth = 0; + if (y < 0 && !forcedot) { + y = Car(y); + } else { + argwidth += PrintSpace(fd); + argwidth += PrintDot(fd); + mode = y < 0; + x = 0; + } + if (y >= 0) { + argwidth += PrintSpace(fd); + argwidth += PrintAtom(fd, y); + if (!once) n += argwidth; + } else { + if (once && (y < 0 || mode)) { + mode = 1; + PrintNewline(fd); + if (depth >= 0) PrintDepth(fd, depth); + PrintIndent(fd, n); + } else { + if (y < 0) mode = 1; + PrintSpace(fd); + } + once = 1; + PrettyPrint(fd, y, n); + } + forcedot = 0; + } + } + PrintChar(fd, L')'); + } +} + +/** + * Prints LISP data structure with style. + * + * @param fd is where i/o goes + * @param x is thing to print + * @param n is indent level + */ +int PrettyPrint(int fd, int x, int n) { + DCHECK_GE(n, 0); + if (!noname) { + GetName(&x); + } + x = EnterPrint(x); + if (1. / x < 0) { + PrettyPrintList(fd, x, n); + n = 0; + } else { + n = PrintAtom(fd, x); + } + LeavePrint(x); + return n; +} diff --git a/tool/plinko/lib/print.c b/tool/plinko/lib/print.c new file mode 100644 index 000000000..42706e25f --- /dev/null +++ b/tool/plinko/lib/print.c @@ -0,0 +1,255 @@ +/*-*- 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/build/lib/case.h" +#include "tool/plinko/lib/char.h" +#include "tool/plinko/lib/plinko.h" +#include "tool/plinko/lib/print.h" +#include "tool/plinko/lib/tree.h" + +int PrintDot(int fd) { + return PrintChar(fd, L'.'); +} + +int PrintSpace(int fd) { + return PrintChar(fd, L' '); +} + +void PrintNewline(int fd) { + PrintChar(fd, L'\n'); +} + +int PrintIndent(int fd, int n) { + int i; + for (i = 0; n > 0; --n) { + i += PrintSpace(fd); + } + return i; +} + +int PrintZeroes(int fd, int n) { + int i; + for (i = 0; n > 0; --n) { + i += PrintChar(fd, L'0'); + } + return i; +} + +int PrintDepth(int fd, int n) { + int i, j; + for (j = i = 0; n > 0; --n, ++j) { + if (j < ARRAYLEN(g_depths)) { + i += PrintChar(fd, g_depths[j][0]); + i += PrintChar(fd, g_depths[j][1]); + i += PrintChar(fd, g_depths[j][2]); + } + } + return i; +} + +int PrintListDot(int fd, int x) { + int n; + n = PrintSpace(fd); + n += PrintDot(fd); + n += PrintSpace(fd); + n += Print(fd, x); + return n; +} + +bool ShouldForceDot(int x) { + return Cdr(x) < 0 && (Car(Cdr(x)) == kClosure || Car(Cdr(x)) == kLambda || + Car(Cdr(x)) == kMacro); +} + +bool ShouldConcealClosure(int x) { + return !logc && + (Car(x) == kClosure /* && Cdr(x) < 0 && Car(Cdr(x)) < 0 && */ + /* Car(Car(Cdr(x))) == kLambda && CountAtoms(x, 256, 0) >= 256 */); +} + +int PrintList(int fd, int x) { + int n = 0; + DCHECK_LE(x, 0); + if (x < cx) { + n += PrintChar(fd, L'!'); + n += PrintInt(fd, x, 0, 0, 0, 10, true); + } else { + if (ShouldConcealClosure(x)) { + x = Car(Cdr(x)); + } + n += PrintChar(fd, L'('); + if (x < 0) { + n += Print(fd, Car(x)); + if (ShouldForceDot(x)) { + n += PrintListDot(fd, Cdr(x)); + } else { + while ((x = Cdr(x))) { + if (x < 0) { + n += PrintSpace(fd); + n += Print(fd, Car(x)); + } else { + n += PrintListDot(fd, x); + break; + } + } + } + } + n += PrintChar(fd, L')'); + } + return n; +} + +bool HasWeirdCharacters(int x) { + int c; + dword e; + do { + e = Get(x); + c = LO(e); + x = HI(e); + if (c == L'`' || c == L'"' || c == L'\'' || IsSpace(c) || IsParen(c) || + IsSpace(c) || IsLower(c) || IsC0(c)) { + return true; + } + } while (x != TERM); + return false; +} + +int PrintString(int fd, int x) { + dword e; + int c, u, n; + n = PrintChar(fd, L'"'); + do { + e = Get(x); + c = LO(e); + x = HI(e); + DCHECK_GT(c, 0); + DCHECK_LT(c, TERM); + if (c < 0200) { + u = c; + c = L'\\'; + switch (c) { + CASE(L'\a', c |= L'a' << 010); + CASE(L'\b', c |= L'b' << 010); + CASE(00033, c |= L'e' << 010); + CASE(L'\f', c |= L'f' << 010); + CASE(L'\n', c |= L'n' << 010); + CASE(L'\r', c |= L'r' << 010); + CASE(L'\t', c |= L't' << 010); + CASE(L'\v', c |= L'v' << 010); + CASE(L'\\', c |= L'\\' << 010); + CASE(L'"', c |= L'"' << 010); + default: + if (32 <= c && c < 127) { + c = u; + } else { + c |= ((L'0' + c / 8 / 8 % 8) << 010 | (L'0' + c / 8 % 8) << 020 | + (L'0' + c % 8) << 030); + } + break; + } + do { + n += PrintChar(fd, c & 255); + } while ((c >>= 010)); + } else { + n += PrintChar(fd, c); + } + } while (x != TERM); + n += PrintChar(fd, L'"'); + return n; +} + +int PrintAtom(int fd, int x) { + dword e; + int c, n = 0; + DCHECK_GE(x, 0); + if (x == 0) { + if (symbolism && !literally) { + n += PrintChar(fd, L'⊥'); + } else { + n += PrintChar(fd, L'N'); + n += PrintChar(fd, L'I'); + n += PrintChar(fd, L'L'); + } + } else if (x == 1) { + if (symbolism && !literally) { + n += PrintChar(fd, L'⊤'); + } else { + n += PrintChar(fd, L'T'); + } + } else if (x >= TERM) { + n += PrintChar(fd, L'!'); + n += PrintInt(fd, x, 0, 0, 0, 10, true); + } else if (symbolism && (c = Symbolize(x)) != -1) { + n += PrintChar(fd, c); + } else { + if (!literally && HasWeirdCharacters(x)) { + n += PrintString(fd, x); + } else { + do { + e = Get(x); + c = LO(e); + n += PrintChar(fd, c); + } while ((x = HI(e)) != TERM); + } + } + return n; +} + +int EnterPrint(int x) { +#if 0 + int i; + if (x < 0) { + DCHECK_GE(pdp, 0); + DCHECK_LT(pdp, ARRAYLEN(g_print)); + if (x < 0) { + for (i = 0; i < pdp; ++i) { + if (x == g_print[i]) { + x = kCycle; + break; + } + } + } + g_print[pdp++] = x; + if (pdp == ARRAYLEN(g_print)) { + x = kTrench; + } + } +#endif + return x; +} + +void LeavePrint(int x) { +#if 0 + if (x < 0) { + --pdp; + } +#endif +} + +int Print(int fd, int x) { + int n; + GetName(&x); + x = EnterPrint(x); + if (1. / x < 0) { + n = PrintList(fd, x); + } else { + n = PrintAtom(fd, x); + } + LeavePrint(x); + return n; +} diff --git a/tool/plinko/lib/print.h b/tool/plinko/lib/print.h new file mode 100644 index 000000000..195406864 --- /dev/null +++ b/tool/plinko/lib/print.h @@ -0,0 +1,31 @@ +#ifndef COSMOPOLITAN_TOOL_PLINKO_LIB_PRINT_H_ +#define COSMOPOLITAN_TOOL_PLINKO_LIB_PRINT_H_ +#if !(__ASSEMBLER__ + __LINKER__ + 0) +COSMOPOLITAN_C_START_ + +int Print(int, int); +int PrettyPrint(int, int, int); + +bool ShouldForceDot(int); +bool ShouldConcealClosure(int); + +int EnterPrint(int); +int PrintArgs(int, int, int, int); +int PrintAtom(int, int); +int PrintChar(int, int); +int PrintDepth(int, int); +int PrintDot(int); +int PrintIndent(int, int); +int PrintInt(int, long, int, char, char, int, bool); +int PrintListDot(int, int); +int PrintSpace(int); +int PrintZeroes(int, int); +void GetName(int *); +void LeavePrint(int); +void PrintHeap(int); +void PrintNewline(int); +void PrintTree(int, int, int); + +COSMOPOLITAN_C_END_ +#endif /* !(__ASSEMBLER__ + __LINKER__ + 0) */ +#endif /* COSMOPOLITAN_TOOL_PLINKO_LIB_PRINT_H_ */ diff --git a/tool/plinko/lib/printchar.c b/tool/plinko/lib/printchar.c new file mode 100644 index 000000000..c6215497f --- /dev/null +++ b/tool/plinko/lib/printchar.c @@ -0,0 +1,42 @@ +/*-*- 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/nexgen32e/bsr.h" +#include "tool/plinko/lib/char.h" +#include "tool/plinko/lib/ktpenc.h" +#include "tool/plinko/lib/plinko.h" + +int PrintChar(int fd, int s) { + unsigned c; + int d, e, i, n; + c = s & 0xffffffff; + if (bp[fd] + 6 > sizeof(g_buffer[fd])) Flush(fd); + if (c < 0200) { + g_buffer[fd][bp[fd]++] = c; + if (c == L'\n') Flush(fd); + } else { + d = c; + e = kTpEnc[bsrl(d) - 7]; + i = n = e & 255; + do g_buffer[fd][bp[fd] + i--] = 0200 | (d & 077); + while (d >>= 6, i); + g_buffer[fd][bp[fd]] = d | e >> 8; + bp[fd] += n + 1; + } + return GetMonospaceCharacterWidth(c); +} diff --git a/tool/plinko/lib/printf.c b/tool/plinko/lib/printf.c new file mode 100644 index 000000000..2a13521b0 --- /dev/null +++ b/tool/plinko/lib/printf.c @@ -0,0 +1,304 @@ +/*-*- 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/strace.internal.h" +#include "libc/nexgen32e/rdtsc.h" +#include "libc/runtime/runtime.h" +#include "libc/str/str.h" +#include "tool/plinko/lib/char.h" +#include "tool/plinko/lib/plinko.h" +#include "tool/plinko/lib/print.h" +#include "tool/plinko/lib/printf.h" +#include "tool/plinko/lib/time.h" + +static inline long GetVarInt(va_list va, signed char t) { + if (t <= 0) return va_arg(va, int); + return va_arg(va, long); +} + +static int PrintStr(int fd, const char *s, int cols) { + int n, j, k = 0, i = 0; + n = strlen(s); + k += PrintIndent(fd, +cols - n); + while (i < n) k += PrintChar(fd, s[i++]); + k += PrintIndent(fd, -cols - n); + return k; +} + +int Printf(const char *f, ...) { + int n; + va_list va; + va_start(va, f); + n = Vfnprintf(f, va, 1, 0); + va_end(va); + return n; +} + +int Fprintf(int fd, const char *f, ...) { + int n; + va_list va; + va_start(va, f); + n = Vfnprintf(f, va, fd, 0); + va_end(va); + return n; +} + +int Fnprintf(int fd, int n, const char *f, ...) { + va_list va; + va_start(va, f); + n = Vfnprintf(f, va, fd, n); + va_end(va); + return n; +} + +int Vfprintf(const char *f, va_list va, int fd) { + return Vfnprintf(f, va, fd, 0); +} + +int Vfnprintf(const char *f, va_list va, int fd, int n) { + enum { kPlain, kEsc, kCsi }; + static int recursive; + dword t, u; + const char *s; + signed char type; + char quot, ansi, gotr, pdot, zero; + int b, c, i, x, y, si, prec, cols, sign; + gotr = false; + t = rdtsc(); + --g_ftrace; + --__strace; + ++recursive; + for (ansi = 0;;) { + for (;;) { + if (!(c = *f++ & 0377) || c == L'%') break; + if (c >= 0300) { + for (b = 0200; c & b; b >>= 1) { + c ^= b; + } + while ((*f & 0300) == 0200) { + c <<= 6; + c |= *f++ & 0177; + } + } + switch (ansi) { + case kPlain: + if (c == 033) { + ansi = kEsc; + } else if (c != L'\n' && c != L'\r') { + n += GetMonospaceCharacterWidth(c); + } else { + n = 0; + } + break; + case kEsc: + if (c == '[') { + ansi = kCsi; + } else { + ansi = kPlain; + } + break; + case kCsi: + if (0x40 <= c && c <= 0x7e) { + ansi = kPlain; + } + break; + default: + unreachable; + } + EmitFormatByte: + PrintChar(fd, c); + } + if (!c) break; + prec = 0; + pdot = 0; + cols = 0; + quot = 0; + type = 0; + zero = 0; + sign = 1; + for (;;) { + switch ((c = *f++)) { + default: + goto EmitFormatByte; + case L'n': + PrintNewline(fd); + n = 0; + break; + case L'l': + ++type; + continue; + case L'0': + case L'1': + case L'2': + case L'3': + case L'4': + case L'5': + case L'6': + case L'7': + case L'8': + case L'9': + si = pdot ? prec : cols; + si *= 10; + si += c - '0'; + goto UpdateCols; + case L'*': + si = va_arg(va, int); + UpdateCols: + if (pdot) { + prec = si; + } else { + if (si < 0) { + si = -si; + sign = -1; + } else if (!si) { + zero = 1; + } + cols = si; + } + continue; + case L'-': + sign = -1; + continue; + case L'.': + pdot = 1; + continue; + case L'_': + case L',': + case L'\'': + quot = c; + continue; + case L'I': + if (depth >= 0) { + n += PrintDepth(fd, depth); + } else { + n += PrintIndent(fd, sp * 2); + } + break; + case L'J': + if (depth >= 0) { + n += PrintDepth(fd, depth - 1); + } else { + n += PrintIndent(fd, (sp - 1) * 2); + } + break; + case L'V': + y = depth >= 0 ? depth : sp; + if (y) { + n += PrintIndent(fd, (y - 1) * 2); + n += PrintChar(fd, L'├'); + n += PrintChar(fd, L'─'); + } + break; + case L'W': + y = depth >= 0 ? depth : sp; + if (y) { + n += PrintIndent(fd, (y - 1) * 2); + n += PrintChar(fd, L'│'); + n += PrintChar(fd, L' '); + } + break; + case L'X': + y = depth >= 0 ? depth : sp; + if (y) { + n += PrintIndent(fd, (y - 1) * 2); + n += PrintChar(fd, L'└'); + n += PrintChar(fd, L'─'); + } + break; + case L'p': + if (simpler) goto SimplePrint; + // fallthrough + case L'P': + n += PrettyPrint(fd, va_arg(va, int), + MAX(0, depth > 0 ? n - depth * 3 : n)); + break; + case L'T': + PrintTree(fd, va_arg(va, int), n); + break; + case L'R': + gotr = true; + n += PrintInt(fd, ClocksToNanos(tick, t), cols * sign, quot, zero, 10, + true); + break; + case L'S': + SimplePrint: + n += Print(fd, va_arg(va, int)); + break; + case L'A': + y = va_arg(va, int); + x = va_arg(va, int); + n += PrintChar(fd, L'['); + n += PrintArgs(fd, y, x, 0); + n += PrintChar(fd, L']'); + break; + case L'K': + if ((b = va_arg(va, int)) < 0) { + PrintChar(fd, L'('); + for (;;) { + n += Print(fd, Car(Car(b))); + if ((b = Cdr(b)) >= 0) break; + PrintChar(fd, L' '); + } + PrintChar(fd, L')'); + } else { + n += Print(fd, b); + } + break; + case L'd': + n += PrintInt(fd, GetVarInt(va, type), cols * sign, quot, zero, 10, + true); + break; + case L'u': + n += + PrintInt(fd, GetVarInt(va, type), cols * sign, quot, zero, 10, 0); + break; + case L'b': + n += PrintInt(fd, GetVarInt(va, type), cols * sign, quot, zero, 2, 0); + break; + case L'o': + n += PrintInt(fd, GetVarInt(va, type), cols * sign, quot, zero, 8, 0); + break; + case L'x': + n += + PrintInt(fd, GetVarInt(va, type), cols * sign, quot, zero, 16, 0); + break; + case L's': + s = va_arg(va, const char *); + if (!s) s = "NULL"; + n += PrintStr(fd, s, cols * sign); + break; + case L'c': + n += PrintChar(fd, va_arg(va, int)); + break; + } + break; + } + } + --recursive; + ++g_ftrace; + ++__strace; + if (!recursive) { + u = rdtsc(); + if (gotr) { + tick = u; + } else { + tick -= u >= t ? u - t : ~t + u + 1; + } + } + return n; +} diff --git a/tool/plinko/lib/printf.h b/tool/plinko/lib/printf.h new file mode 100644 index 000000000..cdea08d88 --- /dev/null +++ b/tool/plinko/lib/printf.h @@ -0,0 +1,14 @@ +#ifndef COSMOPOLITAN_TOOL_PLINKO_LIB_PRINTF_H_ +#define COSMOPOLITAN_TOOL_PLINKO_LIB_PRINTF_H_ +#if !(__ASSEMBLER__ + __LINKER__ + 0) +COSMOPOLITAN_C_START_ + +int Printf(const char *, ...); +int Fprintf(int, const char *, ...); +int Fnprintf(int, int, const char *, ...); +int Vfprintf(const char *, va_list, int); +int Vfnprintf(const char *, va_list, int, int); + +COSMOPOLITAN_C_END_ +#endif /* !(__ASSEMBLER__ + __LINKER__ + 0) */ +#endif /* COSMOPOLITAN_TOOL_PLINKO_LIB_PRINTF_H_ */ diff --git a/tool/plinko/lib/printheap.c b/tool/plinko/lib/printheap.c new file mode 100644 index 000000000..a16759c1c --- /dev/null +++ b/tool/plinko/lib/printheap.c @@ -0,0 +1,52 @@ +/*-*- 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/runtime/symbols.internal.h" +#include "libc/str/str.h" +#include "tool/plinko/lib/plinko.h" +#include "tool/plinko/lib/printf.h" + +static const char *GetElfSymbol(uintptr_t funcaddr) { + int s; + static char buf[19]; + struct SymbolTable *t; + if ((t = GetSymbolTable())) { + if ((s = __get_symbol(t, funcaddr)) != -1) { + return t->name_base + t->names[s]; + } + } + buf[0] = '0'; + buf[1] = 'x'; + uint64toarray_radix16(funcaddr, buf + 2); + return buf; +} + +static const char *GetDispatchName(int x) { + const char *s; + s = GetElfSymbol(LO(GetShadow(x))); + if (startswith(s, "Dispatch")) s += 8; + return s; +} + +void PrintHeap(int i) { + for (; i-- > cx;) { + Printf("%10d (%10d . %10d) %10s[%10d] %p%n", i, LO(Get(i)), HI(Get(i)), + GetDispatchName(i), HI(GetShadow(i)), i); + } +} diff --git a/tool/plinko/lib/printint.c b/tool/plinko/lib/printint.c new file mode 100644 index 000000000..b1df779a7 --- /dev/null +++ b/tool/plinko/lib/printint.c @@ -0,0 +1,45 @@ +/*-*- 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/log/check.h" +#include "tool/plinko/lib/print.h" +#include "tool/plinko/lib/types.h" + +int PrintInt(int fd, long x, int cols, char quot, char zero, int base, + bool issigned) { + dword y; + char z[32]; + int i, j, k, n; + DCHECK_LE(base, 36); + i = j = 0; + y = x < 0 && issigned ? -x : x; + do { + if (quot && j == 3) z[i++ & 31] = quot, j = 0; + z[i++ & 31] = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"[y % base]; + } while (++j, (y /= base)); + k = i + (x < 0 && issigned); + if (zero) { + n = PrintZeroes(fd, +cols - k); + } else { + n = PrintIndent(fd, +cols - k); + } + if (x < 0 && issigned) n += PrintChar(fd, L'-'); + while (i) n += PrintChar(fd, z[--i & 31]); + PrintIndent(fd, -cols - n); + return n; +} diff --git a/tool/plinko/lib/printtree.c b/tool/plinko/lib/printtree.c new file mode 100644 index 000000000..f6d78d1c9 --- /dev/null +++ b/tool/plinko/lib/printtree.c @@ -0,0 +1,33 @@ +/*-*- 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/plinko/lib/print.h" +#include "tool/plinko/lib/printf.h" +#include "tool/plinko/lib/tree.h" + +void PrintTree(int fd, int N, int n) { + if (N >= 0) { + Print(fd, N); + } else { + Fnprintf(fd, n, "%s %S%n%I", Red(N) ? "RED" : "BLK", Key(Ent(N))); + PrintIndent(fd, n); + Fnprintf(fd, n + 2, "%I- %T%n%I", Lit(N)); + PrintIndent(fd, n); + Fnprintf(fd, n + 2, "%I- %T", Rit(N)); + } +} diff --git a/tool/plinko/lib/printvars.c b/tool/plinko/lib/printvars.c new file mode 100644 index 000000000..e89579aee --- /dev/null +++ b/tool/plinko/lib/printvars.c @@ -0,0 +1,51 @@ +/*-*- 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/plinko/lib/plinko.h" +#include "tool/plinko/lib/print.h" + +int PrintArgs(int fd, int keys, int vals, int n) { + if (!keys) return n; + if (keys > 0) { + if (!(vals < 0 && Car(vals) == kClosure)) { + if (n) { + n += PrintChar(fd, L';'); + n += PrintChar(fd, L' '); + } + n += Print(fd, keys); + n += PrintChar(fd, L'='); + n += Print(fd, vals); + } + return n; + } + if (vals > 0) { + if (n) { + n += PrintChar(fd, L';'); + n += PrintChar(fd, L' '); + } + n += Print(fd, Car(keys)); + n += PrintChar(fd, L'='); + n += PrintChar(fd, L'!'); + n += Print(fd, vals); + vals = 0; + } else { + n += PrintArgs(fd, Car(keys), Car(vals), n); + } + if (!Cdr(keys)) return n; + return PrintArgs(fd, Cdr(keys), Cdr(vals), n); +} diff --git a/tool/plinko/lib/read.c b/tool/plinko/lib/read.c new file mode 100644 index 000000000..f35c06a6f --- /dev/null +++ b/tool/plinko/lib/read.c @@ -0,0 +1,289 @@ +/*-*- 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/calls/strace.internal.h" +#include "libc/errno.h" +#include "libc/log/check.h" +#include "libc/runtime/runtime.h" +#include "libc/str/str.h" +#include "libc/sysv/consts/o.h" +#include "tool/plinko/lib/char.h" +#include "tool/plinko/lib/cons.h" +#include "tool/plinko/lib/error.h" +#include "tool/plinko/lib/plinko.h" +#include "tool/plinko/lib/printf.h" + +static int Read1(int); +static int Read2(int); + +noinstrument int ReadSpaces(int fd) { + size_t n; + ssize_t rc; + for (;;) { + rc = read(fd, g_buffer[fd], sizeof(g_buffer[fd]) - 1); + if (rc != -1) { + if ((n = rc)) { + g_buffer[fd][n] = 0; + bp[fd] = 1; + return g_buffer[fd][0] & 255; + } else if (fd == 0 && *inputs) { + close(0); + if (open(*inputs++, O_RDONLY) == -1) { + ++fails; + Flush(1); + Fprintf(2, "error: open(%s) %s%n", inputs[-1], strerror(errno)); + longjmp(exiter, 1); + } + } else { + Flush(1); + Flush(2); + longjmp(exiter, 1); + } + } else if (errno != EINTR) { + ++fails; + Flush(1); + Fprintf(2, "error: read(%d) %s%n", fd, strerror(errno)); + longjmp(exiter, 1); + } + } +} + +noinstrument int ReadByte(int fd) { + int c; + if ((c = g_buffer[fd][bp[fd]++] & 255)) return c; + return ReadSpaces(fd); +} + +noinstrument int ReadChar(int fd) { + int b, a = dx; + for (;;) { + dx = ReadByte(fd); + if (dx != ';') { + break; + } else { + do b = ReadByte(fd); + while ((b != '\n')); + } + } + if (a >= 0300) { + for (b = 0200; a & b; b >>= 1) { + a ^= b; + } + while ((dx & 0300) == 0200) { + a <<= 6; + a |= dx & 0177; + dx = ReadByte(fd); + } + } + if (0 < a && a < TERM) { + return ToUpper(a); + } + Error("thompson-pike varint outside permitted range"); +} + +static int ReadListItem(int fd, int closer, int f(int)) { + int i, n, x, y; + dword t; + if ((x = f(fd)) > 0) { + if (Get(x) == MAKE(closer, TERM)) return -0; + if (Get(x) == MAKE(L'.', TERM)) { + x = f(fd); + if ((y = ReadListItem(fd, closer, Read1))) { + Error("multiple list items after dot: %S", y); + } + return x; + } + } + return ShareCons(x, ReadListItem(fd, closer, Read1)); +} + +static int ReadList(int fd, int closer) { + int t; + ++fails; + t = ReadListItem(fd, closer, Read2); + --fails; + return t; +} + +static int TokenizeInteger(int fd, int b) { + dword a; + int c, i, x, y; + for (i = a = 0;; ++i) { + if ((c = GetDiglet(ToUpper(dx))) != -1 && c < b) { + a = (a * b) + c; + ReadChar(fd); + } else { + ax = TERM; + return Intern(a, TERM); + } + } +} + +static void ConsumeComment(int fd) { + int c, t = 1; + for (;;) { + c = ReadChar(fd); + if (c == '#' && dx == '|') ++t; + if (!t) return; + if (c == '|' && dx == '#') --t; + } +} + +static int ReadAtomRest(int fd, int x) { + int y, t, u; + ax = y = TERM; + if (x == L'\\') x = ReadChar(fd); + if (!IsSpace(dx) && !IsParen(dx) && !IsMathAlnum(x) && !IsMathAlnum(dx)) { + y = ReadAtomRest(fd, ReadChar(fd)); + } + return Intern(x, y); +} + +static int ReadAtom(int fd) { + int a, s, x; + x = ReadChar(fd); + if ((s = Desymbolize(x)) != -1) return s; + a = ReadAtomRest(fd, x); + if (LO(Get(a)) == L'T' && HI(Get(a)) == TERM) { + a = 1; + } else if (LO(Get(a)) == L'N' && HI(Get(a)) != TERM && + LO(Get(HI(Get(a)))) == L'I' && HI(Get(HI(Get(a)))) != TERM && + LO(Get(HI(Get(HI(Get(a)))))) == L'L' && + HI(Get(HI(Get(HI(Get(a)))))) == TERM) { + a = 0; + } + return a; +} + +static int TokenizeComplicated(int fd) { + int c; + ReadChar(fd); + switch ((c = ReadChar(fd))) { + case L'\'': + return List(kFunction, Read(fd)); + case L'B': + return TokenizeInteger(fd, 2); + case L'X': + return TokenizeInteger(fd, 16); + case L'Z': + return TokenizeInteger(fd, 36); + case L'O': + return TokenizeInteger(fd, 8); + case L'|': + ConsumeComment(fd); + return Read(fd); + default: + Error("unsuppported complicated syntax #%c [0x%x]", c, c); + } +} + +static int Read2(int fd) { + int r, f, t, l; + while (IsSpace((l = dx))) ReadChar(fd); + switch (dx) { + case L'#': + r = TokenizeComplicated(fd); + break; + case L'\'': + ReadChar(fd); + r = ShareList(kQuote, Read(fd)); + break; + case L'`': + ReadChar(fd); + r = ShareList(kBackquote, Read(fd)); + break; + case L',': + ReadChar(fd); + if (dx == L'@') { + ReadChar(fd); + r = ShareList(kSplice, Read(fd)); + } else { + r = ShareList(kComma, Read(fd)); + } + break; + case L'"': + r = ShareList(kString, ReadString(fd, ReadByte(fd))); + break; + case L'(': + ReadChar(fd); + r = ReadList(fd, L')'); + break; + case L'[': + ReadChar(fd); + r = ShareList(kSquare, ReadList(fd, L']')); + break; + case L'{': + ReadChar(fd); + r = ShareList(kCurly, ReadList(fd, L'}')); + break; + default: + r = ReadAtom(fd); + break; + } + return r; +} + +static int ReadLambda(int fd, int n) { + int a, c, r, q = 0; + do { + c = ReadChar(fd); + if (c == L'λ') { + for (a = 0; (c = ReadChar(fd)) != '.';) { + a = Cons(Intern(c, TERM), a); + } + for (r = ReadLambda(fd, n); a; a = Cdr(a)) { + r = List3(kLambda, Cons(Car(a), 0), r); + } + } else if (c == L'(') { + r = ReadLambda(fd, n + 1); + } else if (c == L')') { + break; + } else if (IsSpace(c)) { + Raise(kRead); + } else { + r = Intern(c, TERM); + } + if (!q) { + q = r; + } else { + q = List(q, r); + } + if (!n && dx == L')') break; + } while (!IsSpace(dx)); + return q; +} + +static int Read1(int fd) { + while (IsSpace(dx)) ReadChar(fd); + // todo: fix horrible i/o + if (dx == 0xCE && (g_buffer[fd][bp[fd]] & 255) == 0xbb) { + return ReadLambda(fd, 0); + } + return Read2(fd); +} + +int Read(int fd) { + int r; + --g_ftrace; + --__strace; + r = Read1(fd); + ++g_ftrace; + ++__strace; + return r; +} diff --git a/tool/plinko/lib/readstring.c b/tool/plinko/lib/readstring.c new file mode 100644 index 000000000..29bc5f445 --- /dev/null +++ b/tool/plinko/lib/readstring.c @@ -0,0 +1,74 @@ +/*-*- 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/build/lib/case.h" +#include "tool/plinko/lib/char.h" +#include "tool/plinko/lib/plinko.h" + +int ReadString(int fd, unsigned x) { + int i, n, y, z; + ax = y = TERM; + if (x == L'"') { + dx = ReadByte(fd); + return ax; + } else { + z = ReadByte(fd); + if (x == L'\\') { + x = z; + z = ReadByte(fd); + switch (x) { + CASE(L'a', x = L'\a'); + CASE(L'b', x = L'\b'); + CASE(L'e', x = 00033); + CASE(L'f', x = L'\f'); + CASE(L'n', x = L'\n'); + CASE(L'r', x = L'\r'); + CASE(L't', x = L'\t'); + CASE(L'v', x = L'\v'); + case L'x': + n = 2; + goto ReadHexEscape; + case L'u': + n = 4; + goto ReadHexEscape; + case L'U': + n = 8; + goto ReadHexEscape; + default: + if (IsDigit(x)) { + x = GetDiglet(x); + for (i = 0; IsDigit(z) && i < 2; ++i) { + x *= 8; + x += GetDiglet(z); + z = ReadByte(fd); + } + } + break; + ReadHexEscape: + for (x = i = 0; IsHex(z) && i < n; ++i) { + x *= 16; + x += GetDiglet(z); + z = ReadByte(fd); + } + break; + } + } + y = ReadString(fd, z); + } + return Intern(x, y); +} diff --git a/tool/plinko/lib/reverse.c b/tool/plinko/lib/reverse.c new file mode 100644 index 000000000..129680282 --- /dev/null +++ b/tool/plinko/lib/reverse.c @@ -0,0 +1,30 @@ +/*-*- 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/plinko/lib/cons.h" +#include "tool/plinko/lib/plinko.h" + +int Reverse(int x, int y) { + dword t; + while (x < 0) { + t = Get(x); + x = HI(t); + y = Cons(LO(t), y); + } + return y; +} diff --git a/tool/plinko/lib/setup.c b/tool/plinko/lib/setup.c new file mode 100644 index 000000000..4f36e970b --- /dev/null +++ b/tool/plinko/lib/setup.c @@ -0,0 +1,139 @@ +/*-*- 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/str/str.h" +#include "tool/plinko/lib/cons.h" +#include "tool/plinko/lib/plinko.h" + +static void SetInput(const char *s) { + bp[0] = 0; + dx = L' '; + strcpy(stpcpy(g_buffer[0], s), " "); +} + +static void Programme(int i, DispatchFn *f, int x) { + SetShadow(i, MAKE(EncodeDispatchFn(f), x)); +} + +static void Program(int i, DispatchFn *f) { + Programme(i, f, 0); +} + +static void ProgramPrecious(int i) { + Program(i, DispatchPrecious); +} + +static void ProgramLookup(int i) { + Program(i, DispatchLookup); +} + +static void ProgramIgnore0(int i) { + Program(i, DispatchIgnore0); +} + +static void ProgramPlan(int i) { + Program(i, DispatchPlan); +} + +void Setup(void) { + int i; + char buf[4] = "(A)"; + SetShadow(-1, DF(DispatchPlan)); + SetShadow(0, DF(DispatchPrecious)); + SetShadow(+1, DF(DispatchPrecious)); + PROG(ProgramPrecious, kEq, "EQ"); + PROG(ProgramPrecious, kGc, "GC"); + PROG(ProgramPrecious, kCmp, "CMP"); + PROG(ProgramPrecious, kCar, "CAR"); + PROG(ProgramPrecious, kCdr, "CDR"); + PROG(ProgramPrecious, kBeta, "BETA"); + PROG(ProgramPrecious, kAtom, "ATOM"); + PROG(ProgramPrecious, kCond, "COND"); + PROG(ProgramPrecious, kCons, "CONS"); + PROG(ProgramPrecious, kRead, "READ"); + PROG(ProgramPrecious, kDump, "DUMP"); + PROG(ProgramPrecious, kExit, "EXIT"); + PROG(ProgramPrecious, kFork, "FORK"); + PROG(ProgramPrecious, kQuote, "QUOTE"); + PROG(ProgramPrecious, kProgn, "PROGN"); + PROG(ProgramPrecious, kMacro, "MACRO"); + PROG(ProgramPrecious, kQuiet, "QUIET"); + PROG(ProgramPrecious, kError, "ERROR"); + PROG(ProgramPrecious, kTrace, "TRACE"); + PROG(ProgramPrecious, kPrint, "PRINT"); + PROG(ProgramPrecious, kPrinc, "PRINC"); + PROG(ProgramPrecious, kFlush, "FLUSH"); + PROG(ProgramPrecious, kOrder, "ORDER"); + PROG(ProgramPrecious, kGensym, "GENSYM"); + PROG(ProgramPrecious, kPprint, "PPRINT"); + PROG(ProgramPrecious, kIgnore, "IGNORE"); + PROG(ProgramPrecious, kMtrace, "MTRACE"); + PROG(ProgramPrecious, kFtrace, "FTRACE"); + PROG(ProgramPrecious, kGtrace, "GTRACE"); + PROG(ProgramPrecious, kLambda, "LAMBDA"); + PROG(ProgramPrecious, kDefine, "DEFINE"); + PROG(ProgramPrecious, kExpand, "EXPAND"); + PROG(ProgramPrecious, kClosure, "CLOSURE"); + PROG(ProgramPrecious, kPartial, "PARTIAL"); + PROG(ProgramPrecious, kFunction, "FUNCTION"); + PROG(ProgramPrecious, kIntegrate, "INTEGRATE"); + PROG(ProgramPrecious, kPrintheap, "PRINTHEAP"); + PROG(ProgramPrecious, kImpossible, "IMPOSSIBLE"); + PROG(ProgramLookup, kComma, "COMMA_"); + PROG(ProgramLookup, kSplice, "SPLICE_"); + PROG(ProgramLookup, kBackquote, "BACKQUOTE_"); + PROG(ProgramLookup, kString, "STRING_"); + PROG(ProgramLookup, kSquare, "SQUARE_"); + PROG(ProgramLookup, kCurly, "CURLY_"); + PROG(ProgramLookup, kDefun, "DEFUN"); + PROG(ProgramLookup, kDefmacro, "DEFMACRO"); + PROG(ProgramLookup, kAppend, "APPEND"); + PROG(ProgramLookup, kOr, "OR"); + PROG(ProgramLookup, kAnd, "AND"); + PROG(ProgramLookup, kIntersection, "INTERSECTION"); + PROG(ProgramLookup, kList, "LIST"); + PROG(ProgramLookup, kMember, "MEMBER"); + PROG(ProgramLookup, kNot, "NOT"); + PROG(ProgramLookup, kReverse, "REVERSE"); + PROG(ProgramLookup, kSqrt, "SQRT"); + PROG(ProgramLookup, kSubset, "SUBSET"); + PROG(ProgramLookup, kSuperset, "SUPERSET"); + PROG(ProgramLookup, kBecause, "BECAUSE"); + PROG(ProgramLookup, kTherefore, "THEREFORE"); + PROG(ProgramLookup, kUnion, "UNION"); + PROG(ProgramLookup, kImplies, "IMPLIES"); + PROG(ProgramLookup, kYcombinator, "YCOMBINATOR"); + PROG(ProgramLookup, kNand, "NAND"); + PROG(ProgramLookup, kNor, "NOR"); + PROG(ProgramLookup, kXor, "XOR"); + PROG(ProgramLookup, kIff, "IFF"); + PROG(ProgramLookup, kCycle, "CYCLE"); + PROG(ProgramLookup, kTrench, "𝕋ℝ𝔼ℕℂℍ"); + PROG(ProgramLookup, kUnchanged, "ⁿ/ₐ"); + PROG(ProgramIgnore0, kIgnore0, "(IGNORE)"); + for (i = 0; i < 26; ++i, ++buf[1]) { + PROG(ProgramPlan, kConsAlphabet[i], buf); + } + for (buf[0] = L'A', buf[1] = 0, i = 0; i < 26; ++i, ++buf[0]) { + if (buf[0] != 'T') { + PROG(ProgramLookup, kAlphabet[i], buf); + } else { + kAlphabet[i] = 1; + } + } +} diff --git a/tool/plinko/lib/stack.h b/tool/plinko/lib/stack.h new file mode 100644 index 000000000..f1cfa95b5 --- /dev/null +++ b/tool/plinko/lib/stack.h @@ -0,0 +1,48 @@ +#ifndef COSMOPOLITAN_TOOL_PLINKO_LIB_STACK_H_ +#define COSMOPOLITAN_TOOL_PLINKO_LIB_STACK_H_ +#include "libc/log/check.h" +#include "tool/plinko/lib/error.h" +#include "tool/plinko/lib/plinko.h" +#if !(__ASSEMBLER__ + __LINKER__ + 0) +COSMOPOLITAN_C_START_ + +#define SetFrame(r, x) \ + do { \ + if (r & NEED_POP) { \ + Repush(x); \ + } else { \ + r |= NEED_POP; \ + Push(x); \ + } \ + } while (0) + +forceinline dword GetCurrentFrame(void) { + DCHECK_GT(sp, 0); + return g_stack[(sp - 1) & 0xffffffff]; +} + +forceinline void Push(int x) { + unsigned short s = sp; + g_stack[s] = MAKE(x, ~cx); + if (!__builtin_add_overflow(s, 1, &s)) { + sp = s; + } else { + StackOverflow(); + } +} + +forceinline dword Pop(void) { + DCHECK_GT(sp, 0); + return g_stack[--sp & 0xffffffff]; +} + +forceinline void Repush(int x) { + int i; + DCHECK_GT(sp, 0); + i = (sp - 1) & MASK(STACK); + g_stack[i & 0xffffffff] = MAKE(x, HI(g_stack[i & 0xffffffff])); +} + +COSMOPOLITAN_C_END_ +#endif /* !(__ASSEMBLER__ + __LINKER__ + 0) */ +#endif /* COSMOPOLITAN_TOOL_PLINKO_LIB_STACK_H_ */ diff --git a/tool/plinko/lib/symbolize.c b/tool/plinko/lib/symbolize.c new file mode 100644 index 000000000..1656f19f9 --- /dev/null +++ b/tool/plinko/lib/symbolize.c @@ -0,0 +1,112 @@ +/*-*- 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/plinko/lib/plinko.h" + +pureconst int Symbolize(int x) { + if (literally) return -1; + if (x == TERM) return -1; + DCHECK_LT(x, TERM); + switch (LO(Get(x))) { + case L'A': + if (x == kAtom) return L'α'; + if (x == kAnd) return L'∧'; + if (x == kAppend) return L'║'; + return -1; + case L'B': + if (x == kBeta) return L'β'; + if (x == kBecause) return L'∵'; + return -1; + case L'C': + if (x == kCar) return L'⍅'; + if (x == kCdr) return L'⍆'; + if (x == kClosure) return L'⅄'; + if (x == kCond) return L'ζ'; + if (x == kCons) return L'ℶ'; + if (x == kCmp) return L'≷'; + if (x == kCycle) return L'⟳'; + return -1; + case L'D': + if (x == kDefine) return L'≝'; + if (x == kDefmacro) return L'Ψ'; + if (x == kDefun) return L'Λ'; + return -1; + case L'E': + if (x == kEq) return L'≡'; + if (x == kExpand) return L'ə'; + return -1; + case L'F': + if (x == kFunction) return L'𝑓'; + if (x == kFork) return L'⋔'; + return -1; + case L'P': + if (x == kPartial) return L'∂'; + return -1; + case L'I': + if (x == kIff) return L'⟺'; + if (x == kImplies) return L'⟶'; + if (x == kIntegrate) return L'∫'; + if (x == kIntersection) return L'∩'; + return -1; + case L'L': + if (x == kLambda) return L'λ'; + if (x == kList) return L'ℒ'; + return -1; + case L'M': + if (x == kMacro) return L'ψ'; + if (x == kMember) return L'∊'; + return -1; + case L'N': + if (!x) return L'⊥'; + if (x == kNand) return L'⊼'; + if (x == kNor) return L'⊽'; + if (x == kNot) return L'¬'; + return -1; + case L'O': + if (x == kOr) return L'∨'; + if (x == kOrder) return L'⊙'; + return -1; + case L'Q': + if (x == kQuote) return L'Ω'; + return -1; + case L'R': + if (x == kReverse) return L'Я'; + return -1; + case L'S': + if (x == kSqrt) return L'√'; + if (x == kSubset) return L'⊂'; + if (x == kSuperset) return L'⊃'; + return -1; + case L'T': + if (x == 1) return L'⊤'; + if (x == kTherefore) return L'∴'; + return -1; + case L'U': + if (x == kUnion) return L'∪'; + if (x == kImpossible) return L'∅'; + return -1; + case L'X': + if (x == kXor) return L'⊻'; + return -1; + case L'Y': + if (x == kYcombinator) return L'𝕐'; + return -1; + default: + return -1; + } +} diff --git a/tool/plinko/lib/time.h b/tool/plinko/lib/time.h new file mode 100644 index 000000000..4177de518 --- /dev/null +++ b/tool/plinko/lib/time.h @@ -0,0 +1,15 @@ +#ifndef COSMOPOLITAN_TOOL_PLINKO_LIB_TIME_H_ +#define COSMOPOLITAN_TOOL_PLINKO_LIB_TIME_H_ +#if !(__ASSEMBLER__ + __LINKER__ + 0) +COSMOPOLITAN_C_START_ + +static inline uint64_t ClocksToNanos(uint64_t x, uint64_t y) { + // approximation of round(x*.323018) which is usually + // the ratio between inva rdtsc ticks and nanoseconds + uint128_t difference = x - y; + return (difference * 338709) >> 20; +} + +COSMOPOLITAN_C_END_ +#endif /* !(__ASSEMBLER__ + __LINKER__ + 0) */ +#endif /* COSMOPOLITAN_TOOL_PLINKO_LIB_TIME_H_ */ diff --git a/tool/plinko/lib/trace.c b/tool/plinko/lib/trace.c new file mode 100644 index 000000000..19d69c570 --- /dev/null +++ b/tool/plinko/lib/trace.c @@ -0,0 +1,231 @@ +/*-*- 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/plinko/lib/plinko.h" +#include "tool/plinko/lib/printf.h" +#include "tool/plinko/lib/trace.h" + +void EnableTracing(void) { + eval = EvalTrace; + bind_ = BindTrace; + evlis = EvlisTrace; + pairlis = PairlisTrace; + recurse = RecurseTrace; + expand = mtrace ? ExpandTrace : Expand; + kTail[0] = DispatchTailTrace; + kTail[4] = DispatchTailTrace; + kTail[5] = DispatchTailGcTrace; + kTail[6] = DispatchTailTrace; + kTail[7] = DispatchTailTmcGcTrace; +} + +static inline int ShortenExpression(int e) { + return e; +} + +static bool AlwaysTrace(int e) { + return true; +} +static bool LimitedTrace(int e) { + return e < 0; +} + +static relegated struct T TailTracer(dword ea, dword tm, dword r, dword p1, + dword p2, TailFn *f) { + if (depth < ARRAYLEN(g_depths)) { + Fprintf(2, "%J╠═Tail[%p @ %d] p1=%S p2=%S δ %'Rns%n", + ShortenExpression(LO(ea)), LO(ea), LO(p1), LO(p2)); + } + return f(ea, tm, r, p1, p2); +} + +relegated struct T DispatchTailTrace(dword ea, dword tm, dword r, dword p1, + dword p2) { + return TailTracer(ea, tm, r, p1, p2, DispatchTail); +} + +relegated struct T DispatchTailGcTrace(dword ea, dword tm, dword r, dword p1, + dword p2) { + return TailTracer(ea, tm, r, p1, p2, DispatchTailGc); +} + +relegated struct T DispatchTailTmcGcTrace(dword ea, dword tm, dword r, dword p1, + dword p2) { + int x; + if (depth < ARRAYLEN(g_depths)) { + x = LO(tm); + x = x < 0 ? x : ~x; + Fprintf(2, "%J╟⟿Cons[%p @ %d] δ %'Rns%n", x, x); + } + return TailTracer(ea, tm, r, p1, p2, DispatchTailTmcGc); +} + +static relegated int Trace(int e, int a, EvalFn *f, bool p(int), const char *s, + const unsigned short c[5]) { + int d, r, rp, S = sp; + DCHECK_GE(depth, -1); + d = depth; + depth = MAX(d, 0); + if (depth < ARRAYLEN(g_depths)) { + if (p(e)) { + if (loga) { + Fprintf(2, "%I%c%c%s[e=%S @ %d; a=%S @ %d] δ %'Rns%n", c[0], c[1], s, + ShortenExpression(e), e, a, a); + } else { + Fprintf(2, "%I%c%c%s[%S @ %d] δ %'Rns%n", c[0], c[1], s, + ShortenExpression(e), e); + } + } + g_depths[depth][0] = c[2]; + g_depths[depth][1] = L' '; + g_depths[depth][2] = L' '; + } + ++depth; + r = f(e, a); + --depth; + if (depth < ARRAYLEN(g_depths) && p(e)) { + rp = r != e ? r : kUnchanged; + if (sp == S) { + Fprintf(2, "%I%c%c%p @ %d %'Rns%n", c[3], c[4], rp, r); + } else { + Fprintf(2, "%I%c%c%p @ %d %'Rns [STACK SKEW S=%d vs. sp=%d]%n", c[3], + c[4], rp, r, S, sp); + } + } + depth = d; + return r; +} + +relegated int RecurseTrace(dword ea, dword p1, dword p2) { + int r, d, S = sp; + const char *s = "Recurse"; + const unsigned short c[5] = u"╔═║╚═"; + if (depth < ARRAYLEN(g_depths)) { + if (loga) { + Fprintf(2, + "%I%c%c%s[LO(ea)=%S @ %d; HI(ea)=%S @ %d] p1=%S p2=%S δ %'Rns%n", + c[0], c[1], s, ShortenExpression(LO(ea)), LO(ea), HI(ea), HI(ea), + LO(p1), LO(p2)); + } else { + Fprintf(2, "%I%c%c%s[%S @ %d] p1=%S p2=%S δ %'Rns%n", c[0], c[1], s, + ShortenExpression(LO(ea)), LO(ea), LO(p1), LO(p2)); + } + g_depths[depth][0] = c[2]; + g_depths[depth][1] = L' '; + g_depths[depth][2] = L' '; + } + ++depth; + r = Recurse(ea, p1, p2); + --depth; + if (depth < ARRAYLEN(g_depths)) { + if (r != LO(ea)) { + Fprintf(2, "%I%c%c%p @ %d δ %'Rns%n", c[3], c[4], r, r); + } else { + Fprintf(2, "%I%c%cⁿ/ₐ δ %'Rns%n", c[3], c[4]); + } + } + return r; +} + +relegated int EvlisTrace(int e, int a, dword p1, dword p2) { + int r, d, S = sp; + const char *s = "Evlis"; + const unsigned short c[5] = u"╒─┆╘─"; + DCHECK_GE(depth, -1); + d = depth; + depth = MAX(d, 0); + if (depth < ARRAYLEN(g_depths)) { + if (loga) { + Fprintf(2, "%I%c%c%s[e=%S @ %d; a=%S @ %d] δ %'Rns%n", c[0], c[1], s, + ShortenExpression(e), e, a, a); + } else { + Fprintf(2, "%I%c%c%s[%S @ %d] δ %'Rns%n", c[0], c[1], s, + ShortenExpression(e), e); + } + g_depths[depth][0] = c[2]; + g_depths[depth][1] = L' '; + g_depths[depth][2] = L' '; + } + ++depth; + r = Evlis(e, a, p1, p2); + --depth; + if (depth < ARRAYLEN(g_depths)) { + if (r != e) { + Fprintf(2, "%I%c%c%p @ %d δ %'Rns%n", c[3], c[4], r, r); + } else { + Fprintf(2, "%I%c%cⁿ/ₐ δ %'Rns%n", c[3], c[4]); + } + } + depth = d; + return r; +} + +relegated int Trace3(int x, int y, int a, PairFn *f, const char *s, + const unsigned short c[5]) { + int r, d, S = sp; + if (depth < ARRAYLEN(g_depths)) { + if (loga) { + Fprintf(2, "%I%c%c%s[x=%S; y=%S; a=%S] δ %'Rns%n", c[0], c[1], s, + ShortenExpression(x), ShortenExpression(y), a); + } else { + Fprintf(2, "%I%c%c%s[x=%S; y=%S] δ %'Rns%n", c[0], c[1], s, + ShortenExpression(x), ShortenExpression(y)); + } + g_depths[depth][0] = c[2]; + g_depths[depth][1] = L' '; + g_depths[depth][2] = L' '; + } + ++depth; + r = f(x, y, a); + --depth; + return r; +} + +relegated struct Binding BindTrace(int x, int y, int a, int u, dword p1, + dword p2) { + int d, S = sp; + struct Binding r; + if (depth < ARRAYLEN(g_depths)) { + if (loga) { + Fprintf(2, "%I%c%c%s[x=%S; y=%S; a=%S; u=%S] δ %'Rns%n", L'╒', L'─', + "Bind", ShortenExpression(x), ShortenExpression(y), a, u); + } else { + Fprintf(2, "%I%c%c%s[x=%S; y=%S] δ %'Rns%n", L'╒', L'─', "Bind", + ShortenExpression(x), ShortenExpression(y)); + } + g_depths[depth][0] = L'┋'; + g_depths[depth][1] = L' '; + g_depths[depth][2] = L' '; + } + ++depth; + r = Bind(x, y, a, u, p1, p2); + --depth; + return r; +} + +int EvalTrace(int e, int a) { + return Trace(e, a, Eval, AlwaysTrace, "Eval", u"╔═║╚═"); +} + +int ExpandTrace(int e, int a) { + return Trace(e, a, Expand, LimitedTrace, "Expand", u"┌─│└─"); +} + +int PairlisTrace(int x, int y, int a) { + return Trace3(x, y, a, Pairlis, "Pairlis", u"╒─┊╘─"); +} diff --git a/tool/plinko/lib/trace.h b/tool/plinko/lib/trace.h new file mode 100644 index 000000000..9f68a381a --- /dev/null +++ b/tool/plinko/lib/trace.h @@ -0,0 +1,41 @@ +#ifndef COSMOPOLITAN_TOOL_PLINKO_LIB_TRACE_H_ +#define COSMOPOLITAN_TOOL_PLINKO_LIB_TRACE_H_ +#include "libc/str/str.h" +#if !(__ASSEMBLER__ + __LINKER__ + 0) +COSMOPOLITAN_C_START_ + +#define START_TRACE \ + bool t; \ + PairFn *pf; \ + BindFn *bf; \ + EvlisFn *ef; \ + RecurseFn *rf; \ + unsigned char mo; \ + TailFn *tails[8]; \ + EvalFn *ev, *ex; \ + memcpy(tails, kTail, sizeof(kTail)); \ + ev = eval; \ + bf = bind_; \ + ef = evlis; \ + ex = expand; \ + pf = pairlis; \ + rf = recurse; \ + EnableTracing(); \ + t = trace; \ + trace = true + +#define END_TRACE \ + trace = t; \ + eval = ev; \ + bind_ = bf; \ + evlis = ef; \ + expand = ex; \ + pairlis = pf; \ + recurse = rf; \ + memcpy(kTail, tails, sizeof(kTail)) + +void EnableTracing(void); + +COSMOPOLITAN_C_END_ +#endif /* !(__ASSEMBLER__ + __LINKER__ + 0) */ +#endif /* COSMOPOLITAN_TOOL_PLINKO_LIB_TRACE_H_ */ diff --git a/tool/plinko/lib/tree.c b/tool/plinko/lib/tree.c new file mode 100644 index 000000000..cc47482d8 --- /dev/null +++ b/tool/plinko/lib/tree.c @@ -0,0 +1,260 @@ +/*-*- 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/log/check.h" +#include "tool/plinko/lib/index.h" +#include "tool/plinko/lib/tree.h" + +int Nod(int E, int L, int R, int C) { +#ifndef NDEBUG + DCHECK_LE(L, 0); + DCHECK_LE(R, 0); + DCHECK_EQ(0, C & ~1); +#endif + return Cons(Cons(E, (L | R) ? Cons(L, R) : 0), C); +} + +static void CheckTreeImpl(int N) { + int p, e, L, R; + if (N >= 0) Error("N is atom: %S", N); + if (Car(N) >= 0) Error("Car(N) is an atom: %S", N); + if (Cdr(N) & ~1) Error("Cdr(N) is non-bool: %S", N); + if ((L = Lit(N))) { + if ((p = Cmp(Key(Ent(L)), Key(Ent(N)))) != -1) { + Error("Cmp(Key(L), Key(N)) != -1%n" + "Result = %d%n" + "Key(L) = %p%n" + "Key(N) = %p", + p, Key(Ent(L)), Key(Ent(N))); + } + if (Red(N) && Red(L)) { + Error("left node and its parent are both red%n%T", N); + } + CheckTreeImpl(L); + } + if ((R = Rit(N))) { + if ((p = Cmp(Key(Ent(R)), Key(Ent(N)))) != +1) { + Error("Cmp(Key(R), Key(N)) != +1%n" + "Result = %d%n" + "Key(R) = %p%n" + "Key(N) = %p", + p, Key(Ent(R)), Key(Ent(N))); + } + if (Red(N) && Red(R)) { + Error("right node and its parent are both red%n%T", N); + } + CheckTreeImpl(R); + } +} + +static int CheckTree(int N) { +#if DEBUG_TREE + if (N) { + if (Red(N)) Error("tree root is red%n%T", N); + CheckTreeImpl(N); + } +#endif + return N; +} + +static int BalTree(int E, int L, int R, int C) { + // Chris Okasaki "Red-Black Trees in a Functional Setting"; + // Functional Pearls, Cambridge University Press, Jan 1993. + int LL, LR, RL, RR; + if (!C) { + LL = Lit(L); + LR = Rit(L); + RL = Lit(R); + RR = Rit(R); + if (Red(L) && Red(LR)) { + // Degenerate Case No. 1 + // Complete the Triforce + // + // Z + // ╱ ╲ 𝐘 + // 𝐗 d ╱ ╲ + // ╱ ╲ → X Z + // a 𝐘 ╱ ╲ ╱ ╲ + // ╱ ╲ a b c d + // b c + // + // ((Z ((X a (Y b . c) . t) . t) . d)) → + // ((Y ((X a . b)) (Z c . d)) . t) + L = Nod(Ent(L), LL, Lit(LR), 0); + R = Nod(E, Rit(LR), R, 0); + E = Ent(LR); + C = 1; + } else if (Red(L) && Red(LL)) { + // Degenerate Case No. 2 + // Complete the Triforce + // + // Z + // ╱ ╲ 𝐘 + // 𝐘 d ╱ ╲ + // ╱ ╲ → X Z + // 𝐗 c ╱ ╲ ╱ ╲ + // ╱ ╲ a b c d + // a b + // + // ((Z ((Y ((X a . b) . t) . c) . t) . d)) → + // ((Y ((X a . b)) (Z c . d)) . t) + R = Nod(E, LR, R, 0); + E = Ent(L); + L = Bkn(LL); + C = 1; + } else if (Red(R) && Red(RR)) { + // Degenerate Case No. 3 + // Complete the Triforce + // + // X + // ╱ ╲ 𝐘 + // a 𝐘 ╱ ╲ + // ╱ ╲ → X Z + // b 𝐙 ╱ ╲ ╱ ╲ + // ╱ ╲ a b c d + // c d + // + // ((X a (Y b (Z c . d) . t) . t)) → + // ((Y ((X a . b)) (Z c . d)) . t) + L = Nod(E, L, RL, 0); + E = Ent(R); + R = Bkn(RR); + C = 1; + } else if (Red(R) && Red(RL)) { + // Degenerate Case No. 4 + // Complete the Triforce + // + // X + // ╱ ╲ 𝐘 + // a 𝐙 ╱ ╲ + // ╱ ╲ → X Z + // 𝐘 d ╱ ╲ ╱ ╲ + // ╱ ╲ a b c d + // b c + // + // ((X a (Z ((Y b . c) . t) . d) . t)) → + // ((Y ((X a . b)) (Z c . d)) . t) + L = Nod(E, L, Lit(RL), 0); + R = Nod(Ent(R), Rit(RL), RR, 0); + E = Ent(RL); + C = 1; + } + } + return Nod(E, L, R, C); +} + +static int InsTree(int E, int N, int KEEP) { + int P, L, R; + if (N) { + P = Cmp(Key(E), Key(Ent(N))); + if (P < 0) { + if ((L = InsTree(E, Lit(N), KEEP)) > 0) return L; // rethrow + if (L != Lit(N)) N = BalTree(Ent(N), L, Rit(N), Tail(N)); + } else if (P > 0) { + if ((R = InsTree(E, Rit(N), KEEP)) > 0) return R; // rethrow + if (R != Rit(N)) N = BalTree(Ent(N), Lit(N), R, Tail(N)); + } else if (KEEP < 0 || (!KEEP && !Equal(Val(E), Val(Ent(N))))) { + N = Cons(Cons(E, Chl(N)), Red(N)); + } else if (KEEP > 1) { + N = KEEP; // throw + } + } else { + N = Cons(Cons(E, 0), 1); + } + return N; +} + +/** + * Inserts entry into red-black tree. + * + * DICTIONARY NODE SET NODE ATOM SET NODE + * + * ┌───┬───┐ ┌───┬───┐ ┌───┬───┐ + * │ ┬ │ 𝑐 │ │ ┬ │ 𝑐 │ │ ┬ │ 𝑐 │ + * └─│─┴───┘ └─│─┴───┘ └─│─┴───┘ + * ┌─┴─┬───┐ ┌─┴─┬───┐ ┌─┴─┬───┐ + * │ ┬ │ ┬ │ │ ┬ │ ┬ │ │ 𝑣 │ ┬ │ + * └─│─┴─│─┘ └─│─┴─│─┘ └───┴─│─┘ + * ┌───┬──┴┐ ┌┴──┬───┐ ┌───┬──┴┐ ┌┴──┬───┐ ┌─┴─┬───┐ + * │ 𝑥 │ 𝑦 │ │ L │ R │ │ 𝑥 │ ⊥ │ │ L │ R │ │ L │ R │ + * └───┴───┘ └───┴───┘ └───┴───┘ └───┴───┘ └───┴───┘ + * + * @param E is entry which may be + * - (𝑥 . 𝑦) where 𝑥 is the key and 𝑦 is arbitrary tag-along content + * - 𝑣 for memory-efficient sets of atoms + * @param N is red-black tree node which should look like + * - ⊥ is an tree or atom set with zero elements + * - (((𝑥 ⋯) . (𝑙 . 𝑟)) . ⊥) is a black node a.k.a. (((𝑥 ⋯) 𝑙 . 𝑟)) + * - (((𝑥 ⋯) . (𝑙 . 𝑟)) . ⊤) is a red node a.k.a. (((𝑥 ⋯) 𝑙 . 𝑟) . ⊤) + * - ((𝑣 𝑙 . 𝑟)) a memory-efficient black node for an atom set + * - ((𝑣 𝑙 . 𝑟)) is functionally equivalent to (((𝑣) 𝑙 . 𝑟)) + * - ((𝑣 ⊥ . ⊥)) is an atom set with a single element + * - ((𝑣)) is functionally equivalent to ((𝑣 ⊥ . ⊥)) or ((𝑣 . (⊥ . ⊥)) . ⊥) + * - 𝑣 is crash therefore (((⋯) 𝑣)) and ⊥(((⋯) ⊥ . 𝑣)) are crash + * - (𝑣) is crash, first element must be a cons cell + * - ((⋯) . 𝑥) is crash if 𝑥 isn't ⊤ or ⊥ + * @param KEEP may be + * - -1 to replace existing entries always + * - 0 to replace existing entries if values are non-equal + * - 1 to return N if + * - >1 specifies arbitrary tombstone to return if key exists + * @return ((𝑒 𝑙 . 𝑟) . 𝑐) if found where 𝑒 can be 𝑣 or (𝑥 . 𝑦) + * - or KEEP if not found and KEEP > 1 + * - or ⊥ if not found + */ +int PutTree(int E, int N, int KEEP) { + DCHECK_LE(N, 0); + DCHECK_LE(Car(N), 0); + DCHECK_GE(KEEP, -1); + return CheckTree(Bkn(InsTree(E, N, KEEP))); +} + +/** + * Finds node in binary tree. + * @return ((𝑒 𝑙 . 𝑟) . 𝑐) if found, otherwise 0 + */ +int GetTree(int k, int N) { + int p, e; + while (N) { + p = Cmp(k, Key(Ent(N))); + if (p < 0) { + N = Lit(N); + } else if (p > 0) { + N = Rit(N); + } else { + break; + } + } + return N; +} + +int GetTreeCount(int k, int N, int *c) { + int p, e; + while (N) { + ++*c; + p = Cmp(k, Key(Ent(N))); + if (p < 0) { + N = Lit(N); + } else if (p > 0) { + N = Rit(N); + } else { + break; + } + } + return N; +} diff --git a/tool/plinko/lib/tree.h b/tool/plinko/lib/tree.h new file mode 100644 index 000000000..d64dd547f --- /dev/null +++ b/tool/plinko/lib/tree.h @@ -0,0 +1,47 @@ +#ifndef COSMOPOLITAN_TOOL_PLINKO_LIB_TREE_H_ +#define COSMOPOLITAN_TOOL_PLINKO_LIB_TREE_H_ +#include "tool/plinko/lib/cons.h" +#include "tool/plinko/lib/plinko.h" +#if !(__ASSEMBLER__ + __LINKER__ + 0) +COSMOPOLITAN_C_START_ + +int PutTree(int, int, int); +int GetTree(int, int); +int GetTreeCount(int, int, int *); +int Nod(int, int, int, int); + +forceinline pureconst int Key(int E) { + return E < 0 ? Car(E) : E; +} + +forceinline pureconst int Val(int E) { + return E < 0 ? Cdr(E) : E; +} + +forceinline pureconst int Ent(int N) { + return Car(Car(N)); +} + +forceinline pureconst int Chl(int N) { + return Cdr(Car(N)); +} + +forceinline pureconst int Lit(int N) { + return Car(Chl(N)); +} + +forceinline pureconst int Rit(int N) { + return Cdr(Chl(N)); +} + +forceinline pureconst int Red(int N) { + return Cdr(N); +} + +forceinline int Bkn(int N) { + return Red(N) ? Cons(Car(N), 0) : N; +} + +COSMOPOLITAN_C_END_ +#endif /* !(__ASSEMBLER__ + __LINKER__ + 0) */ +#endif /* COSMOPOLITAN_TOOL_PLINKO_LIB_TREE_H_ */ diff --git a/tool/plinko/lib/types.h b/tool/plinko/lib/types.h new file mode 100644 index 000000000..693da8614 --- /dev/null +++ b/tool/plinko/lib/types.h @@ -0,0 +1,15 @@ +#ifndef COSMOPOLITAN_TOOL_PLINKO_LIB_TYPES_H_ +#define COSMOPOLITAN_TOOL_PLINKO_LIB_TYPES_H_ +#if !(__ASSEMBLER__ + __LINKER__ + 0) +COSMOPOLITAN_C_START_ + +typedef unsigned long dword; + +struct qword { + dword ax; + dword dx; +}; + +COSMOPOLITAN_C_END_ +#endif /* !(__ASSEMBLER__ + __LINKER__ + 0) */ +#endif /* COSMOPOLITAN_TOOL_PLINKO_LIB_TYPES_H_ */ diff --git a/tool/plinko/lib/vars.c b/tool/plinko/lib/vars.c new file mode 100644 index 000000000..75b4172d7 --- /dev/null +++ b/tool/plinko/lib/vars.c @@ -0,0 +1,158 @@ +/*-*- 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 "tool/plinko/lib/plinko.h" + +#ifdef __llvm__ +dword cGets; +dword *g_mem; +#endif + +unsigned short sp; + +bool ftrace; +bool mtrace; +bool gtrace; +bool noname; +bool literally; +bool symbolism; + +bool dump; // -d causes globals to be printed at exit +bool trace; // -t causes evaluator to print explanations +bool loga; // -a flag causes -t to print massive environment +bool logc; // -c flag causes -t to print jupiterian closures +bool quiet; // tracks (quiet) state which suppresses (print) +bool stats; // -s causes statistics to be printed after each evaluation +bool simpler; // -S usually disables pretty printing so you can | cut -c-80 + +int cx; // cons stack pointer +int ax; // used by read atom interner +int dx; // used by read for lookahead +int bp[4]; // buffer pointers for file descriptors +int pdp; // used by print to prevent stack overflow +int depth; // when tracing is enabled tracks trace depth +int fails; // failure count to influence process exit code +int cHeap; // statistical approximate of minimum cx during work +int cAtoms; // statistical count of characters in atom hash tree +int cFrost; // monotonic frostline of defined permanent cons cells +int globals; // cons[rbtree;bool 0] of globally scoped definitions i.e. 𝑎 +int revglob; // reverse mapped rbtree of globals (informational printing) +int ordglob; // the original defined order for all global definition keys + +int kTrace; +int kMtrace; +int kFtrace; +int kGtrace; +int kEq; +int kGc; +int kCmp; +int kCar; +int kBackquote; +int kDefun; +int kDefmacro; +int kAppend; +int kBeta; +int kAnd; +int kCdr; +int kRead; +int kDump; +int kQuote; +int kProgn; +int kLambda; +int kDefine; +int kMacro; +int kQuiet; +int kSplice; +int kPrinc; +int kPrint; +int kPprint; +int kIgnore; +int kExpand; +int kCond; +int kAtom; +int kOr; +int kCons; +int kIntegrate; +int kString; +int kSquare; +int kCurly; +int kFork; +int kGensym; +int kTrench; +int kYcombinator; +int kBecause; +int kTherefore; +int kUnion; +int kImplies; +int kNand; +int kNor; +int kXor; +int kIff; +int kPartial; +int kError; +int kExit; +int kClosure; +int kFunction; +int kCycle; +int kFlush; +int kIgnore0; +int kComma; +int kIntersection; +int kList; +int kMember; +int kNot; +int kReverse; +int kSqrt; +int kSubset; +int kSuperset; +int kPrintheap; +int kImpossible; +int kUnchanged; +int kOrder; + +jmp_buf crash; +jmp_buf exiter; + +char g_buffer[4][512]; +unsigned short g_depths[128][3]; + +dword tick; +dword cSets; +dword *g_dis; +EvalFn *eval; +BindFn *bind_; +char **inputs; +EvalFn *expand; +EvlisFn *evlis; +PairFn *pairlis; +TailFn *kTail[8]; +RecurseFn *recurse; + +int g_copy[256]; +int g_print[256]; +int kAlphabet[26]; +dword g_stack[STACK]; +int kConsAlphabet[26]; + +long g_assoc_histogram[12]; +long g_gc_lop_histogram[30]; +long g_gc_marks_histogram[30]; +long g_gc_dense_histogram[30]; +long g_gc_sparse_histogram[30]; +long g_gc_discards_histogram[30]; diff --git a/tool/plinko/plinko.c b/tool/plinko/plinko.c new file mode 100644 index 000000000..eaa47a2ce --- /dev/null +++ b/tool/plinko/plinko.c @@ -0,0 +1,28 @@ +/*-*- 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 2021 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 "libc/log/log.h" +#include "tool/plinko/lib/plinko.h" + +STATIC_YOINK("__zipos_get"); + +int main(int argc, char *argv[]) { + Plinko(argc, argv); + return 0; +} diff --git a/tool/plinko/plinko.mk b/tool/plinko/plinko.mk new file mode 100644 index 000000000..c40d75640 --- /dev/null +++ b/tool/plinko/plinko.mk @@ -0,0 +1,76 @@ +#-*-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_PLINKO + +TOOL_PLINKO_SRCS := $(wildcard tool/plinko/*.c) + +TOOL_PLINKO_OBJS = \ + $(TOOL_PLINKO_SRCS:%.c=o/$(MODE)/%.o) + +TOOL_PLINKO_COMS = \ + $(TOOL_PLINKO_SRCS:%.c=o/$(MODE)/%.com) + +TOOL_PLINKO_BINS = \ + $(TOOL_PLINKO_COMS) \ + $(TOOL_PLINKO_COMS:%=%.dbg) + +TOOL_PLINKO_DIRECTDEPS = \ + LIBC_INTRIN \ + LIBC_LOG \ + LIBC_MEM \ + LIBC_CALLS \ + LIBC_RUNTIME \ + LIBC_UNICODE \ + LIBC_SYSV \ + LIBC_STDIO \ + LIBC_X \ + LIBC_STUBS \ + LIBC_NEXGEN32E \ + LIBC_ZIPOS \ + TOOL_PLINKO_LIB + +TOOL_PLINKO_DEPS := \ + $(call uniq,$(foreach x,$(TOOL_PLINKO_DIRECTDEPS),$($(x)))) + +o/$(MODE)/tool/plinko/plinko.pkg: \ + $(TOOL_PLINKO_OBJS) \ + $(foreach x,$(TOOL_PLINKO_DIRECTDEPS),$($(x)_A).pkg) + +o/$(MODE)/tool/plinko/%.com.dbg: \ + $(TOOL_PLINKO_DEPS) \ + o/$(MODE)/tool/plinko/%.o \ + o/$(MODE)/tool/plinko/plinko.pkg \ + o/$(MODE)/tool/plinko/lib/library.lisp.zip.o \ + $(CRT) \ + $(APE) + @$(APELINK) + +.PRECIOUS: o/$(MODE)/tool/plinko/plinko.com +o/$(MODE)/tool/plinko/plinko.com: \ + o/$(MODE)/tool/plinko/plinko.com.dbg \ + o/$(MODE)/third_party/infozip/zip.com \ + o/$(MODE)/tool/build/symtab.com \ + tool/plinko/plinko.mk + @$(COMPILE) -AOBJCOPY -T$@ $(OBJCOPY) -S -O binary $< $@ + @$(COMPILE) -AMKDIR -T$@ mkdir -p o/$(MODE)/tool/plinko/.redbean + @$(COMPILE) -ASYMTAB o/$(MODE)/tool/build/symtab.com -o o/$(MODE)/tool/plinko/.plinko/.symtab $< + @$(COMPILE) -AZIP -T$@ o/$(MODE)/third_party/infozip/zip.com -9qj $@ \ + o/$(MODE)/tool/plinko/.plinko/.symtab + +$(TOOL_PLINKO_OBJS): \ + $(BUILD_FILES) \ + tool/plinko/plinko.mk + +o/$(MODE)/tool/plinko/plinko.com.zip.o \ +o/$(MODE)/tool/plinko/lib/library.lisp.zip.o \ +o/$(MODE)/tool/plinko/lib/binarytrees.lisp.zip.o \ +o/$(MODE)/tool/plinko/lib/algebra.lisp.zip.o \ +o/$(MODE)/tool/plinko/lib/infix.lisp.zip.o \ +o/$(MODE)/tool/plinko/lib/ok.lisp.zip.o: \ + ZIPOBJ_FLAGS += \ + -B + +.PHONY: o/$(MODE)/tool/plinko +o/$(MODE)/tool/plinko: $(TOOL_PLINKO_BINS) $(TOOL_PLINKO_CHECKS) + diff --git a/tool/tool.mk b/tool/tool.mk index 84036a1a1..f41b34de6 100644 --- a/tool/tool.mk +++ b/tool/tool.mk @@ -7,5 +7,6 @@ o/$(MODE)/tool: \ o/$(MODE)/tool/decode \ o/$(MODE)/tool/hash \ o/$(MODE)/tool/lambda \ + o/$(MODE)/tool/plinko \ o/$(MODE)/tool/net \ o/$(MODE)/tool/viz