/*-*- mode:c;indent-tabs-mode:nil;c-basic-offset:2;tab-width:8;coding:utf-8 -*-│ │ vi: set et 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; 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) { 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 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) { 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); }