mirror of
https://github.com/jart/cosmopolitan.git
synced 2025-01-31 03:27:39 +00:00
Add LISP interpreter
This commit is contained in:
parent
4f98ad1054
commit
d31bebdd2d
84 changed files with 9081 additions and 0 deletions
3
Makefile
3
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
|
||||
|
|
99
test/tool/plinko/algebra_test.lisp
Normal file
99
test/tool/plinko/algebra_test.lisp
Normal file
|
@ -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))
|
222
test/tool/plinko/library_test.lisp
Normal file
222
test/tool/plinko/library_test.lisp
Normal file
|
@ -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))
|
||||
|
118
test/tool/plinko/plinko_test.c
Normal file
118
test/tool/plinko/plinko_test.c
Normal file
|
@ -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));
|
||||
}
|
91
test/tool/plinko/test.mk
Normal file
91
test/tool/plinko/test.mk
Normal file
|
@ -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)
|
|
@ -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
|
||||
|
|
35
tool/plinko/README.txt
Normal file
35
tool/plinko/README.txt
Normal file
|
@ -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 <jtunney@gmail.com>
|
||||
|
||||
LICENSE
|
||||
|
||||
ISC
|
||||
|
||||
SEE ALSO
|
||||
|
||||
SectorLISP
|
||||
SectorLambda
|
483
tool/plinko/lib/algebra.lisp
Normal file
483
tool/plinko/lib/algebra.lisp
Normal file
|
@ -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 0<C<1 ∨ C>1
|
||||
((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))
|
96
tool/plinko/lib/assoc.c
Normal file
96
tool/plinko/lib/assoc.c
Normal file
|
@ -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;
|
||||
}
|
93
tool/plinko/lib/binarytrees.lisp
Normal file
93
tool/plinko/lib/binarytrees.lisp
Normal file
|
@ -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)))))
|
56
tool/plinko/lib/bind.c
Normal file
56
tool/plinko/lib/bind.c
Normal file
|
@ -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};
|
||||
}
|
59
tool/plinko/lib/char.c
Normal file
59
tool/plinko/lib/char.c
Normal file
|
@ -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;
|
||||
}
|
||||
}
|
43
tool/plinko/lib/char.h
Normal file
43
tool/plinko/lib/char.h
Normal file
|
@ -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_ */
|
74
tool/plinko/lib/cmp.c
Normal file
74
tool/plinko/lib/cmp.c
Normal file
|
@ -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;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
38
tool/plinko/lib/config.h
Normal file
38
tool/plinko/lib/config.h
Normal file
|
@ -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_ */
|
66
tool/plinko/lib/cons.c
Normal file
66
tool/plinko/lib/cons.c
Normal file
|
@ -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));
|
||||
}
|
67
tool/plinko/lib/cons.h
Normal file
67
tool/plinko/lib/cons.h
Normal file
|
@ -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_ */
|
25
tool/plinko/lib/countatoms.c
Normal file
25
tool/plinko/lib/countatoms.c
Normal file
|
@ -0,0 +1,25 @@
|
|||
/*-*- mode:c;indent-tabs-mode:nil;c-basic-offset:2;tab-width:8;coding:utf-8 -*-│
|
||||
│vi: set net ft=c ts=2 sts=2 sw=2 fenc=utf-8 :vi│
|
||||
╞══════════════════════════════════════════════════════════════════════════════╡
|
||||
│ Copyright 2022 Justine Alexandra Roberts Tunney │
|
||||
│ │
|
||||
│ Permission to use, copy, modify, and/or distribute this software for │
|
||||
│ any purpose with or without fee is hereby granted, provided that the │
|
||||
│ above copyright notice and this permission notice appear in all copies. │
|
||||
│ │
|
||||
│ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL │
|
||||
│ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED │
|
||||
│ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE │
|
||||
│ AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL │
|
||||
│ DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR │
|
||||
│ PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER │
|
||||
│ TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR │
|
||||
│ PERFORMANCE OF THIS SOFTWARE. │
|
||||
╚─────────────────────────────────────────────────────────────────────────────*/
|
||||
#include "tool/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));
|
||||
}
|
71
tool/plinko/lib/countreferences.c
Normal file
71
tool/plinko/lib/countreferences.c
Normal file
|
@ -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;
|
||||
}
|
108
tool/plinko/lib/define.c
Normal file
108
tool/plinko/lib/define.c
Normal file
|
@ -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;
|
||||
}
|
75
tool/plinko/lib/desymbolize.c
Normal file
75
tool/plinko/lib/desymbolize.c
Normal file
|
@ -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;
|
||||
}
|
||||
}
|
81
tool/plinko/lib/dispatchycombine.c
Normal file
81
tool/plinko/lib/dispatchycombine.c
Normal file
|
@ -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);
|
||||
}
|
76
tool/plinko/lib/enclose.c
Normal file
76
tool/plinko/lib/enclose.c
Normal file
|
@ -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));
|
||||
}
|
57
tool/plinko/lib/error.c
Normal file
57
tool/plinko/lib/error.c
Normal file
|
@ -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);
|
||||
}
|
14
tool/plinko/lib/error.h
Normal file
14
tool/plinko/lib/error.h
Normal file
|
@ -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_ */
|
27
tool/plinko/lib/evlis.c
Normal file
27
tool/plinko/lib/evlis.c
Normal file
|
@ -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));
|
||||
}
|
80
tool/plinko/lib/expand.c
Normal file
80
tool/plinko/lib/expand.c
Normal file
|
@ -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;
|
||||
}
|
68
tool/plinko/lib/findfreevariables.c
Normal file
68
tool/plinko/lib/findfreevariables.c
Normal file
|
@ -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;
|
||||
}
|
38
tool/plinko/lib/flush.c
Normal file
38
tool/plinko/lib/flush.c
Normal file
|
@ -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;
|
||||
}
|
155
tool/plinko/lib/gc.c
Normal file
155
tool/plinko/lib/gc.c
Normal file
|
@ -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;
|
||||
}
|
34
tool/plinko/lib/gc.h
Normal file
34
tool/plinko/lib/gc.h
Normal file
|
@ -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_ */
|
32
tool/plinko/lib/getlongsum.c
Normal file
32
tool/plinko/lib/getlongsum.c
Normal file
|
@ -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;
|
||||
}
|
25
tool/plinko/lib/hasatom.c
Normal file
25
tool/plinko/lib/hasatom.c
Normal file
|
@ -0,0 +1,25 @@
|
|||
/*-*- mode:c;indent-tabs-mode:nil;c-basic-offset:2;tab-width:8;coding:utf-8 -*-│
|
||||
│vi: set net ft=c ts=2 sts=2 sw=2 fenc=utf-8 :vi│
|
||||
╞══════════════════════════════════════════════════════════════════════════════╡
|
||||
│ Copyright 2022 Justine Alexandra Roberts Tunney │
|
||||
│ │
|
||||
│ Permission to use, copy, modify, and/or distribute this software for │
|
||||
│ any purpose with or without fee is hereby granted, provided that the │
|
||||
│ above copyright notice and this permission notice appear in all copies. │
|
||||
│ │
|
||||
│ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL │
|
||||
│ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED │
|
||||
│ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE │
|
||||
│ AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL │
|
||||
│ DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR │
|
||||
│ PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER │
|
||||
│ TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR │
|
||||
│ PERFORMANCE OF THIS SOFTWARE. │
|
||||
╚─────────────────────────────────────────────────────────────────────────────*/
|
||||
#include "tool/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));
|
||||
}
|
50
tool/plinko/lib/histo.c
Normal file
50
tool/plinko/lib/histo.c
Normal file
|
@ -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);
|
||||
}
|
||||
}
|
20
tool/plinko/lib/histo.h
Normal file
20
tool/plinko/lib/histo.h
Normal file
|
@ -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_ */
|
53
tool/plinko/lib/index.c
Normal file
53
tool/plinko/lib/index.c
Normal file
|
@ -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);
|
135
tool/plinko/lib/index.h
Normal file
135
tool/plinko/lib/index.h
Normal file
|
@ -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_ */
|
180
tool/plinko/lib/infix.lisp
Normal file
180
tool/plinko/lib/infix.lisp
Normal file
|
@ -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))))
|
48
tool/plinko/lib/intern.c
Normal file
48
tool/plinko/lib/intern.c
Normal file
|
@ -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);
|
||||
}
|
43
tool/plinko/lib/iscar.c
Normal file
43
tool/plinko/lib/iscar.c
Normal file
|
@ -0,0 +1,43 @@
|
|||
/*-*- mode:c;indent-tabs-mode:nil;c-basic-offset:2;tab-width:8;coding:utf-8 -*-│
|
||||
│vi: set net ft=c ts=2 sts=2 sw=2 fenc=utf-8 :vi│
|
||||
╞══════════════════════════════════════════════════════════════════════════════╡
|
||||
│ Copyright 2022 Justine Alexandra Roberts Tunney │
|
||||
│ │
|
||||
│ Permission to use, copy, modify, and/or distribute this software for │
|
||||
│ any purpose with or without fee is hereby granted, provided that the │
|
||||
│ above copyright notice and this permission notice appear in all copies. │
|
||||
│ │
|
||||
│ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL │
|
||||
│ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED │
|
||||
│ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE │
|
||||
│ AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL │
|
||||
│ DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR │
|
||||
│ PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER │
|
||||
│ TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR │
|
||||
│ PERFORMANCE OF THIS SOFTWARE. │
|
||||
╚─────────────────────────────────────────────────────────────────────────────*/
|
||||
#include "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;
|
||||
}
|
43
tool/plinko/lib/iscdr.c
Normal file
43
tool/plinko/lib/iscdr.c
Normal file
|
@ -0,0 +1,43 @@
|
|||
/*-*- mode:c;indent-tabs-mode:nil;c-basic-offset:2;tab-width:8;coding:utf-8 -*-│
|
||||
│vi: set net ft=c ts=2 sts=2 sw=2 fenc=utf-8 :vi│
|
||||
╞══════════════════════════════════════════════════════════════════════════════╡
|
||||
│ Copyright 2022 Justine Alexandra Roberts Tunney │
|
||||
│ │
|
||||
│ Permission to use, copy, modify, and/or distribute this software for │
|
||||
│ any purpose with or without fee is hereby granted, provided that the │
|
||||
│ above copyright notice and this permission notice appear in all copies. │
|
||||
│ │
|
||||
│ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL │
|
||||
│ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED │
|
||||
│ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE │
|
||||
│ AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL │
|
||||
│ DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR │
|
||||
│ PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER │
|
||||
│ TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR │
|
||||
│ PERFORMANCE OF THIS SOFTWARE. │
|
||||
╚─────────────────────────────────────────────────────────────────────────────*/
|
||||
#include "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;
|
||||
}
|
28
tool/plinko/lib/isconstant.c
Normal file
28
tool/plinko/lib/isconstant.c
Normal file
|
@ -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;
|
||||
}
|
55
tool/plinko/lib/isdelegate.c
Normal file
55
tool/plinko/lib/isdelegate.c
Normal file
|
@ -0,0 +1,55 @@
|
|||
/*-*- mode:c;indent-tabs-mode:nil;c-basic-offset:2;tab-width:8;coding:utf-8 -*-│
|
||||
│vi: set net ft=c ts=2 sts=2 sw=2 fenc=utf-8 :vi│
|
||||
╞══════════════════════════════════════════════════════════════════════════════╡
|
||||
│ Copyright 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;
|
||||
}
|
63
tool/plinko/lib/isif.c
Normal file
63
tool/plinko/lib/isif.c
Normal file
|
@ -0,0 +1,63 @@
|
|||
/*-*- mode:c;indent-tabs-mode:nil;c-basic-offset:2;tab-width:8;coding:utf-8 -*-│
|
||||
│vi: set net ft=c ts=2 sts=2 sw=2 fenc=utf-8 :vi│
|
||||
╞══════════════════════════════════════════════════════════════════════════════╡
|
||||
│ Copyright 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);
|
||||
}
|
343
tool/plinko/lib/iswide.c
Normal file
343
tool/plinko/lib/iswide.c
Normal file
|
@ -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);
|
||||
}
|
172
tool/plinko/lib/isycombinator.c
Normal file
172
tool/plinko/lib/isycombinator.c
Normal file
|
@ -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;
|
||||
}
|
24
tool/plinko/lib/ktpenc.c
Normal file
24
tool/plinko/lib/ktpenc.c
Normal file
|
@ -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};
|
10
tool/plinko/lib/ktpenc.h
Normal file
10
tool/plinko/lib/ktpenc.h
Normal file
|
@ -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_ */
|
74
tool/plinko/lib/lib.mk
Normal file
74
tool/plinko/lib/lib.mk
Normal file
|
@ -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)
|
570
tool/plinko/lib/library.lisp
Normal file
570
tool/plinko/lib/library.lisp
Normal file
|
@ -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))))
|
49
tool/plinko/lib/makesclosures.c
Normal file
49
tool/plinko/lib/makesclosures.c
Normal file
|
@ -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;
|
||||
}
|
18
tool/plinko/lib/ok.lisp
Normal file
18
tool/plinko/lib/ok.lisp
Normal file
|
@ -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)
|
35
tool/plinko/lib/pairlis.c
Normal file
35
tool/plinko/lib/pairlis.c
Normal file
|
@ -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);
|
||||
}
|
||||
}
|
374
tool/plinko/lib/plan.c
Normal file
374
tool/plinko/lib/plan.c
Normal file
|
@ -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);
|
||||
}
|
55
tool/plinko/lib/planfuncalls.c
Normal file
55
tool/plinko/lib/planfuncalls.c
Normal file
|
@ -0,0 +1,55 @@
|
|||
/*-*- mode:c;indent-tabs-mode:nil;c-basic-offset:2;tab-width:8;coding:utf-8 -*-│
|
||||
│vi: set net ft=c ts=2 sts=2 sw=2 fenc=utf-8 :vi│
|
||||
╞══════════════════════════════════════════════════════════════════════════════╡
|
||||
│ Copyright 2022 Justine Alexandra Roberts Tunney │
|
||||
│ │
|
||||
│ Permission to use, copy, modify, and/or distribute this software for │
|
||||
│ any purpose with or without fee is hereby granted, provided that the │
|
||||
│ above copyright notice and this permission notice appear in all copies. │
|
||||
│ │
|
||||
│ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL │
|
||||
│ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED │
|
||||
│ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE │
|
||||
│ AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL │
|
||||
│ DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR │
|
||||
│ PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER │
|
||||
│ TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR │
|
||||
│ PERFORMANCE OF THIS SOFTWARE. │
|
||||
╚─────────────────────────────────────────────────────────────────────────────*/
|
||||
#include "tool/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);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
1062
tool/plinko/lib/plinko.c
Normal file
1062
tool/plinko/lib/plinko.c
Normal file
File diff suppressed because it is too large
Load diff
337
tool/plinko/lib/plinko.h
Normal file
337
tool/plinko/lib/plinko.h
Normal file
|
@ -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_ */
|
109
tool/plinko/lib/preplan.c
Normal file
109
tool/plinko/lib/preplan.c
Normal file
|
@ -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;
|
||||
}
|
130
tool/plinko/lib/prettyprint.c
Normal file
130
tool/plinko/lib/prettyprint.c
Normal file
|
@ -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;
|
||||
}
|
255
tool/plinko/lib/print.c
Normal file
255
tool/plinko/lib/print.c
Normal file
|
@ -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;
|
||||
}
|
31
tool/plinko/lib/print.h
Normal file
31
tool/plinko/lib/print.h
Normal file
|
@ -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_ */
|
42
tool/plinko/lib/printchar.c
Normal file
42
tool/plinko/lib/printchar.c
Normal file
|
@ -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);
|
||||
}
|
304
tool/plinko/lib/printf.c
Normal file
304
tool/plinko/lib/printf.c
Normal file
|
@ -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;
|
||||
}
|
14
tool/plinko/lib/printf.h
Normal file
14
tool/plinko/lib/printf.h
Normal file
|
@ -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_ */
|
52
tool/plinko/lib/printheap.c
Normal file
52
tool/plinko/lib/printheap.c
Normal file
|
@ -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);
|
||||
}
|
||||
}
|
45
tool/plinko/lib/printint.c
Normal file
45
tool/plinko/lib/printint.c
Normal file
|
@ -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;
|
||||
}
|
33
tool/plinko/lib/printtree.c
Normal file
33
tool/plinko/lib/printtree.c
Normal file
|
@ -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));
|
||||
}
|
||||
}
|
51
tool/plinko/lib/printvars.c
Normal file
51
tool/plinko/lib/printvars.c
Normal file
|
@ -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);
|
||||
}
|
289
tool/plinko/lib/read.c
Normal file
289
tool/plinko/lib/read.c
Normal file
|
@ -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;
|
||||
}
|
74
tool/plinko/lib/readstring.c
Normal file
74
tool/plinko/lib/readstring.c
Normal file
|
@ -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);
|
||||
}
|
30
tool/plinko/lib/reverse.c
Normal file
30
tool/plinko/lib/reverse.c
Normal file
|
@ -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;
|
||||
}
|
139
tool/plinko/lib/setup.c
Normal file
139
tool/plinko/lib/setup.c
Normal file
|
@ -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;
|
||||
}
|
||||
}
|
||||
}
|
48
tool/plinko/lib/stack.h
Normal file
48
tool/plinko/lib/stack.h
Normal file
|
@ -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_ */
|
112
tool/plinko/lib/symbolize.c
Normal file
112
tool/plinko/lib/symbolize.c
Normal file
|
@ -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;
|
||||
}
|
||||
}
|
15
tool/plinko/lib/time.h
Normal file
15
tool/plinko/lib/time.h
Normal file
|
@ -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_ */
|
231
tool/plinko/lib/trace.c
Normal file
231
tool/plinko/lib/trace.c
Normal file
|
@ -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"╒─┊╘─");
|
||||
}
|
41
tool/plinko/lib/trace.h
Normal file
41
tool/plinko/lib/trace.h
Normal file
|
@ -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_ */
|
260
tool/plinko/lib/tree.c
Normal file
260
tool/plinko/lib/tree.c
Normal file
|
@ -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;
|
||||
}
|
47
tool/plinko/lib/tree.h
Normal file
47
tool/plinko/lib/tree.h
Normal file
|
@ -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_ */
|
15
tool/plinko/lib/types.h
Normal file
15
tool/plinko/lib/types.h
Normal file
|
@ -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_ */
|
158
tool/plinko/lib/vars.c
Normal file
158
tool/plinko/lib/vars.c
Normal file
|
@ -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];
|
28
tool/plinko/plinko.c
Normal file
28
tool/plinko/plinko.c
Normal file
|
@ -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;
|
||||
}
|
76
tool/plinko/plinko.mk
Normal file
76
tool/plinko/plinko.mk
Normal file
|
@ -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)
|
||||
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue