diff --git a/README.md b/README.md index 7e7f0aa..cd639d6 100644 --- a/README.md +++ b/README.md @@ -14,9 +14,10 @@ primitives on a host runtime and (b) translating the kernel's `.kl` files into that host. This port does both by **compiling KLambda to Lua source** that LuaJIT then trace-compiles to machine code. -It targets **Shen 41.2** (via the KLambda in `ShenOSKernel-41.2/klambda`) and -passes the official 41.2 kernel test suite (134/134). Earlier versions were -certified against the Shen 22.4 kernel test suite. +It targets **Shen 41.2** (the KLambda is vendored under `klambda/`; see +[`klambda/PROVENANCE.md`](klambda/PROVENANCE.md)) and passes the official 41.2 +kernel test suite (134/134). Earlier versions were certified against the Shen +22.4 kernel test suite. ## Quick start @@ -64,7 +65,7 @@ not a tree-walker: | `runtime.lua` | data representation, symbol interning, the KLambda reader | | `compiler.lua` | KLambda → Lua source compiler (statement-based codegen, tail-call → loop lowering) | | `prims.lua` | runtime env: the primitive set, apply/curry machinery, native overrides, loader | -| `boot.lua` | kernel loading, the bytecode + fasl caches, `shen.initialise` | +| `boot.lua` | kernel loading + initialisation, the bytecode + fasl caches | | `shen.lua` | the public embedding API (`require("shen")`) | | `lua_interop.lua` | the Lua ⇄ Shen bridge (`lua.call`, `lua.function`, marshaling) | | `repl.lua` | the interactive REPL (multiline input, error translation, backtraces) | @@ -103,8 +104,9 @@ designed around what LuaJIT's tracing JIT rewards: * **`typecheck_native.lua` — the t-star driver.** The ~16 CPS driver functions are machine-translated from `klambda/t-star.kl` through the same translator (they share the goal vocabulary); the four that escape it (entry, - signature lookup, datatype search, spy display) are hand-ported. The 162 - kernel signatures are harvested from `init.kl` into a native table. The + signature lookup, datatype search, spy display) are hand-ported. The 161 + kernel signatures are harvested from the `(declare …)` forms in `types.kl` + into a native table (pre-refresh kernels harvest from `init.kl` instead). The native driver performs the **byte-identical inference sequence** to the legacy engine (431,741 inferences on the reference typecheck, exactly). * **Legacy native overrides** (`prims.lua`): native Prolog deref core with diff --git a/boot.lua b/boot.lua index fe819b7..8c6ceac 100644 --- a/boot.lua +++ b/boot.lua @@ -1,5 +1,7 @@ -- boot.lua : load the full Shen KLambda kernel into the Lua runtime and --- run (shen.initialise). Returns the prims module P with everything live. +-- initialise it. Returns the prims module P with everything live. (On the +-- S41.2 2026-07-11 kernel the kernel self-initialises at load time; see FILES +-- and initialise() below.) local R = require("runtime") local C = require("compiler") local P = require("prims") @@ -69,11 +71,39 @@ local function find_kldir() end local KLDIR = find_kldir() .. "/" P.KLDIR = KLDIR -- resolved .kl directory (trailing /), for typecheck_native +-- Boot order for the S41.2 (2026-07-11 refresh) kernel. The first 15 entries +-- are the refreshed KLambda modules. The refreshed kernel initialises itself +-- at LOAD time: declarations.kl runs top-level forms — (set *property-vector* +-- (vector 20000)), the environment `set`s, (shen.initialise-arity-table ...), +-- (put shen shen.external-symbols ...) and (shen.build-lambda-table ...) — that +-- the removed init.kl used to run from shen.initialise (see initialise()). +-- +-- Order is NOT upstream Sources/make.shen order. make.shen relies on the +-- factorise pass + a macros bootstrap that runs last; shen-lua compiles KL +-- directly, so what matters is that a module's LOAD-TIME side effects see +-- their dependencies already defined: +-- * declarations' top-level init calls put/vector/hash/shen.lambda-entry +-- (sys), so sys precedes declarations; +-- * types.kl's 161 top-level (declare ...) forms actually RUN the type +-- checker at load (each declare infers the signature's variance), so every +-- function `declare` reaches transitively must already be defined: +-- shen.prolog-vector (macros.kl), shen.*sigf* + the arity table +-- (declarations.kl), and — new in the refresh — shen.rectify-type and the +-- rest of the inference machinery (t-star.kl). Pre-refresh t-star trailed +-- types; the refresh moved shen.rectify-type into t-star, so t-star must +-- now precede types. Hence the tail: macros declarations t-star types. +-- +-- The trailing four are the community ShenOSKernel extensions + stlib, which +-- Tarver's refresh no longer ships as KLambda (stlib is now lazy Shen sources +-- under Lib/StLib). shen-lua keeps vendoring them on top so the standard +-- library and the CLI launcher stay available and the kernel test suite still +-- certifies. They are pure defuns/defmacros and reference only public kernel +-- functions (get/put/… — never the removed dict.* or shen.initialise-*), so +-- they load unchanged against the refreshed kernel. See klambda/PROVENANCE.md. local FILES = { - "toplevel","core","sys","dict","sequent","yacc","reader","prolog", - "track","load","writer","macros","declarations","types","t-star","init", - "extension-features","extension-expand-dynamic","extension-launcher", - "compiler","stlib" + "yacc","core","load","prolog","reader","sequent","sys","toplevel", + "track","writer","backend","macros","declarations","t-star","types", + "extension-features","extension-expand-dynamic","extension-launcher","stlib" } -- ---- standard streams ---------------------------------------------------- @@ -93,7 +123,7 @@ P.GLOBALS["*implementation*"] = rawget(_G, "jit") and "LuaJIT" or _VERSION P.GLOBALS["*port*"] = "shen-lua" P.GLOBALS["*porters*"] = "shen-lua contributors" P.GLOBALS["*os*"] = (package.config and package.config:sub(1,1) == "\\") and "Windows" or "Unix" -P.GLOBALS["*release*"] = "0.1" -- port release; kernel *version* comes from init.kl ("41.2") +P.GLOBALS["*release*"] = "0.1" -- port release; kernel *version* comes from declarations.kl ("41.2") -- ---- kernel bytecode cache ------------------------------------------------- -- Loading the kernel from .kl sources costs ~0.8s (read + parse + KL->Lua @@ -282,10 +312,11 @@ local function read_cache(path, key) end -- ---- load the kernel ----------------------------------------------------- --- Loads the 21 .kl modules that make up Shen 41.2 (core + stlib + extensions; --- same boot list as shen-cl 41.2 — the opt-in --- extension-programmable-pattern-matching.kl is vendored but not booted). --- The 41.2 KLambda sources are vendored under `klambda/` so the repository +-- Loads the 19 .kl modules in FILES (see above): the 15 refreshed S41.2 +-- (2026-07-11) KLambda modules plus the vendored community stlib + 3 booted +-- extensions. The opt-in extension-programmable-pattern-matching.kl is +-- vendored but not booted. +-- The KLambda sources are vendored under `klambda/` so the repository -- is self-contained. You can still override with SHEN_KL_DIR (e.g. to point -- at a full ShenOSKernel checkout during development). @@ -800,13 +831,20 @@ end -- ---- initialise ---------------------------------------------------------- local function initialise() - -- (shen.initialise) sets up the environment, lambda-form tables, etc. - local sym = R.intern("shen.initialise") + -- Kernel environment setup (env globals, *property-vector*, arity table). + -- + -- On the S41.2 (2026-07-11 refresh) kernel this all happens at LOAD time via + -- top-level forms in declarations.kl — there is no `shen.initialise` function + -- to call, so load_kernel() has already done it by the time we get here. + -- + -- Older kernels (pre-refresh community ShenOSKernel, reachable via + -- SHEN_KL_DIR) instead define `shen.initialise` and expect it to be called + -- once, post-load. Preserve that path when the function is present. + local r local fn = P.F["shen.initialise"] - if not fn then error("shen.initialise not defined after kernel load") end - local r = fn() + if fn then r = fn() end -- Register the lua.* interop entries in Shen's own arity/lambda-form - -- tables (needs the *property-vector* that shen.initialise just created). + -- tables (needs the *property-vector* the kernel just created). require("lua_interop").post_initialise() return r end diff --git a/build/make-bundle.lua b/build/make-bundle.lua index b2efd4b..6218a04 100644 --- a/build/make-bundle.lua +++ b/build/make-bundle.lua @@ -70,7 +70,8 @@ do if nm then kl_names[#kl_names + 1] = nm end end p:close() - assert(#kl_names >= 21, "klambda/ looks incomplete (" .. #kl_names .. " files)") + -- 20 vendored .kl: 15 refreshed S41.2 kernel modules + stlib + 4 extensions. + assert(#kl_names >= 20, "klambda/ looks incomplete (" .. #kl_names .. " files)") end -- ---- 3. emit --------------------------------------------------------------- diff --git a/klambda/PROVENANCE.md b/klambda/PROVENANCE.md index bb0ff30..9430814 100644 --- a/klambda/PROVENANCE.md +++ b/klambda/PROVENANCE.md @@ -1,21 +1,105 @@ # Provenance of the vendored KLambda kernel -## Release +The vendored `klambda/` tree has **two lineages**. Read both sections — they +come from different upstreams and are updated independently. -- **Release**: ShenOSKernel-41.2 -- **Tag/URL**: https://github.com/Shen-Language/shen-sources/releases/tag/shen-41.2 -- **Zip SHA-256**: `49f1b85d02348d9b3ebc461570c5c56cc066270ab81e35d5257625fb9d17fe82` +## 1. Kernel proper — S41.2 (2026-07-11 refresh) -All `.kl` files from the release `klambda/` directory are vendored here -**byte-identical** to the release (verified with `cmp` against the extracted -zip). This includes the new opt-in extension -`extension-programmable-pattern-matching.kl`, which is vendored but **not** -on the boot list — shen-lua boots the same 21 modules as shen-cl 41.2. +- **Canonical source**: `pyrex41/shen-s41.1` — the designated mirror of Mark + Tarver's shenlanguage.org uploads (private repo). + - Tag: `s41.2-pristine-20260711` + - Commit: `11fc51bdf53a4dcb505adeec6ec8352754cbe50f` + ("Pristine import of the 2026-07-11 S41.2 refresh from shenlanguage.org") +- **Upstream origin** (what the mirror imported): Mark Tarver's `S41.2.zip`, + the reference SBCL/Windows distribution. + - URL: https://www.shenlanguage.org/Download/S41.2.zip + - Last-Modified: 2026-07-11 + - Zip SHA-256: `51becbfd60fa8c93c3f8ae5b20b948eaa84c4b1d14ad2f5d2a056002a53ee836` -## compiler.kl caveat +These 15 files are vendored **byte-identical** to `KLambda/` in the mirror at +that tag — equivalently, to the zip's `KLambda/` directory (both verified with +`cmp`): -`compiler.kl` is **not** part of the ShenOSKernel release. It is shen-cl's -generated KL->Lisp compiler (a shen-cl build artifact), vendored here from a -freshly generated 41.2 shen-cl build -(`cl-source/ShenOSKernel-41.2/klambda/compiler.kl`, -SHA-256 `ed30a08be4c8916b1e844d437fb9d65a36476e1a99419340b5523fc81a7c3e44`). + yacc core load prolog reader sequent sys t-star toplevel + track types writer backend declarations macros + +> **Caveat — the "41.2" version number was reused.** Upstream re-uploaded a +> *restructured* kernel under the same `41.2` version. This is a **different +> lineage** from the community `ShenOSKernel-41.2` +> (github.com/Shen-Language/shen-sources, tag `shen-41.2`, +> zip SHA-256 `49f1b85d02348d9b3ebc461570c5c56cc066270ab81e35d5257625fb9d17fe82`) +> that this file previously described. We call the current one +> **"S41.2 (2026-07-11 refresh)"** to disambiguate. `(version)` still reports +> `"41.2"` (it is set in `declarations.kl`). + +### What changed vs the community ShenOSKernel-41.2 we used to vendor + +- **New: `backend.kl`** — a `cl.*` KLambda→Common-Lisp backend. Irrelevant to + the Lua runtime, but on the upstream boot list, so vendored and booted (it is + pure defuns; it defines functions that are never called under Lua). +- **Removed: `compiler.kl`** — was shen-cl's generated KL→Lisp compiler (a + shen-cl build artifact, never part of any ShenOSKernel release). shen-lua has + its own Lua compiler (`compiler.lua`) and never used it at runtime. Dropped. +- **Removed: `dict.kl`** — the dictionary layer is gone. Property vectors are + now plain vectors: `*property-vector*` is `(vector 20000)` and `get`/`put` + index it via `hash` + `shen.change-pointer-value` / `shen.remove-pointer`, + rather than the old `shen.dict` / `shen.<-dict` / `shen.dict->`. Internal to + `get`/`put`; callers are unaffected. +- **Removed: `init.kl`** — its work moved into `declarations.kl` and + `toplevel.kl`. There is **no `shen.initialise` function** any more: the + kernel initialises itself at LOAD time via top-level forms in + `declarations.kl` — `(set *property-vector* (vector 20000))`, the environment + `set`s, `(shen.initialise-arity-table …)`, `(put shen shen.external-symbols …)` + and `(shen.build-lambda-table …)`. `shen.initialise-lambda-forms` / + `-signedfuncs` / `-environment` are gone; `shen.initialise-lambda-tables` + (~renamed) and the arity table remain. +- **Removed: `stlib.kl`** — the standard library is no longer shipped as a + precompiled KLambda blob; upstream now ships it as **lazy Shen sources** under + `Lib/StLib/` to be loaded on demand. See section 2 for how shen-lua bridges + this gap. +- Other renames observed: `hush` → `shen.hush`, `input+` → `shen.input-h+` / + `shen.process-input+`, plus new `shen.rdecons`, `shen.shen`, pointer helpers. + +## 2. Standard library + extensions — community ShenOSKernel-41.2 (retained) + +Because Tarver's refresh no longer ships a precompiled `stlib.kl` and shen-lua +does not yet have a lazy `Lib/StLib` loader, these five files are **retained +byte-identical from the community `ShenOSKernel-41.2`** release +(zip SHA-256 `49f1b85d02348d9b3ebc461570c5c56cc066270ab81e35d5257625fb9d17fe82`) +so the standard library and the CLI launcher stay available and the kernel test +suite still certifies 134/134: + +- `stlib.kl` — the precompiled standard library (`filter`, `take`, `drop`, + `reduce`, string/list/vector helpers, …). +- `extension-features.kl`, `extension-expand-dynamic.kl` — booted. +- `extension-launcher.kl` — booted; provides the launcher the CLI can use. +- `extension-programmable-pattern-matching.kl` — vendored, opt-in, **not** booted. + +These are all pure `defun`/`defmacro` and reference only public kernel functions +(`get`/`put`/`arity`/…) — never the removed `dict.*`, `shen.<-dict`, or +`shen.initialise-*` functions — so they load unchanged against the refreshed +kernel. They are library/Shen-level code, effectively version-stable. + +> **Known limitation (pre-existing, not introduced by the refresh).** stlib +> functions get an `F` entry from their `defun` and a compiler arity from the +> boot prescan, so they compile as direct calls and work in loaded programs and +> the test suite. But `stlib.initialise` is never called, so their runtime +> `arity` *property* stays `-1`; a bare `(fn filter)` / top-level `(filter …)` +> reference that resolves through the lambda table fails with "fn: filter is +> undefined". This behaves identically on the pre-refresh kernel. The clean fix +> is a lazy `Lib/StLib` loader (see the PR's "remaining work"). + +## Boot order + +The boot order lives in `boot.lua` (`FILES`) with a full rationale. It is **not** +upstream `Sources/make.shen` order: make.shen relies on the factorise pass and a +macros bootstrap that runs last, whereas shen-lua compiles KLambda directly, so +what matters is that each module's LOAD-TIME side effects (the `declare` forms in +`types.kl`, the init forms in `declarations.kl`) see their dependencies already +defined. The resulting tail is `… macros declarations t-star types`. + +## Overriding + +Set `SHEN_KL_DIR=/path/to/some/other/klambda` to boot a different KLambda tree +(e.g. a full ShenOSKernel checkout during development). `boot.lua` uses it +instead of this vendored directory. diff --git a/klambda/README.md b/klambda/README.md index 687f7d7..6244071 100644 --- a/klambda/README.md +++ b/klambda/README.md @@ -1,27 +1,41 @@ # Vendored KLambda for Shen 41.2 -These are the KLambda kernel sources for **Shen 41.2** (from `ShenOSKernel-41.2`). +These are the KLambda kernel sources for **Shen 41.2**. They are included +directly in this repository so that `shen-lua` is self-contained: you can +`git clone` and run without needing a separate ShenOSKernel checkout. -They are included directly in this repository so that `shen-lua` is self-contained: -you can `git clone` and run without needing a separate ShenOSKernel checkout. - -See [PROVENANCE.md](PROVENANCE.md) for the exact release tag, checksum, and the -`compiler.kl` caveat (it is a shen-cl build artifact, not part of the release). +The tree has **two lineages** — the refreshed kernel proper from +shenlanguage.org, and the community standard library + extensions retained on +top. See [PROVENANCE.md](PROVENANCE.md) for exact sources, checksums, and the +full list of what the refresh added/removed. ## Files -There are 22 `.kl` files: -- core, toplevel, sys, dict, sequent, yacc, reader, prolog, track, load, writer, macros, declarations, types, t-star, init -- compiler (shen-cl build artifact — see PROVENANCE.md) + +There are 20 `.kl` files. + +**Kernel proper — S41.2 (2026-07-11 refresh), 15 files, byte-identical to +`shenlanguage.org/Download/S41.2.zip`:** +- yacc, core, load, prolog, reader, sequent, sys, t-star, toplevel, + track, types, writer, backend, declarations, macros + +**Standard library + extensions — retained from community ShenOSKernel-41.2:** - stlib -- extension-features, extension-expand-dynamic, extension-launcher +- extension-features, extension-expand-dynamic, extension-launcher (booted) - extension-programmable-pattern-matching (vendored, opt-in; NOT on the boot list) +The actual boot order is defined in `boot.lua` (`FILES`), not by this list. + +> Removed relative to the pre-refresh vendored set: `compiler.kl` (a shen-cl +> build artifact), `dict.kl`, and `init.kl` — see PROVENANCE.md. + ## License -See the LICENSE in the root of this repository and the original ShenOSKernel distribution. +See the LICENSE in the root of this repository and the original Shen distribution. ## Overriding -If you want to use a different set of KLambda files (e.g. a development tree or a different Shen version), set the environment variable: +To use a different set of KLambda files (e.g. a development tree or a different +Shen version), set the environment variable: SHEN_KL_DIR=/path/to/some/other/klambda -The `boot.lua` loader will use that location instead of the vendored `klambda/` directory. +The `boot.lua` loader will use that location instead of the vendored `klambda/` +directory. diff --git a/klambda/backend.kl b/klambda/backend.kl new file mode 100644 index 0000000..ae3cddf --- /dev/null +++ b/klambda/backend.kl @@ -0,0 +1,20 @@ +(defun cl.kl-to-lisp (V5674) (cl.kl-to-lisp-h () V5674)) + +(defun cl.kl-to-lisp-h (V5682 V5683) (cond ((= T (MEMBER V5683 V5682)) V5683) ((and (cons? V5683) (and (= type (hd V5683)) (and (cons? (tl V5683)) (and (cons? (tl (tl V5683))) (= () (tl (tl (tl V5683)))))))) (cl.kl-to-lisp-h V5682 (hd (tl V5683)))) ((and (cons? V5683) (and (= protect (hd V5683)) (and (cons? (tl V5683)) (= () (tl (tl V5683)))))) (cl.kl-to-lisp-h V5682 (hd (tl V5683)))) ((and (cons? V5683) (and (= lambda (hd V5683)) (and (cons? (tl V5683)) (and (cons? (tl (tl V5683))) (and (= () (tl (tl (tl V5683)))) (= (hd (tl V5683)) T)))))) (cl.kl-to-lisp-h V5682 (cl.rectify-t V5683))) ((and (cons? V5683) (and (= lambda (hd V5683)) (and (cons? (tl V5683)) (and (cons? (tl (tl V5683))) (= () (tl (tl (tl V5683)))))))) (cons FUNCTION (cons (cons LAMBDA (cons (cons (hd (tl V5683)) ()) (cons (cl.kl-to-lisp-h (cons (hd (tl V5683)) V5682) (hd (tl (tl V5683)))) ()))) ()))) ((and (cons? V5683) (and (= let (hd V5683)) (and (cons? (tl V5683)) (and (cons? (tl (tl V5683))) (and (cons? (tl (tl (tl V5683)))) (and (= () (tl (tl (tl (tl V5683))))) (= (hd (tl V5683)) T))))))) (cl.kl-to-lisp-h V5682 (cl.rectify-t V5683))) ((and (cons? V5683) (and (= let (hd V5683)) (and (cons? (tl V5683)) (and (cons? (tl (tl V5683))) (and (cons? (tl (tl (tl V5683)))) (= () (tl (tl (tl (tl V5683)))))))))) (cons LET (cons (cons (cons (hd (tl V5683)) (cons (cl.kl-to-lisp-h V5682 (hd (tl (tl V5683)))) ())) ()) (cons (cl.kl-to-lisp-h (cons (hd (tl V5683)) V5682) (hd (tl (tl (tl V5683))))) ())))) ((and (cons? V5683) (and (= defun (hd V5683)) (and (cons? (tl V5683)) (and (cons? (tl (tl V5683))) (and (cons? (tl (tl (tl V5683)))) (= () (tl (tl (tl (tl V5683)))))))))) (cons DEFUN (cons (hd (tl V5683)) (cons (hd (tl (tl V5683))) (cons (cl.kl-to-lisp-h (hd (tl (tl V5683))) (hd (tl (tl (tl V5683))))) ()))))) ((and (cons? V5683) (= cond (hd V5683))) (cons COND (CL.MAPCAR (lambda Z5684 (cl.cond-code V5682 Z5684)) (tl V5683)))) ((and (cons? V5683) (or (= T (MEMBER (hd V5683) V5682)) (cons? (hd V5683)))) (let W5685 (CL.MAPCAR (lambda Z5686 (cl.kl-to-lisp-h V5682 Z5686)) V5683) (cl.currylisp W5685))) ((and (cons? V5683) (cl.fastsymbol? (hd V5683))) (let W5687 (CL.MAPCAR (lambda Z5688 (cl.kl-to-lisp-h V5682 Z5688)) (tl V5683)) (let W5689 (cl.maplispsym (hd V5683)) (cl.optimise-application (cons W5689 W5687))))) ((or (number? V5683) (or (string? V5683) (empty? V5683))) V5683) (true (cons QUOTE (cons V5683 ()))))) + +(defun cl.rectify-t (V5690) (SUBST (GENSYM "x") T V5690)) + +(defun cl.currylisp (V5691) (cond ((and (cons? V5691) (and (cons? (tl V5691)) (cons? (tl (tl V5691))))) (cl.currylisp (cons (cons FUNCALL (cons (hd V5691) (cons (hd (tl V5691)) ()))) (tl (tl V5691))))) ((and (cons? V5691) (and (cons? (tl V5691)) (= () (tl (tl V5691))))) (cons FUNCALL V5691)) ((and (cons? V5691) (= () (tl V5691))) (cons FUNCALL V5691)) (true V5691))) + +(defun cl.optimise-application (V5692) (cond ((and (cons? V5692) (and (= protect (hd V5692)) (and (cons? (tl V5692)) (= () (tl (tl V5692)))))) (cl.optimise-application (hd (tl V5692)))) ((and (cons? V5692) (and (= hd (hd V5692)) (and (cons? (tl V5692)) (= () (tl (tl V5692)))))) (cons CAR (cons (cl.optimise-application (hd (tl V5692))) ()))) ((and (cons? V5692) (and (= tl (hd V5692)) (and (cons? (tl V5692)) (= () (tl (tl V5692)))))) (cons CDR (cons (cl.optimise-application (hd (tl V5692))) ()))) ((and (cons? V5692) (and (= cons (hd V5692)) (and (cons? (tl V5692)) (and (cons? (tl (tl V5692))) (= () (tl (tl (tl V5692)))))))) (cons CONS (cons (cl.optimise-application (hd (tl V5692))) (cons (cl.optimise-application (hd (tl (tl V5692)))) ())))) ((and (cons? V5692) (and (= append (hd V5692)) (and (cons? (tl V5692)) (and (cons? (tl (tl V5692))) (= () (tl (tl (tl V5692)))))))) (cons APPEND (cons (cl.optimise-application (hd (tl V5692))) (cons (cl.optimise-application (hd (tl (tl V5692)))) ())))) ((and (cons? V5692) (and (= reverse (hd V5692)) (and (cons? (tl V5692)) (= () (tl (tl V5692)))))) (cons REVERSE (cons (cl.optimise-application (hd (tl V5692))) ()))) ((and (cons? V5692) (and (= length (hd V5692)) (and (cons? (tl V5692)) (= () (tl (tl V5692)))))) (cons CL.LIST-LENGTH (cons (cl.optimise-application (hd (tl V5692))) ()))) ((and (cons? V5692) (and (= if (hd V5692)) (and (cons? (tl V5692)) (and (cons? (tl (tl V5692))) (and (cons? (tl (tl (tl V5692)))) (= () (tl (tl (tl (tl V5692)))))))))) (cons IF (cons (cl.wrap (hd (tl V5692))) (cons (cl.optimise-application (hd (tl (tl V5692)))) (cons (cl.optimise-application (hd (tl (tl (tl V5692))))) ()))))) ((and (cons? V5692) (and (= value (hd V5692)) (and (cons? (tl V5692)) (and (cons? (hd (tl V5692))) (and (cons? (tl (hd (tl V5692)))) (and (= () (tl (tl (hd (tl V5692))))) (and (= () (tl (tl V5692))) (= (hd (hd (tl V5692))) QUOTE)))))))) (hd (tl (hd (tl V5692))))) ((and (cons? V5692) (and (= map (hd V5692)) (and (cons? (tl V5692)) (and (cons? (tl (tl V5692))) (= () (tl (tl (tl V5692)))))))) (cons CL.MAPCAR (tl V5692))) ((and (cons? V5692) (and (= + (hd V5692)) (and (cons? (tl V5692)) (and (= 1 (hd (tl V5692))) (and (cons? (tl (tl V5692))) (= () (tl (tl (tl V5692))))))))) (cons (intern "1+") (cons (cl.optimise-application (hd (tl (tl V5692)))) ()))) ((and (cons? V5692) (and (= + (hd V5692)) (and (cons? (tl V5692)) (and (cons? (tl (tl V5692))) (and (= 1 (hd (tl (tl V5692)))) (= () (tl (tl (tl V5692))))))))) (cons (intern "1+") (cons (cl.optimise-application (hd (tl V5692))) ()))) ((and (cons? V5692) (and (= - (hd V5692)) (and (cons? (tl V5692)) (and (cons? (tl (tl V5692))) (and (= 1 (hd (tl (tl V5692)))) (= () (tl (tl (tl V5692))))))))) (cons (intern "1-") (cons (cl.optimise-application (hd (tl V5692))) ()))) ((cons? V5692) (CL.MAPCAR (lambda Z5693 (cl.optimise-application Z5693)) V5692)) (true V5692))) + +(defun cl.cond-code (V5698 V5699) (cond ((and (cons? V5699) (and (cons? (tl V5699)) (= () (tl (tl V5699))))) (let W5700 (cl.wrap (cl.kl-to-lisp-h V5698 (hd V5699))) (let W5701 (cl.kl-to-lisp-h V5698 (hd (tl V5699))) (cons W5700 (cons W5701 ()))))) (true (simple-error "implementation error in shen.cond-code")))) + +(defun cl.wrap (V5702) (cond ((and (cons? V5702) (and (cons? (tl V5702)) (and (= true (hd (tl V5702))) (and (= () (tl (tl V5702))) (= (hd V5702) QUOTE))))) T) ((and (cons? V5702) (and (= cons? (hd V5702)) (and (cons? (tl V5702)) (= () (tl (tl V5702)))))) (cons CONSP (tl V5702))) ((and (cons? V5702) (and (= string? (hd V5702)) (and (cons? (tl V5702)) (= () (tl (tl V5702)))))) (cons STRINGP (tl V5702))) ((and (cons? V5702) (and (= number? (hd V5702)) (and (cons? (tl V5702)) (= () (tl (tl V5702)))))) (cons NUMBERP (tl V5702))) ((and (cons? V5702) (and (= empty? (hd V5702)) (and (cons? (tl V5702)) (= () (tl (tl V5702)))))) (cons NULL (tl V5702))) ((and (cons? V5702) (and (= and (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (= () (tl (tl (tl V5702)))))))) (cons AND (cons (cl.wrap (hd (tl V5702))) (cons (cl.wrap (hd (tl (tl V5702)))) ())))) ((and (cons? V5702) (and (= or (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (= () (tl (tl (tl V5702)))))))) (cons OR (cons (cl.wrap (hd (tl V5702))) (cons (cl.wrap (hd (tl (tl V5702)))) ())))) ((and (cons? V5702) (and (= not (hd V5702)) (and (cons? (tl V5702)) (= () (tl (tl V5702)))))) (cons NOT (cons (cl.wrap (hd (tl V5702))) ()))) ((and (cons? V5702) (and (= cl.equal? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (and (= () (hd (tl (tl V5702)))) (= () (tl (tl (tl V5702))))))))) (cons NULL (cons (hd (tl V5702)) ()))) ((and (cons? V5702) (and (= cl.equal? (hd V5702)) (and (cons? (tl V5702)) (and (= () (hd (tl V5702))) (and (cons? (tl (tl V5702))) (= () (tl (tl (tl V5702))))))))) (cons NULL (tl (tl V5702)))) ((and (cons? V5702) (and (= cl.equal? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (and (cons? (hd (tl (tl V5702)))) (and (cons? (tl (hd (tl (tl V5702))))) (and (= () (tl (tl (hd (tl (tl V5702)))))) (and (= () (tl (tl (tl V5702)))) (and (= (hd (hd (tl (tl V5702)))) QUOTE) (cl.fastsymbol? (hd (tl (hd (tl (tl V5702))))))))))))))) (cons EQ (tl V5702))) ((and (cons? V5702) (and (= cl.equal? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (hd (tl V5702))) (and (cons? (tl (hd (tl V5702)))) (and (= () (tl (tl (hd (tl V5702))))) (and (cons? (tl (tl V5702))) (and (= () (tl (tl (tl V5702)))) (and (= (hd (hd (tl V5702))) QUOTE) (cl.fastsymbol? (hd (tl (hd (tl V5702)))))))))))))) (cons EQ (tl V5702))) ((and (cons? V5702) (and (= cl.equal? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (hd (tl V5702))) (and (= fail (hd (hd (tl V5702)))) (and (= () (tl (hd (tl V5702)))) (and (cons? (tl (tl V5702))) (= () (tl (tl (tl V5702))))))))))) (cons EQ (tl V5702))) ((and (cons? V5702) (and (= cl.equal? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (and (cons? (hd (tl (tl V5702)))) (and (= fail (hd (hd (tl (tl V5702))))) (and (= () (tl (hd (tl (tl V5702))))) (= () (tl (tl (tl V5702))))))))))) (cons EQ (tl V5702))) ((and (cons? V5702) (and (= cl.equal? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (and (= () (tl (tl (tl V5702)))) (string? (hd (tl V5702)))))))) (cons EQUAL (tl V5702))) ((and (cons? V5702) (and (= cl.equal? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (and (= () (tl (tl (tl V5702)))) (string? (hd (tl (tl V5702))))))))) (cons EQUAL (tl V5702))) ((and (cons? V5702) (and (= cl.equal? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (and (= () (tl (tl (tl V5702)))) (number? (hd (tl V5702)))))))) (cons EQUALP (tl V5702))) ((and (cons? V5702) (and (= cl.equal? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (and (= () (tl (tl (tl V5702)))) (number? (hd (tl (tl V5702))))))))) (cons EQUALP (tl V5702))) ((and (cons? V5702) (and (= cl.equal? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (= () (tl (tl (tl V5702)))))))) (cons cl.ABSEQUAL (tl V5702))) ((and (cons? V5702) (and (= cl.greater? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (= () (tl (tl (tl V5702)))))))) (cons > (tl V5702))) ((and (cons? V5702) (and (= cl.greater-than-or-equal-to? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (= () (tl (tl (tl V5702)))))))) (cons >= (tl V5702))) ((and (cons? V5702) (and (= cl.less? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (= () (tl (tl (tl V5702)))))))) (cons < (tl V5702))) ((and (cons? V5702) (and (= cl.less-than-or-equal-to? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (= () (tl (tl (tl V5702)))))))) (cons <= (tl V5702))) (true (cons cl.wrapper (cons V5702 ()))))) + +(defun cl.fastsymbol? (V5709) (cond ((cons? V5709) false) ((= () V5709) false) ((string? V5709) false) ((number? V5709) false) (true true))) + +(defun cl.wrapper (V5710) (cond ((= true V5710) T) ((= false V5710) ()) (true (simple-error "boolean expected")))) + +(defun cl.maplispsym (V5711) (cond ((= = V5711) cl.equal?) ((= > V5711) cl.greater?) ((= < V5711) cl.less?) ((= >= V5711) cl.greater-than-or-equal-to?) ((= <= V5711) cl.less-than-or-equal-to?) ((= + V5711) cl.add) ((= - V5711) cl.subtract) ((= / V5711) cl.divide) ((= * V5711) cl.multiply) (true V5711))) + diff --git a/klambda/compiler.kl b/klambda/compiler.kl deleted file mode 100644 index 4a54e9e..0000000 --- a/klambda/compiler.kl +++ /dev/null @@ -1,99 +0,0 @@ -"Copyright (c) 2012-2019 Bruno Deferrari. All rights reserved. -BSD 3-Clause License: http://opensource.org/licenses/BSD-3-Clause" - -(defun shen-cl.initialise-compiler () (do (set shen-cl.*compiling-shen-sources* false) (do (set shen-cl.*factorise-patterns* true) shen-cl.done))) - -(defun shen-cl.kl (V414) V414) - -(defun shen-cl.cl (V415) (intern (shen-cl.upcase V415))) - -(defun shen-cl.unbound-symbol? (V420 V421) (cond ((or (symbol? V420) (= V420 ,)) (not (element? V420 V421))) (true false))) - -(defun shen-cl.merge-nested-repeats (V426 V427) (cond ((and (cons? V427) (and (cons? (tl V427)) (and (cons? (tl (tl V427))) (and (cons? (hd (tl (tl V427)))) (and (= () (tl (tl (tl V427)))) (and (= (hd V427) (hd (hd (tl (tl V427))))) (= V426 (hd (hd (tl (tl V427))))))))))) (cons (hd (hd (tl (tl V427)))) (cons (hd (tl V427)) (tl (hd (tl (tl V427))))))) (true V427))) - -(defun shen-cl.merge-nested-lets (V429) (cond ((and (cons? V429) (and (cons? (tl V429)) (and (cons? (hd (tl V429))) (and (= () (tl (hd (tl V429)))) (and (cons? (tl (tl V429))) (and (cons? (hd (tl (tl V429)))) (and (cons? (tl (hd (tl (tl V429))))) (and (cons? (tl (tl (hd (tl (tl V429)))))) (and (= () (tl (tl (tl (hd (tl (tl V429))))))) (and (= () (tl (tl (tl V429)))) (and (= (shen-cl.cl let) (hd V429)) (= (shen-cl.cl let*) (hd (hd (tl (tl V429)))))))))))))))) (cons (hd (hd (tl (tl V429)))) (cons (cons (hd (hd (tl V429))) (hd (tl (hd (tl (tl V429)))))) (tl (tl (hd (tl (tl V429)))))))) ((and (cons? V429) (and (cons? (tl V429)) (and (cons? (hd (tl V429))) (and (= () (tl (hd (tl V429)))) (and (cons? (tl (tl V429))) (and (cons? (hd (tl (tl V429)))) (and (cons? (tl (hd (tl (tl V429))))) (and (cons? (hd (tl (hd (tl (tl V429)))))) (and (= () (tl (hd (tl (hd (tl (tl V429))))))) (and (cons? (tl (tl (hd (tl (tl V429)))))) (and (= () (tl (tl (tl (hd (tl (tl V429))))))) (and (= () (tl (tl (tl V429)))) (and (= (hd V429) (hd (hd (tl (tl V429))))) (= (shen-cl.cl let) (hd (hd (tl (tl V429)))))))))))))))))) (cons (shen-cl.cl let*) (cons (cons (hd (hd (tl V429))) (hd (tl (hd (tl (tl V429)))))) (tl (tl (hd (tl (tl V429)))))))) (true V429))) - -(defun shen-cl.compile-expression (V445 V446) (cond ((= () V445) (cons (shen-cl.cl quote) (cons () ()))) ((= true V445) (cons (shen-cl.cl quote) (cons true ()))) ((= false V445) (cons (shen-cl.cl quote) (cons false ()))) ((shen-cl.unbound-symbol? V445 V446) (shen-cl.emit-symbol V445)) ((and (cons? V445) (and (= value (hd V445)) (and (cons? (tl V445)) (and (= () (tl (tl V445))) (shen-cl.unbound-symbol? (hd (tl V445)) V446))))) (hd (tl V445))) ((and (cons? V445) (and (= let (hd V445)) (and (cons? (tl V445)) (and (cons? (tl (tl V445))) (and (cons? (tl (tl (tl V445)))) (= () (tl (tl (tl (tl V445)))))))))) (shen-cl.merge-nested-lets (shen-cl.emit-let (hd (tl V445)) (hd (tl (tl V445))) (hd (tl (tl (tl V445)))) V446))) ((and (cons? V445) (= cond (hd V445))) (shen-cl.emit-cond (tl V445) V446)) ((and (cons? V445) (and (= if (hd V445)) (and (cons? (tl V445)) (and (cons? (tl (tl V445))) (and (cons? (tl (tl (tl V445)))) (= () (tl (tl (tl (tl V445)))))))))) (shen-cl.emit-if (hd (tl V445)) (hd (tl (tl V445))) (hd (tl (tl (tl V445)))) V446)) ((and (cons? V445) (and (= lambda (hd V445)) (and (cons? (tl V445)) (and (cons? (tl (tl V445))) (= () (tl (tl (tl V445)))))))) (shen-cl.emit-lambda (hd (tl V445)) (hd (tl (tl V445))) V446)) ((and (cons? V445) (and (= and (hd V445)) (and (cons? (tl V445)) (and (cons? (tl (tl V445))) (= () (tl (tl (tl V445)))))))) (cons (shen-cl.kl and) (cons (shen-cl.compile-expression (hd (tl V445)) V446) (cons (shen-cl.compile-expression (hd (tl (tl V445))) V446) ())))) ((and (cons? V445) (and (= or (hd V445)) (and (cons? (tl V445)) (and (cons? (tl (tl V445))) (= () (tl (tl (tl V445)))))))) (cons (shen-cl.kl or) (cons (shen-cl.compile-expression (hd (tl V445)) V446) (cons (shen-cl.compile-expression (hd (tl (tl V445))) V446) ())))) ((and (cons? V445) (and (= trap-error (hd V445)) (and (cons? (tl V445)) (and (cons? (tl (tl V445))) (= () (tl (tl (tl V445)))))))) (shen-cl.emit-trap-error (hd (tl V445)) (hd (tl (tl V445))) V446)) ((and (cons? V445) (and (= do (hd V445)) (and (cons? (tl V445)) (and (cons? (tl (tl V445))) (= () (tl (tl (tl V445)))))))) (shen-cl.merge-nested-repeats (shen-cl.cl progn) (cons (shen-cl.cl progn) (cons (shen-cl.compile-expression (hd (tl V445)) V446) (cons (shen-cl.compile-expression (hd (tl (tl V445))) V446) ()))))) ((and (cons? V445) (and (= = (hd V445)) (and (cons? (tl V445)) (and (cons? (tl (tl V445))) (= () (tl (tl (tl V445)))))))) (shen-cl.emit-equality-check (hd (tl V445)) (hd (tl (tl V445))) V446)) ((and (cons? V445) (and (= thaw (hd V445)) (and (cons? (tl V445)) (= () (tl (tl V445)))))) (cons (shen-cl.cl funcall) (cons (shen-cl.compile-expression (hd (tl V445)) V446) ()))) ((and (cons? V445) (and (= intern (hd V445)) (and (cons? (tl V445)) (and (= () (tl (tl V445))) (string? (hd (tl V445))))))) (cons (shen-cl.cl quote) (cons (intern (hd (tl V445))) ()))) ((and (cons? V445) (and (= type (hd V445)) (and (cons? (tl V445)) (and (cons? (tl (tl V445))) (= () (tl (tl (tl V445)))))))) (shen-cl.compile-expression (hd (tl V445)) V446)) ((and (cons? V445) (and (= lisp.lambda (hd V445)) (and (cons? (tl V445)) (and (cons? (tl (tl V445))) (= () (tl (tl (tl V445)))))))) (cons (shen-cl.cl lambda) (cons (hd (tl V445)) (cons (shen-cl.compile-expression (hd (tl (tl V445))) (append (hd (tl V445)) V446)) ())))) ((and (cons? V445) (and (= lisp.defun (hd V445)) (and (cons? (tl V445)) (and (cons? (tl (tl V445))) (and (cons? (tl (tl (tl V445)))) (= () (tl (tl (tl (tl V445)))))))))) (cons (shen-cl.cl defun) (cons (hd (tl V445)) (cons (hd (tl (tl V445))) (cons (shen-cl.compile-expression (hd (tl (tl (tl V445)))) (hd (tl (tl V445)))) ()))))) ((and (cons? V445) (and (= lisp.block (hd V445)) (and (cons? (tl V445)) (and (cons? (tl (tl V445))) (= () (tl (tl (tl V445)))))))) (cons (shen-cl.cl block) (cons (hd (tl V445)) (cons (shen-cl.compile-expression (hd (tl (tl V445))) V446) ())))) ((and (cons? V445) (and (= shen-cl.lisp.block (hd V445)) (and (cons? (tl V445)) (and (cons? (tl (tl V445))) (= () (tl (tl (tl V445)))))))) (cons (shen-cl.cl block) (cons (hd (tl V445)) (cons (shen-cl.compile-expression (hd (tl (tl V445))) V446) ())))) ((and (cons? V445) (and (= lisp. (hd V445)) (and (cons? (tl V445)) (= () (tl (tl V445)))))) (if (string? (hd (tl V445))) (READ-FROM-STRING (hd (tl V445))) (simple-error (cn "lisp. excepts a string, not " (shen.app (hd (tl V445)) "" shen.a))))) ((and (cons? V445) (and (= %%return (hd V445)) (and (cons? (tl V445)) (= () (tl (tl V445)))))) (cons (shen-cl.cl return) (cons (shen-cl.compile-expression (hd (tl V445)) V446) ()))) ((and (cons? V445) (and (= %%goto-label (hd V445)) (cons? (tl V445)))) (cons (shen-cl.cl go) (cons (hd (tl V445)) ()))) ((and (cons? V445) (and (= %%let-label (hd V445)) (and (cons? (tl V445)) (and (cons? (hd (tl V445))) (and (cons? (tl (tl V445))) (and (cons? (tl (tl (tl V445)))) (= () (tl (tl (tl (tl V445))))))))))) (cons (shen-cl.cl tagbody) (cons (shen-cl.compile-expression (hd (tl (tl (tl V445)))) V446) (cons (hd (hd (tl V445))) (cons (shen-cl.compile-expression (hd (tl (tl V445))) V446) ()))))) ((cons? V445) (shen-cl.emit-application (hd V445) (tl V445) V446)) (true V445))) - -(defun shen-cl.optimise-boolean-check (V447) (cond ((and (cons? V447) (and (= cons? (hd V447)) (and (cons? (tl V447)) (= () (tl (tl V447)))))) (cons (shen-cl.cl consp) (tl V447))) ((and (cons? V447) (and (= string? (hd V447)) (and (cons? (tl V447)) (= () (tl (tl V447)))))) (cons (shen-cl.cl stringp) (tl V447))) ((and (cons? V447) (and (= number? (hd V447)) (and (cons? (tl V447)) (= () (tl (tl V447)))))) (cons (shen-cl.cl numberp) (tl V447))) ((and (cons? V447) (and (= empty? (hd V447)) (and (cons? (tl V447)) (= () (tl (tl V447)))))) (cons (shen-cl.cl null) (tl V447))) ((and (cons? V447) (and (= and (hd V447)) (and (cons? (tl V447)) (and (cons? (tl (tl V447))) (= () (tl (tl (tl V447)))))))) (cons (shen-cl.cl and) (cons (shen-cl.optimise-boolean-check (hd (tl V447))) (cons (shen-cl.optimise-boolean-check (hd (tl (tl V447)))) ())))) ((and (cons? V447) (and (= or (hd V447)) (and (cons? (tl V447)) (and (cons? (tl (tl V447))) (= () (tl (tl (tl V447)))))))) (cons (shen-cl.cl or) (cons (shen-cl.optimise-boolean-check (hd (tl V447))) (cons (shen-cl.optimise-boolean-check (hd (tl (tl V447)))) ())))) ((and (cons? V447) (and (= not (hd V447)) (and (cons? (tl V447)) (= () (tl (tl V447)))))) (cons (shen-cl.cl not) (cons (shen-cl.optimise-boolean-check (hd (tl V447))) ()))) ((and (cons? V447) (and (= shen-cl.equal? (hd V447)) (and (cons? (tl V447)) (and (cons? (tl (tl V447))) (and (cons? (hd (tl (tl V447)))) (and (cons? (tl (hd (tl (tl V447))))) (and (= () (hd (tl (hd (tl (tl V447)))))) (and (= () (tl (tl (hd (tl (tl V447)))))) (and (= () (tl (tl (tl V447)))) (= (hd (hd (tl (tl V447)))) (shen-cl.cl quote))))))))))) (cons (shen-cl.cl null) (cons (hd (tl V447)) ()))) ((and (cons? V447) (and (= shen-cl.equal? (hd V447)) (and (cons? (tl V447)) (and (cons? (hd (tl V447))) (and (cons? (tl (hd (tl V447)))) (and (= () (hd (tl (hd (tl V447))))) (and (= () (tl (tl (hd (tl V447))))) (and (cons? (tl (tl V447))) (and (= () (tl (tl (tl V447)))) (= (hd (hd (tl V447))) (shen-cl.cl quote))))))))))) (cons (shen-cl.cl null) (tl (tl V447)))) ((and (cons? V447) (and (= shen-cl.equal? (hd V447)) (and (cons? (tl V447)) (and (cons? (hd (tl V447))) (and (= fail (hd (hd (tl V447)))) (and (= () (tl (hd (tl V447)))) (and (cons? (tl (tl V447))) (= () (tl (tl (tl V447))))))))))) (cons (shen-cl.cl eq) (tl V447))) ((and (cons? V447) (and (= shen-cl.equal? (hd V447)) (and (cons? (tl V447)) (and (cons? (tl (tl V447))) (and (cons? (hd (tl (tl V447)))) (and (= fail (hd (hd (tl (tl V447))))) (and (= () (tl (hd (tl (tl V447))))) (= () (tl (tl (tl V447))))))))))) (cons (shen-cl.cl eq) (tl V447))) ((and (cons? V447) (and (= shen-cl.equal? (hd V447)) (and (cons? (tl V447)) (and (cons? (tl (tl V447))) (and (= () (tl (tl (tl V447)))) (string? (hd (tl V447)))))))) (cons (shen-cl.cl equal) (tl V447))) ((and (cons? V447) (and (= shen-cl.equal? (hd V447)) (and (cons? (tl V447)) (and (cons? (tl (tl V447))) (and (= () (tl (tl (tl V447)))) (string? (hd (tl (tl V447))))))))) (cons (shen-cl.cl equal) (tl V447))) ((and (cons? V447) (and (= shen-cl.equal? (hd V447)) (and (cons? (tl V447)) (and (cons? (tl (tl V447))) (and (= () (tl (tl (tl V447)))) (number? (hd (tl (tl V447))))))))) (cons (shen-cl.cl equalp) (tl V447))) ((and (cons? V447) (and (= shen-cl.equal? (hd V447)) (and (cons? (tl V447)) (and (cons? (tl (tl V447))) (and (= () (tl (tl (tl V447)))) (number? (hd (tl V447)))))))) (cons (shen-cl.cl equalp) (cons (hd (tl (tl V447))) (cons (hd (tl V447)) ())))) ((and (cons? V447) (and (= shen-cl.equal? (hd V447)) (and (cons? (tl V447)) (and (cons? (tl (tl V447))) (and (cons? (hd (tl (tl V447)))) (and (cons? (tl (hd (tl (tl V447))))) (and (= () (tl (tl (hd (tl (tl V447)))))) (and (= () (tl (tl (tl V447)))) (= (shen-cl.cl quote) (hd (hd (tl (tl V447))))))))))))) (cons (shen-cl.cl eq) (tl V447))) ((and (cons? V447) (and (= shen-cl.equal? (hd V447)) (and (cons? (tl V447)) (and (cons? (hd (tl V447))) (and (cons? (tl (hd (tl V447)))) (and (= () (tl (tl (hd (tl V447))))) (and (cons? (tl (tl V447))) (and (= () (tl (tl (tl V447)))) (= (shen-cl.cl quote) (hd (hd (tl V447)))))))))))) (cons (shen-cl.cl eq) (cons (hd (tl (tl V447))) (cons (hd (tl V447)) ())))) ((and (cons? V447) (and (= shen-cl.equal? (hd V447)) (and (cons? (tl V447)) (and (cons? (tl (tl V447))) (= () (tl (tl (tl V447)))))))) (cons (shen-cl.kl shen-cl.absequal) (tl V447))) ((and (cons? V447) (and (= shen-cl.greater? (hd V447)) (and (cons? (tl V447)) (and (cons? (tl (tl V447))) (= () (tl (tl (tl V447)))))))) (cons (shen-cl.cl >) (tl V447))) ((and (cons? V447) (and (= shen-cl.greater-than-or-equal-to? (hd V447)) (and (cons? (tl V447)) (and (cons? (tl (tl V447))) (= () (tl (tl (tl V447)))))))) (cons (shen-cl.cl >=) (tl V447))) ((and (cons? V447) (and (= shen-cl.less? (hd V447)) (and (cons? (tl V447)) (and (cons? (tl (tl V447))) (= () (tl (tl (tl V447)))))))) (cons (shen-cl.cl <) (tl V447))) ((and (cons? V447) (and (= shen-cl.less-than-or-equal-to? (hd V447)) (and (cons? (tl V447)) (and (cons? (tl (tl V447))) (= () (tl (tl (tl V447)))))))) (cons (shen-cl.cl <=) (tl V447))) ((and (cons? V447) (and (cons? (tl V447)) (and (= true (hd (tl V447))) (and (= () (tl (tl V447))) (= (hd V447) (shen-cl.cl quote)))))) (shen-cl.cl t)) ((and (cons? V447) (and (cons? (tl V447)) (and (= false (hd (tl V447))) (and (= () (tl (tl V447))) (= (hd V447) (shen-cl.cl quote)))))) (shen-cl.cl nil)) (true (cons shen-cl.true? (cons V447 ()))))) - -(defun shen-cl.emit-symbol (V448) (cons (shen-cl.cl quote) (cons V448 ()))) - -(defun shen-cl.subst* (V450 V451 V452) (cond ((= V450 V451) V452) ((= () V451) (shen-cl.subst-nil-element V450 V452)) (true (subst V450 V451 V452)))) - -(defun shen-cl.subst-nil-spine (V455 V456) (cond ((= () V456) ()) ((cons? V456) (cons (shen-cl.subst-nil-element V455 (hd V456)) (shen-cl.subst-nil-spine V455 (tl V456)))) (true (shen.f-error shen-cl.subst-nil-spine)))) - -(defun shen-cl.subst-nil-element (V459 V460) (cond ((= () V460) V459) ((cons? V460) (shen-cl.subst-nil-spine V459 V460)) (true V460))) - -(defun shen-cl.ch-T/NIL (V461) (cond ((= T V461) (shen-cl.cl shen-cl.safe-t)) ((= () V461) (shen-cl.cl shen-cl.safe-nil)) (true V461))) - -(defun shen-cl.emit-let (V462 V463 V464 V465) (let W466 (shen-cl.ch-T/NIL V462) (let W467 (shen-cl.subst* W466 V462 V464) (cons (shen-cl.cl let) (cons (cons (cons W466 (cons (shen-cl.compile-expression V463 V465) ())) ()) (cons (shen-cl.compile-expression W467 (cons W466 V465)) ())))))) - -(defun shen-cl.emit-lambda (V468 V469 V470) (let W471 (shen-cl.ch-T/NIL V468) (let W472 (shen-cl.subst* W471 V468 V469) (cons (shen-cl.kl lambda) (cons W471 (cons (shen-cl.compile-expression W472 (cons W471 V470)) ())))))) - -(defun shen-cl.emit-if (V477 V478 V479 V480) (cond ((= true V477) (shen-cl.compile-expression V478 V480)) ((= false V477) (shen-cl.compile-expression V479 V480)) (true (cons (shen-cl.cl if) (cons (shen-cl.optimise-boolean-check (shen-cl.compile-expression V477 V480)) (cons (shen-cl.compile-expression V478 V480) (cons (shen-cl.compile-expression V479 V480) ()))))))) - -(defun shen-cl.emit-cond (V481 V482) (cons (shen-cl.cl cond) (shen-cl.emit-cond-clauses V481 V482))) - -(defun shen-cl.emit-cond-clauses (V489 V490) (cond ((= () V489) ()) ((and (cons? V489) (and (cons? (hd V489)) (and (= false (hd (hd V489))) (and (cons? (tl (hd V489))) (= () (tl (tl (hd V489)))))))) (shen-cl.emit-cond-clauses (tl V489) V490)) ((and (cons? V489) (and (cons? (hd V489)) (and (= true (hd (hd V489))) (and (cons? (tl (hd V489))) (= () (tl (tl (hd V489)))))))) (cons (cons (shen-cl.cl t) (cons (shen-cl.compile-expression (hd (tl (hd V489))) V490) ())) ())) ((and (cons? V489) (and (cons? (hd V489)) (and (cons? (tl (hd V489))) (= () (tl (tl (hd V489))))))) (let W491 (shen-cl.optimise-boolean-check (shen-cl.compile-expression (hd (hd V489)) V490)) (let W492 (shen-cl.compile-expression (hd (tl (hd V489))) V490) (let W493 (shen-cl.emit-cond-clauses (tl V489) V490) (cons (cons W491 (cons W492 ())) W493))))) (true (shen.f-error shen-cl.emit-cond-clauses)))) - -(defun shen-cl.emit-trap-error (V494 V495 V496) (let Freeze497 (freeze (cond (true (cons trap-error (cons (shen-cl.compile-expression V494 V496) (cons (shen-cl.compile-expression V495 V496) ())))))) (if (and (cons? V494) (and (value shen-cl.*compiling-shen-sources*) (element? (hd V494) (cons value (cons <-vector (cons <-address (cons get ()))))))) (let Result498 (shen-cl.emit-trap-error-optimise V494 V495 V496) (if (= Result498 (fail)) (thaw Freeze497) Result498)) (thaw Freeze497)))) - -(defun shen-cl.emit-trap-error-optimise (V505 V506 V507) (cond ((and (cons? V505) (and (= value (hd V505)) (and (cons? (tl V505)) (and (= () (tl (tl V505))) (and (cons? V506) (and (= lambda (hd V506)) (and (cons? (tl V506)) (and (cons? (tl (tl V506))) (= () (tl (tl (tl V506)))))))))))) (shen-cl.compile-expression (cons shen-cl.value/or (cons (hd (tl V505)) (cons (cons freeze (tl (tl V506))) ()))) V507)) ((and (cons? V505) (and (= <-vector (hd V505)) (and (cons? (tl V505)) (and (cons? (tl (tl V505))) (and (= () (tl (tl (tl V505)))) (and (cons? V506) (and (= lambda (hd V506)) (and (cons? (tl V506)) (and (cons? (tl (tl V506))) (= () (tl (tl (tl V506))))))))))))) (shen-cl.compile-expression (cons shen-cl.<-vector/or (cons (hd (tl V505)) (cons (hd (tl (tl V505))) (cons (cons freeze (tl (tl V506))) ())))) V507)) ((and (cons? V505) (and (= <-address (hd V505)) (and (cons? (tl V505)) (and (cons? (tl (tl V505))) (and (= () (tl (tl (tl V505)))) (and (cons? V506) (and (= lambda (hd V506)) (and (cons? (tl V506)) (and (cons? (tl (tl V506))) (= () (tl (tl (tl V506))))))))))))) (shen-cl.compile-expression (cons shen-cl.<-address/or (cons (hd (tl V505)) (cons (hd (tl (tl V505))) (cons (cons freeze (tl (tl V506))) ())))) V507)) ((and (cons? V505) (and (= get (hd V505)) (and (cons? (tl V505)) (and (cons? (tl (tl V505))) (and (cons? (tl (tl (tl V505)))) (and (= () (tl (tl (tl (tl V505))))) (and (cons? V506) (and (= lambda (hd V506)) (and (cons? (tl V506)) (and (cons? (tl (tl V506))) (= () (tl (tl (tl V506)))))))))))))) (shen-cl.compile-expression (cons shen-cl.get/or (cons (hd (tl V505)) (cons (hd (tl (tl V505))) (cons (hd (tl (tl (tl V505)))) (cons (cons freeze (tl (tl V506))) ()))))) V507)) (true (fail)))) - -(defun shen-cl.emit-equality-check (V508 V509 V510) (cons (shen-cl.kl shen-cl.equal?) (cons (shen-cl.compile-expression V508 V510) (cons (shen-cl.compile-expression V509 V510) ())))) - -(defun shen-cl.emit-application (V511 V512 V513) (shen-cl.emit-application* V511 (arity V511) V512 V513)) - -(defun shen-cl.is-partial-application? (V514 V515 V516) (not (or (= V515 -1) (= V515 (length V516))))) - -(defun shen-cl.take-n (V519 V520) (cond ((= 0 V520) ()) ((cons? V519) (cons (hd V519) (shen-cl.take-n (tl V519) (- V520 1)))) (true (shen.f-error shen-cl.take-n)))) - -(defun shen-cl.drop-n (V521 V522) (cond ((= 0 V522) V521) ((cons? V521) (shen-cl.drop-n (tl V521) (- V522 1))) (true (shen.f-error shen-cl.drop-n)))) - -(defun shen-cl.emit-partial-application (V531 V532 V533 V534) (cond ((> V532 (length V533)) (let W535 (map (lambda Z536 (shen-cl.compile-expression Z536 V534)) V533) (shen-cl.nest-call (shen-cl.nest-lambda V531 V532 V534) W535))) ((< V532 (length V533)) (let W537 (shen-cl.compile-expression (cons V531 (shen-cl.take-n V533 V532)) V534) (let W538 (map (lambda Z539 (shen-cl.compile-expression Z539 V534)) (shen-cl.drop-n V533 V532)) (shen-cl.nest-call W537 W538)))) (true (simple-error "emit-partial-application called with non-partial application")))) - -(defun shen-cl.dynamic-application? (V540 V541) (or (cons? V540) (element? V540 V541))) - -(defun shen-cl.emit-dynamic-application (V542 V543 V544) (cond ((= () V543) (cons (shen-cl.cl funcall) (cons (shen-cl.compile-expression V542 V544) ()))) (true (let W545 (map (lambda Z546 (shen-cl.compile-expression Z546 V544)) V543) (shen-cl.nest-call (shen-cl.compile-expression V542 V544) W545))))) - -(defun shen-cl.lisp-prefixed-h? (V551) (cond ((and (cons? V551) (and (= "l" (hd V551)) (and (cons? (tl V551)) (and (= "i" (hd (tl V551))) (and (cons? (tl (tl V551))) (and (= "s" (hd (tl (tl V551)))) (and (cons? (tl (tl (tl V551)))) (and (= "p" (hd (tl (tl (tl V551))))) (and (cons? (tl (tl (tl (tl V551))))) (= "." (hd (tl (tl (tl (tl V551))))))))))))))) true) (true false))) - -(defun shen-cl.lisp-prefixed? (V554) (cond ((symbol? V554) (shen-cl.lisp-prefixed-h? (explode V554))) (true false))) - -(defun shen-cl.remove-lisp-prefix (V555) (cond ((symbol? V555) (shen-cl.remove-lisp-prefix (str V555))) ((and (shen.+string? V555) (and (= "l" (hdstr V555)) (and (shen.+string? (tlstr V555)) (and (= "i" (hdstr (tlstr V555))) (and (shen.+string? (tlstr (tlstr V555))) (and (= "s" (hdstr (tlstr (tlstr V555)))) (and (shen.+string? (tlstr (tlstr (tlstr V555)))) (and (= "p" (hdstr (tlstr (tlstr (tlstr V555))))) (and (shen.+string? (tlstr (tlstr (tlstr (tlstr V555))))) (= "." (hdstr (tlstr (tlstr (tlstr (tlstr V555))))))))))))))) (intern (tlstr (tlstr (tlstr (tlstr (tlstr V555))))))) (true (shen.f-error shen-cl.remove-lisp-prefix)))) - -(defun shen-cl.upcase (V556) (shen-cl.upcase-h (explode V556))) - -(defun shen-cl.upcase-h (V557) (cond ((= () V557) "") ((cons? V557) (cn (shen-cl.upcase-char (hd V557)) (shen-cl.upcase-h (tl V557)))) (true (shen.f-error shen-cl.upcase-h)))) - -(defun shen-cl.upcase-char (V558) (n->string (shen-cl.upcase-charcode (string->n V558)))) - -(defun shen-cl.upcase-charcode (V559) (cond ((and (>= V559 97) (<= V559 122)) (- V559 32)) (true V559))) - -(defun shen-cl.qualify-op (V560) (cond ((shen-cl.lisp-prefixed? V560) (shen-cl.cl (shen-cl.remove-lisp-prefix V560))) ((symbol? V560) (shen-cl.kl V560)) (true V560))) - -(defun shen-cl.not-fail (V563 V564) (cond ((not (= V563 (fail))) (V564 V563)) (true V563))) - -(defun shen-cl.binary-op-mapping (V567) (cond ((= + V567) (shen-cl.kl shen-cl.add)) ((= - V567) (shen-cl.kl shen-cl.subtract)) ((= * V567) (shen-cl.kl shen-cl.multiply)) ((= / V567) (shen-cl.kl shen-cl.divide)) ((= > V567) (shen-cl.kl shen-cl.greater?)) ((= < V567) (shen-cl.kl shen-cl.less?)) ((= >= V567) (shen-cl.kl shen-cl.greater-than-or-equal-to?)) ((= <= V567) (shen-cl.kl shen-cl.less-than-or-equal-to?)) ((= cons V567) (shen-cl.cl cons)) ((= reverse V567) (shen-cl.cl reverse)) ((= append V567) (shen-cl.cl append)) (true (fail)))) - -(defun shen-cl.unary-op-mapping (V570) (cond ((= hd V570) (shen-cl.cl car)) ((= tl V570) (shen-cl.cl cdr)) ((= length V570) (shen-cl.cl list-length)) (true (fail)))) - -(defun shen-cl.optimise-static-application (V571) (cond ((and (cons? V571) (and (= shen-cl.add (hd V571)) (and (cons? (tl V571)) (and (= 1 (hd (tl V571))) (and (cons? (tl (tl V571))) (= () (tl (tl (tl V571))))))))) (cons (shen-cl.cl (intern "1+")) (tl (tl V571)))) ((and (cons? V571) (and (= shen-cl.add (hd V571)) (and (cons? (tl V571)) (and (cons? (tl (tl V571))) (and (= 1 (hd (tl (tl V571)))) (= () (tl (tl (tl V571))))))))) (cons (shen-cl.cl (intern "1+")) (cons (hd (tl V571)) ()))) ((and (cons? V571) (and (= shen-cl.subtract (hd V571)) (and (cons? (tl V571)) (and (cons? (tl (tl V571))) (and (= 1 (hd (tl (tl V571)))) (= () (tl (tl (tl V571))))))))) (cons (shen-cl.cl (intern "1-")) (cons (hd (tl V571)) ()))) ((and (cons? V571) (and (cons? (tl V571)) (and (cons? (tl (tl V571))) (and (cons? (hd (tl (tl V571)))) (and (cons? (tl (hd (tl (tl V571))))) (and (= () (hd (tl (hd (tl (tl V571)))))) (and (= () (tl (tl (hd (tl (tl V571)))))) (and (= () (tl (tl (tl V571)))) (and (= (shen-cl.cl cons) (hd V571)) (= (shen-cl.cl quote) (hd (hd (tl (tl V571)))))))))))))) (cons (shen-cl.cl list) (cons (hd (tl V571)) ()))) ((and (cons? V571) (and (cons? (tl V571)) (and (cons? (tl (tl V571))) (and (cons? (hd (tl (tl V571)))) (and (= () (tl (tl (tl V571)))) (and (= (shen-cl.cl cons) (hd V571)) (= (shen-cl.cl list) (hd (hd (tl (tl V571))))))))))) (cons (hd (hd (tl (tl V571)))) (cons (hd (tl V571)) (tl (hd (tl (tl V571))))))) (true V571))) - -(defun shen-cl.emit-static-application (V574 V575 V576 V577) (let Freeze586 (freeze (cond (true (let Freeze588 (freeze (cond (true (let W584 (map (lambda Z585 (shen-cl.compile-expression Z585 V577)) V576) (cons (shen-cl.qualify-op V574) W584))))) (if (= 1 V575) (let Result589 (shen-cl.not-fail (shen-cl.unary-op-mapping V574) (lambda Z581 (let W582 (map (lambda Z583 (shen-cl.compile-expression Z583 V577)) V576) (cons Z581 W582)))) (if (= Result589 (fail)) (thaw Freeze588) Result589)) (thaw Freeze588)))))) (if (= 2 V575) (let Result587 (shen-cl.not-fail (shen-cl.binary-op-mapping V574) (lambda Z578 (let W579 (map (lambda Z580 (shen-cl.compile-expression Z580 V577)) V576) (cons Z578 W579)))) (if (= Result587 (fail)) (thaw Freeze586) Result587)) (thaw Freeze586)))) - -(defun shen-cl.emit-application* (V590 V591 V592 V593) (if (shen-cl.is-partial-application? V590 V591 V592) (shen-cl.emit-partial-application V590 V591 V592 V593) (if (shen-cl.dynamic-application? V590 V593) (shen-cl.emit-dynamic-application V590 V592 V593) (shen-cl.optimise-static-application (shen-cl.emit-static-application V590 V591 V592 V593))))) - -(defun shen-cl.nest-call (V594 V595) (cond ((= () V595) V594) ((cons? V595) (shen-cl.nest-call (cons (shen-cl.cl funcall) (cons V594 (cons (hd V595) ()))) (tl V595))) (true (shen.f-error shen-cl.nest-call)))) - -(defun shen-cl.nest-lambda (V596 V597 V598) (cond ((<= V597 0) (shen-cl.compile-expression V596 V598)) (true (let W599 (gensym Y) (cons (shen-cl.kl lambda) (cons W599 (cons (shen-cl.nest-lambda (shen-cl.merge-args V596 W599) (- V597 1) (cons W599 V598)) ()))))))) - -(defun shen-cl.merge-args (V600 V601) (cond ((cons? V600) (append V600 (cons V601 ()))) (true (cons V600 (cons V601 ()))))) - -(defun shen-cl.factorise-defun (V602) (cond ((and (cons? V602) (and (= defun (hd V602)) (and (cons? (tl V602)) (and (cons? (tl (tl V602))) (and (cons? (tl (tl (tl V602)))) (and (cons? (hd (tl (tl (tl V602))))) (and (= cond (hd (hd (tl (tl (tl V602)))))) (= () (tl (tl (tl (tl V602)))))))))))) (shen-cl.add-block (shen.x.factorise-defun.factorise-defun V602))) (true (shen.f-error shen-cl.factorise-defun)))) - -(defun shen-cl.add-block (V603) (cond ((and (cons? V603) (and (= defun (hd V603)) (and (cons? (tl V603)) (and (cons? (tl (tl V603))) (and (cons? (tl (tl (tl V603)))) (= () (tl (tl (tl (tl V603)))))))))) (cons defun (cons (hd (tl V603)) (cons (hd (tl (tl V603))) (cons (cons lisp.block (cons () (tl (tl (tl V603))))) ()))))) (true (shen.f-error shen-cl.add-block)))) - -(defun shen-cl.kl->lisp (V604) (cond ((and (cons? V604) (and (= defun (hd V604)) (and (cons? (tl V604)) (and (cons? (tl (tl V604))) (and (cons? (tl (tl (tl V604)))) (and (cons? (hd (tl (tl (tl V604))))) (and (= cond (hd (hd (tl (tl (tl V604)))))) (and (= () (tl (tl (tl (tl V604))))) (value shen-cl.*factorise-patterns*))))))))) (shen-cl.kl->lisp (shen-cl.factorise-defun V604))) ((and (cons? V604) (and (= defun (hd V604)) (and (cons? (tl V604)) (and (cons? (tl (tl V604))) (and (cons? (tl (tl (tl V604)))) (= () (tl (tl (tl (tl V604)))))))))) (cons (shen-cl.cl defun) (cons (shen-cl.qualify-op (hd (tl V604))) (cons (hd (tl (tl V604))) (cons (shen-cl.compile-expression (hd (tl (tl (tl V604)))) (hd (tl (tl V604)))) ()))))) (true (shen-cl.compile-expression V604 ())))) - diff --git a/klambda/core.kl b/klambda/core.kl index 974c8b6..da44a84 100644 --- a/klambda/core.kl +++ b/klambda/core.kl @@ -1,137 +1,121 @@ -(defun shen.shen->kl (V531) (let W532 (shen.shen->kl-h V531) (shen.record-and-evaluate W532))) +(defun shen.shen->kl (V521) (let W522 (shen.shen->kl-h V521) (shen.record-and-evaluate W522))) -(defun shen.record-and-evaluate (V533) (cond ((and (cons? V533) (and (= defun (hd V533)) (and (cons? (tl V533)) (and (cons? (tl (tl V533))) (and (cons? (tl (tl (tl V533)))) (= () (tl (tl (tl (tl V533)))))))))) (let W534 (if (shen.sysfunc? (hd (tl V533))) (simple-error (shen.app (hd (tl V533)) " is not a legitimate function name -" shen.a)) shen.skip) (let W535 (shen.store-arity (hd (tl V533)) (length (hd (tl (tl V533))))) (let W536 (shen.record-kl (hd (tl V533)) V533) (let W537 (eval-kl V533) (shen.fn-print (hd (tl V533)))))))) (true V533))) +(defun shen.record-and-evaluate (V523) (cond ((and (cons? V523) (and (= defun (hd V523)) (and (cons? (tl V523)) (and (cons? (tl (tl V523))) (and (cons? (tl (tl (tl V523)))) (= () (tl (tl (tl (tl V523)))))))))) (let W524 (if (shen.sysfunc? (hd (tl V523))) (simple-error (shen.app (hd (tl V523)) " is not a legitimate function name +" shen.a)) shen.skip) (let W525 (shen.store-arity (hd (tl V523)) (length (hd (tl (tl V523))))) (let W526 (shen.record-kl (hd (tl V523)) V523) (let W527 (eval-kl V523) (shen.fn-print (hd (tl V523)))))))) (true V523))) -(defun shen.shen->kl-h (V538) (cond ((and (cons? V538) (and (= define (hd V538)) (cons? (tl V538)))) (shen.shendef->kldef (hd (tl V538)) (tl (tl V538)))) ((and (cons? V538) (and (= defun (hd V538)) (and (cons? (tl V538)) (and (cons? (tl (tl V538))) (and (cons? (tl (tl (tl V538)))) (= () (tl (tl (tl (tl V538)))))))))) V538) ((and (cons? V538) (and (= type (hd V538)) (and (cons? (tl V538)) (and (cons? (tl (tl V538))) (= () (tl (tl (tl V538)))))))) (cons type (cons (hd (tl V538)) (cons (shen.rcons_form (hd (tl (tl V538)))) ())))) ((and (cons? V538) (and (= input+ (hd V538)) (and (cons? (tl V538)) (and (cons? (tl (tl V538))) (= () (tl (tl (tl V538)))))))) (cons input+ (cons (shen.rcons_form (hd (tl V538))) (tl (tl V538))))) ((cons? V538) (map (lambda Z539 (shen.shen->kl-h Z539)) V538)) (true V538))) +(defun shen.shen->kl-h (V528) (cond ((and (cons? V528) (and (= define (hd V528)) (cons? (tl V528)))) (shen.shendef->kldef (hd (tl V528)) (tl (tl V528)))) ((and (cons? V528) (and (= defun (hd V528)) (and (cons? (tl V528)) (and (cons? (tl (tl V528))) (and (cons? (tl (tl (tl V528)))) (= () (tl (tl (tl (tl V528)))))))))) V528) ((and (cons? V528) (and (= type (hd V528)) (and (cons? (tl V528)) (and (cons? (tl (tl V528))) (= () (tl (tl (tl V528)))))))) (cons type (cons (hd (tl V528)) (cons (shen.rcons_form (hd (tl (tl V528)))) ())))) ((and (cons? V528) (and (= input+ (hd V528)) (and (cons? (tl V528)) (and (cons? (tl (tl V528))) (= () (tl (tl (tl V528)))))))) (cons input+ (cons (shen.rcons_form (hd (tl V528))) (tl (tl V528))))) ((cons? V528) (map (lambda Z529 (shen.shen->kl-h Z529)) V528)) (true V528))) -(defun shen.shendef->kldef (V540 V541) (compile (lambda Z542 (shen. Z542)) (cons V540 V541))) +(defun shen.shendef->kldef (V530 V531) (compile (lambda Z532 (shen. Z532)) (cons V530 V531))) -(defun shen. (V543) (let W544 (let W545 (shen. V543) (if (shen.parse-failure? W545) (shen.parse-failure) (let W546 (shen.<-out W545) (let W547 (shen.in-> W545) (if (shen.hds=? W547 {) (let W548 (tail W547) (let W549 (shen. W548) (if (shen.parse-failure? W549) (shen.parse-failure) (let W550 (shen.in-> W549) (if (shen.hds=? W550 }) (let W551 (tail W550) (let W552 (shen. W551) (if (shen.parse-failure? W552) (shen.parse-failure) (let W553 (shen.<-out W552) (let W554 (shen.in-> W552) (shen.comb W554 (shen.shendef->kldef-h W546 W553))))))) (shen.parse-failure)))))) (shen.parse-failure)))))) (if (shen.parse-failure? W544) (let W555 (let W556 (shen. V543) (if (shen.parse-failure? W556) (shen.parse-failure) (let W557 (shen.<-out W556) (let W558 (shen.in-> W556) (let W559 (shen. W558) (if (shen.parse-failure? W559) (shen.parse-failure) (let W560 (shen.<-out W559) (let W561 (shen.in-> W559) (shen.comb W561 (shen.shendef->kldef-h W557 W560)))))))))) (if (shen.parse-failure? W555) (shen.parse-failure) W555)) W544))) +(defun shen. (V533) (let W534 (let W535 (shen. V533) (if (shen.parse-failure? W535) (shen.parse-failure) (let W536 (shen.<-out W535) (let W537 (shen.in-> W535) (if (shen.hds=? W537 {) (let W538 (tail W537) (let W539 (shen. W538) (if (shen.parse-failure? W539) (shen.parse-failure) (let W540 (shen.in-> W539) (if (shen.hds=? W540 }) (let W541 (tail W540) (let W542 (shen. W541) (if (shen.parse-failure? W542) (shen.parse-failure) (let W543 (shen.<-out W542) (let W544 (shen.in-> W542) (shen.comb W544 (shen.shendef->kldef-h W536 W543))))))) (shen.parse-failure)))))) (shen.parse-failure)))))) (if (shen.parse-failure? W534) (let W545 (let W546 (shen. V533) (if (shen.parse-failure? W546) (shen.parse-failure) (let W547 (shen.<-out W546) (let W548 (shen.in-> W546) (let W549 (shen. W548) (if (shen.parse-failure? W549) (shen.parse-failure) (let W550 (shen.<-out W549) (let W551 (shen.in-> W549) (shen.comb W551 (shen.shendef->kldef-h W547 W550)))))))))) (if (shen.parse-failure? W545) (shen.parse-failure) W545)) W534))) -(defun shen.shendef->kldef-h (V562 V563) (let W564 (map (lambda Z565 (fst Z565)) V563) (let W566 (shen.arity-chk V562 W564) (let W567 (map (lambda Z568 (shen.free-var-chk V562 Z568)) V563) (let W569 (shen.unprotect V563) (let W570 (shen.factorise-code (shen.compile-to-kl V562 W569 W566)) W570)))))) +(defun shen.shendef->kldef-h (V552 V553) (let W554 (map (lambda Z555 (fst Z555)) V553) (let W556 (shen.arity-chk V552 W554) (let W557 (map (lambda Z558 (shen.free-var-chk V552 Z558)) V553) (let W559 (shen.unprotect V553) (let W560 (shen.factorise-code (shen.compile-to-kl V552 W559 W556)) W560)))))) -(defun shen.unprotect (V571) (cond ((tuple? V571) (@p (shen.unprotect (fst V571)) (shen.unprotect (snd V571)))) ((and (cons? V571) (and (= protect (hd V571)) (and (cons? (tl V571)) (= () (tl (tl V571)))))) (shen.unprotect (hd (tl V571)))) ((cons? V571) (map (lambda Z572 (shen.unprotect Z572)) V571)) (true V571))) +(defun shen.unprotect (V561) (cond ((tuple? V561) (@p (shen.unprotect (fst V561)) (shen.unprotect (snd V561)))) ((and (cons? V561) (and (= protect (hd V561)) (and (cons? (tl V561)) (= () (tl (tl V561)))))) (shen.unprotect (hd (tl V561)))) ((cons? V561) (map (lambda Z562 (shen.unprotect Z562)) V561)) (true V561))) -(defun shen. (V573) (let W574 (if (cons? V573) (let W575 (head V573) (let W576 (tail V573) (shen.comb W576 (if (and (symbol? W575) (not (variable? W575))) W575 (simple-error (shen.app W575 " is not a legitimate function name. -" shen.a)))))) (shen.parse-failure)) (if (shen.parse-failure? W574) (shen.parse-failure) W574))) +(defun shen. (V563) (let W564 (if (cons? V563) (let W565 (head V563) (let W566 (tail V563) (shen.comb W566 (if (and (symbol? W565) (not (variable? W565))) W565 (simple-error (shen.app W565 " is not a legitimate function name. +" shen.a)))))) (shen.parse-failure)) (if (shen.parse-failure? W564) (shen.parse-failure) W564))) -(defun shen. (V577) (let W578 (if (cons? V577) (let W579 (head V577) (let W580 (tail V577) (let W581 (shen. W580) (if (shen.parse-failure? W581) (shen.parse-failure) (let W582 (shen.<-out W581) (let W583 (shen.in-> W581) (if (not (element? W579 (cons { (cons } ())))) (shen.comb W583 (cons W579 W582)) (shen.parse-failure)))))))) (shen.parse-failure)) (if (shen.parse-failure? W578) (let W584 (let W585 ( V577) (if (shen.parse-failure? W585) (shen.parse-failure) (let W586 (shen.in-> W585) (shen.comb W586 ())))) (if (shen.parse-failure? W584) (shen.parse-failure) W584)) W578))) +(defun shen. (V567) (let W568 (if (cons? V567) (let W569 (head V567) (let W570 (tail V567) (let W571 (shen. W570) (if (shen.parse-failure? W571) (shen.parse-failure) (let W572 (shen.<-out W571) (let W573 (shen.in-> W571) (if (not (element? W569 (cons { (cons } ())))) (shen.comb W573 (cons W569 W572)) (shen.parse-failure)))))))) (shen.parse-failure)) (if (shen.parse-failure? W568) (let W574 (let W575 ( V567) (if (shen.parse-failure? W575) (shen.parse-failure) (let W576 (shen.in-> W575) (shen.comb W576 ())))) (if (shen.parse-failure? W574) (shen.parse-failure) W574)) W568))) -(defun shen. (V587) (let W588 (let W589 (shen. V587) (if (shen.parse-failure? W589) (shen.parse-failure) (let W590 (shen.<-out W589) (let W591 (shen.in-> W589) (let W592 (shen. W591) (if (shen.parse-failure? W592) (shen.parse-failure) (let W593 (shen.<-out W592) (let W594 (shen.in-> W592) (shen.comb W594 (cons (shen.linearise W590) W593)))))))))) (if (shen.parse-failure? W588) (let W595 (let W596 ( V587) (if (shen.parse-failure? W596) (shen.parse-failure) (let W597 (shen.<-out W596) (let W598 (shen.in-> W596) (shen.comb W598 (if (empty? W597) () (simple-error (cn "Shen syntax error here: - " (shen.app W597 " - ..." shen.r))))))))) (if (shen.parse-failure? W595) (shen.parse-failure) W595)) W588))) +(defun shen. (V577) (let W578 (let W579 (shen. V577) (if (shen.parse-failure? W579) (shen.parse-failure) (let W580 (shen.<-out W579) (let W581 (shen.in-> W579) (let W582 (shen. W581) (if (shen.parse-failure? W582) (shen.parse-failure) (let W583 (shen.<-out W582) (let W584 (shen.in-> W582) (shen.comb W584 (cons (shen.linearise W580) W583)))))))))) (if (shen.parse-failure? W578) (let W585 (let W586 ( V577) (if (shen.parse-failure? W586) (shen.parse-failure) (let W587 (shen.<-out W586) (let W588 (shen.in-> W586) (shen.comb W588 (if (empty? W587) () (simple-error (cn "Shen syntax error here: + " (shen.app W587 " + ..." shen.r))))))))) (if (shen.parse-failure? W585) (shen.parse-failure) W585)) W578))) -(defun shen.linearise (V601) (cond ((tuple? V601) (shen.linearise-h (fst V601) (fst V601) () (snd V601))) (true (simple-error "implementation error in shen.linearise")))) +(defun shen.linearise (V591) (cond ((tuple? V591) (shen.linearise-h (fst V591) (fst V591) () (snd V591))) (true (simple-error "implementation error in shen.linearise")))) -(defun shen.linearise-h (V614 V615 V616 V617) (cond ((= () V614) (@p V615 V617)) ((and (cons? V614) (cons? (hd V614))) (shen.linearise-h (append (hd V614) (tl V614)) V615 V616 V617)) ((and (cons? V614) (variable? (hd V614))) (if (element? (hd V614) V616) (let W618 (gensym V) (shen.linearise-h (tl V614) (shen.rep-X (hd V614) W618 V615) V616 (cons where (cons (cons = (cons W618 (cons (hd V614) ()))) (cons V617 ()))))) (shen.linearise-h (tl V614) V615 (cons (hd V614) V616) V617))) ((cons? V614) (shen.linearise-h (tl V614) V615 V616 V617)) (true (simple-error "implementation error in shen.linearise-h")))) +(defun shen.linearise-h (V604 V605 V606 V607) (cond ((= () V604) (@p V605 V607)) ((and (cons? V604) (cons? (hd V604))) (shen.linearise-h (append (hd V604) (tl V604)) V605 V606 V607)) ((and (cons? V604) (variable? (hd V604))) (if (element? (hd V604) V606) (let W608 (gensym V) (shen.linearise-h (tl V604) (shen.rep-X (hd V604) W608 V605) V606 (cons where (cons (cons = (cons W608 (cons (hd V604) ()))) (cons V607 ()))))) (shen.linearise-h (tl V604) V605 (cons (hd V604) V606) V607))) ((cons? V604) (shen.linearise-h (tl V604) V605 V606 V607)) (true (simple-error "implementation error in shen.linearise-h")))) -(defun shen. (V619) (let W620 (let W621 (shen. V619) (if (shen.parse-failure? W621) (shen.parse-failure) (let W622 (shen.<-out W621) (let W623 (shen.in-> W621) (if (shen.hds=? W623 ->) (let W624 (tail W623) (if (cons? W624) (let W625 (head W624) (let W626 (tail W624) (if (shen.hds=? W626 where) (let W627 (tail W626) (if (cons? W627) (let W628 (head W627) (let W629 (tail W627) (shen.comb W629 (@p W622 (cons where (cons W628 (cons W625 ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W620) (let W630 (let W631 (shen. V619) (if (shen.parse-failure? W631) (shen.parse-failure) (let W632 (shen.<-out W631) (let W633 (shen.in-> W631) (if (shen.hds=? W633 ->) (let W634 (tail W633) (if (cons? W634) (let W635 (head W634) (let W636 (tail W634) (shen.comb W636 (@p W632 W635)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W630) (let W637 (let W638 (shen. V619) (if (shen.parse-failure? W638) (shen.parse-failure) (let W639 (shen.<-out W638) (let W640 (shen.in-> W638) (if (shen.hds=? W640 <-) (let W641 (tail W640) (if (cons? W641) (let W642 (head W641) (let W643 (tail W641) (if (shen.hds=? W643 where) (let W644 (tail W643) (if (cons? W644) (let W645 (head W644) (let W646 (tail W644) (shen.comb W646 (@p W639 (cons where (cons W645 (cons (cons shen.choicepoint! (cons W642 ())) ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W637) (let W647 (let W648 (shen. V619) (if (shen.parse-failure? W648) (shen.parse-failure) (let W649 (shen.<-out W648) (let W650 (shen.in-> W648) (if (shen.hds=? W650 <-) (let W651 (tail W650) (if (cons? W651) (let W652 (head W651) (let W653 (tail W651) (shen.comb W653 (@p W649 (cons shen.choicepoint! (cons W652 ())))))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W647) (shen.parse-failure) W647)) W637)) W630)) W620))) +(defun shen. (V609) (let W610 (let W611 (shen. V609) (if (shen.parse-failure? W611) (shen.parse-failure) (let W612 (shen.<-out W611) (let W613 (shen.in-> W611) (if (shen.hds=? W613 ->) (let W614 (tail W613) (if (cons? W614) (let W615 (head W614) (let W616 (tail W614) (if (shen.hds=? W616 where) (let W617 (tail W616) (if (cons? W617) (let W618 (head W617) (let W619 (tail W617) (shen.comb W619 (@p W612 (cons where (cons W618 (cons W615 ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W610) (let W620 (let W621 (shen. V609) (if (shen.parse-failure? W621) (shen.parse-failure) (let W622 (shen.<-out W621) (let W623 (shen.in-> W621) (if (shen.hds=? W623 ->) (let W624 (tail W623) (if (cons? W624) (let W625 (head W624) (let W626 (tail W624) (shen.comb W626 (@p W622 W625)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W620) (let W627 (let W628 (shen. V609) (if (shen.parse-failure? W628) (shen.parse-failure) (let W629 (shen.<-out W628) (let W630 (shen.in-> W628) (if (shen.hds=? W630 <-) (let W631 (tail W630) (if (cons? W631) (let W632 (head W631) (let W633 (tail W631) (if (shen.hds=? W633 where) (let W634 (tail W633) (if (cons? W634) (let W635 (head W634) (let W636 (tail W634) (shen.comb W636 (@p W629 (cons where (cons W635 (cons (cons shen.choicepoint! (cons W632 ())) ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W627) (let W637 (let W638 (shen. V609) (if (shen.parse-failure? W638) (shen.parse-failure) (let W639 (shen.<-out W638) (let W640 (shen.in-> W638) (if (shen.hds=? W640 <-) (let W641 (tail W640) (if (cons? W641) (let W642 (head W641) (let W643 (tail W641) (shen.comb W643 (@p W639 (cons shen.choicepoint! (cons W642 ())))))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W637) (shen.parse-failure) W637)) W627)) W620)) W610))) -(defun shen. (V654) (let W655 (let W656 (shen. V654) (if (shen.parse-failure? W656) (shen.parse-failure) (let W657 (shen.<-out W656) (let W658 (shen.in-> W656) (let W659 (shen. W658) (if (shen.parse-failure? W659) (shen.parse-failure) (let W660 (shen.<-out W659) (let W661 (shen.in-> W659) (shen.comb W661 (cons W657 W660)))))))))) (if (shen.parse-failure? W655) (let W662 (let W663 ( V654) (if (shen.parse-failure? W663) (shen.parse-failure) (let W664 (shen.in-> W663) (shen.comb W664 ())))) (if (shen.parse-failure? W662) (shen.parse-failure) W662)) W655))) +(defun shen. (V644) (let W645 (let W646 (shen. V644) (if (shen.parse-failure? W646) (shen.parse-failure) (let W647 (shen.<-out W646) (let W648 (shen.in-> W646) (let W649 (shen. W648) (if (shen.parse-failure? W649) (shen.parse-failure) (let W650 (shen.<-out W649) (let W651 (shen.in-> W649) (shen.comb W651 (cons W647 W650)))))))))) (if (shen.parse-failure? W645) (let W652 (let W653 ( V644) (if (shen.parse-failure? W653) (shen.parse-failure) (let W654 (shen.in-> W653) (shen.comb W654 ())))) (if (shen.parse-failure? W652) (shen.parse-failure) W652)) W645))) -(defun shen. (V665) (let W666 (if (shen.ccons? V665) (let W667 (head V665) (let W668 (tail V665) (if (shen.hds=? W667 vector) (let W669 (tail W667) (if (shen.hds=? W669 0) (let W670 (tail W669) (let W671 ( W670) (if (shen.parse-failure? W671) (shen.parse-failure) (let W672 (shen.in-> W671) (shen.comb W668 (cons vector (cons 0 ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W666) (let W673 (if (cons? V665) (let W674 (head V665) (let W675 (tail V665) (if (cons? W674) (shen.comb W675 (shen.compound-pattern W674)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W673) (let W676 (let W677 (shen. V665) (if (shen.parse-failure? W677) (shen.parse-failure) (let W678 (shen.<-out W677) (let W679 (shen.in-> W677) (shen.comb W679 W678))))) (if (shen.parse-failure? W676) (shen.parse-failure) W676)) W673)) W666))) +(defun shen. (V655) (let W656 (if (shen.ccons? V655) (let W657 (head V655) (let W658 (tail V655) (let W659 (shen. W657) (if (shen.parse-failure? W659) (shen.parse-failure) (let W660 (shen.<-out W659) (let W661 (shen.in-> W659) (let W662 (shen. W661) (if (shen.parse-failure? W662) (shen.parse-failure) (let W663 (shen.<-out W662) (let W664 (shen.in-> W662) (let W665 (shen. W664) (if (shen.parse-failure? W665) (shen.parse-failure) (let W666 (shen.<-out W665) (let W667 (shen.in-> W665) (let W668 ( W667) (if (shen.parse-failure? W668) (shen.parse-failure) (let W669 (shen.in-> W668) (shen.comb W658 (cons W660 (cons W663 (cons W666 ()))))))))))))))))))))) (shen.parse-failure)) (if (shen.parse-failure? W656) (let W670 (if (shen.ccons? V655) (let W671 (head V655) (let W672 (tail V655) (if (shen.hds=? W671 vector) (let W673 (tail W671) (if (shen.hds=? W673 0) (let W674 (tail W673) (let W675 ( W674) (if (shen.parse-failure? W675) (shen.parse-failure) (let W676 (shen.in-> W675) (shen.comb W672 (cons vector (cons 0 ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W670) (let W677 (if (cons? V655) (let W678 (head V655) (let W679 (tail V655) (if (cons? W678) (shen.comb W679 (shen.constructor-error W678)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W677) (let W680 (let W681 (shen. V655) (if (shen.parse-failure? W681) (shen.parse-failure) (let W682 (shen.<-out W681) (let W683 (shen.in-> W681) (shen.comb W683 W682))))) (if (shen.parse-failure? W680) (shen.parse-failure) W680)) W677)) W670)) W656))) -(defun shen. (V680) (let W681 (if (cons? V680) (let W682 (head V680) (let W683 (tail V680) (if (shen.constructor? W682) (shen.comb W683 W682) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W681) (shen.parse-failure) W681))) +(defun shen. (V684) (let W685 (if (cons? V684) (let W686 (head V684) (let W687 (tail V684) (if (shen.constructor? W686) (shen.comb W687 W686) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W685) (shen.parse-failure) W685))) -(defun shen.constructor? (V684) (element? V684 (cons cons (cons @p (cons @s (cons @v ())))))) +(defun shen.constructor? (V688) (element? V688 (cons cons (cons @p (cons @s (cons @v ())))))) -(defun shen.constructor-error (V685) (simple-error (shen.app V685 " is not a legitimate constructor +(defun shen.constructor-error (V689) (simple-error (shen.app V689 " is not a legitimate constructor " shen.r))) -(defun shen.custom-pattern-compiler (V686 V687) (let W688 (value shen.*custom-pattern-compiler*) (if (= W688 false) (thaw V687) ((W688 V686) V687)))) +(defun shen. (V690) (let W691 (if (cons? V690) (let W692 (head V690) (let W693 (tail V690) (if (= W692 _) (shen.comb W693 (gensym Y)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W691) (let W694 (if (cons? V690) (let W695 (head V690) (let W696 (tail V690) (if (not (element? W695 (cons -> (cons <- ())))) (shen.comb W696 W695) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W694) (shen.parse-failure) W694)) W691))) -(defun shen.custom-pattern-reducer (V689) (let W690 (value shen.*custom-pattern-reducer*) (if (= W690 false) (fail) (W690 V689)))) +(defun shen. (V697) (let W698 (let W699 (shen. V697) (if (shen.parse-failure? W699) (shen.parse-failure) (let W700 (shen.<-out W699) (let W701 (shen.in-> W699) (shen.comb W701 W700))))) (if (shen.parse-failure? W698) (shen.parse-failure) W698))) -(defun shen.compound-pattern (V691) (shen.custom-pattern-compiler V691 (freeze (shen.compound-pattern-h V691)))) +(defun shen. (V702) (let W703 (let W704 (shen. V702) (if (shen.parse-failure? W704) (shen.parse-failure) (let W705 (shen.<-out W704) (let W706 (shen.in-> W704) (shen.comb W706 W705))))) (if (shen.parse-failure? W703) (shen.parse-failure) W703))) -(defun shen.compound-pattern-h (V692) (cond ((and (cons? V692) (and (cons? (tl V692)) (and (cons? (tl (tl V692))) (and (= () (tl (tl (tl V692)))) (shen.constructor? (hd V692)))))) (cons (hd V692) (cons (shen.compile-pattern-fragment (hd (tl V692))) (cons (shen.compile-pattern-fragment (hd (tl (tl V692)))) ())))) (true (shen.constructor-error V692)))) +(defun shen.fn-print (V707) (let W708 (absvector 2) (let W709 (address-> W708 0 shen.printF) (let W710 (address-> W709 1 (@s "(" (@s "f" (@s "n" (@s " " (@s (str V707) ")")))))) W710)))) -(defun shen.compile-pattern-fragment (V693) (cond ((and (cons? V693) (and (= vector (hd V693)) (and (cons? (tl V693)) (and (= 0 (hd (tl V693))) (= () (tl (tl V693))))))) V693) ((cons? V693) (shen.compound-pattern V693)) ((= V693 _) (gensym Y)) ((not (element? V693 (cons -> (cons <- ())))) V693) (true (shen.constructor-error V693)))) +(defun shen.printF (V711) (<-address V711 1)) -(defun shen.custom-pattern? (V698) (cond ((and (cons? V698) (and (= @p (hd V698)) (and (cons? (tl V698)) (and (= shen.custom-pattern (hd (tl V698))) (and (cons? (tl (tl V698))) (= () (tl (tl (tl V698))))))))) true) (true false))) - -(defun shen.custom-pattern-body (V701) (cond ((and (cons? V701) (and (= @p (hd V701)) (and (cons? (tl V701)) (and (= shen.custom-pattern (hd (tl V701))) (and (cons? (tl (tl V701))) (= () (tl (tl (tl V701))))))))) (hd (tl (tl V701)))) (true (simple-error "implementation error in shen.custom-pattern-body")))) - -(defun shen. (V702) (let W703 (if (cons? V702) (let W704 (head V702) (let W705 (tail V702) (if (= W704 _) (shen.comb W705 (gensym Y)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W703) (let W706 (if (cons? V702) (let W707 (head V702) (let W708 (tail V702) (if (not (element? W707 (cons -> (cons <- ())))) (shen.comb W708 W707) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W706) (shen.parse-failure) W706)) W703))) - -(defun shen. (V709) (let W710 (let W711 (shen. V709) (if (shen.parse-failure? W711) (shen.parse-failure) (let W712 (shen.<-out W711) (let W713 (shen.in-> W711) (shen.comb W713 W712))))) (if (shen.parse-failure? W710) (shen.parse-failure) W710))) - -(defun shen. (V714) (let W715 (let W716 (shen. V714) (if (shen.parse-failure? W716) (shen.parse-failure) (let W717 (shen.<-out W716) (let W718 (shen.in-> W716) (shen.comb W718 W717))))) (if (shen.parse-failure? W715) (shen.parse-failure) W715))) - -(defun shen.fn-print (V719) (let W720 (absvector 2) (let W721 (address-> W720 0 shen.printF) (let W722 (address-> W721 1 (@s "(" (@s "f" (@s "n" (@s " " (@s (str V719) ")")))))) W722)))) - -(defun shen.printF (V723) (<-address V723 1)) - -(defun shen.arity-chk (V728 V729) (cond ((and (cons? V729) (= () (tl V729))) (length (hd V729))) ((and (cons? V729) (and (cons? (tl V729)) (= (length (hd V729)) (length (hd (tl V729)))))) (shen.arity-chk V728 (tl V729))) (true (simple-error (cn "arity error in " (shen.app V728 " +(defun shen.arity-chk (V716 V717) (cond ((and (cons? V717) (= () (tl V717))) (length (hd V717))) ((and (cons? V717) (and (cons? (tl V717)) (= (length (hd V717)) (length (hd (tl V717)))))) (shen.arity-chk V716 (tl V717))) (true (simple-error (cn "arity error in " (shen.app V716 " " shen.a)))))) -(defun shen.free-var-chk (V730 V731) (cond ((tuple? V731) (shen.free-variable-error-message V730 (shen.find-free-vars (shen.extract-vars (fst V731)) (snd V731)))) (true (shen.f-error shen.free-var-chk)))) - -(defun shen.free-variable-error-message (V732 V733) (if (empty? V733) shen.skip (do (pr (cn "free variables in " (shen.app V732 ":" shen.a)) (stoutput)) (do (shen.for-each (lambda Z734 (pr (cn " " (shen.app Z734 "" shen.a)) (stoutput))) V733) (do (nl 1) (abort)))))) +(defun shen.free-var-chk (V718 V719) (cond ((tuple? V719) (shen.free-variable-error-message V718 (shen.find-free-vars (shen.extract-vars (fst V719)) (snd V719)))) (true (simple-error "partial function shen.free-var-chk")))) -(defun shen.extract-vars (V737) (cond ((variable? V737) (cons V737 ())) ((cons? V737) (union (shen.extract-vars (hd V737)) (shen.extract-vars (tl V737)))) (true ()))) +(defun shen.free-variable-error-message (V720 V721) (if (empty? V721) shen.skip (do (pr (cn "free variables in " (shen.app V720 ":" shen.a)) (stoutput)) (do (map (lambda Z722 (pr (cn " " (shen.app Z722 "" shen.a)) (stoutput))) V721) (do (nl 1) (abort)))))) -(defun shen.find-free-vars (V742 V743) (cond ((and (cons? V743) (and (= protect (hd V743)) (and (cons? (tl V743)) (= () (tl (tl V743)))))) ()) ((and (cons? V743) (and (= let (hd V743)) (and (cons? (tl V743)) (and (cons? (tl (tl V743))) (and (cons? (tl (tl (tl V743)))) (= () (tl (tl (tl (tl V743)))))))))) (union (shen.find-free-vars V742 (hd (tl (tl V743)))) (shen.find-free-vars (cons (hd (tl V743)) V742) (hd (tl (tl (tl V743))))))) ((and (cons? V743) (and (= lambda (hd V743)) (and (cons? (tl V743)) (and (cons? (tl (tl V743))) (= () (tl (tl (tl V743)))))))) (shen.find-free-vars (cons (hd (tl V743)) V742) (hd (tl (tl V743))))) ((cons? V743) (union (shen.find-free-vars V742 (hd V743)) (shen.find-free-vars V742 (tl V743)))) ((shen.free-variable? V743 V742) (cons V743 ())) (true ()))) +(defun shen.extract-vars (V725) (cond ((variable? V725) (cons V725 ())) ((cons? V725) (union (shen.extract-vars (hd V725)) (shen.extract-vars (tl V725)))) (true ()))) -(defun shen.free-variable? (V744 V745) (and (variable? V744) (not (element? V744 V745)))) +(defun shen.find-free-vars (V730 V731) (cond ((and (cons? V731) (and (= protect (hd V731)) (and (cons? (tl V731)) (= () (tl (tl V731)))))) ()) ((and (cons? V731) (and (= let (hd V731)) (and (cons? (tl V731)) (and (cons? (tl (tl V731))) (and (cons? (tl (tl (tl V731)))) (= () (tl (tl (tl (tl V731)))))))))) (union (shen.find-free-vars V730 (hd (tl (tl V731)))) (shen.find-free-vars (cons (hd (tl V731)) V730) (hd (tl (tl (tl V731))))))) ((and (cons? V731) (and (= lambda (hd V731)) (and (cons? (tl V731)) (and (cons? (tl (tl V731))) (= () (tl (tl (tl V731)))))))) (shen.find-free-vars (cons (hd (tl V731)) V730) (hd (tl (tl V731))))) ((cons? V731) (union (shen.find-free-vars V730 (hd V731)) (shen.find-free-vars V730 (tl V731)))) ((shen.free-variable? V731 V730) (cons V731 ())) (true ()))) -(defun shen.record-kl (V746 V747) (do (set shen.*userdefs* (adjoin V746 (value shen.*userdefs*))) (put V746 shen.source V747 (value *property-vector*)))) +(defun shen.free-variable? (V732 V733) (and (variable? V732) (not (element? V732 V733)))) -(defun shen.compile-to-kl (V748 V749 V750) (let W751 (shen.parameters V750) (let W752 (shen.scan-body V748 (shen.kl-body V749 W751)) (let W753 (cons defun (cons V748 (cons W751 (cons (shen.cond-form W752) ())))) W753)))) +(defun shen.record-kl (V734 V735) (do (set shen.*userdefs* (adjoin V734 (value shen.*userdefs*))) (put V734 shen.source V735 (value *property-vector*)))) -(defun shen.parameters (V754) (cond ((= 0 V754) ()) (true (cons (gensym V) (shen.parameters (- V754 1)))))) +(defun shen.compile-to-kl (V736 V737 V738) (let W739 (shen.parameters V738) (let W740 (shen.scan-body V736 (shen.kl-body V737 W739)) (let W741 (cons defun (cons V736 (cons W739 (cons (shen.cond-form W740) ())))) W741)))) -(defun shen.cond-form (V757) (cond ((and (cons? V757) (and (cons? (hd V757)) (and (= true (hd (hd V757))) (and (cons? (tl (hd V757))) (= () (tl (tl (hd V757)))))))) (hd (tl (hd V757)))) (true (cons cond V757)))) +(defun shen.parameters (V742) (cond ((= 0 V742) ()) (true (cons (gensym V) (shen.parameters (- V742 1)))))) -(defun shen.scan-body (V766 V767) (cond ((= () V767) (cons (cons true (cons (cons shen.f-error (cons V766 ())) ())) ())) ((and (cons? V767) (shen.choicepoint? (hd V767))) (shen.choicepoint V766 (gensym Freeze) (gensym Result) (hd V767) (tl V767))) ((and (cons? V767) (and (cons? (hd V767)) (and (= true (hd (hd V767))) (and (cons? (tl (hd V767))) (= () (tl (tl (hd V767)))))))) (cons (hd V767) ())) ((cons? V767) (cons (hd V767) (shen.scan-body V766 (tl V767)))) (true (simple-error "implementation error in shen.scan-body")))) +(defun shen.cond-form (V745) (cond ((and (cons? V745) (and (cons? (hd V745)) (and (= true (hd (hd V745))) (and (cons? (tl (hd V745))) (= () (tl (tl (hd V745)))))))) (hd (tl (hd V745)))) (true (cons cond V745)))) -(defun shen.choicepoint? (V774) (cond ((and (cons? V774) (and (cons? (tl V774)) (and (cons? (hd (tl V774))) (and (= shen.choicepoint! (hd (hd (tl V774)))) (and (cons? (tl (hd (tl V774)))) (and (= () (tl (tl (hd (tl V774))))) (= () (tl (tl V774))))))))) true) (true false))) +(defun shen.scan-body (V754 V755) (cond ((= () V755) (cons (cons true (cons (cons shen.f-error (cons V754 ())) ())) ())) ((and (cons? V755) (shen.choicepoint? (hd V755))) (shen.choicepoint V754 (gensym Freeze) (gensym Result) (hd V755) (tl V755))) ((and (cons? V755) (and (cons? (hd V755)) (and (= true (hd (hd V755))) (and (cons? (tl (hd V755))) (= () (tl (tl (hd V755)))))))) (cons (hd V755) ())) ((cons? V755) (cons (hd V755) (shen.scan-body V754 (tl V755)))) (true (simple-error "implementation error in shen.scan-body")))) -(defun shen.choicepoint (V790 V791 V792 V793 V794) (cond ((and (cons? V793) (and (cons? (tl V793)) (and (cons? (hd (tl V793))) (and (cons? (tl (hd (tl V793)))) (and (cons? (hd (tl (hd (tl V793))))) (and (= fail-if (hd (hd (tl (hd (tl V793)))))) (and (cons? (tl (hd (tl (hd (tl V793)))))) (and (cons? (tl (tl (hd (tl (hd (tl V793))))))) (and (= () (tl (tl (tl (hd (tl (hd (tl V793)))))))) (and (= () (tl (tl (hd (tl V793))))) (and (= () (tl (tl V793))) (= V790 (hd (tl (hd (tl (hd (tl V793)))))))))))))))))) (cons (cons true (cons (cons let (cons V791 (cons (cons freeze (cons (cons cond (shen.scan-body (hd (tl (hd (tl (hd (tl V793)))))) V794)) ())) (cons (cons if (cons (hd V793) (cons (cons let (cons V792 (cons (hd (tl (tl (hd (tl (hd (tl V793))))))) (cons (cons if (cons (cons (hd (tl (hd (tl (hd (tl V793)))))) (cons V792 ())) (cons (cons thaw (cons V791 ())) (cons V792 ())))) ())))) (cons (cons thaw (cons V791 ())) ())))) ())))) ())) ())) ((and (cons? V793) (and (cons? (tl V793)) (and (cons? (hd (tl V793))) (and (cons? (tl (hd (tl V793)))) (and (= () (tl (tl (hd (tl V793))))) (= () (tl (tl V793)))))))) (cons (cons true (cons (cons let (cons V791 (cons (cons freeze (cons (cons cond (shen.scan-body V790 V794)) ())) (cons (cons if (cons (hd V793) (cons (cons let (cons V792 (cons (hd (tl (hd (tl V793)))) (cons (cons if (cons (cons = (cons V792 (cons (cons fail ()) ()))) (cons (cons thaw (cons V791 ())) (cons V792 ())))) ())))) (cons (cons thaw (cons V791 ())) ())))) ())))) ())) ())) (true (simple-error "implementation error in shen.choicepoint")))) +(defun shen.choicepoint? (V762) (cond ((and (cons? V762) (and (cons? (tl V762)) (and (cons? (hd (tl V762))) (and (= shen.choicepoint! (hd (hd (tl V762)))) (and (cons? (tl (hd (tl V762)))) (and (= () (tl (tl (hd (tl V762))))) (= () (tl (tl V762))))))))) true) (true false))) -(defun shen.rep-X (V796 V797 V798) (cond ((= V796 V798) V797) ((cons? V798) (let W799 (shen.rep-X V796 V797 (hd V798)) (if (= W799 (hd V798)) (cons (hd V798) (shen.rep-X V796 V797 (tl V798))) (cons W799 (tl V798))))) (true V798))) +(defun shen.choicepoint (V778 V779 V780 V781 V782) (cond ((and (cons? V781) (and (cons? (tl V781)) (and (cons? (hd (tl V781))) (and (cons? (tl (hd (tl V781)))) (and (cons? (hd (tl (hd (tl V781))))) (and (= fail-if (hd (hd (tl (hd (tl V781)))))) (and (cons? (tl (hd (tl (hd (tl V781)))))) (and (cons? (tl (tl (hd (tl (hd (tl V781))))))) (and (= () (tl (tl (tl (hd (tl (hd (tl V781)))))))) (and (= () (tl (tl (hd (tl V781))))) (and (= () (tl (tl V781))) (= V778 (hd (tl (hd (tl (hd (tl V781)))))))))))))))))) (cons (cons true (cons (cons let (cons V779 (cons (cons freeze (cons (cons cond (shen.scan-body (hd (tl (hd (tl (hd (tl V781)))))) V782)) ())) (cons (cons if (cons (hd V781) (cons (cons let (cons V780 (cons (hd (tl (tl (hd (tl (hd (tl V781))))))) (cons (cons if (cons (cons (hd (tl (hd (tl (hd (tl V781)))))) (cons V780 ())) (cons (cons thaw (cons V779 ())) (cons V780 ())))) ())))) (cons (cons thaw (cons V779 ())) ())))) ())))) ())) ())) ((and (cons? V781) (and (cons? (tl V781)) (and (cons? (hd (tl V781))) (and (cons? (tl (hd (tl V781)))) (and (= () (tl (tl (hd (tl V781))))) (= () (tl (tl V781)))))))) (cons (cons true (cons (cons let (cons V779 (cons (cons freeze (cons (cons cond (shen.scan-body V778 V782)) ())) (cons (cons if (cons (hd V781) (cons (cons let (cons V780 (cons (hd (tl (hd (tl V781)))) (cons (cons if (cons (cons = (cons V780 (cons (cons fail ()) ()))) (cons (cons thaw (cons V779 ())) (cons V780 ())))) ())))) (cons (cons thaw (cons V779 ())) ())))) ())))) ())) ())) (true (simple-error "implementation error in shen.choicepoint")))) -(defun shen.alpha-convert (V800) (cond ((and (cons? V800) (and (= lambda (hd V800)) (and (cons? (tl V800)) (and (cons? (tl (tl V800))) (= () (tl (tl (tl V800)))))))) (let W801 (gensym Z) (let W802 (cons lambda (cons W801 (cons (shen.beta (hd (tl V800)) W801 (hd (tl (tl V800)))) ()))) (map (lambda Z803 (shen.alpha-convert Z803)) W802)))) ((and (cons? V800) (and (= let (hd V800)) (and (cons? (tl V800)) (and (cons? (tl (tl V800))) (and (cons? (tl (tl (tl V800)))) (= () (tl (tl (tl (tl V800)))))))))) (let W804 (gensym W) (let W805 (cons let (cons W804 (cons (hd (tl (tl V800))) (cons (shen.beta (hd (tl V800)) W804 (hd (tl (tl (tl V800))))) ())))) (map (lambda Z806 (shen.alpha-convert Z806)) W805)))) ((cons? V800) (map (lambda Z807 (shen.alpha-convert Z807)) V800)) (true V800))) +(defun shen.rep-X (V784 V785 V786) (cond ((= V784 V786) V785) ((cons? V786) (let W787 (shen.rep-X V784 V785 (hd V786)) (if (= W787 (hd V786)) (cons (hd V786) (shen.rep-X V784 V785 (tl V786))) (cons W787 (tl V786))))) (true V786))) -(defun shen.kl-body (V808 V809) (map (lambda Z810 (shen.triple-stack () (fst Z810) V809 (shen.alpha-convert (snd Z810)))) V808)) +(defun shen.kl-body (V788 V789) (map (lambda Z790 (shen.triple-stack () (fst Z790) V789 (shen.alpha-convert (snd Z790)))) V788)) -(defun shen.triple-stack (V819 V820 V821 V822) (cond ((and (= () V820) (and (= () V821) (and (cons? V822) (and (= where (hd V822)) (and (cons? (tl V822)) (and (cons? (tl (tl V822))) (= () (tl (tl (tl V822)))))))))) (shen.triple-stack (cons (hd (tl V822)) V819) () () (hd (tl (tl V822))))) ((and (= () V820) (= () V821)) (cons (shen.rectify-test (reverse V819)) (cons V822 ()))) ((and (cons? V820) (and (cons? V821) (variable? (hd V820)))) (shen.triple-stack V819 (tl V820) (tl V821) (shen.beta (hd V820) (hd V821) V822))) ((and (cons? V820) (and (cons? V821) (shen.custom-pattern? (hd V820)))) (shen.custom-pattern-triple-stack V819 (shen.custom-pattern-body (hd V820)) (tl V820) (hd V821) (tl V821) V822)) ((and (cons? V820) (and (cons? (hd V820)) (and (cons? (tl (hd V820))) (and (cons? (tl (tl (hd V820)))) (and (= () (tl (tl (tl (hd V820))))) (and (cons? V821) (shen.constructor? (hd (hd V820))))))))) (shen.triple-stack (cons (cons (shen.op-test (hd (hd V820))) (cons (hd V821) ())) V819) (cons (hd (tl (hd V820))) (cons (hd (tl (tl (hd V820)))) (tl V820))) (cons (cons (shen.op1 (hd (hd V820))) (cons (hd V821) ())) (cons (cons (shen.op2 (hd (hd V820))) (cons (hd V821) ())) (tl V821))) (shen.beta (hd V820) (hd V821) V822))) ((and (cons? V820) (cons? V821)) (shen.triple-stack (cons (cons = (cons (hd V820) (cons (hd V821) ()))) V819) (tl V820) (tl V821) V822)) (true (simple-error "implementation error in shen.triple-stack")))) +(defun shen.alpha-convert (V791) (cond ((and (cons? V791) (and (= lambda (hd V791)) (and (cons? (tl V791)) (and (cons? (tl (tl V791))) (= () (tl (tl (tl V791)))))))) (let W792 (gensym Z) (let W793 (cons lambda (cons W792 (cons (shen.beta (hd (tl V791)) W792 (hd (tl (tl V791)))) ()))) (map (lambda Z794 (shen.alpha-convert Z794)) W793)))) ((and (cons? V791) (and (= let (hd V791)) (and (cons? (tl V791)) (and (cons? (tl (tl V791))) (and (cons? (tl (tl (tl V791)))) (= () (tl (tl (tl (tl V791)))))))))) (let W795 (gensym W) (let W796 (cons let (cons W795 (cons (hd (tl (tl V791))) (cons (shen.beta (hd (tl V791)) W795 (hd (tl (tl (tl V791))))) ())))) (map (lambda Z797 (shen.alpha-convert Z797)) W796)))) ((cons? V791) (map (lambda Z798 (shen.alpha-convert Z798)) V791)) (true V791))) -(defun shen.custom-pattern-triple-stack (V823 V824 V825 V826 V827 V828) (let W829 (shen.custom-pattern-reducer (@p V824 V826)) (if (tuple? W829) (let W830 (fst W829) (let W831 (snd W829) (shen.triple-stack (append (reverse W830) V823) (append (map (lambda Z832 (fst Z832)) W831) V825) (append (map (lambda Z833 (snd Z833)) W831) V827) (shen.beta V824 V826 V828)))) (shen.constructor-error V824)))) +(defun shen.triple-stack (V807 V808 V809 V810) (cond ((and (= () V808) (and (= () V809) (and (cons? V810) (and (= where (hd V810)) (and (cons? (tl V810)) (and (cons? (tl (tl V810))) (= () (tl (tl (tl V810)))))))))) (shen.triple-stack (cons (hd (tl V810)) V807) () () (hd (tl (tl V810))))) ((and (= () V808) (= () V809)) (cons (shen.rectify-test (reverse V807)) (cons V810 ()))) ((and (cons? V808) (and (cons? V809) (variable? (hd V808)))) (shen.triple-stack V807 (tl V808) (tl V809) (shen.beta (hd V808) (hd V809) V810))) ((and (cons? V808) (and (cons? (hd V808)) (and (cons? (tl (hd V808))) (and (cons? (tl (tl (hd V808)))) (and (= () (tl (tl (tl (hd V808))))) (cons? V809)))))) (shen.triple-stack (cons (cons (shen.op-test (hd (hd V808))) (cons (hd V809) ())) V807) (cons (hd (tl (hd V808))) (cons (hd (tl (tl (hd V808)))) (tl V808))) (cons (cons (shen.op1 (hd (hd V808))) (cons (hd V809) ())) (cons (cons (shen.op2 (hd (hd V808))) (cons (hd V809) ())) (tl V809))) (shen.beta (hd V808) (hd V809) V810))) ((and (cons? V808) (cons? V809)) (shen.triple-stack (cons (cons = (cons (hd V808) (cons (hd V809) ()))) V807) (tl V808) (tl V809) V810)) (true (simple-error "implementation error in shen.triple-stack")))) -(defun shen.rectify-test (V836) (cond ((= () V836) true) ((and (cons? V836) (= () (tl V836))) (hd V836)) ((and (cons? V836) (cons? (tl V836))) (cons and (cons (hd V836) (cons (shen.rectify-test (tl V836)) ())))) (true (simple-error "implementation error in shen.rectify-test")))) +(defun shen.rectify-test (V813) (cond ((= () V813) true) ((and (cons? V813) (= () (tl V813))) (hd V813)) ((and (cons? V813) (cons? (tl V813))) (cons and (cons (hd V813) (cons (shen.rectify-test (tl V813)) ())))) (true (simple-error "implementation error in shen.rectify-test")))) -(defun shen.beta (V846 V847 V848) (cond ((= V846 V848) V847) ((and (cons? V848) (and (= lambda (hd V848)) (and (cons? (tl V848)) (and (cons? (tl (tl V848))) (and (= () (tl (tl (tl V848)))) (= V846 (hd (tl V848)))))))) V848) ((and (cons? V848) (and (= let (hd V848)) (and (cons? (tl V848)) (and (cons? (tl (tl V848))) (and (cons? (tl (tl (tl V848)))) (and (= () (tl (tl (tl (tl V848))))) (= V846 (hd (tl V848))))))))) (cons let (cons (hd (tl V848)) (cons (shen.beta (hd (tl V848)) V847 (hd (tl (tl V848)))) (tl (tl (tl V848))))))) ((cons? V848) (map (lambda Z849 (shen.beta V846 V847 Z849)) V848)) (true V848))) +(defun shen.beta (V823 V824 V825) (cond ((= V823 V825) V824) ((and (cons? V825) (and (= lambda (hd V825)) (and (cons? (tl V825)) (and (cons? (tl (tl V825))) (and (= () (tl (tl (tl V825)))) (= V823 (hd (tl V825)))))))) V825) ((and (cons? V825) (and (= let (hd V825)) (and (cons? (tl V825)) (and (cons? (tl (tl V825))) (and (cons? (tl (tl (tl V825)))) (and (= () (tl (tl (tl (tl V825))))) (= V823 (hd (tl V825))))))))) (cons let (cons (hd (tl V825)) (cons (shen.beta (hd (tl V825)) V824 (hd (tl (tl V825)))) (tl (tl (tl V825))))))) ((cons? V825) (map (lambda Z826 (shen.beta V823 V824 Z826)) V825)) (true V825))) -(defun shen.op1 (V852) (cond ((= cons V852) hd) ((= @s V852) hdstr) ((= @p V852) fst) ((= @v V852) hdv) (true (simple-error "implementation error in shen.op1")))) +(defun shen.op1 (V829) (cond ((= cons V829) hd) ((= @s V829) hdstr) ((= @p V829) fst) ((= @v V829) hdv) (true (simple-error "implementation error in shen.op1")))) -(defun shen.op2 (V855) (cond ((= cons V855) tl) ((= @s V855) tlstr) ((= @p V855) snd) ((= @v V855) tlv) (true (simple-error "implementation error in shen.op2")))) +(defun shen.op2 (V832) (cond ((= cons V832) tl) ((= @s V832) tlstr) ((= @p V832) snd) ((= @v V832) tlv) (true (simple-error "implementation error in shen.op2")))) -(defun shen.op-test (V858) (cond ((= cons V858) cons?) ((= @s V858) shen.+string?) ((= @p V858) tuple?) ((= @v V858) shen.+vector?) (true (simple-error "implementation error in shen.op-test")))) +(defun shen.op-test (V835) (cond ((= cons V835) cons?) ((= @s V835) shen.+string?) ((= @p V835) tuple?) ((= @v V835) shen.+vector?) (true (simple-error "implementation error in shen.op-test")))) -(defun shen.+string? (V859) (cond ((= "" V859) false) (true (string? V859)))) +(defun shen.+string? (V836) (cond ((= "" V836) false) (true (string? V836)))) -(defun shen.+vector? (V860) (cond ((= V860 (vector 0)) false) (true (vector? V860)))) +(defun shen.+vector? (V837) (cond ((= V837 (vector 0)) false) (true (vector? V837)))) -(defun factorise (V863) (cond ((= + V863) (set shen.*factorise?* true)) ((= - V863) (set shen.*factorise?* false)) (true (simple-error "factorise expects a + or a - +(defun factorise (V840) (cond ((= + V840) (set shen.*factorise?* true)) ((= - V840) (set shen.*factorise?* false)) (true (simple-error "factorise expects a + or a - ")))) -(defun shen.factorise-code (V864) (cond ((value shen.*factorise?*) (shen.factor V864)) (true V864))) +(defun shen.factorise-code (V841) (cond ((value shen.*factorise?*) (shen.factor V841)) (true V841))) -(defun shen.factor (V865) (cond ((and (cons? V865) (and (= defun (hd V865)) (and (cons? (tl V865)) (and (cons? (tl (tl V865))) (and (cons? (tl (tl (tl V865)))) (and (cons? (hd (tl (tl (tl V865))))) (and (= cond (hd (hd (tl (tl (tl V865)))))) (= () (tl (tl (tl (tl V865)))))))))))) (cons defun (cons (hd (tl V865)) (cons (hd (tl (tl V865))) (cons (shen.factor-recognisors (tl (hd (tl (tl (tl V865)))))) ()))))) (true V865))) +(defun shen.factor (V842) (cond ((and (cons? V842) (and (= defun (hd V842)) (and (cons? (tl V842)) (and (cons? (tl (tl V842))) (and (cons? (tl (tl (tl V842)))) (and (cons? (hd (tl (tl (tl V842))))) (and (= cond (hd (hd (tl (tl (tl V842)))))) (= () (tl (tl (tl (tl V842)))))))))))) (cons defun (cons (hd (tl V842)) (cons (hd (tl (tl V842))) (cons (shen.factor-recognisors (tl (hd (tl (tl (tl V842)))))) ()))))) (true V842))) -(defun shen.factor-recognisors (V868) (cond ((and (cons? V868) (and (cons? (hd V868)) (and (= true (hd (hd V868))) (and (cons? (tl (hd V868))) (= () (tl (tl (hd V868)))))))) (hd (tl (hd V868)))) ((and (cons? V868) (and (cons? (hd V868)) (and (cons? (hd (hd V868))) (and (= and (hd (hd (hd V868)))) (and (cons? (tl (hd (hd V868)))) (and (cons? (tl (tl (hd (hd V868))))) (and (= () (tl (tl (tl (hd (hd V868)))))) (and (cons? (tl (hd V868))) (= () (tl (tl (hd V868)))))))))))) (let W869 (shen.pivot-on (hd (tl (hd (hd V868)))) V868 ()) (let W870 (fst W869) (if (shen.bad-pivot? W870) (cons if (cons (hd (hd V868)) (cons (hd (tl (hd V868))) (cons (shen.factor-recognisors (tl V868)) ())))) (let W871 (snd W869) (let W872 (shen.factor-recognisors W871) (let W873 (gensym GoTo) (let W874 (reverse (cons (cons true (cons (cons thaw (cons W873 ())) ())) W870)) (let W875 (cons let (cons W873 (cons (cons freeze (cons W872 ())) (cons (cons if (cons (hd (tl (hd (hd V868)))) (cons (shen.factor-selectors (hd (tl (hd (hd V868)))) (shen.factor-recognisors W874)) (cons (cons thaw (cons W873 ())) ())))) ())))) (shen.remove-indirection W875)))))))))) ((and (cons? V868) (and (cons? (hd V868)) (and (cons? (tl (hd V868))) (= () (tl (tl (hd V868))))))) (cons if (cons (hd (hd V868)) (cons (hd (tl (hd V868))) (cons (shen.factor-recognisors (tl V868)) ()))))) (true (shen.f-error shen.factor-recognisors)))) +(defun shen.factor-recognisors (V845) (cond ((and (cons? V845) (and (cons? (hd V845)) (and (= true (hd (hd V845))) (and (cons? (tl (hd V845))) (= () (tl (tl (hd V845)))))))) (hd (tl (hd V845)))) ((and (cons? V845) (and (cons? (hd V845)) (and (cons? (hd (hd V845))) (and (= and (hd (hd (hd V845)))) (and (cons? (tl (hd (hd V845)))) (and (cons? (tl (tl (hd (hd V845))))) (and (= () (tl (tl (tl (hd (hd V845)))))) (and (cons? (tl (hd V845))) (= () (tl (tl (hd V845)))))))))))) (let W846 (shen.pivot-on (hd (tl (hd (hd V845)))) V845 ()) (let W847 (fst W846) (if (shen.bad-pivot? W847) (cons if (cons (hd (hd V845)) (cons (hd (tl (hd V845))) (cons (shen.factor-recognisors (tl V845)) ())))) (let W848 (snd W846) (let W849 (shen.factor-recognisors W848) (let W850 (gensym GoTo) (let W851 (reverse (cons (cons true (cons (cons thaw (cons W850 ())) ())) W847)) (let W852 (cons let (cons W850 (cons (cons freeze (cons W849 ())) (cons (cons if (cons (hd (tl (hd (hd V845)))) (cons (shen.factor-selectors (hd (tl (hd (hd V845)))) (shen.factor-recognisors W851)) (cons (cons thaw (cons W850 ())) ())))) ())))) (shen.remove-indirection W852)))))))))) ((and (cons? V845) (and (cons? (hd V845)) (and (cons? (tl (hd V845))) (= () (tl (tl (hd V845))))))) (cons if (cons (hd (hd V845)) (cons (hd (tl (hd V845))) (cons (shen.factor-recognisors (tl V845)) ()))))) (true (simple-error "partial function shen.factor-recognisors")))) -(defun shen.bad-pivot? (V880) (cond ((and (cons? V880) (= () (tl V880))) true) (true false))) +(defun shen.bad-pivot? (V857) (cond ((and (cons? V857) (= () (tl V857))) true) (true false))) -(defun shen.remove-indirection (V881) (cond ((and (cons? V881) (and (= let (hd V881)) (and (cons? (tl V881)) (and (cons? (tl (tl V881))) (and (cons? (hd (tl (tl V881)))) (and (= freeze (hd (hd (tl (tl V881))))) (and (cons? (tl (hd (tl (tl V881))))) (and (cons? (hd (tl (hd (tl (tl V881)))))) (and (= thaw (hd (hd (tl (hd (tl (tl V881))))))) (and (cons? (tl (hd (tl (hd (tl (tl V881))))))) (and (= () (tl (tl (hd (tl (hd (tl (tl V881)))))))) (and (= () (tl (tl (hd (tl (tl V881)))))) (and (cons? (tl (tl (tl V881)))) (and (= () (tl (tl (tl (tl V881))))) (symbol? (hd (tl (hd (tl (hd (tl (tl V881)))))))))))))))))))))) (subst (hd (tl (hd (tl (hd (tl (tl V881))))))) (hd (tl V881)) (hd (tl (tl (tl V881)))))) (true V881))) +(defun shen.remove-indirection (V858) (cond ((and (cons? V858) (and (= let (hd V858)) (and (cons? (tl V858)) (and (cons? (tl (tl V858))) (and (cons? (hd (tl (tl V858)))) (and (= freeze (hd (hd (tl (tl V858))))) (and (cons? (tl (hd (tl (tl V858))))) (and (cons? (hd (tl (hd (tl (tl V858)))))) (and (= thaw (hd (hd (tl (hd (tl (tl V858))))))) (and (cons? (tl (hd (tl (hd (tl (tl V858))))))) (and (= () (tl (tl (hd (tl (hd (tl (tl V858)))))))) (and (= () (tl (tl (hd (tl (tl V858)))))) (and (cons? (tl (tl (tl V858)))) (and (= () (tl (tl (tl (tl V858))))) (symbol? (hd (tl (hd (tl (hd (tl (tl V858)))))))))))))))))))))) (subst (hd (tl (hd (tl (hd (tl (tl V858))))))) (hd (tl V858)) (hd (tl (tl (tl V858)))))) (true V858))) -(defun shen.pivot-on (V884 V885 V886) (cond ((and (cons? V885) (and (cons? (hd V885)) (and (cons? (hd (hd V885))) (and (= and (hd (hd (hd V885)))) (and (cons? (tl (hd (hd V885)))) (and (cons? (tl (tl (hd (hd V885))))) (and (= () (tl (tl (tl (hd (hd V885)))))) (and (cons? (tl (hd V885))) (and (= () (tl (tl (hd V885)))) (= V884 (hd (tl (hd (hd V885)))))))))))))) (shen.pivot-on (hd (tl (hd (hd V885)))) (tl V885) (cons (cons (hd (tl (tl (hd (hd V885))))) (tl (hd V885))) V886))) ((and (cons? V885) (and (cons? (hd V885)) (and (cons? (tl (hd V885))) (and (= () (tl (tl (hd V885)))) (= V884 (hd (hd V885))))))) (shen.pivot-on (hd (hd V885)) (tl V885) (cons (cons true (tl (hd V885))) V886))) (true (@p V886 V885)))) +(defun shen.pivot-on (V861 V862 V863) (cond ((and (cons? V862) (and (cons? (hd V862)) (and (cons? (hd (hd V862))) (and (= and (hd (hd (hd V862)))) (and (cons? (tl (hd (hd V862)))) (and (cons? (tl (tl (hd (hd V862))))) (and (= () (tl (tl (tl (hd (hd V862)))))) (and (cons? (tl (hd V862))) (and (= () (tl (tl (hd V862)))) (= V861 (hd (tl (hd (hd V862)))))))))))))) (shen.pivot-on (hd (tl (hd (hd V862)))) (tl V862) (cons (cons (hd (tl (tl (hd (hd V862))))) (tl (hd V862))) V863))) ((and (cons? V862) (and (cons? (hd V862)) (and (cons? (tl (hd V862))) (and (= () (tl (tl (hd V862)))) (= V861 (hd (hd V862))))))) (shen.pivot-on (hd (hd V862)) (tl V862) (cons (cons true (tl (hd V862))) V863))) (true (@p V863 V862)))) -(defun shen.factor-selectors (V889 V890) (cond ((and (cons? V889) (and (cons? (tl V889)) (= () (tl (tl V889))))) (let W891 (shen.op (hd V889)) (if (= shen.skip W891) V890 (shen.factor-selectors-h (cons (cons (shen.op1 W891) (tl V889)) (cons (cons (shen.op2 W891) (tl V889)) ())) V890)))) (true V890))) +(defun shen.factor-selectors (V866 V867) (cond ((and (cons? V866) (and (cons? (tl V866)) (= () (tl (tl V866))))) (let W868 (shen.op (hd V866)) (if (= shen.skip W868) V867 (shen.factor-selectors-h (cons (cons (shen.op1 W868) (tl V866)) (cons (cons (shen.op2 W868) (tl V866)) ())) V867)))) (true V867))) -(defun shen.op (V894) (cond ((= cons? V894) cons) ((= shen.+string? V894) @s) ((= shen.+vector? V894) @v) ((= tuple? V894) @p) (true shen.skip))) +(defun shen.op (V871) (cond ((= cons? V871) cons) ((= shen.+string? V871) @s) ((= shen.+vector? V871) @v) ((= tuple? V871) @p) (true shen.skip))) -(defun shen.factor-selectors-h (V895 V896) (cond ((= () V895) V896) ((cons? V895) (if (> (occurrences (hd V895) V896) 1) (let W897 (gensym Select) (cons let (cons W897 (cons (hd V895) (cons (shen.factor-selectors-h (tl V895) (subst W897 (hd V895) V896)) ()))))) (shen.factor-selectors-h (tl V895) V896))) (true (shen.f-error shen.factor-selectors-h)))) +(defun shen.factor-selectors-h (V872 V873) (cond ((= () V872) V873) ((cons? V872) (if (> (occurrences (hd V872) V873) 1) (let W874 (gensym Select) (cons let (cons W874 (cons (hd V872) (cons (shen.factor-selectors-h (tl V872) (subst W874 (hd V872) V873)) ()))))) (shen.factor-selectors-h (tl V872) V873))) (true (simple-error "partial function shen.factor-selectors-h")))) diff --git a/klambda/declarations.kl b/klambda/declarations.kl index dea061b..bae45af 100644 --- a/klambda/declarations.kl +++ b/klambda/declarations.kl @@ -1,25 +1,99 @@ -(defun datatypes () (map (lambda Z904 (shen.typename Z904)) (value shen.*alldatatypes*))) +(set shen.*history* ()) -(defun shen.included () (map (lambda Z905 (shen.typename Z905)) (value shen.*datatypes*))) +(set shen.*tc* false) -(defun shen.typename (V908) (cond ((cons? V908) (intern (shen.typename-h (str (hd V908))))) (true (shen.f-error shen.typename)))) +(set *property-vector* (vector 20000)) -(defun shen.typename-h (V909) (cond ((= "#type" V909) "") ((shen.+string? V909) (cn (hdstr V909) (shen.typename-h (tlstr V909)))) (true (shen.f-error shen.typename-h)))) +(set *macros* (cons (cons shen.macros (lambda X (shen.macros X))) ())) -(defun prolog-memory (V910) (if (< V910 0) (value shen.*prolog-memory*) (if (integer? V910) (set shen.*prolog-memory* V910) (simple-error "prolog memory expects an integer value +(set shen.*gensym* 0) + +(set shen.*tracking* ()) + +(set shen.*profiled* ()) + +(set *home-directory* "") + +(set shen.*special* (cons @p (cons @s (cons @v (cons cons (cons lambda (cons let (cons where (cons set (cons open (cons shen.input-h+ (cons type ())))))))))))) + +(set shen.*extraspecial* ()) + +(set shen.*spy* false) + +(set shen.*datatypes* ()) + +(set shen.*alldatatypes* ()) + +(set shen.*shen-type-theory-enabled?* true) + +(set shen.*package* null) + +(set shen.*synonyms* ()) + +(set shen.*system* ()) + +(set shen.*sigf* ()) + +(set shen.*occurs* true) + +(set shen.*factorise?* false) + +(set shen.*maxinferences* 1000000) + +(set *maximum-print-sequence-size* 20) + +(set shen.*call* 0) + +(set shen.*infs* 0) + +(set *hush* false) + +(set shen.*optimise* false) + +(set *version* "41.2") + +(set shen.*names* ()) + +(set shen.*step* false) + +(set shen.*it* "") + +(set shen.*residue* ()) + +(set shen.*prolog-memory* 1000) + +(set shen.*loading?* false) + +(set shen.*userdefs* ()) + +(defun datatypes () (map (lambda Z5718 (shen.typename Z5718)) (value shen.*alldatatypes*))) + +(defun included () (map (lambda Z5719 (shen.typename Z5719)) (value shen.*datatypes*))) + +(defun shen.typename (V5722) (cond ((cons? V5722) (intern (shen.typename-h (str (hd V5722))))) (true (simple-error "partial function shen.typename")))) + +(defun shen.typename-h (V5723) (cond ((= "#type" V5723) "") ((shen.+string? V5723) (cn (hdstr V5723) (shen.typename-h (tlstr V5723)))) (true (simple-error "partial function shen.typename-h")))) + +(defun prolog-memory (V5724) (if (< V5724 0) (value shen.*prolog-memory*) (if (integer? V5724) (set shen.*prolog-memory* V5724) (simple-error "prolog memory expects an integer value ")))) -(defun arity (V911) (trap-error (get V911 arity (value *property-vector*)) (lambda Z912 -1))) +(defun shen.initialise-lambda-tables (V5727) (cond ((= () V5727) ()) ((and (cons? V5727) (cons? (tl V5727))) (let W5728 (put (hd V5727) arity (hd (tl V5727)) (value *property-vector*)) (shen.initialise-arity-table (tl (tl V5727))))) (true (simple-error "implementation error in shen.initialise-arity-table")))) + +(defun arity (V5729) (trap-error (get V5729 arity (value *property-vector*)) (lambda Z5730 -1))) + +(defun shen.initialise-arity-table (V5733) (cond ((= () V5733) ()) ((and (cons? V5733) (cons? (tl V5733))) (let W5734 (put (hd V5733) arity (hd (tl V5733)) (value *property-vector*)) (shen.initialise-arity-table (tl (tl V5733))))) (true (simple-error "implementation error in shen.initialise-arity-table")))) + +(shen.initialise-arity-table (cons abort (cons 0 (cons absolute (cons 1 (cons absvector? (cons 1 (cons absvector (cons 1 (cons address-> (cons 3 (cons adjoin (cons 2 (cons and (cons 2 (cons append (cons 2 (cons arity (cons 1 (cons assoc (cons 2 (cons atom? (cons 1 (cons boolean? (cons 1 (cons bootstrap (cons 1 (cons bound? (cons 1 (cons bind (cons 6 (cons call (cons 5 (cons cd (cons 1 (cons compile (cons 2 (cons concat (cons 2 (cons cons (cons 2 (cons cons? (cons 1 (cons cn (cons 2 (cons close (cons 1 (cons datatypes (cons 0 (cons declare (cons 2 (cons destroy (cons 1 (cons difference (cons 2 (cons do (cons 2 (cons element? (cons 2 (cons empty? (cons 1 (cons enable-type-theory (cons 1 (cons external (cons 1 (cons error-to-string (cons 1 (cons eval (cons 1 (cons eval-kl (cons 1 (cons explode (cons 1 (cons external (cons 1 (cons factorise (cons 1 (cons factorise? (cons 0 (cons fail-if (cons 2 (cons fail (cons 0 (cons fix (cons 2 (cons findall (cons 7 (cons foreign (cons 1 (cons fork (cons 5 (cons freeze (cons 1 (cons fresh (cons 0 (cons fst (cons 1 (cons fn (cons 1 (cons function (cons 1 (cons gensym (cons 1 (cons get (cons 3 (cons get-time (cons 1 (cons address-> (cons 3 (cons <-address (cons 2 (cons <-vector (cons 2 (cons > (cons 2 (cons >= (cons 2 (cons = (cons 2 (cons hash (cons 2 (cons hd (cons 1 (cons hdv (cons 1 (cons hdstr (cons 1 (cons head (cons 1 (cons hush? (cons 0 (cons hush (cons 1 (cons if (cons 3 (cons include (cons 1 (cons included (cons 0 (cons in-package (cons 1 (cons integer? (cons 1 (cons internal (cons 1 (cons intern (cons 1 (cons inferences (cons 0 (cons input (cons 1 (cons input+ (cons 2 (cons implementation (cons 0 (cons include-all-but (cons 1 (cons intersection (cons 2 (cons internal (cons 1 (cons it (cons 0 (cons is (cons 6 (cons is! (cons 6 (cons language (cons 0 (cons length (cons 1 (cons limit (cons 1 (cons lineread (cons 1 (cons list (cons 1 (cons load (cons 1 (cons < (cons 2 (cons <= (cons 2 (cons vector (cons 1 (cons macroexpand (cons 1 (cons map (cons 2 (cons mapcan (cons 2 (cons maxinferences (cons 1 (cons nl (cons 1 (cons not (cons 1 (cons nth (cons 2 (cons n->string (cons 1 (cons number? (cons 1 (cons occurs-check (cons 1 (cons occurrences (cons 2 (cons occurs? (cons 0 (cons occurs-check (cons 1 (cons open (cons 2 (cons optimise (cons 1 (cons optimise? (cons 0 (cons or (cons 2 (cons os (cons 0 (cons package (cons 3 (cons package? (cons 1 (cons port (cons 0 (cons porters (cons 0 (cons pos (cons 2 (cons preclude-all-but (cons 1 (cons print (cons 1 (cons profile (cons 1 (cons shen.print-prolog-vector (cons 1 (cons shen.print-freshterm (cons 1 (cons shen.printF (cons 1 (cons prolog-memory (cons 1 (cons profile-results (cons 1 (cons pr (cons 2 (cons ps (cons 1 (cons preclude (cons 1 (cons preclude-all-but (cons 1 (cons protect (cons 1 (cons put (cons 4 (cons read-file-as-string (cons 1 (cons read-file-as-bytelist (cons 1 (cons read-file (cons 1 (cons read (cons 1 (cons read-byte (cons 1 (cons read-from-string (cons 1 (cons read-from-string-unprocessed (cons 1 (cons shen.read-unit-string (cons 1 (cons receive (cons 1 (cons release (cons 0 (cons remove (cons 2 (cons reverse (cons 1 (cons set (cons 2 (cons simple-error (cons 1 (cons snd (cons 1 (cons specialise (cons 2 (cons spy (cons 1 (cons spy? (cons 0 (cons step (cons 1 (cons step? (cons 0 (cons stinput (cons 0 (cons stoutput (cons 0 (cons str (cons 1 (cons string->n (cons 1 (cons string->symbol (cons 1 (cons string? (cons 1 (cons subst (cons 3 (cons sum (cons 1 (cons symbol? (cons 1 (cons systemf (cons 1 (cons tail (cons 1 (cons tl (cons 1 (cons tc (cons 1 (cons tc? (cons 0 (cons thaw (cons 1 (cons tlstr (cons 1 (cons track (cons 1 (cons tracked (cons 0 (cons trap-error (cons 2 (cons tuple? (cons 1 (cons type (cons 2 (cons return (cons 5 (cons unabsolute (cons 1 (cons undefmacro (cons 1 (cons unput (cons 3 (cons unprofile (cons 1 (cons union (cons 2 (cons untrack (cons 1 (cons undefmacro (cons 1 (cons update-lambda-table (cons 2 (cons userdefs (cons 0 (cons vector (cons 1 (cons vector? (cons 1 (cons vector-> (cons 3 (cons value (cons 1 (cons variable? (cons 1 (cons var? (cons 5 (cons version (cons 0 (cons when (cons 5 (cons write-byte (cons 2 (cons write-to-file (cons 2 (cons y-or-n? (cons 1 (cons + (cons 2 (cons * (cons 2 (cons / (cons 2 (cons - (cons 2 (cons == (cons 2 (cons (cons 1 (cons (cons 1 (cons (cons 1 (cons @p (cons 2 (cons @v (cons 2 (cons @s (cons 2 ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) -(defun shen.initialise-arity-table (V915) (cond ((= () V915) ()) ((and (cons? V915) (cons? (tl V915))) (let W916 (put (hd V915) arity (hd (tl V915)) (value *property-vector*)) (shen.initialise-arity-table (tl (tl V915))))) (true (simple-error "implementation error in shen.initialise-arity-table")))) +(defun systemf (V5735) (let W5736 (get shen shen.external-symbols (value *property-vector*)) (let W5737 (put shen shen.external-symbols (adjoin V5735 W5736) (value *property-vector*)) V5735))) -(defun systemf (V917) (let W918 (get shen shen.external-symbols (value *property-vector*)) (let W919 (put shen shen.external-symbols (adjoin V917 W918) (value *property-vector*)) V917))) +(defun adjoin (V5738 V5739) (if (element? V5738 V5739) V5739 (cons V5738 V5739))) -(defun adjoin (V920 V921) (if (element? V920 V921) V921 (cons V920 V921))) +(put shen shen.external-symbols (cons ! (cons } (cons { (cons --> (cons <-- (cons && (cons (intern ":") (cons (intern ";") (cons (intern ":=") (cons (intern ",") (cons _ (cons *language* (cons *implementation* (cons *stinput* (cons *stoutput* (cons *home-directory* (cons *version* (cons *maximum-print-sequence-size* (cons *macros* (cons *os* (cons *release* (cons *property-vector* (cons @v (cons @p (cons @s (cons *port* (cons *porters* (cons *hush* (cons <- (cons -> (cons (cons == (cons = (cons >= (cons > (cons ==> (cons /. (cons (cons (cons $ (cons - (cons / (cons * (cons + (cons <= (cons < (cons >> (cons (vector 0) (cons y-or-n? (cons write-to-file (cons write-byte (cons where (cons when (cons version (cons verified (cons variable? (cons var? (cons value (cons vector-> (cons <-vector (cons vector (cons vector? (cons userdefs (cons u! (cons update-lambda-table (cons unspecialise (cons untrack (cons unit (cons unix (cons union (cons unput (cons unprofile (cons undefmacro (cons unabsolute (cons return (cons type (cons tuple? (cons true (cons trap-error (cons tracked (cons track (cons time (cons thaw (cons tc? (cons tc (cons tl (cons tlstr (cons tlv (cons tail (cons systemf (cons synonyms (cons system-S? (cons symbol (cons symbol? (cons string->symbol (cons sum (cons subst (cons string? (cons string->n (cons stream (cons string (cons stinput (cons stoutput (cons step (cons sqts (cons spy (cons specialise (cons snd (cons simple-error (cons set (cons save (cons str (cons run (cons reverse (cons retract (cons remove (cons release (cons read (cons receive (cons read-file (cons read-file-as-bytelist (cons read-file-as-string (cons read-byte (cons read-from-string (cons read-from-string-unprocessed (cons package? (cons put (cons preclude (cons preclude-all-but (cons ps (cons prolog? (cons protect (cons profile-results (cons profile (cons prolog-memory (cons print (cons pr (cons pos (cons porters (cons port (cons package (cons output (cons out (cons os (cons or (cons optimise (cons optimise? (cons open (cons occurrences (cons occurs-check (cons occurs? (cons n->string (cons number? (cons number (cons null (cons nth (cons not (cons nl (cons mode (cons macroexpand (cons maxinferences (cons mapcan (cons map (cons make-string (cons load (cons loaded (cons list (cons lineread (cons limit (cons length (cons let (cons lazy (cons lambda (cons language (cons is (cons intersection (cons inferences (cons intern (cons integer? (cons input (cons input+ (cons included (cons include (cons include-all-but (cons it (cons is (cons is! (cons in (cons in-package (cons internal (cons implementation (cons if (cons hush? (cons hush? (cons head (cons hd (cons hdv (cons hdstr (cons hash (cons get (cons get-time (cons gensym (cons fn (cons function (cons fst (cons freeze (cons fresh (cons fork (cons foreign (cons fix (cons file (cons fail (cons fail-if (cons factorise (cons factorise? (cons findall (cons false (cons enable-type-theory (cons explode (cons external (cons exception (cons eval-kl (cons eval (cons error-to-string (cons error (cons empty? (cons element? (cons do (cons difference (cons destroy (cons defun (cons define (cons defmacro (cons defcc (cons defprolog (cons declare (cons datatype (cons datatypes (cons ctxt (cons cn (cons cons? (cons cons (cons cond (cons concat (cons compile (cons cd (cons cases (cons call (cons close (cons bind (cons bound? (cons boolean? (cons boolean (cons bootstrap (cons (intern "bar!") (cons spy? (cons step? (cons atom? (cons asserta (cons assertz (cons assoc (cons arity (cons append (cons and (cons adjoin (cons <-address (cons address-> (cons absvector? (cons absvector (cons absolute (cons abort ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (value *property-vector*)) -(defun shen.lambda-entry (V922) (let W923 (arity V922) (if (or (= W923 -1) (= W923 0)) () (cons V922 (eval-kl (shen.lambda-function (cons V922 ()) W923)))))) +(defun shen.lambda-entry (V5740) (let W5741 (arity V5740) (if (or (= W5741 -1) (= W5741 0)) () (cons V5740 (eval-kl (shen.lambda-function (cons V5740 ()) W5741)))))) -(defun shen.set-lambda-form-entry (V924) (cond ((cons? V924) (put (hd V924) shen.lambda-form (tl V924) (value *property-vector*))) (true (shen.f-error shen.set-lambda-form-entry)))) +(defun shen.build-lambda-table (V5742) (let W5743 (map (lambda Z5744 (shen.lambda-entry Z5744)) V5742) (set shen.*lambdatable* (cons (cons shen.tuple (lambda Z5745 (shen.tuple Z5745))) (cons (cons shen.pvar (lambda Z5746 (shen.pvar Z5746))) (cons (cons shen.print-prolog-vector (lambda Z5747 (shen.print-prolog-vector Z5747))) (cons (cons shen.print-freshterm (lambda Z5748 (shen.print-freshterm Z5748))) (cons (cons shen.printF (lambda Z5749 (shen.printF Z5749))) W5743)))))))) -(defun shen.build-lambda-table (V925) (let W926 (map (lambda Z927 (shen.lambda-entry Z927)) V925) (shen.for-each (lambda Z928 (shen.set-lambda-form-entry Z928)) (cons (cons shen.tuple (lambda Z929 (shen.tuple Z929))) (cons (cons shen.pvar (lambda Z930 (shen.pvar Z930))) (cons (cons shen.dictionary (lambda Z931 (shen.dictionary Z931))) (cons (cons shen.print-prolog-vector (lambda Z932 (shen.print-prolog-vector Z932))) (cons (cons shen.print-freshterm (lambda Z933 (shen.print-freshterm Z933))) (cons (cons shen.printF (lambda Z934 (shen.printF Z934))) W926))))))))) +(shen.build-lambda-table (external shen)) diff --git a/klambda/dict.kl b/klambda/dict.kl deleted file mode 100644 index 0fff379..0000000 --- a/klambda/dict.kl +++ /dev/null @@ -1,33 +0,0 @@ -(defun shen.dict (V4162) (cond ((< V4162 1) (simple-error (cn "invalid initial dict size: " (shen.app V4162 "" shen.s)))) (true (let W4163 (absvector (+ 3 V4162)) (let W4164 (address-> W4163 0 shen.dictionary) (let W4165 (address-> W4163 1 V4162) (let W4166 (address-> W4163 2 0) (let W4167 (shen.fillvector W4163 3 (+ 2 V4162) ()) W4163)))))))) - -(defun shen.dict? (V4168) (and (absvector? V4168) (= (trap-error (<-address V4168 0) (lambda Z4169 shen.not-dictionary)) shen.dictionary))) - -(defun shen.dict-capacity (V4170) (<-address V4170 1)) - -(defun shen.dict-count (V4171) (<-address V4171 2)) - -(defun shen.dict-count-> (V4172 V4173) (address-> V4172 2 V4173)) - -(defun shen.<-dict-bucket (V4174 V4175) (<-address V4174 (+ 3 V4175))) - -(defun shen.dict-bucket-> (V4176 V4177 V4178) (address-> V4176 (+ 3 V4177) V4178)) - -(defun shen.dict-update-count (V4179 V4180 V4181) (let W4182 (- (length V4181) (length V4180)) (shen.dict-count-> V4179 (+ W4182 (shen.dict-count V4179))))) - -(defun shen.dict-> (V4183 V4184 V4185) (let W4186 (hash V4184 (shen.dict-capacity V4183)) (let W4187 (shen.<-dict-bucket V4183 W4186) (let W4188 (shen.assoc-set V4184 V4185 W4187) (let W4189 (shen.dict-bucket-> V4183 W4186 W4188) (let W4190 (shen.dict-update-count V4183 W4187 W4188) V4185)))))) - -(defun shen.<-dict (V4191 V4192) (let W4193 (hash V4192 (shen.dict-capacity V4191)) (let W4194 (shen.<-dict-bucket V4191 W4193) (let W4195 (assoc V4192 W4194) (if (empty? W4195) (simple-error (cn "value " (shen.app V4192 " not found in dict -" shen.a))) (tl W4195)))))) - -(defun shen.dict-rm (V4196 V4197) (let W4198 (hash V4197 (shen.dict-capacity V4196)) (let W4199 (shen.<-dict-bucket V4196 W4198) (let W4200 (shen.assoc-rm V4197 W4199) (let W4201 (shen.dict-bucket-> V4196 W4198 W4200) (let W4202 (shen.dict-update-count V4196 W4199 W4200) V4197)))))) - -(defun shen.dict-fold (V4203 V4204 V4205) (let W4206 (shen.dict-capacity V4204) (shen.dict-fold-h V4203 V4204 V4205 0 W4206))) - -(defun shen.dict-fold-h (V4208 V4209 V4210 V4211 V4212) (cond ((= V4211 V4212) V4210) (true (let W4213 (shen.<-dict-bucket V4209 V4211) (let W4214 (shen.bucket-fold V4208 W4213 V4210) (shen.dict-fold-h V4208 V4209 W4214 (+ 1 V4211) V4212)))))) - -(defun shen.bucket-fold (V4215 V4216 V4217) (cond ((= () V4216) V4217) ((and (cons? V4216) (cons? (hd V4216))) (((V4215 (hd (hd V4216))) (tl (hd V4216))) (shen.bucket-fold V4215 (tl V4216) V4217))) (true (shen.f-error shen.bucket-fold)))) - -(defun shen.dict-keys (V4218) (shen.dict-fold (lambda Z4219 (lambda Z4220 (lambda Z4221 (cons Z4219 Z4221)))) V4218 ())) - -(defun shen.dict-values (V4222) (shen.dict-fold (lambda Z4223 (lambda Z4224 (lambda Z4225 (cons Z4224 Z4225)))) V4222 ())) - diff --git a/klambda/init.kl b/klambda/init.kl deleted file mode 100644 index cfbda0c..0000000 --- a/klambda/init.kl +++ /dev/null @@ -1,8 +0,0 @@ -(defun shen.initialise-environment () (do (set shen.*history* ()) (do (set shen.*tc* false) (do (set *property-vector* (shen.dict 20000)) (do (set *macros* (cons (cons shen.macros (lambda X (shen.macros X))) ())) (do (set shen.*gensym* 0) (do (set shen.*tracking* ()) (do (set shen.*profiled* ()) (do (set shen.*special* (cons @p (cons @s (cons @v (cons cons (cons lambda (cons let (cons where (cons set (cons open (cons input+ (cons type ())))))))))))) (do (set shen.*extraspecial* ()) (do (set shen.*spy* false) (do (set shen.*datatypes* ()) (do (set shen.*alldatatypes* ()) (do (set shen.*shen-type-theory-enabled?* true) (do (set shen.*package* null) (do (set shen.*synonyms* ()) (do (set shen.*system* ()) (do (set shen.*occurs* true) (do (set shen.*factorise?* false) (do (set shen.*maxinferences* 1000000) (do (set *maximum-print-sequence-size* 20) (do (set shen.*call* 0) (do (set shen.*infs* 0) (do (set *hush* false) (do (set shen.*optimise* false) (do (set *version* "41.2") (do (set shen.*names* ()) (do (set shen.*step* false) (do (set shen.*it* "") (do (set shen.*residue* ()) (do (set *absolute* ()) (do (set shen.*prolog-memory* 1000) (do (set shen.*loading?* false) (do (set shen.*userdefs* ()) (do (set shen.*demodulation-function* (lambda X X)) (do (set shen.*custom-pattern-compiler* false) (do (set shen.*custom-pattern-reducer* false) (do (if (not (bound? *home-directory*)) (set *home-directory* "") shen.skip) (do (if (not (bound? *sterror*)) (set *sterror* (value *stoutput*)) shen.skip) (do (prolog-memory 10000) (do (set shen.*loading?* false) (do (shen.initialise-arity-table (cons abort (cons 0 (cons absolute (cons 1 (cons absvector? (cons 1 (cons absvector (cons 1 (cons address-> (cons 3 (cons adjoin (cons 2 (cons and (cons 2 (cons append (cons 2 (cons arity (cons 1 (cons assoc (cons 2 (cons atom? (cons 1 (cons boolean? (cons 1 (cons bootstrap (cons 1 (cons bound? (cons 1 (cons bind (cons 6 (cons call (cons 5 (cons cd (cons 1 (cons compile (cons 2 (cons concat (cons 2 (cons cons (cons 2 (cons cons? (cons 1 (cons cn (cons 2 (cons close (cons 1 (cons datatypes (cons 0 (cons declare (cons 2 (cons destroy (cons 1 (cons difference (cons 2 (cons do (cons 2 (cons element? (cons 2 (cons empty? (cons 1 (cons enable-type-theory (cons 1 (cons external (cons 1 (cons error-to-string (cons 1 (cons eval (cons 1 (cons eval-kl (cons 1 (cons explode (cons 1 (cons external (cons 1 (cons factorise (cons 1 (cons factorise? (cons 0 (cons fail-if (cons 2 (cons fail (cons 0 (cons fix (cons 2 (cons findall (cons 7 (cons foreign (cons 1 (cons fork (cons 5 (cons freeze (cons 1 (cons fresh (cons 0 (cons fst (cons 1 (cons fn (cons 1 (cons function (cons 1 (cons gensym (cons 1 (cons get (cons 3 (cons get-time (cons 1 (cons address-> (cons 3 (cons <-address (cons 2 (cons <-vector (cons 2 (cons > (cons 2 (cons >= (cons 2 (cons = (cons 2 (cons hash (cons 2 (cons hd (cons 1 (cons hdv (cons 1 (cons hdstr (cons 1 (cons head (cons 1 (cons hush? (cons 0 (cons hush (cons 1 (cons if (cons 3 (cons include (cons 1 (cons shen.included (cons 0 (cons in-package (cons 1 (cons integer? (cons 1 (cons internal (cons 1 (cons intern (cons 1 (cons inferences (cons 0 (cons input (cons 1 (cons input+ (cons 2 (cons implementation (cons 0 (cons include-all-but (cons 1 (cons intersection (cons 2 (cons internal (cons 1 (cons it (cons 0 (cons is (cons 6 (cons is! (cons 6 (cons language (cons 0 (cons length (cons 1 (cons limit (cons 1 (cons lineread (cons 1 (cons list (cons 1 (cons load (cons 1 (cons < (cons 2 (cons <= (cons 2 (cons vector (cons 1 (cons macroexpand (cons 1 (cons map (cons 2 (cons mapcan (cons 2 (cons maxinferences (cons 1 (cons nl (cons 1 (cons not (cons 1 (cons nth (cons 2 (cons n->string (cons 1 (cons number? (cons 1 (cons occurs-check (cons 1 (cons occurrences (cons 2 (cons occurs? (cons 0 (cons occurs-check (cons 1 (cons open (cons 2 (cons optimise (cons 1 (cons optimise? (cons 0 (cons or (cons 2 (cons os (cons 0 (cons package (cons 3 (cons package? (cons 1 (cons port (cons 0 (cons porters (cons 0 (cons pos (cons 2 (cons preclude-all-but (cons 1 (cons print (cons 1 (cons profile (cons 1 (cons shen.print-prolog-vector (cons 1 (cons shen.print-freshterm (cons 1 (cons shen.printF (cons 1 (cons prolog-memory (cons 1 (cons profile-results (cons 1 (cons pr (cons 2 (cons ps (cons 1 (cons preclude (cons 1 (cons preclude-all-but (cons 1 (cons protect (cons 1 (cons put (cons 4 (cons read-file-as-string (cons 1 (cons read-file-as-bytelist (cons 1 (cons read-file (cons 1 (cons read (cons 1 (cons read-byte (cons 1 (cons read-from-string (cons 1 (cons read-from-string-unprocessed (cons 1 (cons shen.read-unit-string (cons 1 (cons receive (cons 1 (cons release (cons 0 (cons remove (cons 2 (cons reverse (cons 1 (cons set (cons 2 (cons simple-error (cons 1 (cons snd (cons 1 (cons specialise (cons 2 (cons spy (cons 1 (cons shen.spy? (cons 0 (cons step (cons 1 (cons shen.step? (cons 0 (cons stinput (cons 0 (cons stoutput (cons 0 (cons str (cons 1 (cons string->n (cons 1 (cons string->symbol (cons 1 (cons string? (cons 1 (cons subst (cons 3 (cons sum (cons 1 (cons symbol? (cons 1 (cons systemf (cons 1 (cons tail (cons 1 (cons tl (cons 1 (cons tc (cons 1 (cons tc? (cons 0 (cons thaw (cons 1 (cons tlstr (cons 1 (cons track (cons 1 (cons tracked (cons 0 (cons trap-error (cons 2 (cons tuple? (cons 1 (cons type (cons 2 (cons return (cons 5 (cons unabsolute (cons 1 (cons undefmacro (cons 1 (cons unput (cons 3 (cons unprofile (cons 1 (cons union (cons 2 (cons untrack (cons 1 (cons undefmacro (cons 1 (cons update-lambda-table (cons 2 (cons userdefs (cons 0 (cons vector (cons 1 (cons vector? (cons 1 (cons vector-> (cons 3 (cons value (cons 1 (cons variable? (cons 1 (cons var? (cons 5 (cons version (cons 0 (cons when (cons 5 (cons write-byte (cons 2 (cons write-to-file (cons 2 (cons y-or-n? (cons 1 (cons + (cons 2 (cons * (cons 2 (cons / (cons 2 (cons - (cons 2 (cons == (cons 2 (cons (cons 1 (cons (cons 1 (cons (cons 1 (cons @p (cons 2 (cons @v (cons 2 (cons @s (cons 2 ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (do (put shen shen.external-symbols (cons ! (cons } (cons { (cons --> (cons <-- (cons && (cons (intern ":") (cons (intern ";") (cons (intern ":=") (cons (intern ",") (cons _ (cons *language* (cons *implementation* (cons *stinput* (cons *sterror* (cons *stoutput* (cons *home-directory* (cons *version* (cons *maximum-print-sequence-size* (cons *macros* (cons *os* (cons *release* (cons *property-vector* (cons @v (cons @p (cons @s (cons *port* (cons *porters* (cons *hush* (cons <- (cons -> (cons (cons == (cons = (cons >= (cons > (cons ==> (cons /. (cons (cons (cons $ (cons - (cons / (cons * (cons + (cons <= (cons < (cons >> (cons (vector 0) (cons y-or-n? (cons write-to-file (cons write-byte (cons where (cons when (cons warn (cons version (cons verified (cons variable? (cons var? (cons value (cons vector-> (cons <-vector (cons vector (cons vector? (cons u! (cons update-lambda-table (cons unspecialise (cons untrack (cons unit (cons shen.unix (cons union (cons unput (cons unprofile (cons undefmacro (cons unabsolute (cons return (cons type (cons tuple? (cons true (cons trap-error (cons track (cons time (cons thaw (cons tc? (cons tc (cons tl (cons tlstr (cons tlv (cons tail (cons systemf (cons synonyms (cons symbol (cons symbol? (cons string->symbol (cons sum (cons subst (cons string? (cons string->n (cons stream (cons string (cons stinput (cons sterror (cons stoutput (cons step (cons spy (cons specialise (cons snd (cons simple-error (cons set (cons save (cons str (cons run (cons reverse (cons retract (cons remove (cons release (cons read (cons receive (cons read-file (cons read-file-as-bytelist (cons read-file-as-string (cons read-byte (cons read-from-string (cons read-from-string-unprocessed (cons package? (cons put (cons preclude (cons preclude-all-but (cons ps (cons prolog? (cons protect (cons profile-results (cons profile (cons prolog-memory (cons print (cons pr (cons pos (cons porters (cons port (cons package (cons output (cons out (cons os (cons or (cons optimise (cons open (cons occurrences (cons occurs-check (cons n->string (cons number? (cons number (cons null (cons nth (cons not (cons nl (cons mode (cons macroexpand (cons maxinferences (cons mapcan (cons map (cons make-string (cons load (cons loaded (cons list (cons lineread (cons limit (cons length (cons let (cons lazy (cons lambda (cons language (cons is (cons intersection (cons inferences (cons intern (cons integer? (cons input (cons input+ (cons inline (cons include (cons include-all-but (cons it (cons is (cons is! (cons in (cons in-package (cons internal (cons implementation (cons if (cons head (cons hd (cons hdv (cons hdstr (cons hash (cons get (cons get-time (cons gensym (cons fn (cons function (cons fst (cons freeze (cons fresh (cons fork (cons foreign (cons fix (cons file (cons fail (cons fail-if (cons factorise (cons findall (cons false (cons enable-type-theory (cons explode (cons external (cons exception (cons eval-kl (cons eval (cons error-to-string (cons error (cons empty? (cons element? (cons do (cons difference (cons destroy (cons defun (cons define (cons defmacro (cons defcc (cons defprolog (cons declare (cons datatype (cons datatypes (cons shen.ctxt (cons cn (cons cons? (cons cons (cons cond (cons concat (cons compile (cons cd (cons cases (cons call (cons close (cons bind (cons bound? (cons boolean? (cons boolean (cons bootstrap (cons (intern "bar!") (cons atom? (cons asserta (cons assertz (cons assoc (cons arity (cons append (cons and (cons adjoin (cons <-address (cons address-> (cons absvector? (cons absvector (cons absolute (cons abort ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (value *property-vector*)) (set shen.*empty-absvector* (absvector 0))))))))))))))))))))))))))))))))))))))))))))) - -(defun shen.initialise-signedfuncs () (do (set shen.*sigf* ()) (do (set shen.*sigf* (shen.assoc-> abort (lambda V5951 (lambda B5947 (lambda L5948 (lambda Key5949 (lambda C5950 (let A (shen.newpv B5947) (shen.gc B5947 (is! V5951 (cons --> (cons A ())) B5947 L5948 Key5949 C5950)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> absolute (lambda V5956 (lambda B5952 (lambda L5953 (lambda Key5954 (lambda C5955 (is! V5956 (cons string (cons --> (cons (cons list (cons string ())) ()))) B5952 L5953 Key5954 C5955)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> absvector? (lambda V5961 (lambda B5957 (lambda L5958 (lambda Key5959 (lambda C5960 (let A (shen.newpv B5957) (shen.gc B5957 (is! V5961 (cons A (cons --> (cons boolean ()))) B5957 L5958 Key5959 C5960)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> adjoin (lambda V5966 (lambda B5962 (lambda L5963 (lambda Key5964 (lambda C5965 (let A (shen.newpv B5962) (shen.gc B5962 (is! V5966 (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B5962 L5963 Key5964 C5965)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> and (lambda V5971 (lambda B5967 (lambda L5968 (lambda Key5969 (lambda C5970 (is! V5971 (cons boolean (cons --> (cons (cons boolean (cons --> (cons boolean ()))) ()))) B5967 L5968 Key5969 C5970)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.app (lambda V5976 (lambda B5972 (lambda L5973 (lambda Key5974 (lambda C5975 (let A (shen.newpv B5972) (shen.gc B5972 (is! V5976 (cons A (cons --> (cons (cons string (cons --> (cons (cons symbol (cons --> (cons string ()))) ()))) ()))) B5972 L5973 Key5974 C5975)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> append (lambda V5981 (lambda B5977 (lambda L5978 (lambda Key5979 (lambda C5980 (let A (shen.newpv B5977) (shen.gc B5977 (is! V5981 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B5977 L5978 Key5979 C5980)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> arity (lambda V5986 (lambda B5982 (lambda L5983 (lambda Key5984 (lambda C5985 (let A (shen.newpv B5982) (shen.gc B5982 (is! V5986 (cons A (cons --> (cons number ()))) B5982 L5983 Key5984 C5985)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> assoc (lambda V5991 (lambda B5987 (lambda L5988 (lambda Key5989 (lambda C5990 (let A (shen.newpv B5987) (shen.gc B5987 (is! V5991 (cons A (cons --> (cons (cons (cons list (cons (cons list (cons A ())) ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B5987 L5988 Key5989 C5990)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> atom? (lambda V5996 (lambda B5992 (lambda L5993 (lambda Key5994 (lambda C5995 (let A (shen.newpv B5992) (shen.gc B5992 (is! V5996 (cons A (cons --> (cons boolean ()))) B5992 L5993 Key5994 C5995)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> boolean? (lambda V6001 (lambda B5997 (lambda L5998 (lambda Key5999 (lambda C6000 (let A (shen.newpv B5997) (shen.gc B5997 (is! V6001 (cons A (cons --> (cons boolean ()))) B5997 L5998 Key5999 C6000)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> bootstrap (lambda V6006 (lambda B6002 (lambda L6003 (lambda Key6004 (lambda C6005 (is! V6006 (cons string (cons --> (cons string ()))) B6002 L6003 Key6004 C6005)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> bound? (lambda V6011 (lambda B6007 (lambda L6008 (lambda Key6009 (lambda C6010 (is! V6011 (cons symbol (cons --> (cons boolean ()))) B6007 L6008 Key6009 C6010)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.ccons? (lambda V6016 (lambda B6012 (lambda L6013 (lambda Key6014 (lambda C6015 (let A (shen.newpv B6012) (shen.gc B6012 (is! V6016 (cons (cons list (cons A ())) (cons --> (cons boolean ()))) B6012 L6013 Key6014 C6015)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> cd (lambda V6021 (lambda B6017 (lambda L6018 (lambda Key6019 (lambda C6020 (is! V6021 (cons string (cons --> (cons string ()))) B6017 L6018 Key6019 C6020)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> close (lambda V6026 (lambda B6022 (lambda L6023 (lambda Key6024 (lambda C6025 (let A (shen.newpv B6022) (shen.gc B6022 (let B (shen.newpv B6022) (shen.gc B6022 (is! V6026 (cons (cons stream (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) B6022 L6023 Key6024 C6025)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> cn (lambda V6031 (lambda B6027 (lambda L6028 (lambda Key6029 (lambda C6030 (is! V6031 (cons string (cons --> (cons (cons string (cons --> (cons string ()))) ()))) B6027 L6028 Key6029 C6030)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> compile (lambda V6036 (lambda B6032 (lambda L6033 (lambda Key6034 (lambda C6035 (let A (shen.newpv B6032) (shen.gc B6032 (let B (shen.newpv B6032) (shen.gc B6032 (is! V6036 (cons (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons B ()))) ()))) B6032 L6033 Key6034 C6035)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> cons? (lambda V6041 (lambda B6037 (lambda L6038 (lambda Key6039 (lambda C6040 (let A (shen.newpv B6037) (shen.gc B6037 (is! V6041 (cons A (cons --> (cons boolean ()))) B6037 L6038 Key6039 C6040)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> datatypes (lambda V6046 (lambda B6042 (lambda L6043 (lambda Key6044 (lambda C6045 (is! V6046 (cons --> (cons (cons list (cons symbol ())) ())) B6042 L6043 Key6044 C6045)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> destroy (lambda V6051 (lambda B6047 (lambda L6048 (lambda Key6049 (lambda C6050 (is! V6051 (cons symbol (cons --> (cons symbol ()))) B6047 L6048 Key6049 C6050)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> difference (lambda V6056 (lambda B6052 (lambda L6053 (lambda Key6054 (lambda C6055 (let A (shen.newpv B6052) (shen.gc B6052 (is! V6056 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6052 L6053 Key6054 C6055)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> do (lambda V6061 (lambda B6057 (lambda L6058 (lambda Key6059 (lambda C6060 (let A (shen.newpv B6057) (shen.gc B6057 (let B (shen.newpv B6057) (shen.gc B6057 (is! V6061 (cons A (cons --> (cons (cons B (cons --> (cons B ()))) ()))) B6057 L6058 Key6059 C6060)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> (lambda V6066 (lambda B6062 (lambda L6063 (lambda Key6064 (lambda C6065 (let A (shen.newpv B6062) (shen.gc B6062 (let B (shen.newpv B6062) (shen.gc B6062 (is! V6066 (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons (cons list (cons B ())) ()))) ()))) B6062 L6063 Key6064 C6065)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> (lambda V6071 (lambda B6067 (lambda L6068 (lambda Key6069 (lambda C6070 (let B (shen.newpv B6067) (shen.gc B6067 (let A (shen.newpv B6067) (shen.gc B6067 (is! V6071 (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons B ())) (cons (cons list (cons A ())) ()))) ()))) B6067 L6068 Key6069 C6070)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> (lambda V6076 (lambda B6072 (lambda L6073 (lambda Key6074 (lambda C6075 (let A (shen.newpv B6072) (shen.gc B6072 (let B (shen.newpv B6072) (shen.gc B6072 (is! V6076 (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons (cons list (cons B ())) ()))) ()))) B6072 L6073 Key6074 C6075)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.parse-failure? (lambda V6081 (lambda B6077 (lambda L6078 (lambda Key6079 (lambda C6080 (let A (shen.newpv B6077) (shen.gc B6077 (let B (shen.newpv B6077) (shen.gc B6077 (is! V6081 (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons boolean ()))) B6077 L6078 Key6079 C6080)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.parse-failure (lambda V6086 (lambda B6082 (lambda L6083 (lambda Key6084 (lambda C6085 (let A (shen.newpv B6082) (shen.gc B6082 (let B (shen.newpv B6082) (shen.gc B6082 (is! V6086 (cons --> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) ())) B6082 L6083 Key6084 C6085)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.<-out (lambda V6091 (lambda B6087 (lambda L6088 (lambda Key6089 (lambda C6090 (let A (shen.newpv B6087) (shen.gc B6087 (let B (shen.newpv B6087) (shen.gc B6087 (is! V6091 (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons B ()))) B6087 L6088 Key6089 C6090)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.in-> (lambda V6096 (lambda B6092 (lambda L6093 (lambda Key6094 (lambda C6095 (let B (shen.newpv B6092) (shen.gc B6092 (let A (shen.newpv B6092) (shen.gc B6092 (is! V6096 (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons (cons list (cons A ())) ()))) B6092 L6093 Key6094 C6095)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.comb (lambda V6101 (lambda B6097 (lambda L6098 (lambda Key6099 (lambda C6100 (let A (shen.newpv B6097) (shen.gc B6097 (let B (shen.newpv B6097) (shen.gc B6097 (is! V6101 (cons (cons list (cons A ())) (cons --> (cons (cons B (cons --> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) ()))) ()))) B6097 L6098 Key6099 C6100)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> element? (lambda V6106 (lambda B6102 (lambda L6103 (lambda Key6104 (lambda C6105 (let A (shen.newpv B6102) (shen.gc B6102 (is! V6106 (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons boolean ()))) ()))) B6102 L6103 Key6104 C6105)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> empty? (lambda V6111 (lambda B6107 (lambda L6108 (lambda Key6109 (lambda C6110 (let A (shen.newpv B6107) (shen.gc B6107 (is! V6111 (cons A (cons --> (cons boolean ()))) B6107 L6108 Key6109 C6110)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> enable-type-theory (lambda V6116 (lambda B6112 (lambda L6113 (lambda Key6114 (lambda C6115 (is! V6116 (cons symbol (cons --> (cons boolean ()))) B6112 L6113 Key6114 C6115)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> external (lambda V6121 (lambda B6117 (lambda L6118 (lambda Key6119 (lambda C6120 (is! V6121 (cons symbol (cons --> (cons (cons list (cons symbol ())) ()))) B6117 L6118 Key6119 C6120)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> error-to-string (lambda V6126 (lambda B6122 (lambda L6123 (lambda Key6124 (lambda C6125 (is! V6126 (cons exception (cons --> (cons string ()))) B6122 L6123 Key6124 C6125)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> explode (lambda V6131 (lambda B6127 (lambda L6128 (lambda Key6129 (lambda C6130 (let A (shen.newpv B6127) (shen.gc B6127 (is! V6131 (cons A (cons --> (cons (cons list (cons string ())) ()))) B6127 L6128 Key6129 C6130)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> factorise (lambda V6136 (lambda B6132 (lambda L6133 (lambda Key6134 (lambda C6135 (is! V6136 (cons symbol (cons --> (cons symbol ()))) B6132 L6133 Key6134 C6135)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> factorise? (lambda V6141 (lambda B6137 (lambda L6138 (lambda Key6139 (lambda C6140 (is! V6141 (cons --> (cons boolean ())) B6137 L6138 Key6139 C6140)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> fail (lambda V6146 (lambda B6142 (lambda L6143 (lambda Key6144 (lambda C6145 (is! V6146 (cons --> (cons symbol ())) B6142 L6143 Key6144 C6145)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> fix (lambda V6151 (lambda B6147 (lambda L6148 (lambda Key6149 (lambda C6150 (let A (shen.newpv B6147) (shen.gc B6147 (is! V6151 (cons (cons A (cons --> (cons A ()))) (cons --> (cons (cons A (cons --> (cons A ()))) ()))) B6147 L6148 Key6149 C6150)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> freeze (lambda V6156 (lambda B6152 (lambda L6153 (lambda Key6154 (lambda C6155 (let A (shen.newpv B6152) (shen.gc B6152 (is! V6156 (cons A (cons --> (cons (cons lazy (cons A ())) ()))) B6152 L6153 Key6154 C6155)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> fst (lambda V6161 (lambda B6157 (lambda L6158 (lambda Key6159 (lambda C6160 (let B (shen.newpv B6157) (shen.gc B6157 (let A (shen.newpv B6157) (shen.gc B6157 (is! V6161 (cons (cons A (cons * (cons B ()))) (cons --> (cons A ()))) B6157 L6158 Key6159 C6160)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> gensym (lambda V6166 (lambda B6162 (lambda L6163 (lambda Key6164 (lambda C6165 (is! V6166 (cons symbol (cons --> (cons symbol ()))) B6162 L6163 Key6164 C6165)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.hds=? (lambda V6171 (lambda B6167 (lambda L6168 (lambda Key6169 (lambda C6170 (let A (shen.newpv B6167) (shen.gc B6167 (is! V6171 (cons (cons list (cons A ())) (cons --> (cons (cons A (cons --> (cons boolean ()))) ()))) B6167 L6168 Key6169 C6170)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hush (lambda V6176 (lambda B6172 (lambda L6173 (lambda Key6174 (lambda C6175 (is! V6176 (cons symbol (cons --> (cons boolean ()))) B6172 L6173 Key6174 C6175)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hush? (lambda V6181 (lambda B6177 (lambda L6178 (lambda Key6179 (lambda C6180 (is! V6181 (cons --> (cons boolean ())) B6177 L6178 Key6179 C6180)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> <-vector (lambda V6186 (lambda B6182 (lambda L6183 (lambda Key6184 (lambda C6185 (let A (shen.newpv B6182) (shen.gc B6182 (is! V6186 (cons (cons vector (cons A ())) (cons --> (cons (cons number (cons --> (cons A ()))) ()))) B6182 L6183 Key6184 C6185)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> vector-> (lambda V6191 (lambda B6187 (lambda L6188 (lambda Key6189 (lambda C6190 (let A (shen.newpv B6187) (shen.gc B6187 (is! V6191 (cons (cons vector (cons A ())) (cons --> (cons (cons number (cons --> (cons (cons A (cons --> (cons (cons vector (cons A ())) ()))) ()))) ()))) B6187 L6188 Key6189 C6190)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> vector (lambda V6196 (lambda B6192 (lambda L6193 (lambda Key6194 (lambda C6195 (let A (shen.newpv B6192) (shen.gc B6192 (is! V6196 (cons number (cons --> (cons (cons vector (cons A ())) ()))) B6192 L6193 Key6194 C6195)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> get-time (lambda V6201 (lambda B6197 (lambda L6198 (lambda Key6199 (lambda C6200 (is! V6201 (cons symbol (cons --> (cons number ()))) B6197 L6198 Key6199 C6200)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hash (lambda V6206 (lambda B6202 (lambda L6203 (lambda Key6204 (lambda C6205 (let A (shen.newpv B6202) (shen.gc B6202 (is! V6206 (cons A (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6202 L6203 Key6204 C6205)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> head (lambda V6211 (lambda B6207 (lambda L6208 (lambda Key6209 (lambda C6210 (let A (shen.newpv B6207) (shen.gc B6207 (is! V6211 (cons (cons list (cons A ())) (cons --> (cons A ()))) B6207 L6208 Key6209 C6210)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hdv (lambda V6216 (lambda B6212 (lambda L6213 (lambda Key6214 (lambda C6215 (let A (shen.newpv B6212) (shen.gc B6212 (is! V6216 (cons (cons vector (cons A ())) (cons --> (cons A ()))) B6212 L6213 Key6214 C6215)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hdstr (lambda V6221 (lambda B6217 (lambda L6218 (lambda Key6219 (lambda C6220 (is! V6221 (cons string (cons --> (cons string ()))) B6217 L6218 Key6219 C6220)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> if (lambda V6226 (lambda B6222 (lambda L6223 (lambda Key6224 (lambda C6225 (let A (shen.newpv B6222) (shen.gc B6222 (is! V6226 (cons boolean (cons --> (cons (cons A (cons --> (cons (cons A (cons --> (cons A ()))) ()))) ()))) B6222 L6223 Key6224 C6225)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> in-package (lambda V6231 (lambda B6227 (lambda L6228 (lambda Key6229 (lambda C6230 (is! V6231 (cons symbol (cons --> (cons symbol ()))) B6227 L6228 Key6229 C6230)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> it (lambda V6236 (lambda B6232 (lambda L6233 (lambda Key6234 (lambda C6235 (is! V6236 (cons --> (cons string ())) B6232 L6233 Key6234 C6235)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> implementation (lambda V6241 (lambda B6237 (lambda L6238 (lambda Key6239 (lambda C6240 (is! V6241 (cons --> (cons string ())) B6237 L6238 Key6239 C6240)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> include (lambda V6246 (lambda B6242 (lambda L6243 (lambda Key6244 (lambda C6245 (is! V6246 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) B6242 L6243 Key6244 C6245)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> include-all-but (lambda V6251 (lambda B6247 (lambda L6248 (lambda Key6249 (lambda C6250 (is! V6251 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) B6247 L6248 Key6249 C6250)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> included (lambda V6256 (lambda B6252 (lambda L6253 (lambda Key6254 (lambda C6255 (is! V6256 (cons --> (cons (cons list (cons symbol ())) ())) B6252 L6253 Key6254 C6255)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> inferences (lambda V6261 (lambda B6257 (lambda L6258 (lambda Key6259 (lambda C6260 (is! V6261 (cons --> (cons number ())) B6257 L6258 Key6259 C6260)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.insert (lambda V6266 (lambda B6262 (lambda L6263 (lambda Key6264 (lambda C6265 (let A (shen.newpv B6262) (shen.gc B6262 (is! V6266 (cons A (cons --> (cons (cons string (cons --> (cons string ()))) ()))) B6262 L6263 Key6264 C6265)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> integer? (lambda V6271 (lambda B6267 (lambda L6268 (lambda Key6269 (lambda C6270 (let A (shen.newpv B6267) (shen.gc B6267 (is! V6271 (cons A (cons --> (cons boolean ()))) B6267 L6268 Key6269 C6270)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> internal (lambda V6276 (lambda B6272 (lambda L6273 (lambda Key6274 (lambda C6275 (is! V6276 (cons symbol (cons --> (cons (cons list (cons symbol ())) ()))) B6272 L6273 Key6274 C6275)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> intersection (lambda V6281 (lambda B6277 (lambda L6278 (lambda Key6279 (lambda C6280 (let A (shen.newpv B6277) (shen.gc B6277 (is! V6281 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6277 L6278 Key6279 C6280)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> language (lambda V6286 (lambda B6282 (lambda L6283 (lambda Key6284 (lambda C6285 (is! V6286 (cons --> (cons string ())) B6282 L6283 Key6284 C6285)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> length (lambda V6291 (lambda B6287 (lambda L6288 (lambda Key6289 (lambda C6290 (let A (shen.newpv B6287) (shen.gc B6287 (is! V6291 (cons (cons list (cons A ())) (cons --> (cons number ()))) B6287 L6288 Key6289 C6290)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> limit (lambda V6296 (lambda B6292 (lambda L6293 (lambda Key6294 (lambda C6295 (let A (shen.newpv B6292) (shen.gc B6292 (is! V6296 (cons (cons vector (cons A ())) (cons --> (cons number ()))) B6292 L6293 Key6294 C6295)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> lineread (lambda V6301 (lambda B6297 (lambda L6298 (lambda Key6299 (lambda C6300 (is! V6301 (cons (cons stream (cons in ())) (cons --> (cons (cons list (cons unit ())) ()))) B6297 L6298 Key6299 C6300)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> load (lambda V6306 (lambda B6302 (lambda L6303 (lambda Key6304 (lambda C6305 (is! V6306 (cons string (cons --> (cons symbol ()))) B6302 L6303 Key6304 C6305)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> map (lambda V6311 (lambda B6307 (lambda L6308 (lambda Key6309 (lambda C6310 (let A (shen.newpv B6307) (shen.gc B6307 (let B (shen.newpv B6307) (shen.gc B6307 (is! V6311 (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) ()))) B6307 L6308 Key6309 C6310)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> mapcan (lambda V6316 (lambda B6312 (lambda L6313 (lambda Key6314 (lambda C6315 (let A (shen.newpv B6312) (shen.gc B6312 (let B (shen.newpv B6312) (shen.gc B6312 (is! V6316 (cons (cons A (cons --> (cons (cons list (cons B ())) ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) ()))) B6312 L6313 Key6314 C6315)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> maxinferences (lambda V6321 (lambda B6317 (lambda L6318 (lambda Key6319 (lambda C6320 (is! V6321 (cons number (cons --> (cons number ()))) B6317 L6318 Key6319 C6320)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> n->string (lambda V6326 (lambda B6322 (lambda L6323 (lambda Key6324 (lambda C6325 (is! V6326 (cons number (cons --> (cons string ()))) B6322 L6323 Key6324 C6325)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> nl (lambda V6331 (lambda B6327 (lambda L6328 (lambda Key6329 (lambda C6330 (is! V6331 (cons number (cons --> (cons number ()))) B6327 L6328 Key6329 C6330)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> not (lambda V6336 (lambda B6332 (lambda L6333 (lambda Key6334 (lambda C6335 (is! V6336 (cons boolean (cons --> (cons boolean ()))) B6332 L6333 Key6334 C6335)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> nth (lambda V6341 (lambda B6337 (lambda L6338 (lambda Key6339 (lambda C6340 (let A (shen.newpv B6337) (shen.gc B6337 (is! V6341 (cons number (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons A ()))) ()))) B6337 L6338 Key6339 C6340)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> number? (lambda V6346 (lambda B6342 (lambda L6343 (lambda Key6344 (lambda C6345 (let A (shen.newpv B6342) (shen.gc B6342 (is! V6346 (cons A (cons --> (cons boolean ()))) B6342 L6343 Key6344 C6345)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> occurrences (lambda V6351 (lambda B6347 (lambda L6348 (lambda Key6349 (lambda C6350 (let A (shen.newpv B6347) (shen.gc B6347 (let B (shen.newpv B6347) (shen.gc B6347 (is! V6351 (cons A (cons --> (cons (cons B (cons --> (cons number ()))) ()))) B6347 L6348 Key6349 C6350)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> occurs-check (lambda V6356 (lambda B6352 (lambda L6353 (lambda Key6354 (lambda C6355 (is! V6356 (cons symbol (cons --> (cons boolean ()))) B6352 L6353 Key6354 C6355)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> occurs? (lambda V6361 (lambda B6357 (lambda L6358 (lambda Key6359 (lambda C6360 (is! V6361 (cons --> (cons boolean ())) B6357 L6358 Key6359 C6360)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> optimise (lambda V6366 (lambda B6362 (lambda L6363 (lambda Key6364 (lambda C6365 (is! V6366 (cons symbol (cons --> (cons boolean ()))) B6362 L6363 Key6364 C6365)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> optimise? (lambda V6371 (lambda B6367 (lambda L6368 (lambda Key6369 (lambda C6370 (is! V6371 (cons --> (cons boolean ())) B6367 L6368 Key6369 C6370)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> or (lambda V6376 (lambda B6372 (lambda L6373 (lambda Key6374 (lambda C6375 (is! V6376 (cons boolean (cons --> (cons (cons boolean (cons --> (cons boolean ()))) ()))) B6372 L6373 Key6374 C6375)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> os (lambda V6381 (lambda B6377 (lambda L6378 (lambda Key6379 (lambda C6380 (is! V6381 (cons --> (cons string ())) B6377 L6378 Key6379 C6380)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> package? (lambda V6386 (lambda B6382 (lambda L6383 (lambda Key6384 (lambda C6385 (is! V6386 (cons symbol (cons --> (cons boolean ()))) B6382 L6383 Key6384 C6385)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> port (lambda V6391 (lambda B6387 (lambda L6388 (lambda Key6389 (lambda C6390 (is! V6391 (cons --> (cons string ())) B6387 L6388 Key6389 C6390)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> porters (lambda V6396 (lambda B6392 (lambda L6393 (lambda Key6394 (lambda C6395 (is! V6396 (cons --> (cons string ())) B6392 L6393 Key6394 C6395)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> pos (lambda V6401 (lambda B6397 (lambda L6398 (lambda Key6399 (lambda C6400 (is! V6401 (cons string (cons --> (cons (cons number (cons --> (cons string ()))) ()))) B6397 L6398 Key6399 C6400)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> pr (lambda V6406 (lambda B6402 (lambda L6403 (lambda Key6404 (lambda C6405 (is! V6406 (cons string (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons string ()))) ()))) B6402 L6403 Key6404 C6405)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> print (lambda V6411 (lambda B6407 (lambda L6408 (lambda Key6409 (lambda C6410 (let A (shen.newpv B6407) (shen.gc B6407 (is! V6411 (cons A (cons --> (cons A ()))) B6407 L6408 Key6409 C6410)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> profile (lambda V6416 (lambda B6412 (lambda L6413 (lambda Key6414 (lambda C6415 (is! V6416 (cons symbol (cons --> (cons symbol ()))) B6412 L6413 Key6414 C6415)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> preclude (lambda V6421 (lambda B6417 (lambda L6418 (lambda Key6419 (lambda C6420 (is! V6421 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) B6417 L6418 Key6419 C6420)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.proc-nl (lambda V6426 (lambda B6422 (lambda L6423 (lambda Key6424 (lambda C6425 (is! V6426 (cons string (cons --> (cons string ()))) B6422 L6423 Key6424 C6425)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> profile-results (lambda V6431 (lambda B6427 (lambda L6428 (lambda Key6429 (lambda C6430 (is! V6431 (cons symbol (cons --> (cons (cons symbol (cons * (cons number ()))) ()))) B6427 L6428 Key6429 C6430)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> protect (lambda V6436 (lambda B6432 (lambda L6433 (lambda Key6434 (lambda C6435 (let A (shen.newpv B6432) (shen.gc B6432 (is! V6436 (cons A (cons --> (cons A ()))) B6432 L6433 Key6434 C6435)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> preclude-all-but (lambda V6441 (lambda B6437 (lambda L6438 (lambda Key6439 (lambda C6440 (is! V6441 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) B6437 L6438 Key6439 C6440)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.prhush (lambda V6446 (lambda B6442 (lambda L6443 (lambda Key6444 (lambda C6445 (is! V6446 (cons string (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons string ()))) ()))) B6442 L6443 Key6444 C6445)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> prolog-memory (lambda V6451 (lambda B6447 (lambda L6448 (lambda Key6449 (lambda C6450 (is! V6451 (cons number (cons --> (cons number ()))) B6447 L6448 Key6449 C6450)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> ps (lambda V6456 (lambda B6452 (lambda L6453 (lambda Key6454 (lambda C6455 (is! V6456 (cons symbol (cons --> (cons (cons list (cons unit ())) ()))) B6452 L6453 Key6454 C6455)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read (lambda V6461 (lambda B6457 (lambda L6458 (lambda Key6459 (lambda C6460 (is! V6461 (cons (cons stream (cons in ())) (cons --> (cons unit ()))) B6457 L6458 Key6459 C6460)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-byte (lambda V6466 (lambda B6462 (lambda L6463 (lambda Key6464 (lambda C6465 (is! V6466 (cons (cons stream (cons in ())) (cons --> (cons number ()))) B6462 L6463 Key6464 C6465)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-file-as-bytelist (lambda V6471 (lambda B6467 (lambda L6468 (lambda Key6469 (lambda C6470 (is! V6471 (cons string (cons --> (cons (cons list (cons number ())) ()))) B6467 L6468 Key6469 C6470)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-file-as-string (lambda V6476 (lambda B6472 (lambda L6473 (lambda Key6474 (lambda C6475 (is! V6476 (cons string (cons --> (cons string ()))) B6472 L6473 Key6474 C6475)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-file (lambda V6481 (lambda B6477 (lambda L6478 (lambda Key6479 (lambda C6480 (is! V6481 (cons string (cons --> (cons (cons list (cons unit ())) ()))) B6477 L6478 Key6479 C6480)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-from-string (lambda V6486 (lambda B6482 (lambda L6483 (lambda Key6484 (lambda C6485 (is! V6486 (cons string (cons --> (cons (cons list (cons unit ())) ()))) B6482 L6483 Key6484 C6485)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-from-string-unprocessed (lambda V6491 (lambda B6487 (lambda L6488 (lambda Key6489 (lambda C6490 (is! V6491 (cons string (cons --> (cons (cons list (cons unit ())) ()))) B6487 L6488 Key6489 C6490)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> release (lambda V6496 (lambda B6492 (lambda L6493 (lambda Key6494 (lambda C6495 (is! V6496 (cons --> (cons string ())) B6492 L6493 Key6494 C6495)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> remove (lambda V6501 (lambda B6497 (lambda L6498 (lambda Key6499 (lambda C6500 (let A (shen.newpv B6497) (shen.gc B6497 (is! V6501 (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6497 L6498 Key6499 C6500)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> reverse (lambda V6506 (lambda B6502 (lambda L6503 (lambda Key6504 (lambda C6505 (let A (shen.newpv B6502) (shen.gc B6502 (is! V6506 (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) B6502 L6503 Key6504 C6505)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> simple-error (lambda V6511 (lambda B6507 (lambda L6508 (lambda Key6509 (lambda C6510 (let A (shen.newpv B6507) (shen.gc B6507 (is! V6511 (cons string (cons --> (cons A ()))) B6507 L6508 Key6509 C6510)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> snd (lambda V6516 (lambda B6512 (lambda L6513 (lambda Key6514 (lambda C6515 (let A (shen.newpv B6512) (shen.gc B6512 (let B (shen.newpv B6512) (shen.gc B6512 (is! V6516 (cons (cons A (cons * (cons B ()))) (cons --> (cons B ()))) B6512 L6513 Key6514 C6515)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> specialise (lambda V6521 (lambda B6517 (lambda L6518 (lambda Key6519 (lambda C6520 (is! V6521 (cons symbol (cons --> (cons (cons number (cons --> (cons symbol ()))) ()))) B6517 L6518 Key6519 C6520)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> spy (lambda V6526 (lambda B6522 (lambda L6523 (lambda Key6524 (lambda C6525 (is! V6526 (cons symbol (cons --> (cons boolean ()))) B6522 L6523 Key6524 C6525)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.spy? (lambda V6531 (lambda B6527 (lambda L6528 (lambda Key6529 (lambda C6530 (is! V6531 (cons --> (cons boolean ())) B6527 L6528 Key6529 C6530)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> step (lambda V6536 (lambda B6532 (lambda L6533 (lambda Key6534 (lambda C6535 (is! V6536 (cons symbol (cons --> (cons boolean ()))) B6532 L6533 Key6534 C6535)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.step? (lambda V6541 (lambda B6537 (lambda L6538 (lambda Key6539 (lambda C6540 (is! V6541 (cons --> (cons boolean ())) B6537 L6538 Key6539 C6540)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> stinput (lambda V6546 (lambda B6542 (lambda L6543 (lambda Key6544 (lambda C6545 (is! V6546 (cons --> (cons (cons stream (cons in ())) ())) B6542 L6543 Key6544 C6545)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> sterror (lambda V6551 (lambda B6547 (lambda L6548 (lambda Key6549 (lambda C6550 (is! V6551 (cons --> (cons (cons stream (cons out ())) ())) B6547 L6548 Key6549 C6550)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> stoutput (lambda V6556 (lambda B6552 (lambda L6553 (lambda Key6554 (lambda C6555 (is! V6556 (cons --> (cons (cons stream (cons out ())) ())) B6552 L6553 Key6554 C6555)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> string? (lambda V6561 (lambda B6557 (lambda L6558 (lambda Key6559 (lambda C6560 (let A (shen.newpv B6557) (shen.gc B6557 (is! V6561 (cons A (cons --> (cons boolean ()))) B6557 L6558 Key6559 C6560)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> str (lambda V6566 (lambda B6562 (lambda L6563 (lambda Key6564 (lambda C6565 (let A (shen.newpv B6562) (shen.gc B6562 (is! V6566 (cons A (cons --> (cons string ()))) B6562 L6563 Key6564 C6565)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> string->n (lambda V6571 (lambda B6567 (lambda L6568 (lambda Key6569 (lambda C6570 (is! V6571 (cons string (cons --> (cons number ()))) B6567 L6568 Key6569 C6570)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> string->symbol (lambda V6576 (lambda B6572 (lambda L6573 (lambda Key6574 (lambda C6575 (is! V6576 (cons string (cons --> (cons symbol ()))) B6572 L6573 Key6574 C6575)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> sum (lambda V6581 (lambda B6577 (lambda L6578 (lambda Key6579 (lambda C6580 (is! V6581 (cons (cons list (cons number ())) (cons --> (cons number ()))) B6577 L6578 Key6579 C6580)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> symbol? (lambda V6586 (lambda B6582 (lambda L6583 (lambda Key6584 (lambda C6585 (let A (shen.newpv B6582) (shen.gc B6582 (is! V6586 (cons A (cons --> (cons boolean ()))) B6582 L6583 Key6584 C6585)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> systemf (lambda V6591 (lambda B6587 (lambda L6588 (lambda Key6589 (lambda C6590 (is! V6591 (cons symbol (cons --> (cons symbol ()))) B6587 L6588 Key6589 C6590)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> system-S? (lambda V6596 (lambda B6592 (lambda L6593 (lambda Key6594 (lambda C6595 (is! V6596 (cons --> (cons boolean ())) B6592 L6593 Key6594 C6595)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tail (lambda V6601 (lambda B6597 (lambda L6598 (lambda Key6599 (lambda C6600 (let A (shen.newpv B6597) (shen.gc B6597 (is! V6601 (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) B6597 L6598 Key6599 C6600)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tlstr (lambda V6606 (lambda B6602 (lambda L6603 (lambda Key6604 (lambda C6605 (is! V6606 (cons string (cons --> (cons string ()))) B6602 L6603 Key6604 C6605)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tlv (lambda V6611 (lambda B6607 (lambda L6608 (lambda Key6609 (lambda C6610 (let A (shen.newpv B6607) (shen.gc B6607 (is! V6611 (cons (cons vector (cons A ())) (cons --> (cons (cons vector (cons A ())) ()))) B6607 L6608 Key6609 C6610)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tc (lambda V6616 (lambda B6612 (lambda L6613 (lambda Key6614 (lambda C6615 (is! V6616 (cons symbol (cons --> (cons boolean ()))) B6612 L6613 Key6614 C6615)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tc? (lambda V6621 (lambda B6617 (lambda L6618 (lambda Key6619 (lambda C6620 (is! V6621 (cons --> (cons boolean ())) B6617 L6618 Key6619 C6620)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> thaw (lambda V6626 (lambda B6622 (lambda L6623 (lambda Key6624 (lambda C6625 (let A (shen.newpv B6622) (shen.gc B6622 (is! V6626 (cons (cons lazy (cons A ())) (cons --> (cons A ()))) B6622 L6623 Key6624 C6625)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> track (lambda V6631 (lambda B6627 (lambda L6628 (lambda Key6629 (lambda C6630 (is! V6631 (cons symbol (cons --> (cons symbol ()))) B6627 L6628 Key6629 C6630)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tracked (lambda V6636 (lambda B6632 (lambda L6633 (lambda Key6634 (lambda C6635 (is! V6636 (cons --> (cons (cons list (cons symbol ())) ())) B6632 L6633 Key6634 C6635)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> trap-error (lambda V6641 (lambda B6637 (lambda L6638 (lambda Key6639 (lambda C6640 (let A (shen.newpv B6637) (shen.gc B6637 (is! V6641 (cons A (cons --> (cons (cons (cons exception (cons --> (cons A ()))) (cons --> (cons A ()))) ()))) B6637 L6638 Key6639 C6640)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tuple? (lambda V6646 (lambda B6642 (lambda L6643 (lambda Key6644 (lambda C6645 (let A (shen.newpv B6642) (shen.gc B6642 (is! V6646 (cons A (cons --> (cons boolean ()))) B6642 L6643 Key6644 C6645)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> unabsolute (lambda V6651 (lambda B6647 (lambda L6648 (lambda Key6649 (lambda C6650 (is! V6651 (cons string (cons --> (cons (cons list (cons string ())) ()))) B6647 L6648 Key6649 C6650)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> undefmacro (lambda V6656 (lambda B6652 (lambda L6653 (lambda Key6654 (lambda C6655 (is! V6656 (cons symbol (cons --> (cons symbol ()))) B6652 L6653 Key6654 C6655)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> union (lambda V6661 (lambda B6657 (lambda L6658 (lambda Key6659 (lambda C6660 (let A (shen.newpv B6657) (shen.gc B6657 (is! V6661 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6657 L6658 Key6659 C6660)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> unprofile (lambda V6666 (lambda B6662 (lambda L6663 (lambda Key6664 (lambda C6665 (is! V6666 (cons symbol (cons --> (cons symbol ()))) B6662 L6663 Key6664 C6665)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> untrack (lambda V6671 (lambda B6667 (lambda L6668 (lambda Key6669 (lambda C6670 (is! V6671 (cons symbol (cons --> (cons symbol ()))) B6667 L6668 Key6669 C6670)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> userdefs (lambda V6676 (lambda B6672 (lambda L6673 (lambda Key6674 (lambda C6675 (is! V6676 (cons --> (cons (cons list (cons symbol ())) ())) B6672 L6673 Key6674 C6675)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> variable? (lambda V6681 (lambda B6677 (lambda L6678 (lambda Key6679 (lambda C6680 (let A (shen.newpv B6677) (shen.gc B6677 (is! V6681 (cons A (cons --> (cons boolean ()))) B6677 L6678 Key6679 C6680)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> vector? (lambda V6686 (lambda B6682 (lambda L6683 (lambda Key6684 (lambda C6685 (let A (shen.newpv B6682) (shen.gc B6682 (is! V6686 (cons A (cons --> (cons boolean ()))) B6682 L6683 Key6684 C6685)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> version (lambda V6691 (lambda B6687 (lambda L6688 (lambda Key6689 (lambda C6690 (is! V6691 (cons --> (cons string ())) B6687 L6688 Key6689 C6690)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> write-to-file (lambda V6696 (lambda B6692 (lambda L6693 (lambda Key6694 (lambda C6695 (let A (shen.newpv B6692) (shen.gc B6692 (is! V6696 (cons string (cons --> (cons (cons A (cons --> (cons A ()))) ()))) B6692 L6693 Key6694 C6695)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> write-byte (lambda V6701 (lambda B6697 (lambda L6698 (lambda Key6699 (lambda C6700 (is! V6701 (cons number (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons number ()))) ()))) B6697 L6698 Key6699 C6700)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> y-or-n? (lambda V6706 (lambda B6702 (lambda L6703 (lambda Key6704 (lambda C6705 (is! V6706 (cons string (cons --> (cons boolean ()))) B6702 L6703 Key6704 C6705)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> > (lambda V6711 (lambda B6707 (lambda L6708 (lambda Key6709 (lambda C6710 (is! V6711 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) B6707 L6708 Key6709 C6710)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> < (lambda V6716 (lambda B6712 (lambda L6713 (lambda Key6714 (lambda C6715 (is! V6716 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) B6712 L6713 Key6714 C6715)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> >= (lambda V6721 (lambda B6717 (lambda L6718 (lambda Key6719 (lambda C6720 (is! V6721 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) B6717 L6718 Key6719 C6720)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> <= (lambda V6726 (lambda B6722 (lambda L6723 (lambda Key6724 (lambda C6725 (is! V6726 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) B6722 L6723 Key6724 C6725)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> = (lambda V6731 (lambda B6727 (lambda L6728 (lambda Key6729 (lambda C6730 (let A (shen.newpv B6727) (shen.gc B6727 (is! V6731 (cons A (cons --> (cons (cons A (cons --> (cons boolean ()))) ()))) B6727 L6728 Key6729 C6730)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> + (lambda V6736 (lambda B6732 (lambda L6733 (lambda Key6734 (lambda C6735 (is! V6736 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6732 L6733 Key6734 C6735)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> / (lambda V6741 (lambda B6737 (lambda L6738 (lambda Key6739 (lambda C6740 (is! V6741 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6737 L6738 Key6739 C6740)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> - (lambda V6746 (lambda B6742 (lambda L6743 (lambda Key6744 (lambda C6745 (is! V6746 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6742 L6743 Key6744 C6745)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> * (lambda V6751 (lambda B6747 (lambda L6748 (lambda Key6749 (lambda C6750 (is! V6751 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6747 L6748 Key6749 C6750)))))) (value shen.*sigf*))) (set shen.*sigf* (shen.assoc-> == (lambda V6756 (lambda B6752 (lambda L6753 (lambda Key6754 (lambda C6755 (let A (shen.newpv B6752) (shen.gc B6752 (let B (shen.newpv B6752) (shen.gc B6752 (is! V6756 (cons A (cons --> (cons (cons B (cons --> (cons boolean ()))) ()))) B6752 L6753 Key6754 C6755)))))))))) (value shen.*sigf*)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) - -(defun shen.initialise-lambda-forms () (do (shen.set-lambda-form-entry (cons shen.tuple (lambda Y1220 (shen.tuple Y1220)))) (do (shen.set-lambda-form-entry (cons shen.pvar (lambda Y1219 (shen.pvar Y1219)))) (do (shen.set-lambda-form-entry (cons shen.dictionary (lambda Y1218 (shen.dictionary Y1218)))) (do (shen.set-lambda-form-entry (cons shen.print-prolog-vector (lambda Y1217 (shen.print-prolog-vector Y1217)))) (do (shen.set-lambda-form-entry (cons shen.print-freshterm (lambda Y1216 (shen.print-freshterm Y1216)))) (do (shen.set-lambda-form-entry (cons shen.printF (lambda Y1215 (shen.printF Y1215)))) (do (shen.set-lambda-form-entry (cons absolute (lambda Y1214 (absolute Y1214)))) (do (shen.set-lambda-form-entry (cons absvector? (lambda Y1213 (absvector? Y1213)))) (do (shen.set-lambda-form-entry (cons absvector (lambda Y1212 (absvector Y1212)))) (do (shen.set-lambda-form-entry (cons address-> (lambda Y1209 (lambda Y1210 (lambda Y1211 (address-> Y1209 Y1210 Y1211)))))) (do (shen.set-lambda-form-entry (cons adjoin (lambda Y1207 (lambda Y1208 (adjoin Y1207 Y1208))))) (do (shen.set-lambda-form-entry (cons and (lambda Y1205 (lambda Y1206 (and Y1205 Y1206))))) (do (shen.set-lambda-form-entry (cons append (lambda Y1203 (lambda Y1204 (append Y1203 Y1204))))) (do (shen.set-lambda-form-entry (cons arity (lambda Y1202 (arity Y1202)))) (do (shen.set-lambda-form-entry (cons assoc (lambda Y1200 (lambda Y1201 (assoc Y1200 Y1201))))) (do (shen.set-lambda-form-entry (cons atom? (lambda Y1199 (atom? Y1199)))) (do (shen.set-lambda-form-entry (cons boolean? (lambda Y1198 (boolean? Y1198)))) (do (shen.set-lambda-form-entry (cons bootstrap (lambda Y1197 (bootstrap Y1197)))) (do (shen.set-lambda-form-entry (cons bound? (lambda Y1196 (bound? Y1196)))) (do (shen.set-lambda-form-entry (cons bind (lambda Y1190 (lambda Y1191 (lambda Y1192 (lambda Y1193 (lambda Y1194 (lambda Y1195 (bind Y1190 Y1191 Y1192 Y1193 Y1194 Y1195))))))))) (do (shen.set-lambda-form-entry (cons call (lambda Y1185 (lambda Y1186 (lambda Y1187 (lambda Y1188 (lambda Y1189 (call Y1185 Y1186 Y1187 Y1188 Y1189)))))))) (do (shen.set-lambda-form-entry (cons cd (lambda Y1184 (cd Y1184)))) (do (shen.set-lambda-form-entry (cons compile (lambda Y1182 (lambda Y1183 (compile Y1182 Y1183))))) (do (shen.set-lambda-form-entry (cons concat (lambda Y1180 (lambda Y1181 (concat Y1180 Y1181))))) (do (shen.set-lambda-form-entry (cons cons (lambda Y1178 (lambda Y1179 (cons Y1178 Y1179))))) (do (shen.set-lambda-form-entry (cons cons? (lambda Y1177 (cons? Y1177)))) (do (shen.set-lambda-form-entry (cons cn (lambda Y1175 (lambda Y1176 (cn Y1175 Y1176))))) (do (shen.set-lambda-form-entry (cons close (lambda Y1174 (close Y1174)))) (do (shen.set-lambda-form-entry (cons declare (lambda Y1172 (lambda Y1173 (declare Y1172 Y1173))))) (do (shen.set-lambda-form-entry (cons destroy (lambda Y1171 (destroy Y1171)))) (do (shen.set-lambda-form-entry (cons difference (lambda Y1169 (lambda Y1170 (difference Y1169 Y1170))))) (do (shen.set-lambda-form-entry (cons do (lambda Y1167 (lambda Y1168 (do Y1167 Y1168))))) (do (shen.set-lambda-form-entry (cons element? (lambda Y1165 (lambda Y1166 (element? Y1165 Y1166))))) (do (shen.set-lambda-form-entry (cons empty? (lambda Y1164 (empty? Y1164)))) (do (shen.set-lambda-form-entry (cons enable-type-theory (lambda Y1163 (enable-type-theory Y1163)))) (do (shen.set-lambda-form-entry (cons external (lambda Y1162 (external Y1162)))) (do (shen.set-lambda-form-entry (cons error-to-string (lambda Y1161 (error-to-string Y1161)))) (do (shen.set-lambda-form-entry (cons eval (lambda Y1160 (eval Y1160)))) (do (shen.set-lambda-form-entry (cons eval-kl (lambda Y1159 (eval-kl Y1159)))) (do (shen.set-lambda-form-entry (cons explode (lambda Y1158 (explode Y1158)))) (do (shen.set-lambda-form-entry (cons external (lambda Y1157 (external Y1157)))) (do (shen.set-lambda-form-entry (cons factorise (lambda Y1156 (factorise Y1156)))) (do (shen.set-lambda-form-entry (cons fail-if (lambda Y1154 (lambda Y1155 (fail-if Y1154 Y1155))))) (do (shen.set-lambda-form-entry (cons fix (lambda Y1152 (lambda Y1153 (fix Y1152 Y1153))))) (do (shen.set-lambda-form-entry (cons findall (lambda Y1145 (lambda Y1146 (lambda Y1147 (lambda Y1148 (lambda Y1149 (lambda Y1150 (lambda Y1151 (findall Y1145 Y1146 Y1147 Y1148 Y1149 Y1150 Y1151)))))))))) (do (shen.set-lambda-form-entry (cons fork (lambda Y1140 (lambda Y1141 (lambda Y1142 (lambda Y1143 (lambda Y1144 (fork Y1140 Y1141 Y1142 Y1143 Y1144)))))))) (do (shen.set-lambda-form-entry (cons freeze (lambda Y1139 (freeze Y1139)))) (do (shen.set-lambda-form-entry (cons fst (lambda Y1138 (fst Y1138)))) (do (shen.set-lambda-form-entry (cons fn (lambda Y1137 (fn Y1137)))) (do (shen.set-lambda-form-entry (cons function (lambda Y1136 (function Y1136)))) (do (shen.set-lambda-form-entry (cons gensym (lambda Y1135 (gensym Y1135)))) (do (shen.set-lambda-form-entry (cons get (lambda Y1132 (lambda Y1133 (lambda Y1134 (get Y1132 Y1133 Y1134)))))) (do (shen.set-lambda-form-entry (cons get-time (lambda Y1131 (get-time Y1131)))) (do (shen.set-lambda-form-entry (cons address-> (lambda Y1128 (lambda Y1129 (lambda Y1130 (address-> Y1128 Y1129 Y1130)))))) (do (shen.set-lambda-form-entry (cons <-address (lambda Y1126 (lambda Y1127 (<-address Y1126 Y1127))))) (do (shen.set-lambda-form-entry (cons <-vector (lambda Y1124 (lambda Y1125 (<-vector Y1124 Y1125))))) (do (shen.set-lambda-form-entry (cons > (lambda Y1122 (lambda Y1123 (> Y1122 Y1123))))) (do (shen.set-lambda-form-entry (cons >= (lambda Y1120 (lambda Y1121 (>= Y1120 Y1121))))) (do (shen.set-lambda-form-entry (cons = (lambda Y1118 (lambda Y1119 (= Y1118 Y1119))))) (do (shen.set-lambda-form-entry (cons hash (lambda Y1116 (lambda Y1117 (hash Y1116 Y1117))))) (do (shen.set-lambda-form-entry (cons hd (lambda Y1115 (hd Y1115)))) (do (shen.set-lambda-form-entry (cons hdv (lambda Y1114 (hdv Y1114)))) (do (shen.set-lambda-form-entry (cons hdstr (lambda Y1113 (hdstr Y1113)))) (do (shen.set-lambda-form-entry (cons head (lambda Y1112 (head Y1112)))) (do (shen.set-lambda-form-entry (cons hush (lambda Y1111 (hush Y1111)))) (do (shen.set-lambda-form-entry (cons if (lambda Y1108 (lambda Y1109 (lambda Y1110 (if Y1108 Y1109 Y1110)))))) (do (shen.set-lambda-form-entry (cons include (lambda Y1107 (include Y1107)))) (do (shen.set-lambda-form-entry (cons in-package (lambda Y1106 (in-package Y1106)))) (do (shen.set-lambda-form-entry (cons integer? (lambda Y1105 (integer? Y1105)))) (do (shen.set-lambda-form-entry (cons internal (lambda Y1104 (internal Y1104)))) (do (shen.set-lambda-form-entry (cons intern (lambda Y1103 (intern Y1103)))) (do (shen.set-lambda-form-entry (cons input (lambda Y1102 (input Y1102)))) (do (shen.set-lambda-form-entry (cons input+ (lambda Y1100 (lambda Y1101 (input+ Y1100 Y1101))))) (do (shen.set-lambda-form-entry (cons include-all-but (lambda Y1099 (include-all-but Y1099)))) (do (shen.set-lambda-form-entry (cons intersection (lambda Y1097 (lambda Y1098 (intersection Y1097 Y1098))))) (do (shen.set-lambda-form-entry (cons internal (lambda Y1096 (internal Y1096)))) (do (shen.set-lambda-form-entry (cons is (lambda Y1090 (lambda Y1091 (lambda Y1092 (lambda Y1093 (lambda Y1094 (lambda Y1095 (is Y1090 Y1091 Y1092 Y1093 Y1094 Y1095))))))))) (do (shen.set-lambda-form-entry (cons is! (lambda Y1084 (lambda Y1085 (lambda Y1086 (lambda Y1087 (lambda Y1088 (lambda Y1089 (is! Y1084 Y1085 Y1086 Y1087 Y1088 Y1089))))))))) (do (shen.set-lambda-form-entry (cons length (lambda Y1083 (length Y1083)))) (do (shen.set-lambda-form-entry (cons limit (lambda Y1082 (limit Y1082)))) (do (shen.set-lambda-form-entry (cons lineread (lambda Y1081 (lineread Y1081)))) (do (shen.set-lambda-form-entry (cons load (lambda Y1080 (load Y1080)))) (do (shen.set-lambda-form-entry (cons < (lambda Y1078 (lambda Y1079 (< Y1078 Y1079))))) (do (shen.set-lambda-form-entry (cons <= (lambda Y1076 (lambda Y1077 (<= Y1076 Y1077))))) (do (shen.set-lambda-form-entry (cons vector (lambda Y1075 (vector Y1075)))) (do (shen.set-lambda-form-entry (cons macroexpand (lambda Y1074 (macroexpand Y1074)))) (do (shen.set-lambda-form-entry (cons map (lambda Y1072 (lambda Y1073 (map Y1072 Y1073))))) (do (shen.set-lambda-form-entry (cons mapcan (lambda Y1070 (lambda Y1071 (mapcan Y1070 Y1071))))) (do (shen.set-lambda-form-entry (cons maxinferences (lambda Y1069 (maxinferences Y1069)))) (do (shen.set-lambda-form-entry (cons nl (lambda Y1068 (nl Y1068)))) (do (shen.set-lambda-form-entry (cons not (lambda Y1067 (not Y1067)))) (do (shen.set-lambda-form-entry (cons nth (lambda Y1065 (lambda Y1066 (nth Y1065 Y1066))))) (do (shen.set-lambda-form-entry (cons n->string (lambda Y1064 (n->string Y1064)))) (do (shen.set-lambda-form-entry (cons number? (lambda Y1063 (number? Y1063)))) (do (shen.set-lambda-form-entry (cons occurs-check (lambda Y1062 (occurs-check Y1062)))) (do (shen.set-lambda-form-entry (cons occurrences (lambda Y1060 (lambda Y1061 (occurrences Y1060 Y1061))))) (do (shen.set-lambda-form-entry (cons occurs-check (lambda Y1059 (occurs-check Y1059)))) (do (shen.set-lambda-form-entry (cons open (lambda Y1057 (lambda Y1058 (open Y1057 Y1058))))) (do (shen.set-lambda-form-entry (cons optimise (lambda Y1056 (optimise Y1056)))) (do (shen.set-lambda-form-entry (cons or (lambda Y1054 (lambda Y1055 (or Y1054 Y1055))))) (do (shen.set-lambda-form-entry (cons package? (lambda Y1053 (package? Y1053)))) (do (shen.set-lambda-form-entry (cons pos (lambda Y1051 (lambda Y1052 (pos Y1051 Y1052))))) (do (shen.set-lambda-form-entry (cons preclude-all-but (lambda Y1050 (preclude-all-but Y1050)))) (do (shen.set-lambda-form-entry (cons print (lambda Y1049 (print Y1049)))) (do (shen.set-lambda-form-entry (cons profile (lambda Y1048 (profile Y1048)))) (do (shen.set-lambda-form-entry (cons shen.print-prolog-vector (lambda Y1047 (shen.print-prolog-vector Y1047)))) (do (shen.set-lambda-form-entry (cons shen.print-freshterm (lambda Y1046 (shen.print-freshterm Y1046)))) (do (shen.set-lambda-form-entry (cons shen.printF (lambda Y1045 (shen.printF Y1045)))) (do (shen.set-lambda-form-entry (cons prolog-memory (lambda Y1044 (prolog-memory Y1044)))) (do (shen.set-lambda-form-entry (cons profile-results (lambda Y1043 (profile-results Y1043)))) (do (shen.set-lambda-form-entry (cons pr (lambda Y1041 (lambda Y1042 (pr Y1041 Y1042))))) (do (shen.set-lambda-form-entry (cons ps (lambda Y1040 (ps Y1040)))) (do (shen.set-lambda-form-entry (cons preclude (lambda Y1039 (preclude Y1039)))) (do (shen.set-lambda-form-entry (cons preclude-all-but (lambda Y1038 (preclude-all-but Y1038)))) (do (shen.set-lambda-form-entry (cons protect (lambda Y1037 (protect Y1037)))) (do (shen.set-lambda-form-entry (cons put (lambda Y1033 (lambda Y1034 (lambda Y1035 (lambda Y1036 (put Y1033 Y1034 Y1035 Y1036))))))) (do (shen.set-lambda-form-entry (cons read-file-as-string (lambda Y1032 (read-file-as-string Y1032)))) (do (shen.set-lambda-form-entry (cons read-file-as-bytelist (lambda Y1031 (read-file-as-bytelist Y1031)))) (do (shen.set-lambda-form-entry (cons read-file (lambda Y1030 (read-file Y1030)))) (do (shen.set-lambda-form-entry (cons read (lambda Y1029 (read Y1029)))) (do (shen.set-lambda-form-entry (cons read-byte (lambda Y1028 (read-byte Y1028)))) (do (shen.set-lambda-form-entry (cons read-from-string (lambda Y1027 (read-from-string Y1027)))) (do (shen.set-lambda-form-entry (cons read-from-string-unprocessed (lambda Y1026 (read-from-string-unprocessed Y1026)))) (do (shen.set-lambda-form-entry (cons shen.read-unit-string (lambda Y1025 (shen.read-unit-string Y1025)))) (do (shen.set-lambda-form-entry (cons remove (lambda Y1023 (lambda Y1024 (remove Y1023 Y1024))))) (do (shen.set-lambda-form-entry (cons reverse (lambda Y1022 (reverse Y1022)))) (do (shen.set-lambda-form-entry (cons set (lambda Y1020 (lambda Y1021 (set Y1020 Y1021))))) (do (shen.set-lambda-form-entry (cons simple-error (lambda Y1019 (simple-error Y1019)))) (do (shen.set-lambda-form-entry (cons snd (lambda Y1018 (snd Y1018)))) (do (shen.set-lambda-form-entry (cons specialise (lambda Y1016 (lambda Y1017 (specialise Y1016 Y1017))))) (do (shen.set-lambda-form-entry (cons spy (lambda Y1015 (spy Y1015)))) (do (shen.set-lambda-form-entry (cons step (lambda Y1014 (step Y1014)))) (do (shen.set-lambda-form-entry (cons str (lambda Y1013 (str Y1013)))) (do (shen.set-lambda-form-entry (cons string->n (lambda Y1012 (string->n Y1012)))) (do (shen.set-lambda-form-entry (cons string->symbol (lambda Y1011 (string->symbol Y1011)))) (do (shen.set-lambda-form-entry (cons string? (lambda Y1010 (string? Y1010)))) (do (shen.set-lambda-form-entry (cons subst (lambda Y1007 (lambda Y1008 (lambda Y1009 (subst Y1007 Y1008 Y1009)))))) (do (shen.set-lambda-form-entry (cons sum (lambda Y1006 (sum Y1006)))) (do (shen.set-lambda-form-entry (cons symbol? (lambda Y1005 (symbol? Y1005)))) (do (shen.set-lambda-form-entry (cons systemf (lambda Y1004 (systemf Y1004)))) (do (shen.set-lambda-form-entry (cons tail (lambda Y1003 (tail Y1003)))) (do (shen.set-lambda-form-entry (cons tl (lambda Y1002 (tl Y1002)))) (do (shen.set-lambda-form-entry (cons tc (lambda Y1001 (tc Y1001)))) (do (shen.set-lambda-form-entry (cons thaw (lambda Y1000 (thaw Y1000)))) (do (shen.set-lambda-form-entry (cons tlstr (lambda Y999 (tlstr Y999)))) (do (shen.set-lambda-form-entry (cons track (lambda Y998 (track Y998)))) (do (shen.set-lambda-form-entry (cons trap-error (lambda Y996 (lambda Y997 (trap-error Y996 Y997))))) (do (shen.set-lambda-form-entry (cons tuple? (lambda Y995 (tuple? Y995)))) (do (shen.set-lambda-form-entry (cons type (lambda Y993 (lambda Y994 (type Y993 Y994))))) (do (shen.set-lambda-form-entry (cons return (lambda Y988 (lambda Y989 (lambda Y990 (lambda Y991 (lambda Y992 (return Y988 Y989 Y990 Y991 Y992)))))))) (do (shen.set-lambda-form-entry (cons unabsolute (lambda Y987 (unabsolute Y987)))) (do (shen.set-lambda-form-entry (cons undefmacro (lambda Y986 (undefmacro Y986)))) (do (shen.set-lambda-form-entry (cons unput (lambda Y983 (lambda Y984 (lambda Y985 (unput Y983 Y984 Y985)))))) (do (shen.set-lambda-form-entry (cons unprofile (lambda Y982 (unprofile Y982)))) (do (shen.set-lambda-form-entry (cons union (lambda Y980 (lambda Y981 (union Y980 Y981))))) (do (shen.set-lambda-form-entry (cons untrack (lambda Y979 (untrack Y979)))) (do (shen.set-lambda-form-entry (cons undefmacro (lambda Y978 (undefmacro Y978)))) (do (shen.set-lambda-form-entry (cons update-lambda-table (lambda Y976 (lambda Y977 (update-lambda-table Y976 Y977))))) (do (shen.set-lambda-form-entry (cons vector (lambda Y975 (vector Y975)))) (do (shen.set-lambda-form-entry (cons vector? (lambda Y974 (vector? Y974)))) (do (shen.set-lambda-form-entry (cons vector-> (lambda Y971 (lambda Y972 (lambda Y973 (vector-> Y971 Y972 Y973)))))) (do (shen.set-lambda-form-entry (cons value (lambda Y970 (value Y970)))) (do (shen.set-lambda-form-entry (cons variable? (lambda Y969 (variable? Y969)))) (do (shen.set-lambda-form-entry (cons var? (lambda Y964 (lambda Y965 (lambda Y966 (lambda Y967 (lambda Y968 (var? Y964 Y965 Y966 Y967 Y968)))))))) (do (shen.set-lambda-form-entry (cons when (lambda Y959 (lambda Y960 (lambda Y961 (lambda Y962 (lambda Y963 (when Y959 Y960 Y961 Y962 Y963)))))))) (do (shen.set-lambda-form-entry (cons write-byte (lambda Y957 (lambda Y958 (write-byte Y957 Y958))))) (do (shen.set-lambda-form-entry (cons write-to-file (lambda Y955 (lambda Y956 (write-to-file Y955 Y956))))) (do (shen.set-lambda-form-entry (cons y-or-n? (lambda Y954 (y-or-n? Y954)))) (do (shen.set-lambda-form-entry (cons + (lambda Y952 (lambda Y953 (+ Y952 Y953))))) (do (shen.set-lambda-form-entry (cons * (lambda Y950 (lambda Y951 (* Y950 Y951))))) (do (shen.set-lambda-form-entry (cons / (lambda Y948 (lambda Y949 (/ Y948 Y949))))) (do (shen.set-lambda-form-entry (cons - (lambda Y946 (lambda Y947 (- Y946 Y947))))) (do (shen.set-lambda-form-entry (cons == (lambda Y944 (lambda Y945 (== Y944 Y945))))) (do (shen.set-lambda-form-entry (cons (lambda Y943 ( Y943)))) (do (shen.set-lambda-form-entry (cons (lambda Y942 ( Y942)))) (do (shen.set-lambda-form-entry (cons (lambda Y941 ( Y941)))) (do (shen.set-lambda-form-entry (cons @p (lambda Y939 (lambda Y940 (@p Y939 Y940))))) (do (shen.set-lambda-form-entry (cons @v (lambda Y937 (lambda Y938 (@v Y937 Y938))))) (shen.set-lambda-form-entry (cons @s (lambda Y935 (lambda Y936 (@s Y935 Y936)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) - -(defun shen.initialise () (do (shen.initialise-environment) (do (shen.initialise-lambda-forms) (shen.initialise-signedfuncs)))) - diff --git a/klambda/load.kl b/klambda/load.kl index b70d520..a359283 100644 --- a/klambda/load.kl +++ b/klambda/load.kl @@ -1,43 +1,43 @@ -(defun load (V1239) (let W1240 (value shen.*tc*) (let W1241 (let W1242 (get-time run) (let W1243 (shen.load-help W1240 (read-file V1239)) (let W1244 (get-time run) (let W1245 (- W1244 W1242) (let W1246 (pr (cn " -run time: " (cn (str W1245) " secs -")) (stoutput)) W1243))))) (let W1247 (if W1240 (pr (cn " +(defun load (V893) (let W894 (value shen.*tc*) (let W895 (let W896 (get-time run) (let W897 (shen.load-help W894 (read-file V893)) (let W898 (get-time run) (let W899 (- W898 W896) (let W900 (pr (cn " +run time: " (cn (str W899) " secs +")) (stoutput)) W897))))) (let W901 (if W894 (pr (cn " typechecked in " (shen.app (inferences) " inferences " shen.a)) (stoutput)) shen.skip) loaded)))) -(defun shen.load-help (V1250 V1251) (cond ((= false V1250) (shen.eval-and-print V1251)) (true (shen.check-eval-and-print V1251)))) +(defun shen.load-help (V904 V905) (cond ((= false V904) (shen.eval-and-print V905)) (true (shen.check-eval-and-print V905)))) -(defun shen.eval-and-print (V1252) (shen.for-each (lambda Z1253 (pr (shen.app (eval-kl (shen.shen->kl Z1253)) " -" shen.s) (stoutput))) V1252)) +(defun shen.eval-and-print (V906) (map (lambda Z907 (pr (shen.app (eval-kl (shen.shen->kl Z907)) " +" shen.s) (stoutput))) V906)) -(defun shen.check-eval-and-print (V1254) (let W1255 (mapcan (lambda Z1256 (shen.typetable Z1256)) V1254) (let W1257 (trap-error (shen.assumetypes W1255) (lambda Z1258 (shen.unwind-types Z1258 W1255))) (trap-error (shen.work-through V1254) (lambda Z1259 (shen.unwind-types Z1259 W1255)))))) +(defun shen.check-eval-and-print (V908) (let W909 (mapcan (lambda Z910 (shen.typetable Z910)) V908) (let W911 (trap-error (shen.assumetypes W909) (lambda Z912 (shen.unwind-types Z912 W909))) (trap-error (shen.work-through V908) (lambda Z913 (shen.unwind-types Z913 W909)))))) -(defun shen.typetable (V1264) (cond ((and (cons? V1264) (and (= define (hd V1264)) (and (cons? (tl V1264)) (and (cons? (tl (tl V1264))) (= { (hd (tl (tl V1264)))))))) (cons (hd (tl V1264)) (cons (shen.rectify-type (shen.type-F (hd (tl V1264)) (tl (tl (tl V1264))))) ()))) ((and (cons? V1264) (and (= define (hd V1264)) (cons? (tl V1264)))) (simple-error (cn "missing { in " (shen.app (hd (tl V1264)) " +(defun shen.typetable (V918) (cond ((and (cons? V918) (and (= define (hd V918)) (and (cons? (tl V918)) (and (cons? (tl (tl V918))) (= { (hd (tl (tl V918)))))))) (cons (hd (tl V918)) (cons (shen.rectify-type (shen.type-F (hd (tl V918)) (tl (tl (tl V918))))) ()))) ((and (cons? V918) (and (= define (hd V918)) (cons? (tl V918)))) (simple-error (cn "missing { in " (shen.app (hd (tl V918)) " " shen.a)))) (true ()))) -(defun shen.type-F (V1271 V1272) (cond ((and (cons? V1272) (= } (hd V1272))) ()) ((cons? V1272) (cons (hd V1272) (shen.type-F V1271 (tl V1272)))) (true (simple-error (cn "missing } in " (shen.app V1271 " +(defun shen.type-F (V925 V926) (cond ((and (cons? V926) (= } (hd V926))) ()) ((cons? V926) (cons (hd V926) (shen.type-F V925 (tl V926)))) (true (simple-error (cn "missing } in " (shen.app V925 " " shen.a)))))) -(defun shen.assumetypes (V1275) (cond ((= () V1275) ()) ((and (cons? V1275) (cons? (tl V1275))) (do (declare (hd V1275) (hd (tl V1275))) (shen.assumetypes (tl (tl V1275))))) (true (simple-error "implementation error in shen.assumetype")))) +(defun shen.assumetypes (V929) (cond ((= () V929) ()) ((and (cons? V929) (cons? (tl V929))) (do (declare (hd V929) (hd (tl V929))) (shen.assumetypes (tl (tl V929))))) (true (simple-error "implementation error in shen.assumetype")))) -(defun shen.unwind-types (V1280 V1281) (cond ((and (cons? V1281) (cons? (tl V1281))) (do (destroy (hd V1281)) (shen.unwind-types V1280 (tl (tl V1281))))) (true (simple-error (error-to-string V1280))))) +(defun shen.unwind-types (V934 V935) (cond ((and (cons? V935) (cons? (tl V935))) (do (destroy (hd V935)) (shen.unwind-types V934 (tl (tl V935))))) (true (simple-error (error-to-string V934))))) -(defun shen.work-through (V1284) (cond ((= () V1284) ()) ((and (cons? V1284) (and (cons? (tl V1284)) (and (cons? (tl (tl V1284))) (= (hd (tl V1284)) (intern ":"))))) (let W1285 (shen.typecheck (hd V1284) (hd (tl (tl V1284)))) (if (= W1285 false) (shen.type-error) (let W1286 (eval-kl (shen.shen->kl (hd V1284))) (let W1287 (pr (shen.app W1286 (cn " : " (shen.app (shen.pretty-type W1285) " -" shen.r)) shen.s) (stoutput)) (shen.work-through (tl (tl (tl V1284))))))))) ((cons? V1284) (shen.work-through (cons (hd V1284) (cons (intern ":") (cons A (tl V1284)))))) (true (simple-error "implementation error in shen.work-through")))) +(defun shen.work-through (V938) (cond ((= () V938) ()) ((and (cons? V938) (and (cons? (tl V938)) (and (cons? (tl (tl V938))) (= (hd (tl V938)) (intern ":"))))) (let W939 (shen.typecheck (hd V938) (hd (tl (tl V938)))) (if (= W939 false) (shen.type-error) (let W940 (eval-kl (shen.shen->kl (hd V938))) (let W941 (pr (shen.app W940 (cn " : " (shen.app (shen.pretty-type W939) " +" shen.r)) shen.s) (stoutput)) (shen.work-through (tl (tl (tl V938))))))))) ((cons? V938) (shen.work-through (cons (hd V938) (cons (intern ":") (cons A (tl V938)))))) (true (simple-error "implementation error in shen.work-through")))) -(defun shen.pretty-type (V1289) (cond ((and (cons? V1289) (and (cons? (hd V1289)) (and (= list (hd (hd V1289))) (and (cons? (tl (hd V1289))) (and (= () (tl (tl (hd V1289)))) (and (cons? (tl V1289)) (and (= --> (hd (tl V1289))) (and (cons? (tl (tl V1289))) (and (cons? (hd (tl (tl V1289)))) (and (= str (hd (hd (tl (tl V1289))))) (and (cons? (tl (hd (tl (tl V1289))))) (and (cons? (hd (tl (hd (tl (tl V1289)))))) (and (= list (hd (hd (tl (hd (tl (tl V1289))))))) (and (cons? (tl (hd (tl (hd (tl (tl V1289))))))) (and (= () (tl (tl (hd (tl (hd (tl (tl V1289)))))))) (and (cons? (tl (tl (hd (tl (tl V1289)))))) (and (= () (tl (tl (tl (hd (tl (tl V1289))))))) (and (= () (tl (tl (tl V1289)))) (= (hd (tl (hd V1289))) (hd (tl (hd (tl (hd (tl (tl V1289)))))))))))))))))))))))))) (cons (hd (tl (hd (tl (tl V1289))))) (cons ==> (tl (tl (hd (tl (tl V1289)))))))) ((cons? V1289) (map (lambda Z1290 (shen.pretty-type Z1290)) V1289)) (true V1289))) +(defun shen.pretty-type (V943) (cond ((and (cons? V943) (and (cons? (hd V943)) (and (= list (hd (hd V943))) (and (cons? (tl (hd V943))) (and (= () (tl (tl (hd V943)))) (and (cons? (tl V943)) (and (= --> (hd (tl V943))) (and (cons? (tl (tl V943))) (and (cons? (hd (tl (tl V943)))) (and (= str (hd (hd (tl (tl V943))))) (and (cons? (tl (hd (tl (tl V943))))) (and (cons? (hd (tl (hd (tl (tl V943)))))) (and (= list (hd (hd (tl (hd (tl (tl V943))))))) (and (cons? (tl (hd (tl (hd (tl (tl V943))))))) (and (= () (tl (tl (hd (tl (hd (tl (tl V943)))))))) (and (cons? (tl (tl (hd (tl (tl V943)))))) (and (= () (tl (tl (tl (hd (tl (tl V943))))))) (and (= () (tl (tl (tl V943)))) (= (hd (tl (hd V943))) (hd (tl (hd (tl (hd (tl (tl V943)))))))))))))))))))))))))) (cons (hd (tl (hd (tl (tl V943))))) (cons ==> (tl (tl (hd (tl (tl V943)))))))) ((cons? V943) (map (lambda Z944 (shen.pretty-type Z944)) V943)) (true V943))) (defun shen.type-error () (simple-error "type error ")) -(defun bootstrap (V1291) (let W1292 (shen.klfile V1291) (let W1293 (read-file V1291) (let W1294 (open W1292 out) (let W1295 (map (lambda Z1296 (shen.partial (shen.shen->kl-h Z1296))) W1293) (let W1297 (shen.write-kl W1295 W1294) W1292)))))) +(defun bootstrap (V945) (let W946 (shen.klfile V945) (let W947 (read-file V945) (let W948 (open W946 out) (let W949 (map (lambda Z950 (shen.partial (shen.shen->kl-h Z950))) W947) (let W951 (shen.write-kl W949 W948) W946)))))) -(defun shen.partial (V1298) (cond ((and (cons? V1298) (and (= shen.f-error (hd V1298)) (and (cons? (tl V1298)) (= () (tl (tl V1298)))))) (cons simple-error (cons (cn "partial function " (str (hd (tl V1298)))) ()))) ((cons? V1298) (map (lambda Z1299 (shen.partial Z1299)) V1298)) (true V1298))) +(defun shen.partial (V952) (cond ((and (cons? V952) (and (= shen.f-error (hd V952)) (and (cons? (tl V952)) (= () (tl (tl V952)))))) (cons simple-error (cons (cn "partial function " (str (hd (tl V952)))) ()))) ((cons? V952) (map (lambda Z953 (shen.partial Z953)) V952)) (true V952))) -(defun shen.write-kl (V1302 V1303) (cond ((= () V1302) (close V1303)) ((and (cons? V1302) (cons? (hd V1302))) (shen.write-kl (tl V1302) (do (shen.write-kl-h (hd V1302) V1303) V1303))) ((cons? V1302) (shen.write-kl (tl V1302) V1303)) (true (shen.f-error shen.write-kl)))) +(defun shen.write-kl (V956 V957) (cond ((= () V956) (close V957)) ((and (cons? V956) (cons? (hd V956))) (shen.write-kl (tl V956) (do (shen.write-kl-h (hd V956) V957) V957))) ((cons? V956) (shen.write-kl (tl V956) V957)) (true (simple-error "partial function shen.write-kl")))) -(defun shen.write-kl-h (V1306 V1307) (cond ((and (cons? V1306) (and (= defun (hd V1306)) (and (cons? (tl V1306)) (and (= fail (hd (tl V1306))) (and (cons? (tl (tl V1306))) (and (= () (hd (tl (tl V1306)))) (and (cons? (tl (tl (tl V1306)))) (= () (tl (tl (tl (tl V1306)))))))))))) (pr "(defun fail () shen.fail!)" V1307)) (true (pr (shen.app V1306 " +(defun shen.write-kl-h (V960 V961) (cond ((and (cons? V960) (and (= defun (hd V960)) (and (cons? (tl V960)) (and (= fail (hd (tl V960))) (and (cons? (tl (tl V960))) (and (= () (hd (tl (tl V960)))) (and (cons? (tl (tl (tl V960)))) (= () (tl (tl (tl (tl V960)))))))))))) (pr "(defun fail () shen.fail!)" V961)) (true (pr (shen.app V960 " -" shen.r) V1307)))) +" shen.r) V961)))) -(defun shen.klfile (V1308) (cond ((= "" V1308) ".kl") ((= ".shen" V1308) ".kl") ((shen.+string? V1308) (@s (hdstr V1308) (shen.klfile (tlstr V1308)))) (true (shen.f-error shen.klfile)))) +(defun shen.klfile (V962) (cond ((= "" V962) ".kl") ((= ".shen" V962) ".kl") ((shen.+string? V962) (@s (hdstr V962) (shen.klfile (tlstr V962)))) (true (simple-error "partial function shen.klfile")))) diff --git a/klambda/macros.kl b/klambda/macros.kl index 8ef8a89..719f80b 100644 --- a/klambda/macros.kl +++ b/klambda/macros.kl @@ -1,65 +1,65 @@ -(defun macroexpand (V6939) (let W6940 (map (lambda Z6941 (tl Z6941)) (value *macros*)) (shen.macroexpand-h V6939 W6940 W6940))) +(defun macroexpand (V5783) (let W5784 (map (lambda Z5785 (tl Z5785)) (value *macros*)) (shen.macroexpand-h V5783 W5784 W5784))) -(defun shen.macroexpand-h (V6950 V6951 V6952) (if (= () V6951) V6950 (if (cons? V6951) (let W6953 (shen.walk (hd V6951) V6950) (if (= V6950 W6953) (shen.macroexpand-h V6950 (tl V6951) V6952) (shen.macroexpand-h W6953 V6952 V6952))) (simple-error "implementation error in shen.macroexpand-h")))) +(defun shen.macroexpand-h (V5794 V5795 V5796) (if (= () V5795) V5794 (if (cons? V5795) (let W5797 (shen.walk (hd V5795) V5794) (if (= V5794 W5797) (shen.macroexpand-h V5794 (tl V5795) V5796) (shen.macroexpand-h W5797 V5796 V5796))) (simple-error "implementation error in shen.macroexpand-h")))) -(defun shen.walk (V6954 V6955) (if (cons? V6955) (V6954 (map (lambda Z6956 (shen.walk V6954 Z6956)) V6955)) (V6954 V6955))) +(defun shen.walk (V5798 V5799) (if (cons? V5799) (V5798 (map (lambda Z5800 (shen.walk V5798 Z5800)) V5799)) (V5798 V5799))) -(defun shen.macros (V6957) (let GoTo6958 (freeze V6957) (if (cons? V6957) (let Select6963 (hd V6957) (let Select6964 (tl V6957) (if (and (= defmacro Select6963) (cons? Select6964)) (shen.process-def (hd Select6964) (tl Select6964)) (if (= defcc Select6963) (shen.yacc->shen Select6964) (if (and (= u! Select6963) (and (cons? Select6964) (= () (tl Select6964)))) (cons protect (cons (shen.make-uppercase (hd Select6964)) ())) (if (and (= error Select6963) (cons? Select6964)) (cons simple-error (cons (shen.mkstr (hd Select6964) (tl Select6964)) ())) (if (and (= output Select6963) (cons? Select6964)) (cons pr (cons (shen.mkstr (hd Select6964) (tl Select6964)) (cons (cons stoutput ()) ()))) (if (and (= pr Select6963) (and (cons? Select6964) (= () (tl Select6964)))) (cons pr (cons (hd Select6964) (cons (cons stoutput ()) ()))) (if (and (= make-string Select6963) (cons? Select6964)) (shen.mkstr (hd Select6964) (tl Select6964)) (if (and (= lineread Select6963) (= () Select6964)) (cons lineread (cons (cons stinput ()) ())) (if (and (= input Select6963) (= () Select6964)) (cons input (cons (cons stinput ()) ())) (if (and (= read Select6963) (= () Select6964)) (cons read (cons (cons stinput ()) ())) (if (and (= input+ Select6963) (and (cons? Select6964) (= () (tl Select6964)))) (cons input+ (cons (hd Select6964) (cons (cons stinput ()) ()))) (if (and (= read-byte Select6963) (= () Select6964)) (shen.process-read-byte) (if (= prolog? Select6963) (shen.call-prolog Select6964) (if (and (= defprolog Select6963) (cons? Select6964)) (shen.compile-prolog (hd Select6964) (tl Select6964)) (if (and (= datatype Select6963) (cons? Select6964)) (shen.process-datatype (hd Select6964) (tl Select6964)) (if (= @s Select6963) (shen.process-@s V6957) (if (= synonyms Select6963) (shen.process-synonyms Select6964) (if (and (= nl Select6963) (= () Select6964)) (cons nl (cons 1 ())) (if (= let Select6963) (shen.process-let V6957) (if (= /. Select6963) (shen.process-lambda V6957) (if (= cases Select6963) (shen.process-cases V6957) (if (and (= time Select6963) (and (cons? Select6964) (= () (tl Select6964)))) (shen.process-time (hd Select6964)) (if (and (= put Select6963) (and (cons? Select6964) (and (cons? (tl Select6964)) (and (cons? (tl (tl Select6964))) (= () (tl (tl (tl Select6964)))))))) (cons put (cons (hd Select6964) (cons (hd (tl Select6964)) (cons (hd (tl (tl Select6964))) (cons (cons value (cons *property-vector* ())) ()))))) (if (and (= get Select6963) (and (cons? Select6964) (and (cons? (tl Select6964)) (= () (tl (tl Select6964)))))) (cons get (cons (hd Select6964) (cons (hd (tl Select6964)) (cons (cons value (cons *property-vector* ())) ())))) (if (and (= unput Select6963) (and (cons? Select6964) (and (cons? (tl Select6964)) (= () (tl (tl Select6964)))))) (cons unput (cons (hd Select6964) (cons (hd (tl Select6964)) (cons (cons value (cons *property-vector* ())) ())))) (if (and (= shen.@c Select6963) (and (cons? Select6964) (= () (tl Select6964)))) (shen.rcons_form (hd Select6964)) (let GoTo6959 (freeze (if (and (cons? Select6964) (and (cons? (tl Select6964)) (and (cons? (tl (tl Select6964))) (element? Select6963 (cons @p (cons @v (cons append (cons and (cons or (cons + (cons * (cons do ())))))))))))) (cons Select6963 (cons (hd Select6964) (cons (shen.process-assoc (cons Select6963 (tl Select6964))) ()))) (thaw GoTo6958))) (if (= shen.@ch Select6963) (if (cons? Select6964) (let Select6961 (hd Select6964) (let Select6962 (tl Select6964) (if (and (cons? Select6961) (and (cons? (tl Select6961)) (and (cons? (tl (tl Select6961))) (and (= () (tl (tl (tl Select6961)))) (and (= () Select6962) (= (hd (tl Select6961)) (intern ":"))))))) (shen.cons-form-respect-modes (cons - (cons (cons (hd Select6961) (cons (hd (tl Select6961)) (cons (cons + (tl (tl Select6961))) ()))) ()))) (if (= () Select6962) (shen.cons-form-respect-modes Select6961) (thaw GoTo6959))))) (thaw GoTo6959)) (thaw GoTo6959))))))))))))))))))))))))))))))) (thaw GoTo6958)))) +(defun shen.macros (V5801) (let GoTo5802 (freeze V5801) (if (cons? V5801) (let Select5807 (hd V5801) (let Select5808 (tl V5801) (if (and (= defmacro Select5807) (cons? Select5808)) (shen.process-def (hd Select5808) (tl Select5808)) (if (= defcc Select5807) (shen.yacc->shen Select5808) (if (and (= u! Select5807) (and (cons? Select5808) (= () (tl Select5808)))) (cons protect (cons (shen.make-uppercase (hd Select5808)) ())) (if (and (= error Select5807) (cons? Select5808)) (cons simple-error (cons (shen.mkstr (hd Select5808) (tl Select5808)) ())) (if (and (= output Select5807) (cons? Select5808)) (cons pr (cons (shen.mkstr (hd Select5808) (tl Select5808)) (cons (cons stoutput ()) ()))) (if (and (= pr Select5807) (and (cons? Select5808) (= () (tl Select5808)))) (cons pr (cons (hd Select5808) (cons (cons stoutput ()) ()))) (if (and (= make-string Select5807) (cons? Select5808)) (shen.mkstr (hd Select5808) (tl Select5808)) (if (and (= lineread Select5807) (= () Select5808)) (cons lineread (cons (cons stinput ()) ())) (if (and (= input Select5807) (= () Select5808)) (cons input (cons (cons stinput ()) ())) (if (and (= read Select5807) (= () Select5808)) (cons read (cons (cons stinput ()) ())) (if (and (= input+ Select5807) (cons? Select5808)) (shen.process-input+ V5801) (if (and (= read-byte Select5807) (= () Select5808)) (shen.process-read-byte) (if (= prolog? Select5807) (shen.call-prolog Select5808) (if (and (= defprolog Select5807) (cons? Select5808)) (shen.compile-prolog (hd Select5808) (tl Select5808)) (if (and (= datatype Select5807) (cons? Select5808)) (shen.process-datatype (hd Select5808) (tl Select5808)) (if (= @s Select5807) (shen.process-@s V5801) (if (= synonyms Select5807) (shen.process-synonyms Select5808) (if (and (= nl Select5807) (= () Select5808)) (cons nl (cons 1 ())) (if (= let Select5807) (shen.process-let V5801) (if (= /. Select5807) (shen.process-lambda V5801) (if (= cases Select5807) (shen.process-cases V5801) (if (and (= time Select5807) (and (cons? Select5808) (= () (tl Select5808)))) (shen.process-time (hd Select5808)) (if (and (= put Select5807) (and (cons? Select5808) (and (cons? (tl Select5808)) (and (cons? (tl (tl Select5808))) (= () (tl (tl (tl Select5808)))))))) (cons put (cons (hd Select5808) (cons (hd (tl Select5808)) (cons (hd (tl (tl Select5808))) (cons (cons value (cons *property-vector* ())) ()))))) (if (and (= get Select5807) (and (cons? Select5808) (and (cons? (tl Select5808)) (= () (tl (tl Select5808)))))) (cons get (cons (hd Select5808) (cons (hd (tl Select5808)) (cons (cons value (cons *property-vector* ())) ())))) (if (and (= unput Select5807) (and (cons? Select5808) (and (cons? (tl Select5808)) (= () (tl (tl Select5808)))))) (cons unput (cons (hd Select5808) (cons (hd (tl Select5808)) (cons (cons value (cons *property-vector* ())) ())))) (if (and (= shen.@c Select5807) (and (cons? Select5808) (= () (tl Select5808)))) (shen.rcons_form (hd Select5808)) (let GoTo5803 (freeze (if (and (cons? Select5808) (and (cons? (tl Select5808)) (and (cons? (tl (tl Select5808))) (element? Select5807 (cons @p (cons @v (cons append (cons and (cons or (cons + (cons * (cons do ())))))))))))) (cons Select5807 (cons (hd Select5808) (cons (shen.process-assoc (cons Select5807 (tl Select5808))) ()))) (thaw GoTo5802))) (if (= shen.@ch Select5807) (if (cons? Select5808) (let Select5805 (hd Select5808) (let Select5806 (tl Select5808) (if (and (cons? Select5805) (and (cons? (tl Select5805)) (and (cons? (tl (tl Select5805))) (and (= () (tl (tl (tl Select5805)))) (and (= () Select5806) (= (hd (tl Select5805)) (intern ":"))))))) (shen.cons-form-respect-modes (cons - (cons (cons (hd Select5805) (cons (hd (tl Select5805)) (cons (cons + (tl (tl Select5805))) ()))) ()))) (if (= () Select5806) (shen.cons-form-respect-modes Select5805) (thaw GoTo5803))))) (thaw GoTo5803)) (thaw GoTo5803))))))))))))))))))))))))))))))) (thaw GoTo5802)))) -(defun shen.cons-form-respect-modes (V6965) (let GoTo6966 (freeze V6965) (if (cons? V6965) (let Select6967 (hd V6965) (let Select6968 (tl V6965) (if (and (= + Select6967) (and (cons? Select6968) (= () (tl Select6968)))) (cons + (cons (shen.cons-form-respect-modes (hd Select6968)) ())) (if (and (= - Select6967) (and (cons? Select6968) (= () (tl Select6968)))) (cons - (cons (shen.cons-form-respect-modes (hd Select6968)) ())) (cons cons (cons (shen.cons-form-respect-modes Select6967) (cons (shen.cons-form-respect-modes Select6968) ()))))))) (thaw GoTo6966)))) +(defun shen.process-input+ (V5809) (let GoTo5810 (freeze (simple-error "partial function shen.process-input+")) (if (cons? V5809) (let Select5815 (tl V5809) (if (= input+ (hd V5809)) (if (cons? Select5815) (let Select5813 (hd Select5815) (let Select5814 (tl Select5815) (if (= () Select5814) (cons shen.input-h+ (cons (shen.rcons_form Select5813) (cons (cons stinput ()) ()))) (if (and (cons? Select5814) (= () (tl Select5814))) (cons shen.input-h+ (cons (shen.rcons_form Select5813) Select5814)) (thaw GoTo5810))))) (thaw GoTo5810)) (thaw GoTo5810))) (thaw GoTo5810)))) -(defun shen.process-def (V6969 V6970) (let W6971 (cons X (cons -> (cons X ()))) (let W6972 (eval (cons define (cons V6969 (append V6970 W6971)))) (let W6973 (shen.record-macro V6969 (fn V6969)) V6969)))) +(defun shen.cons-form-respect-modes (V5816) (let GoTo5817 (freeze V5816) (if (cons? V5816) (let Select5818 (hd V5816) (let Select5819 (tl V5816) (if (and (= + Select5818) (and (cons? Select5819) (= () (tl Select5819)))) (cons + (cons (shen.cons-form-respect-modes (hd Select5819)) ())) (if (and (= - Select5818) (and (cons? Select5819) (= () (tl Select5819)))) (cons - (cons (shen.cons-form-respect-modes (hd Select5819)) ())) (cons cons (cons (shen.cons-form-respect-modes Select5818) (cons (shen.cons-form-respect-modes Select5819) ()))))))) (thaw GoTo5817)))) -(defun shen.process-let (V6974) (if (and (cons? V6974) (and (= let (hd V6974)) (and (cons? (tl V6974)) (and (cons? (tl (tl V6974))) (and (cons? (tl (tl (tl V6974)))) (cons? (tl (tl (tl (tl V6974)))))))))) (cons let (cons (hd (tl V6974)) (cons (hd (tl (tl V6974))) (cons (cons let (tl (tl (tl V6974)))) ())))) V6974)) +(defun shen.process-def (V5820 V5821) (let W5822 (cons X (cons -> (cons X ()))) (let W5823 (eval (cons define (cons V5820 (append V5821 W5822)))) (let W5824 (shen.record-macro V5820 (fn V5820)) V5820)))) -(defun shen.process-@s (V6975) (let GoTo6977 (freeze V6975) (if (cons? V6975) (let Select6984 (tl V6975) (if (= @s (hd V6975)) (if (cons? Select6984) (let Select6982 (hd Select6984) (let Select6983 (tl Select6984) (if (cons? Select6983) (let Select6981 (tl Select6983) (if (cons? Select6981) (cons @s (cons Select6982 (cons (shen.process-@s (cons @s Select6983)) ()))) (if (and (= () Select6981) (string? Select6982)) (let W6976 (explode Select6982) (if (> (length W6976) 1) (shen.process-@s (cons @s (append W6976 Select6983))) V6975)) (thaw GoTo6977)))) (thaw GoTo6977)))) (thaw GoTo6977)) (thaw GoTo6977))) (thaw GoTo6977)))) +(defun shen.process-let (V5825) (if (and (cons? V5825) (and (= let (hd V5825)) (and (cons? (tl V5825)) (and (cons? (tl (tl V5825))) (and (cons? (tl (tl (tl V5825)))) (cons? (tl (tl (tl (tl V5825)))))))))) (cons let (cons (hd (tl V5825)) (cons (hd (tl (tl V5825))) (cons (cons let (tl (tl (tl V5825)))) ())))) V5825)) -(defun shen.process-datatype (V6985 V6986) (let W6987 (shen.intern-type V6985) (let W6988 (compile (lambda Z6989 (shen. Z6989)) (cons W6987 V6986)) W6987))) +(defun shen.process-@s (V5826) (let GoTo5828 (freeze V5826) (if (cons? V5826) (let Select5835 (tl V5826) (if (= @s (hd V5826)) (if (cons? Select5835) (let Select5833 (hd Select5835) (let Select5834 (tl Select5835) (if (cons? Select5834) (let Select5832 (tl Select5834) (if (cons? Select5832) (cons @s (cons Select5833 (cons (shen.process-@s (cons @s Select5834)) ()))) (if (and (= () Select5832) (string? Select5833)) (let W5827 (explode Select5833) (if (> (length W5827) 1) (shen.process-@s (cons @s (append W5827 Select5834))) V5826)) (thaw GoTo5828)))) (thaw GoTo5828)))) (thaw GoTo5828)) (thaw GoTo5828))) (thaw GoTo5828)))) -(defun shen.intern-type (V6990) (intern (cn (str V6990) "#type"))) +(defun shen.process-datatype (V5836 V5837) (let W5838 (shen.intern-type V5836) (let W5839 (compile (lambda Z5840 (shen. Z5840)) (cons W5838 V5837)) W5838))) -(defun shen.process-synonyms (V6991) (shen.synonyms-h (set shen.*synonyms* (append V6991 (value shen.*synonyms*))))) +(defun shen.intern-type (V5841) (intern (cn (str V5841) "#type"))) -(defun shen.lambda-of-defun (V6994) (if (and (cons? V6994) (and (= defun (hd V6994)) (and (cons? (tl V6994)) (and (cons? (tl (tl V6994))) (and (cons? (hd (tl (tl V6994)))) (and (= () (tl (hd (tl (tl V6994))))) (and (cons? (tl (tl (tl V6994)))) (= () (tl (tl (tl (tl V6994)))))))))))) (eval (cons /. (cons (hd (hd (tl (tl V6994)))) (tl (tl (tl V6994)))))) (shen.f-error shen.lambda-of-defun))) +(defun shen.process-synonyms (V5842) (shen.synonyms-h (set shen.*synonyms* (append V5842 (value shen.*synonyms*))))) -(defun shen.synonyms-h (V6995) (let W6996 (map (lambda Z6997 (shen.curry-type Z6997)) V6995) (let W6998 (shen.lambda-of-defun (shen.shendef->kldef shen.demod (shen.compile-synonyms W6996))) (let W6999 (set shen.*demodulation-function* W6998) synonyms)))) +(defun shen.synonyms-h (V5843) (let W5844 (map (lambda Z5845 (shen.curry-type Z5845)) V5843) (let W5846 (eval (cons define (cons shen.demod (shen.compile-synonyms W5844)))) synonyms))) -(defun shen.compile-synonyms (V7002) (if (= () V7002) (let W7003 (gensym X) (cons W7003 (cons -> (cons W7003 ())))) (if (and (cons? V7002) (cons? (tl V7002))) (cons (shen.rcons_form (hd V7002)) (cons -> (cons (shen.rcons_form (hd (tl V7002))) (shen.compile-synonyms (tl (tl V7002)))))) (simple-error "synonyms requires an even number of arguments +(defun shen.compile-synonyms (V5849) (if (= () V5849) (let W5850 (gensym X) (cons W5850 (cons -> (cons W5850 ())))) (if (and (cons? V5849) (cons? (tl V5849))) (cons (shen.rcons_form (hd V5849)) (cons -> (cons (shen.rcons_form (hd (tl V5849))) (shen.compile-synonyms (tl (tl V5849)))))) (simple-error "synonyms requires an even number of arguments ")))) -(defun shen.process-lambda (V7004) (let GoTo7005 (freeze V7004) (if (cons? V7004) (let Select7012 (tl V7004) (if (= /. (hd V7004)) (if (cons? Select7012) (let Select7010 (hd Select7012) (let Select7011 (tl Select7012) (if (cons? Select7011) (let Select7009 (tl Select7011) (if (cons? Select7009) (cons lambda (cons Select7010 (cons (shen.process-lambda (cons /. Select7011)) ()))) (if (= () Select7009) (if (variable? Select7010) (cons lambda Select7012) (simple-error (shen.app Select7010 " is not a variable -" shen.s))) (thaw GoTo7005)))) (thaw GoTo7005)))) (thaw GoTo7005)) (thaw GoTo7005))) (thaw GoTo7005)))) +(defun shen.process-lambda (V5851) (let GoTo5852 (freeze V5851) (if (cons? V5851) (let Select5859 (tl V5851) (if (= /. (hd V5851)) (if (cons? Select5859) (let Select5857 (hd Select5859) (let Select5858 (tl Select5859) (if (cons? Select5858) (let Select5856 (tl Select5858) (if (cons? Select5856) (cons lambda (cons Select5857 (cons (shen.process-lambda (cons /. Select5858)) ()))) (if (= () Select5856) (if (variable? Select5857) (cons lambda Select5859) (simple-error (shen.app Select5857 " is not a variable +" shen.s))) (thaw GoTo5852)))) (thaw GoTo5852)))) (thaw GoTo5852)) (thaw GoTo5852))) (thaw GoTo5852)))) -(defun shen.process-cases (V7015) (let GoTo7016 (freeze V7015) (if (cons? V7015) (let Select7024 (tl V7015) (if (= cases (hd V7015)) (if (cons? Select7024) (let Select7022 (hd Select7024) (let Select7023 (tl Select7024) (if (and (= true Select7022) (cons? Select7023)) (hd Select7023) (let GoTo7019 (freeze (if (= () Select7023) (simple-error "error: odd number of case elements -") (thaw GoTo7016))) (if (cons? Select7023) (let Select7020 (hd Select7023) (let Select7021 (tl Select7023) (if (= () Select7021) (cons if (cons Select7022 (cons Select7020 (cons (cons simple-error (cons "error: cases exhausted" ())) ())))) (cons if (cons Select7022 (cons Select7020 (cons (shen.process-cases (cons cases Select7021)) ()))))))) (thaw GoTo7019)))))) (thaw GoTo7016)) (thaw GoTo7016))) (thaw GoTo7016)))) +(defun shen.process-cases (V5862) (let GoTo5863 (freeze V5862) (if (cons? V5862) (let Select5871 (tl V5862) (if (= cases (hd V5862)) (if (cons? Select5871) (let Select5869 (hd Select5871) (let Select5870 (tl Select5871) (if (and (= true Select5869) (cons? Select5870)) (hd Select5870) (let GoTo5866 (freeze (if (= () Select5870) (simple-error "error: odd number of case elements +") (thaw GoTo5863))) (if (cons? Select5870) (let Select5867 (hd Select5870) (let Select5868 (tl Select5870) (if (= () Select5868) (cons if (cons Select5869 (cons Select5867 (cons (cons simple-error (cons "error: cases exhausted" ())) ())))) (cons if (cons Select5869 (cons Select5867 (cons (shen.process-cases (cons cases Select5868)) ()))))))) (thaw GoTo5866)))))) (thaw GoTo5863)) (thaw GoTo5863))) (thaw GoTo5863)))) -(defun shen.process-time (V7025) (cons let (cons Start (cons (cons get-time (cons run ())) (cons Result (cons V7025 (cons Finish (cons (cons get-time (cons run ())) (cons Time (cons (cons - (cons Finish (cons Start ()))) (cons Message (cons (cons pr (cons (cons cn (cons " +(defun shen.process-time (V5872) (cons let (cons Start (cons (cons get-time (cons run ())) (cons Result (cons V5872 (cons Finish (cons (cons get-time (cons run ())) (cons Time (cons (cons - (cons Finish (cons Start ()))) (cons Message (cons (cons pr (cons (cons cn (cons " run time: " (cons (cons cn (cons (cons str (cons Time ())) (cons " secs " ()))) ()))) (cons (cons stoutput ()) ()))) (cons Result ()))))))))))))) -(defun shen.process-assoc (V7026) (if (and (cons? V7026) (and (cons? (tl V7026)) (and (cons? (tl (tl V7026))) (cons? (tl (tl (tl V7026))))))) (cons (hd V7026) (cons (hd (tl V7026)) (cons (cons (hd V7026) (tl (tl V7026))) ()))) V7026)) +(defun shen.process-assoc (V5873) (if (and (cons? V5873) (and (cons? (tl V5873)) (and (cons? (tl (tl V5873))) (cons? (tl (tl (tl V5873))))))) (cons (hd V5873) (cons (hd (tl V5873)) (cons (cons (hd V5873) (tl (tl V5873))) ()))) V5873)) -(defun shen.make-uppercase (V7027) (intern (shen.mu-h (str V7027)))) +(defun shen.make-uppercase (V5874) (intern (shen.mu-h (str V5874)))) -(defun shen.mu-h (V7028) (if (= "" V7028) "" (if (shen.+string? V7028) (let W7029 (string->n (hdstr V7028)) (let W7030 (- W7029 32) (let W7031 (if (and (>= W7029 97) (<= W7029 122)) (n->string W7030) (hdstr V7028)) (@s W7031 (shen.mu-h (tlstr V7028)))))) (shen.f-error shen.mu-h)))) +(defun shen.mu-h (V5875) (if (= "" V5875) "" (if (shen.+string? V5875) (let W5876 (string->n (hdstr V5875)) (let W5877 (- W5876 32) (let W5878 (if (and (>= W5876 97) (<= W5876 122)) (n->string W5877) (hdstr V5875)) (@s W5878 (shen.mu-h (tlstr V5875)))))) (simple-error "partial function shen.mu-h")))) -(defun shen.record-macro (V7032 V7033) (set *macros* (shen.update-assoc V7032 V7033 (value *macros*)))) +(defun shen.record-macro (V5879 V5880) (set *macros* (shen.update-assoc V5879 V5880 (value *macros*)))) -(defun shen.update-assoc (V7043 V7044 V7045) (if (= () V7045) (cons (cons V7043 V7044) ()) (let GoTo7046 (freeze (simple-error "implementation error in shen.update-assoc")) (if (cons? V7045) (let Select7047 (hd V7045) (let Select7048 (tl V7045) (if (and (cons? Select7047) (= V7043 (hd Select7047))) (cons (cons (hd Select7047) V7044) Select7048) (cons Select7047 (shen.update-assoc V7043 V7044 Select7048))))) (thaw GoTo7046))))) +(defun shen.update-assoc (V5890 V5891 V5892) (if (= () V5892) (cons (cons V5890 V5891) ()) (let GoTo5893 (freeze (simple-error "implementation error in shen.update-assoc")) (if (cons? V5892) (let Select5894 (hd V5892) (let Select5895 (tl V5892) (if (and (cons? Select5894) (= V5890 (hd Select5894))) (cons (cons (hd Select5894) V5891) Select5895) (cons Select5894 (shen.update-assoc V5890 V5891 Select5895))))) (thaw GoTo5893))))) (defun shen.process-read-byte () (if (shen.char-stinput? (stinput)) (cons string->n (cons (cons shen.read-unit-string (cons (cons stinput ()) ())) ())) (cons read-byte (cons (cons stinput ()) ())))) -(defun shen.call-prolog (V7049) (let W7050 (cons shen.prolog-vector ()) (let W7051 (cons @v (cons true (cons 0 (cons (cons vector (cons 0 ())) ())))) (let W7052 0 (let W7053 (cons freeze (cons true ())) (let W7054 (compile (lambda Z7055 (shen. Z7055)) V7049) (let W7056 (shen.received V7049) (let W7057 (gensym V) (let W7058 (gensym L) (let W7059 (gensym K) (let W7060 (gensym C) (let W7061 (cons lambda (cons W7057 (cons (cons lambda (cons W7058 (cons (cons lambda (cons W7059 (cons (cons lambda (cons W7060 (cons (shen.continue W7056 W7054 W7057 W7058 W7059 W7060) ()))) ()))) ()))) ()))) (cons W7061 (cons W7050 (cons W7051 (cons W7052 (cons W7053 ()))))))))))))))))) +(defun shen.call-prolog (V5896) (let W5897 (cons shen.prolog-vector ()) (let W5898 (cons @v (cons true (cons 0 (cons (cons vector (cons 0 ())) ())))) (let W5899 0 (let W5900 (cons freeze (cons true ())) (let W5901 (compile (lambda Z5902 (shen. Z5902)) V5896) (let W5903 (shen.received V5896) (let W5904 (gensym V) (let W5905 (gensym L) (let W5906 (gensym K) (let W5907 (gensym C) (let W5908 (cons lambda (cons W5904 (cons (cons lambda (cons W5905 (cons (cons lambda (cons W5906 (cons (cons lambda (cons W5907 (cons (shen.continue W5903 W5901 W5904 W5905 W5906 W5907) ()))) ()))) ()))) ()))) (cons W5908 (cons W5897 (cons W5898 (cons W5899 (cons W5900 ()))))))))))))))))) -(defun shen.received (V7064) (let GoTo7065 (freeze ()) (if (cons? V7064) (let Select7066 (hd V7064) (let Select7067 (tl V7064) (if (and (= receive Select7066) (and (cons? Select7067) (= () (tl Select7067)))) Select7067 (union (shen.received Select7066) (shen.received Select7067))))) (thaw GoTo7065)))) +(defun shen.received (V5911) (let GoTo5912 (freeze ()) (if (cons? V5911) (let Select5913 (hd V5911) (let Select5914 (tl V5911) (if (and (= receive Select5913) (and (cons? Select5914) (= () (tl Select5914)))) Select5914 (union (shen.received Select5913) (shen.received Select5914))))) (thaw GoTo5912)))) -(defun shen.prolog-vector () (let W7068 (absvector (value shen.*prolog-memory*)) (let W7069 (address-> W7068 0 shen.print-prolog-vector) (let W7070 (address-> W7068 1 2) W7070)))) +(defun shen.prolog-vector () (let W5915 (absvector (value shen.*prolog-memory*)) (let W5916 (address-> W5915 0 shen.print-prolog-vector) (let W5917 (address-> W5915 1 2) W5917)))) -(defun receive (V7071) V7071) +(defun receive (V5918) V5918) -(defun shen.rcons_form (V7072) (if (cons? V7072) (cons cons (cons (shen.rcons_form (hd V7072)) (cons (shen.rcons_form (tl V7072)) ()))) V7072)) +(defun shen.rcons_form (V5919) (if (cons? V5919) (cons cons (cons (shen.rcons_form (hd V5919)) (cons (shen.rcons_form (tl V5919)) ()))) V5919)) -(defun shen.tuple-up (V7073) (if (cons? V7073) (cons @p (cons (hd V7073) (cons (shen.tuple-up (tl V7073)) ()))) V7073)) +(defun shen.tuple-up (V5920) (if (cons? V5920) (cons @p (cons (hd V5920) (cons (shen.tuple-up (tl V5920)) ()))) V5920)) -(defun undefmacro (V7074) (do (set *macros* (remove (assoc V7074 (value *macros*)) (value *macros*))) V7074)) +(defun undefmacro (V5921) (do (set *macros* (remove (assoc V5921 (value *macros*)) (value *macros*))) V5921)) diff --git a/klambda/prolog.kl b/klambda/prolog.kl index 60513f9..6ddc724 100644 --- a/klambda/prolog.kl +++ b/klambda/prolog.kl @@ -1,202 +1,202 @@ -(defun asserta (V1577) (shen.assert* V1577 shen.top)) +(defun asserta (V1231) (shen.assert* V1231 shen.top)) -(defun assertz (V1578) (shen.assert* V1578 shen.bottom)) +(defun assertz (V1232) (shen.assert* V1232 shen.bottom)) -(defun shen.assert* (V1579 V1580) (cond ((and (cons? V1579) (and (cons? (tl V1579)) (= <-- (hd (tl V1579))))) (let W1581 (shen.predicate (hd V1579)) (let W1582 (shen.terms (hd V1579)) (let W1583 (length W1582) (let W1584 (shen.parameters W1583) (let W1585 (arity W1581) (let W1586 (if (= W1585 -1) (do (eval (shen.create-skeleton W1581 W1584)) (put W1581 shen.dynamic () (value *property-vector*))) shen.skip) (let W1587 (shen.insert-info W1581 W1582 (tl (tl V1579)) V1579 V1580) W1581)))))))) (true (shen.f-error shen.assert*)))) +(defun shen.assert* (V1233 V1234) (cond ((and (cons? V1233) (and (cons? (tl V1233)) (= <-- (hd (tl V1233))))) (let W1235 (shen.predicate (hd V1233)) (let W1236 (shen.terms (hd V1233)) (let W1237 (length W1236) (let W1238 (shen.parameters W1237) (let W1239 (arity W1235) (let W1240 (if (= W1239 -1) (do (eval (shen.create-skeleton W1235 W1238)) (put W1235 shen.dynamic () (value *property-vector*))) shen.skip) (let W1241 (shen.insert-info W1235 W1236 (tl (tl V1233)) V1233 V1234) W1235)))))))) (true (simple-error "partial function shen.assert*")))) -(defun shen.predicate (V1590) (cond ((cons? V1590) (hd V1590)) (true V1590))) +(defun shen.predicate (V1244) (cond ((cons? V1244) (hd V1244)) (true V1244))) -(defun shen.terms (V1595) (cond ((cons? V1595) (tl V1595)) (true ()))) +(defun shen.terms (V1249) (cond ((cons? V1249) (tl V1249)) (true ()))) -(defun shen.create-skeleton (V1596 V1597) (cons defprolog (cons V1596 (shen.dynamic-default V1596 V1597)))) +(defun shen.create-skeleton (V1250 V1251) (cons defprolog (cons V1250 (shen.dynamic-default V1250 V1251)))) -(defun shen.dynamic-default (V1598 V1599) (append V1599 (cons <-- (cons (cons shen.call-dynamic (cons (shen.cons-form V1599) (cons (cons get (cons V1598 (cons shen.dynamic ()))) ()))) (cons (intern ";") ()))))) +(defun shen.dynamic-default (V1252 V1253) (append V1253 (cons <-- (cons (cons shen.call-dynamic (cons (shen.cons-form V1253) (cons (cons get (cons V1252 (cons shen.dynamic ()))) ()))) (cons (intern ";") ()))))) -(defun shen.insert-info (V1600 V1601 V1602 V1603 V1604) (let W1605 (gensym shen.g) (let W1606 (eval (append (cons defprolog (cons W1605 ())) (append V1601 (cons <-- V1602)))) (let W1607 (cons (fn W1605) (cons W1605 V1603)) (let W1608 (get V1600 shen.dynamic (value *property-vector*)) (let W1609 (if (= V1604 shen.top) (cons W1607 W1608) (append W1608 (cons W1607 ()))) (put V1600 shen.dynamic W1609 (value *property-vector*)))))))) +(defun shen.insert-info (V1254 V1255 V1256 V1257 V1258) (let W1259 (gensym shen.g) (let W1260 (eval (append (cons defprolog (cons W1259 ())) (append V1255 (cons <-- V1256)))) (let W1261 (cons (fn W1259) (cons W1259 V1257)) (let W1262 (get V1254 shen.dynamic (value *property-vector*)) (let W1263 (if (= V1258 shen.top) (cons W1261 W1262) (append W1262 (cons W1261 ()))) (put V1254 shen.dynamic W1263 (value *property-vector*)))))))) -(defun shen.newname () (let W1610 (value shen.*names*) (let W1611 (if (empty? W1610) (gensym shen.g) (do (set shen.*names* (tl W1610)) (hd W1610))) W1611))) +(defun shen.newname () (let W1264 (value shen.*names*) (let W1265 (if (empty? W1264) (gensym shen.g) (do (set shen.*names* (tl W1264)) (hd W1264))) W1265))) -(defun shen.call-dynamic (V1612 V1613 V1614 V1615 V1616 V1617) (let W1618 (if (shen.unlocked? V1615) (let W1619 (shen.lazyderef V1613 V1614) (if (cons? W1619) (let W1620 (shen.lazyderef (hd W1619) V1614) (if (cons? W1620) (let W1621 (hd W1620) (do (shen.incinfs) (shen.callrec W1621 V1612 V1614 V1615 V1616 V1617))) false)) false)) false) (if (= W1618 false) (if (shen.unlocked? V1615) (let W1622 (shen.lazyderef V1613 V1614) (if (cons? W1622) (let W1623 (tl W1622) (do (shen.incinfs) (shen.call-dynamic V1612 W1623 V1614 V1615 V1616 V1617))) false)) false) W1618))) +(defun shen.call-dynamic (V1266 V1267 V1268 V1269 V1270 V1271) (let W1272 (if (shen.unlocked? V1269) (let W1273 (shen.lazyderef V1267 V1268) (if (cons? W1273) (let W1274 (shen.lazyderef (hd W1273) V1268) (if (cons? W1274) (let W1275 (hd W1274) (do (shen.incinfs) (shen.callrec W1275 V1266 V1268 V1269 V1270 V1271))) false)) false)) false) (if (= W1272 false) (if (shen.unlocked? V1269) (let W1276 (shen.lazyderef V1267 V1268) (if (cons? W1276) (let W1277 (tl W1276) (do (shen.incinfs) (shen.call-dynamic V1266 W1277 V1268 V1269 V1270 V1271))) false)) false) W1272))) -(defun shen.callrec (V1624 V1625 V1626 V1627 V1628 V1629) (cond ((= () V1625) ((((V1624 V1626) V1627) V1628) V1629)) ((cons? V1625) (shen.callrec (V1624 (hd V1625)) (tl V1625) V1626 V1627 V1628 V1629)) (true (shen.f-error shen.callrec)))) +(defun shen.callrec (V1278 V1279 V1280 V1281 V1282 V1283) (cond ((= () V1279) ((((V1278 V1280) V1281) V1282) V1283)) ((cons? V1279) (shen.callrec (V1278 (hd V1279)) (tl V1279) V1280 V1281 V1282 V1283)) (true (simple-error "partial function shen.callrec")))) -(defun retract (V1630) (cond ((and (cons? V1630) (and (cons? (tl V1630)) (= <-- (hd (tl V1630))))) (let W1631 (shen.predicate (hd V1630)) (let W1632 (get W1631 shen.dynamic (value *property-vector*)) (put W1631 shen.dynamic (shen.retract-clause V1630 W1632) (value *property-vector*))))) (true (shen.f-error retract)))) +(defun retract (V1284) (cond ((and (cons? V1284) (and (cons? (tl V1284)) (= <-- (hd (tl V1284))))) (let W1285 (shen.predicate (hd V1284)) (let W1286 (get W1285 shen.dynamic (value *property-vector*)) (put W1285 shen.dynamic (shen.retract-clause V1284 W1286) (value *property-vector*))))) (true (simple-error "partial function retract")))) -(defun shen.retract-clause (V1638 V1639) (cond ((= () V1639) ()) ((and (cons? V1639) (and (cons? (hd V1639)) (and (cons? (tl (hd V1639))) (= V1638 (tl (tl (hd V1639))))))) (do (set shen.*names* (cons (hd (tl (hd V1639))) (value shen.*names*))) (tl V1639))) ((cons? V1639) (cons (hd V1639) (shen.retract-clause V1638 (tl V1639)))) (true (shen.f-error shen.retract-clause)))) +(defun shen.retract-clause (V1292 V1293) (cond ((= () V1293) ()) ((and (cons? V1293) (and (cons? (hd V1293)) (and (cons? (tl (hd V1293))) (= V1292 (tl (tl (hd V1293))))))) (do (set shen.*names* (cons (hd (tl (hd V1293))) (value shen.*names*))) (tl V1293))) ((cons? V1293) (cons (hd V1293) (shen.retract-clause V1292 (tl V1293)))) (true (simple-error "partial function shen.retract-clause")))) -(defun shen.compile-prolog (V1640 V1641) (compile (lambda Z1642 (shen. Z1642)) (cons V1640 V1641))) +(defun shen.compile-prolog (V1294 V1295) (compile (lambda Z1296 (shen. Z1296)) (cons V1294 V1295))) -(defun shen. (V1643) (let W1644 (if (cons? V1643) (let W1645 (head V1643) (let W1646 (tail V1643) (let W1647 (shen. W1646) (if (shen.parse-failure? W1647) (shen.parse-failure) (let W1648 (shen.<-out W1647) (let W1649 (shen.in-> W1647) (shen.comb W1649 (let W1650 (shen.prolog-arity-check W1645 W1648) (let W1651 (map (lambda Z1652 (shen.linearise-clause Z1652)) W1648) (shen.horn-clause-procedure W1645 W1651)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W1644) (shen.parse-failure) W1644))) +(defun shen. (V1297) (let W1298 (if (cons? V1297) (let W1299 (head V1297) (let W1300 (tail V1297) (let W1301 (shen. W1300) (if (shen.parse-failure? W1301) (shen.parse-failure) (let W1302 (shen.<-out W1301) (let W1303 (shen.in-> W1301) (shen.comb W1303 (let W1304 (shen.prolog-arity-check W1299 W1302) (let W1305 (map (lambda Z1306 (shen.linearise-clause Z1306)) W1302) (shen.horn-clause-procedure W1299 W1305)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W1298) (shen.parse-failure) W1298))) -(defun shen.prolog-arity-check (V1655 V1656) (cond ((and (cons? V1656) (and (cons? (hd V1656)) (and (cons? (tl (hd V1656))) (and (= () (tl (tl (hd V1656)))) (= () (tl V1656)))))) (length (hd (hd V1656)))) ((and (cons? V1656) (and (cons? (hd V1656)) (and (cons? (tl (hd V1656))) (= () (tl (tl (hd V1656))))))) (shen.pac-h V1655 (length (hd (hd V1656))) (tl V1656))) (true (shen.f-error shen.prolog-arity-check)))) +(defun shen.prolog-arity-check (V1309 V1310) (cond ((and (cons? V1310) (and (cons? (hd V1310)) (and (cons? (tl (hd V1310))) (and (= () (tl (tl (hd V1310)))) (= () (tl V1310)))))) (length (hd (hd V1310)))) ((and (cons? V1310) (and (cons? (hd V1310)) (and (cons? (tl (hd V1310))) (= () (tl (tl (hd V1310))))))) (shen.pac-h V1309 (length (hd (hd V1310))) (tl V1310))) (true (simple-error "partial function shen.prolog-arity-check")))) -(defun shen.pac-h (V1661 V1662 V1663) (cond ((= () V1663) V1662) ((and (cons? V1663) (cons? (hd V1663))) (if (= V1662 (length (hd (hd V1663)))) (shen.pac-h V1661 V1662 (tl V1663)) (simple-error (cn "arity error in prolog procedure " (shen.app V1661 " -" shen.a))))) (true (shen.f-error shen.pac-h)))) +(defun shen.pac-h (V1315 V1316 V1317) (cond ((= () V1317) V1316) ((and (cons? V1317) (cons? (hd V1317))) (if (= V1316 (length (hd (hd V1317)))) (shen.pac-h V1315 V1316 (tl V1317)) (simple-error (cn "arity error in prolog procedure " (shen.app V1315 " +" shen.a))))) (true (simple-error "partial function shen.pac-h")))) -(defun shen. (V1664) (let W1665 (let W1666 (shen. V1664) (if (shen.parse-failure? W1666) (shen.parse-failure) (let W1667 (shen.<-out W1666) (let W1668 (shen.in-> W1666) (let W1669 (shen. W1668) (if (shen.parse-failure? W1669) (shen.parse-failure) (let W1670 (shen.<-out W1669) (let W1671 (shen.in-> W1669) (shen.comb W1671 (cons W1667 W1670)))))))))) (if (shen.parse-failure? W1665) (let W1672 (let W1673 ( V1664) (if (shen.parse-failure? W1673) (shen.parse-failure) (let W1674 (shen.<-out W1673) (let W1675 (shen.in-> W1673) (shen.comb W1675 (if (empty? W1674) () (simple-error (cn "Prolog syntax error here: - " (shen.app W1674 " - ..." shen.r))))))))) (if (shen.parse-failure? W1672) (shen.parse-failure) W1672)) W1665))) +(defun shen. (V1318) (let W1319 (let W1320 (shen. V1318) (if (shen.parse-failure? W1320) (shen.parse-failure) (let W1321 (shen.<-out W1320) (let W1322 (shen.in-> W1320) (let W1323 (shen. W1322) (if (shen.parse-failure? W1323) (shen.parse-failure) (let W1324 (shen.<-out W1323) (let W1325 (shen.in-> W1323) (shen.comb W1325 (cons W1321 W1324)))))))))) (if (shen.parse-failure? W1319) (let W1326 (let W1327 ( V1318) (if (shen.parse-failure? W1327) (shen.parse-failure) (let W1328 (shen.<-out W1327) (let W1329 (shen.in-> W1327) (shen.comb W1329 (if (empty? W1328) () (simple-error (cn "Prolog syntax error here: + " (shen.app W1328 " + ..." shen.r))))))))) (if (shen.parse-failure? W1326) (shen.parse-failure) W1326)) W1319))) -(defun shen.linearise-clause (V1676) (cond ((and (cons? V1676) (and (cons? (tl V1676)) (= () (tl (tl V1676))))) (shen.lch (shen.linearise (@p (hd V1676) (hd (tl V1676)))))) (true (shen.f-error shen.linearise-clause)))) +(defun shen.linearise-clause (V1330) (cond ((and (cons? V1330) (and (cons? (tl V1330)) (= () (tl (tl V1330))))) (shen.lch (shen.linearise (@p (hd V1330) (hd (tl V1330)))))) (true (simple-error "partial function shen.linearise-clause")))) -(defun shen.lch (V1677) (cond ((tuple? V1677) (cons (fst V1677) (cons (shen.lchh (snd V1677)) ()))) (true (shen.f-error shen.lch)))) +(defun shen.lch (V1331) (cond ((tuple? V1331) (cons (fst V1331) (cons (shen.lchh (snd V1331)) ()))) (true (simple-error "partial function shen.lch")))) -(defun shen.lchh (V1678) (cond ((and (cons? V1678) (and (= where (hd V1678)) (and (cons? (tl V1678)) (and (cons? (hd (tl V1678))) (and (= = (hd (hd (tl V1678)))) (and (cons? (tl (hd (tl V1678)))) (and (cons? (tl (tl (hd (tl V1678))))) (and (= () (tl (tl (tl (hd (tl V1678)))))) (and (cons? (tl (tl V1678))) (= () (tl (tl (tl V1678))))))))))))) (cons (cons (if (value shen.*occurs*) is! is) (tl (hd (tl V1678)))) (shen.lchh (hd (tl (tl V1678)))))) (true V1678))) +(defun shen.lchh (V1332) (cond ((and (cons? V1332) (and (= where (hd V1332)) (and (cons? (tl V1332)) (and (cons? (hd (tl V1332))) (and (= = (hd (hd (tl V1332)))) (and (cons? (tl (hd (tl V1332)))) (and (cons? (tl (tl (hd (tl V1332))))) (and (= () (tl (tl (tl (hd (tl V1332)))))) (and (cons? (tl (tl V1332))) (= () (tl (tl (tl V1332))))))))))))) (cons (cons (if (value shen.*occurs*) is! is) (tl (hd (tl V1332)))) (shen.lchh (hd (tl (tl V1332)))))) (true V1332))) -(defun shen. (V1679) (let W1680 (let W1681 (shen. V1679) (if (shen.parse-failure? W1681) (shen.parse-failure) (let W1682 (shen.<-out W1681) (let W1683 (shen.in-> W1681) (if (shen.hds=? W1683 <--) (let W1684 (tail W1683) (let W1685 (shen. W1684) (if (shen.parse-failure? W1685) (shen.parse-failure) (let W1686 (shen.<-out W1685) (let W1687 (shen.in-> W1685) (let W1688 (shen. W1687) (if (shen.parse-failure? W1688) (shen.parse-failure) (let W1689 (shen.in-> W1688) (shen.comb W1689 (cons W1682 (cons W1686 ()))))))))))) (shen.parse-failure)))))) (if (shen.parse-failure? W1680) (shen.parse-failure) W1680))) +(defun shen. (V1333) (let W1334 (let W1335 (shen. V1333) (if (shen.parse-failure? W1335) (shen.parse-failure) (let W1336 (shen.<-out W1335) (let W1337 (shen.in-> W1335) (if (shen.hds=? W1337 <--) (let W1338 (tail W1337) (let W1339 (shen. W1338) (if (shen.parse-failure? W1339) (shen.parse-failure) (let W1340 (shen.<-out W1339) (let W1341 (shen.in-> W1339) (let W1342 (shen. W1341) (if (shen.parse-failure? W1342) (shen.parse-failure) (let W1343 (shen.in-> W1342) (shen.comb W1343 (cons W1336 (cons W1340 ()))))))))))) (shen.parse-failure)))))) (if (shen.parse-failure? W1334) (shen.parse-failure) W1334))) -(defun shen. (V1690) (let W1691 (let W1692 (shen. V1690) (if (shen.parse-failure? W1692) (shen.parse-failure) (let W1693 (shen.<-out W1692) (let W1694 (shen.in-> W1692) (let W1695 (shen. W1694) (if (shen.parse-failure? W1695) (shen.parse-failure) (let W1696 (shen.<-out W1695) (let W1697 (shen.in-> W1695) (shen.comb W1697 (cons W1693 W1696)))))))))) (if (shen.parse-failure? W1691) (let W1698 (let W1699 ( V1690) (if (shen.parse-failure? W1699) (shen.parse-failure) (let W1700 (shen.in-> W1699) (shen.comb W1700 ())))) (if (shen.parse-failure? W1698) (shen.parse-failure) W1698)) W1691))) +(defun shen. (V1344) (let W1345 (let W1346 (shen. V1344) (if (shen.parse-failure? W1346) (shen.parse-failure) (let W1347 (shen.<-out W1346) (let W1348 (shen.in-> W1346) (let W1349 (shen. W1348) (if (shen.parse-failure? W1349) (shen.parse-failure) (let W1350 (shen.<-out W1349) (let W1351 (shen.in-> W1349) (shen.comb W1351 (cons W1347 W1350)))))))))) (if (shen.parse-failure? W1345) (let W1352 (let W1353 ( V1344) (if (shen.parse-failure? W1353) (shen.parse-failure) (let W1354 (shen.in-> W1353) (shen.comb W1354 ())))) (if (shen.parse-failure? W1352) (shen.parse-failure) W1352)) W1345))) -(defun shen. (V1701) (let W1702 (if (cons? V1701) (let W1703 (head V1701) (let W1704 (tail V1701) (if (and (atom? W1703) (not (shen.prolog-keyword? W1703))) (shen.comb W1704 W1703) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1702) (let W1705 (if (cons? V1701) (let W1706 (head V1701) (let W1707 (tail V1701) (if (= W1706 (intern ":")) (shen.comb W1707 W1706) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1705) (let W1708 (if (shen.ccons? V1701) (let W1709 (head V1701) (let W1710 (tail V1701) (if (shen.hds=? W1709 cons) (let W1711 (tail W1709) (let W1712 (shen. W1711) (if (shen.parse-failure? W1712) (shen.parse-failure) (let W1713 (shen.<-out W1712) (let W1714 (shen.in-> W1712) (let W1715 (shen. W1714) (if (shen.parse-failure? W1715) (shen.parse-failure) (let W1716 (shen.<-out W1715) (let W1717 (shen.in-> W1715) (let W1718 ( W1717) (if (shen.parse-failure? W1718) (shen.parse-failure) (let W1719 (shen.in-> W1718) (shen.comb W1710 (cons cons (cons W1713 (cons W1716 ())))))))))))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1708) (let W1720 (if (shen.ccons? V1701) (let W1721 (head V1701) (let W1722 (tail V1701) (if (shen.hds=? W1721 +) (let W1723 (tail W1721) (let W1724 (shen. W1723) (if (shen.parse-failure? W1724) (shen.parse-failure) (let W1725 (shen.<-out W1724) (let W1726 (shen.in-> W1724) (let W1727 ( W1726) (if (shen.parse-failure? W1727) (shen.parse-failure) (let W1728 (shen.in-> W1727) (shen.comb W1722 (cons shen.+m (cons W1725 ()))))))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1720) (let W1729 (if (shen.ccons? V1701) (let W1730 (head V1701) (let W1731 (tail V1701) (if (shen.hds=? W1730 -) (let W1732 (tail W1730) (let W1733 (shen. W1732) (if (shen.parse-failure? W1733) (shen.parse-failure) (let W1734 (shen.<-out W1733) (let W1735 (shen.in-> W1733) (let W1736 ( W1735) (if (shen.parse-failure? W1736) (shen.parse-failure) (let W1737 (shen.in-> W1736) (shen.comb W1731 (cons shen.-m (cons W1734 ()))))))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1729) (let W1738 (if (shen.ccons? V1701) (let W1739 (head V1701) (let W1740 (tail V1701) (if (shen.hds=? W1739 mode) (let W1741 (tail W1739) (let W1742 (shen. W1741) (if (shen.parse-failure? W1742) (shen.parse-failure) (let W1743 (shen.<-out W1742) (let W1744 (shen.in-> W1742) (if (shen.hds=? W1744 +) (let W1745 (tail W1744) (let W1746 ( W1745) (if (shen.parse-failure? W1746) (shen.parse-failure) (let W1747 (shen.in-> W1746) (shen.comb W1740 (cons shen.+m (cons W1743 ()))))))) (shen.parse-failure))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1738) (let W1748 (if (shen.ccons? V1701) (let W1749 (head V1701) (let W1750 (tail V1701) (if (shen.hds=? W1749 mode) (let W1751 (tail W1749) (let W1752 (shen. W1751) (if (shen.parse-failure? W1752) (shen.parse-failure) (let W1753 (shen.<-out W1752) (let W1754 (shen.in-> W1752) (if (shen.hds=? W1754 -) (let W1755 (tail W1754) (let W1756 ( W1755) (if (shen.parse-failure? W1756) (shen.parse-failure) (let W1757 (shen.in-> W1756) (shen.comb W1750 (cons shen.-m (cons W1753 ()))))))) (shen.parse-failure))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1748) (shen.parse-failure) W1748)) W1738)) W1729)) W1720)) W1708)) W1705)) W1702))) +(defun shen. (V1355) (let W1356 (if (cons? V1355) (let W1357 (head V1355) (let W1358 (tail V1355) (if (and (atom? W1357) (not (shen.prolog-keyword? W1357))) (shen.comb W1358 W1357) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1356) (let W1359 (if (cons? V1355) (let W1360 (head V1355) (let W1361 (tail V1355) (if (= W1360 (intern ":")) (shen.comb W1361 W1360) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1359) (let W1362 (if (shen.ccons? V1355) (let W1363 (head V1355) (let W1364 (tail V1355) (if (shen.hds=? W1363 cons) (let W1365 (tail W1363) (let W1366 (shen. W1365) (if (shen.parse-failure? W1366) (shen.parse-failure) (let W1367 (shen.<-out W1366) (let W1368 (shen.in-> W1366) (let W1369 (shen. W1368) (if (shen.parse-failure? W1369) (shen.parse-failure) (let W1370 (shen.<-out W1369) (let W1371 (shen.in-> W1369) (let W1372 ( W1371) (if (shen.parse-failure? W1372) (shen.parse-failure) (let W1373 (shen.in-> W1372) (shen.comb W1364 (cons cons (cons W1367 (cons W1370 ())))))))))))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1362) (let W1374 (if (shen.ccons? V1355) (let W1375 (head V1355) (let W1376 (tail V1355) (if (shen.hds=? W1375 +) (let W1377 (tail W1375) (let W1378 (shen. W1377) (if (shen.parse-failure? W1378) (shen.parse-failure) (let W1379 (shen.<-out W1378) (let W1380 (shen.in-> W1378) (let W1381 ( W1380) (if (shen.parse-failure? W1381) (shen.parse-failure) (let W1382 (shen.in-> W1381) (shen.comb W1376 (cons shen.+m (cons W1379 ()))))))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1374) (let W1383 (if (shen.ccons? V1355) (let W1384 (head V1355) (let W1385 (tail V1355) (if (shen.hds=? W1384 -) (let W1386 (tail W1384) (let W1387 (shen. W1386) (if (shen.parse-failure? W1387) (shen.parse-failure) (let W1388 (shen.<-out W1387) (let W1389 (shen.in-> W1387) (let W1390 ( W1389) (if (shen.parse-failure? W1390) (shen.parse-failure) (let W1391 (shen.in-> W1390) (shen.comb W1385 (cons shen.-m (cons W1388 ()))))))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1383) (let W1392 (if (shen.ccons? V1355) (let W1393 (head V1355) (let W1394 (tail V1355) (if (shen.hds=? W1393 mode) (let W1395 (tail W1393) (let W1396 (shen. W1395) (if (shen.parse-failure? W1396) (shen.parse-failure) (let W1397 (shen.<-out W1396) (let W1398 (shen.in-> W1396) (if (shen.hds=? W1398 +) (let W1399 (tail W1398) (let W1400 ( W1399) (if (shen.parse-failure? W1400) (shen.parse-failure) (let W1401 (shen.in-> W1400) (shen.comb W1394 (cons shen.+m (cons W1397 ()))))))) (shen.parse-failure))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1392) (let W1402 (if (shen.ccons? V1355) (let W1403 (head V1355) (let W1404 (tail V1355) (if (shen.hds=? W1403 mode) (let W1405 (tail W1403) (let W1406 (shen. W1405) (if (shen.parse-failure? W1406) (shen.parse-failure) (let W1407 (shen.<-out W1406) (let W1408 (shen.in-> W1406) (if (shen.hds=? W1408 -) (let W1409 (tail W1408) (let W1410 ( W1409) (if (shen.parse-failure? W1410) (shen.parse-failure) (let W1411 (shen.in-> W1410) (shen.comb W1404 (cons shen.-m (cons W1407 ()))))))) (shen.parse-failure))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1402) (shen.parse-failure) W1402)) W1392)) W1383)) W1374)) W1362)) W1359)) W1356))) -(defun shen.prolog-keyword? (V1758) (element? V1758 (cons (intern ";") (cons <-- ())))) +(defun shen.prolog-keyword? (V1412) (element? V1412 (cons (intern ";") (cons <-- ())))) -(defun atom? (V1759) (or (symbol? V1759) (or (string? V1759) (or (boolean? V1759) (or (number? V1759) (empty? V1759)))))) +(defun atom? (V1413) (or (symbol? V1413) (or (string? V1413) (or (boolean? V1413) (or (number? V1413) (empty? V1413)))))) -(defun shen. (V1760) (let W1761 (let W1762 (shen. V1760) (if (shen.parse-failure? W1762) (shen.parse-failure) (let W1763 (shen.<-out W1762) (let W1764 (shen.in-> W1762) (shen.comb W1764 W1763))))) (if (shen.parse-failure? W1761) (shen.parse-failure) W1761))) +(defun shen. (V1414) (let W1415 (let W1416 (shen. V1414) (if (shen.parse-failure? W1416) (shen.parse-failure) (let W1417 (shen.<-out W1416) (let W1418 (shen.in-> W1416) (shen.comb W1418 W1417))))) (if (shen.parse-failure? W1415) (shen.parse-failure) W1415))) -(defun shen. (V1765) (let W1766 (let W1767 (shen. V1765) (if (shen.parse-failure? W1767) (shen.parse-failure) (let W1768 (shen.<-out W1767) (let W1769 (shen.in-> W1767) (shen.comb W1769 W1768))))) (if (shen.parse-failure? W1766) (shen.parse-failure) W1766))) +(defun shen. (V1419) (let W1420 (let W1421 (shen. V1419) (if (shen.parse-failure? W1421) (shen.parse-failure) (let W1422 (shen.<-out W1421) (let W1423 (shen.in-> W1421) (shen.comb W1423 W1422))))) (if (shen.parse-failure? W1420) (shen.parse-failure) W1420))) -(defun shen. (V1770) (let W1771 (let W1772 (shen. V1770) (if (shen.parse-failure? W1772) (shen.parse-failure) (let W1773 (shen.<-out W1772) (let W1774 (shen.in-> W1772) (let W1775 (shen. W1774) (if (shen.parse-failure? W1775) (shen.parse-failure) (let W1776 (shen.<-out W1775) (let W1777 (shen.in-> W1775) (shen.comb W1777 (cons W1773 W1776)))))))))) (if (shen.parse-failure? W1771) (let W1778 (let W1779 ( V1770) (if (shen.parse-failure? W1779) (shen.parse-failure) (let W1780 (shen.in-> W1779) (shen.comb W1780 ())))) (if (shen.parse-failure? W1778) (shen.parse-failure) W1778)) W1771))) +(defun shen. (V1424) (let W1425 (let W1426 (shen. V1424) (if (shen.parse-failure? W1426) (shen.parse-failure) (let W1427 (shen.<-out W1426) (let W1428 (shen.in-> W1426) (let W1429 (shen. W1428) (if (shen.parse-failure? W1429) (shen.parse-failure) (let W1430 (shen.<-out W1429) (let W1431 (shen.in-> W1429) (shen.comb W1431 (cons W1427 W1430)))))))))) (if (shen.parse-failure? W1425) (let W1432 (let W1433 ( V1424) (if (shen.parse-failure? W1433) (shen.parse-failure) (let W1434 (shen.in-> W1433) (shen.comb W1434 ())))) (if (shen.parse-failure? W1432) (shen.parse-failure) W1432)) W1425))) -(defun shen. (V1781) (let W1782 (if (shen.hds=? V1781 !) (let W1783 (tail V1781) (shen.comb W1783 !)) (shen.parse-failure)) (if (shen.parse-failure? W1782) (let W1784 (if (shen.ccons? V1781) (let W1785 (head V1781) (let W1786 (tail V1781) (let W1787 (shen. W1785) (if (shen.parse-failure? W1787) (shen.parse-failure) (let W1788 (shen.<-out W1787) (let W1789 (shen.in-> W1787) (let W1790 ( W1789) (if (shen.parse-failure? W1790) (shen.parse-failure) (let W1791 (shen.in-> W1790) (shen.comb W1786 W1788)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W1784) (shen.parse-failure) W1784)) W1782))) +(defun shen. (V1435) (let W1436 (if (shen.hds=? V1435 !) (let W1437 (tail V1435) (shen.comb W1437 !)) (shen.parse-failure)) (if (shen.parse-failure? W1436) (let W1438 (if (shen.ccons? V1435) (let W1439 (head V1435) (let W1440 (tail V1435) (let W1441 (shen. W1439) (if (shen.parse-failure? W1441) (shen.parse-failure) (let W1442 (shen.<-out W1441) (let W1443 (shen.in-> W1441) (let W1444 ( W1443) (if (shen.parse-failure? W1444) (shen.parse-failure) (let W1445 (shen.in-> W1444) (shen.comb W1440 W1442)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W1438) (shen.parse-failure) W1438)) W1436))) -(defun shen. (V1792) (let W1793 (let W1794 (shen. V1792) (if (shen.parse-failure? W1794) (shen.parse-failure) (let W1795 (shen.<-out W1794) (let W1796 (shen.in-> W1794) (let W1797 (shen. W1796) (if (shen.parse-failure? W1797) (shen.parse-failure) (let W1798 (shen.<-out W1797) (let W1799 (shen.in-> W1797) (shen.comb W1799 (cons W1795 W1798)))))))))) (if (shen.parse-failure? W1793) (let W1800 (let W1801 ( V1792) (if (shen.parse-failure? W1801) (shen.parse-failure) (let W1802 (shen.in-> W1801) (shen.comb W1802 ())))) (if (shen.parse-failure? W1800) (shen.parse-failure) W1800)) W1793))) +(defun shen. (V1446) (let W1447 (let W1448 (shen. V1446) (if (shen.parse-failure? W1448) (shen.parse-failure) (let W1449 (shen.<-out W1448) (let W1450 (shen.in-> W1448) (let W1451 (shen. W1450) (if (shen.parse-failure? W1451) (shen.parse-failure) (let W1452 (shen.<-out W1451) (let W1453 (shen.in-> W1451) (shen.comb W1453 (cons W1449 W1452)))))))))) (if (shen.parse-failure? W1447) (let W1454 (let W1455 ( V1446) (if (shen.parse-failure? W1455) (shen.parse-failure) (let W1456 (shen.in-> W1455) (shen.comb W1456 ())))) (if (shen.parse-failure? W1454) (shen.parse-failure) W1454)) W1447))) -(defun shen. (V1803) (let W1804 (let W1805 (shen. V1803) (if (shen.parse-failure? W1805) (shen.parse-failure) (let W1806 (shen.<-out W1805) (let W1807 (shen.in-> W1805) (shen.comb W1807 W1806))))) (if (shen.parse-failure? W1804) (let W1808 (if (cons? V1803) (let W1809 (head V1803) (let W1810 (tail V1803) (if (atom? W1809) (shen.comb W1810 W1809) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1808) (let W1811 (if (shen.ccons? V1803) (let W1812 (head V1803) (let W1813 (tail V1803) (let W1814 (shen. W1812) (if (shen.parse-failure? W1814) (shen.parse-failure) (let W1815 (shen.<-out W1814) (let W1816 (shen.in-> W1814) (let W1817 ( W1816) (if (shen.parse-failure? W1817) (shen.parse-failure) (let W1818 (shen.in-> W1817) (shen.comb W1813 W1815)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W1811) (shen.parse-failure) W1811)) W1808)) W1804))) +(defun shen. (V1457) (let W1458 (let W1459 (shen. V1457) (if (shen.parse-failure? W1459) (shen.parse-failure) (let W1460 (shen.<-out W1459) (let W1461 (shen.in-> W1459) (shen.comb W1461 W1460))))) (if (shen.parse-failure? W1458) (let W1462 (if (cons? V1457) (let W1463 (head V1457) (let W1464 (tail V1457) (if (atom? W1463) (shen.comb W1464 W1463) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1462) (let W1465 (if (shen.ccons? V1457) (let W1466 (head V1457) (let W1467 (tail V1457) (let W1468 (shen. W1466) (if (shen.parse-failure? W1468) (shen.parse-failure) (let W1469 (shen.<-out W1468) (let W1470 (shen.in-> W1468) (let W1471 ( W1470) (if (shen.parse-failure? W1471) (shen.parse-failure) (let W1472 (shen.in-> W1471) (shen.comb W1467 W1469)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W1465) (shen.parse-failure) W1465)) W1462)) W1458))) -(defun shen. (V1819) (let W1820 (if (cons? V1819) (let W1821 (head V1819) (let W1822 (tail V1819) (if (= W1821 _) (shen.comb W1822 (gensym Y)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1820) (shen.parse-failure) W1820))) +(defun shen. (V1473) (let W1474 (if (cons? V1473) (let W1475 (head V1473) (let W1476 (tail V1473) (if (= W1475 _) (shen.comb W1476 (gensym Y)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1474) (shen.parse-failure) W1474))) -(defun shen. (V1823) (let W1824 (if (cons? V1823) (let W1825 (head V1823) (let W1826 (tail V1823) (if (shen.semicolon? W1825) (shen.comb W1826 W1825) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1824) (shen.parse-failure) W1824))) +(defun shen. (V1477) (let W1478 (if (cons? V1477) (let W1479 (head V1477) (let W1480 (tail V1477) (if (shen.semicolon? W1479) (shen.comb W1480 W1479) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1478) (shen.parse-failure) W1478))) -(defun shen.horn-clause-procedure (V1827 V1828) (let W1829 (gensym B) (let W1830 (gensym L) (let W1831 (gensym K) (let W1832 (gensym C) (let W1833 (shen.prolog-parameters V1828) (let W1834 (shen.hascut? V1828) (let W1835 (shen.prolog-fbody V1828 W1833 W1829 W1830 W1831 W1832 W1834) (let W1836 (if W1834 (cons let (cons W1831 (cons (cons + (cons W1831 (cons 1 ()))) (cons W1835 ())))) W1835) (let W1837 (cons define (cons V1827 (append W1833 (append (cons W1829 (cons W1830 (cons W1831 (cons W1832 (cons -> ()))))) (cons W1836 ()))))) W1837)))))))))) +(defun shen.horn-clause-procedure (V1481 V1482) (let W1483 (gensym B) (let W1484 (gensym L) (let W1485 (gensym K) (let W1486 (gensym C) (let W1487 (shen.prolog-parameters V1482) (let W1488 (shen.hascut? V1482) (let W1489 (shen.prolog-fbody V1482 W1487 W1483 W1484 W1485 W1486 W1488) (let W1490 (if W1488 (cons let (cons W1485 (cons (cons + (cons W1485 (cons 1 ()))) (cons W1489 ())))) W1489) (let W1491 (cons define (cons V1481 (append W1487 (append (cons W1483 (cons W1484 (cons W1485 (cons W1486 (cons -> ()))))) (cons W1490 ()))))) W1491)))))))))) -(defun shen.hascut? (V1840) (cond ((= ! V1840) true) ((cons? V1840) (or (shen.hascut? (hd V1840)) (shen.hascut? (tl V1840)))) (true false))) +(defun shen.hascut? (V1494) (cond ((= ! V1494) true) ((cons? V1494) (or (shen.hascut? (hd V1494)) (shen.hascut? (tl V1494)))) (true false))) -(defun shen.prolog-parameters (V1845) (cond ((and (cons? V1845) (cons? (hd V1845))) (shen.parameters (length (hd (hd V1845))))) (true (shen.f-error shen.prolog-parameters)))) +(defun shen.prolog-parameters (V1499) (cond ((and (cons? V1499) (cons? (hd V1499))) (shen.parameters (length (hd (hd V1499))))) (true (simple-error "partial function shen.prolog-parameters")))) -(defun shen.prolog-fbody (V1866 V1867 V1868 V1869 V1870 V1871 V1872) (cond ((and (= () V1866) (= true V1872)) (cons shen.unlock (cons V1869 (cons V1870 ())))) ((and (cons? V1866) (and (cons? (hd V1866)) (and (cons? (tl (hd V1866))) (and (= () (tl (tl (hd V1866)))) (and (= () (tl V1866)) (= false V1872)))))) (let W1873 (shen.continue (hd (hd V1866)) (hd (tl (hd V1866))) V1868 V1869 V1870 V1871) (cons if (cons (cons shen.unlocked? (cons V1869 ())) (cons (shen.compile-head shen.+m (hd (hd V1866)) V1867 V1868 W1873) (cons false ())))))) ((and (cons? V1866) (and (cons? (hd V1866)) (and (cons? (tl (hd V1866))) (= () (tl (tl (hd V1866))))))) (let W1874 (gensym C) (let W1875 (shen.continue (hd (hd V1866)) (hd (tl (hd V1866))) V1868 V1869 V1870 V1871) (cons let (cons W1874 (cons (cons if (cons (cons shen.unlocked? (cons V1869 ())) (cons (shen.compile-head shen.+m (hd (hd V1866)) V1867 V1868 W1875) (cons false ())))) (cons (cons if (cons (cons = (cons W1874 (cons false ()))) (cons (shen.prolog-fbody (tl V1866) V1867 V1868 V1869 V1870 V1871 V1872) (cons W1874 ())))) ()))))))) (true (simple-error "implementation error in shen.prolog-fbody")))) +(defun shen.prolog-fbody (V1520 V1521 V1522 V1523 V1524 V1525 V1526) (cond ((and (= () V1520) (= true V1526)) (cons shen.unlock (cons V1523 (cons V1524 ())))) ((and (cons? V1520) (and (cons? (hd V1520)) (and (cons? (tl (hd V1520))) (and (= () (tl (tl (hd V1520)))) (and (= () (tl V1520)) (= false V1526)))))) (let W1527 (shen.continue (hd (hd V1520)) (hd (tl (hd V1520))) V1522 V1523 V1524 V1525) (cons if (cons (cons shen.unlocked? (cons V1523 ())) (cons (shen.compile-head shen.+m (hd (hd V1520)) V1521 V1522 W1527) (cons false ())))))) ((and (cons? V1520) (and (cons? (hd V1520)) (and (cons? (tl (hd V1520))) (= () (tl (tl (hd V1520))))))) (let W1528 (gensym C) (let W1529 (shen.continue (hd (hd V1520)) (hd (tl (hd V1520))) V1522 V1523 V1524 V1525) (cons let (cons W1528 (cons (cons if (cons (cons shen.unlocked? (cons V1523 ())) (cons (shen.compile-head shen.+m (hd (hd V1520)) V1521 V1522 W1529) (cons false ())))) (cons (cons if (cons (cons = (cons W1528 (cons false ()))) (cons (shen.prolog-fbody (tl V1520) V1521 V1522 V1523 V1524 V1525 V1526) (cons W1528 ())))) ()))))))) (true (simple-error "implementation error in shen.prolog-fbody")))) -(defun shen.unlock (V1876 V1877) (if (and (shen.locked? V1876) (shen.fits? V1877 V1876)) (shen.openlock V1876) false)) +(defun shen.unlock (V1530 V1531) (if (and (shen.locked? V1530) (shen.fits? V1531 V1530)) (shen.openlock V1530) false)) -(defun shen.locked? (V1878) (not (shen.unlocked? V1878))) +(defun shen.locked? (V1532) (not (shen.unlocked? V1532))) -(defun shen.unlocked? (V1879) (<-address V1879 1)) +(defun shen.unlocked? (V1533) (<-address V1533 1)) -(defun shen.openlock (V1880) (do (address-> V1880 1 true) false)) +(defun shen.openlock (V1534) (do (address-> V1534 1 true) false)) -(defun shen.fits? (V1881 V1882) (= V1881 (<-address V1882 2))) +(defun shen.fits? (V1535 V1536) (= V1535 (<-address V1536 2))) -(defun shen.cut (V1885 V1886 V1887 V1888) (let W1889 (thaw V1888) (if (and (= W1889 false) (shen.unlocked? V1886)) (shen.lock V1887 V1886) W1889))) +(defun shen.cut (V1539 V1540 V1541 V1542) (let W1543 (thaw V1542) (if (and (= W1543 false) (shen.unlocked? V1540)) (shen.lock V1541 V1540) W1543))) -(defun shen.lock (V1890 V1891) (let W1892 (address-> V1891 1 false) (let W1893 (address-> V1891 2 V1890) false))) +(defun shen.lock (V1544 V1545) (let W1546 (address-> V1545 1 false) (let W1547 (address-> V1545 2 V1544) false))) -(defun shen.continue (V1894 V1895 V1896 V1897 V1898 V1899) (let W1900 (shen.extract-vars V1894) (let W1901 (shen.extract-free-vars V1895) (let W1902 (difference W1901 W1900) (let W1903 (cons do (cons (cons shen.incinfs ()) (cons (shen.compile-body V1895 V1896 V1897 V1898 V1899) ()))) (shen.stpart W1902 W1903 V1896)))))) +(defun shen.continue (V1548 V1549 V1550 V1551 V1552 V1553) (let W1554 (shen.extract-vars V1548) (let W1555 (shen.extract-free-vars V1549) (let W1556 (difference W1555 W1554) (let W1557 (cons do (cons (cons shen.incinfs ()) (cons (shen.compile-body V1549 V1550 V1551 V1552 V1553) ()))) (shen.stpart W1556 W1557 V1550)))))) -(defun shen.extract-free-vars (V1906) (cond ((and (cons? V1906) (and (= lambda (hd V1906)) (and (cons? (tl V1906)) (and (cons? (tl (tl V1906))) (= () (tl (tl (tl V1906)))))))) (remove (hd (tl V1906)) (shen.extract-free-vars (hd (tl (tl V1906)))))) ((cons? V1906) (union (shen.extract-free-vars (hd V1906)) (shen.extract-free-vars (tl V1906)))) ((variable? V1906) (cons V1906 ())) (true ()))) +(defun shen.extract-free-vars (V1560) (cond ((and (cons? V1560) (and (= lambda (hd V1560)) (and (cons? (tl V1560)) (and (cons? (tl (tl V1560))) (= () (tl (tl (tl V1560)))))))) (remove (hd (tl V1560)) (shen.extract-free-vars (hd (tl (tl V1560)))))) ((cons? V1560) (union (shen.extract-free-vars (hd V1560)) (shen.extract-free-vars (tl V1560)))) ((variable? V1560) (cons V1560 ())) (true ()))) -(defun shen.compile-body (V1923 V1924 V1925 V1926 V1927) (cond ((= () V1923) (cons thaw (cons V1927 ()))) ((and (cons? V1923) (= ! (hd V1923))) (shen.compile-body (cons (cons shen.cut ()) (tl V1923)) V1924 V1925 V1926 V1927)) ((and (cons? V1923) (= () (tl V1923))) (append (shen.deref-calls (hd V1923) V1924) (cons V1924 (cons V1925 (cons V1926 (cons V1927 ())))))) ((cons? V1923) (let W1928 (shen.deref-calls (hd V1923) V1924) (append W1928 (cons V1924 (cons V1925 (cons V1926 (cons (shen.freeze-literals (tl V1923) V1924 V1925 V1926 V1927) ()))))))) (true (simple-error "implementation error in shen.compile-fbody")))) +(defun shen.compile-body (V1577 V1578 V1579 V1580 V1581) (cond ((= () V1577) (cons thaw (cons V1581 ()))) ((and (cons? V1577) (= ! (hd V1577))) (shen.compile-body (cons (cons shen.cut ()) (tl V1577)) V1578 V1579 V1580 V1581)) ((and (cons? V1577) (= () (tl V1577))) (append (shen.deref-calls (hd V1577) V1578) (cons V1578 (cons V1579 (cons V1580 (cons V1581 ())))))) ((cons? V1577) (let W1582 (shen.deref-calls (hd V1577) V1578) (append W1582 (cons V1578 (cons V1579 (cons V1580 (cons (shen.freeze-literals (tl V1577) V1578 V1579 V1580 V1581) ()))))))) (true (simple-error "implementation error in shen.compile-fbody")))) -(defun shen.freeze-literals (V1945 V1946 V1947 V1948 V1949) (cond ((= () V1945) V1949) ((and (cons? V1945) (= ! (hd V1945))) (shen.freeze-literals (cons (cons shen.cut ()) (tl V1945)) V1946 V1947 V1948 V1949)) ((cons? V1945) (let W1950 (shen.deref-calls (hd V1945) V1946) (cons freeze (cons (append W1950 (cons V1946 (cons V1947 (cons V1948 (cons (shen.freeze-literals (tl V1945) V1946 V1947 V1948 V1949) ()))))) ())))) (true (simple-error "implementation error in shen.freeze-literals")))) +(defun shen.freeze-literals (V1599 V1600 V1601 V1602 V1603) (cond ((= () V1599) V1603) ((and (cons? V1599) (= ! (hd V1599))) (shen.freeze-literals (cons (cons shen.cut ()) (tl V1599)) V1600 V1601 V1602 V1603)) ((cons? V1599) (let W1604 (shen.deref-calls (hd V1599) V1600) (cons freeze (cons (append W1604 (cons V1600 (cons V1601 (cons V1602 (cons (shen.freeze-literals (tl V1599) V1600 V1601 V1602 V1603) ()))))) ())))) (true (simple-error "implementation error in shen.freeze-literals")))) -(defun shen.deref-calls (V1955 V1956) (cond ((and (cons? V1955) (= fork (hd V1955))) (cons fork (cons (shen.deref-forked-literals (tl V1955) V1956) ()))) ((cons? V1955) (cons (hd V1955) (map (lambda Z1957 (shen.function-calls Z1957 V1956)) (tl V1955)))) (true (simple-error "implementation error in shen.deref-calls")))) +(defun shen.deref-calls (V1609 V1610) (cond ((and (cons? V1609) (= fork (hd V1609))) (cons fork (cons (shen.deref-forked-literals (tl V1609) V1610) ()))) ((cons? V1609) (cons (hd V1609) (map (lambda Z1611 (shen.function-calls Z1611 V1610)) (tl V1609)))) (true (simple-error "implementation error in shen.deref-calls")))) -(defun shen.deref-forked-literals (V1964 V1965) (cond ((= () V1964) ()) ((cons? V1964) (cons cons (cons (shen.deref-calls (hd V1964) V1965) (cons (shen.deref-forked-literals (tl V1964) V1965) ())))) (true (simple-error "fork requires a list of literals +(defun shen.deref-forked-literals (V1618 V1619) (cond ((= () V1618) ()) ((cons? V1618) (cons cons (cons (shen.deref-calls (hd V1618) V1619) (cons (shen.deref-forked-literals (tl V1618) V1619) ())))) (true (simple-error "fork requires a list of literals ")))) -(defun shen.function-calls (V1968 V1969) (cond ((and (cons? V1968) (and (= cons (hd V1968)) (and (cons? (tl V1968)) (and (cons? (tl (tl V1968))) (= () (tl (tl (tl V1968)))))))) (cons cons (cons (shen.function-calls (hd (tl V1968)) V1969) (cons (shen.function-calls (hd (tl (tl V1968))) V1969) ())))) ((cons? V1968) (shen.deref-terms V1968 V1969 ())) (true V1968))) +(defun shen.function-calls (V1622 V1623) (cond ((and (cons? V1622) (and (= cons (hd V1622)) (and (cons? (tl V1622)) (and (cons? (tl (tl V1622))) (= () (tl (tl (tl V1622)))))))) (cons cons (cons (shen.function-calls (hd (tl V1622)) V1623) (cons (shen.function-calls (hd (tl (tl V1622))) V1623) ())))) ((cons? V1622) (shen.deref-terms V1622 V1623 ())) (true V1622))) -(defun shen.deref-terms (V1978 V1979 V1980) (cond ((and (cons? V1978) (and (= 0 (hd V1978)) (and (cons? (tl V1978)) (= () (tl (tl V1978)))))) (if (variable? (hd (tl V1978))) (hd (tl V1978)) (simple-error (cn "attempt to optimise a non-variable " (shen.app (hd (tl V1978)) " -" shen.s))))) ((and (cons? V1978) (and (= 1 (hd V1978)) (and (cons? (tl V1978)) (= () (tl (tl V1978)))))) (if (variable? (hd (tl V1978))) (cons shen.lazyderef (cons (hd (tl V1978)) (cons V1979 ()))) (simple-error (cn "attempt to optimise a non-variable " (shen.app (hd (tl V1978)) " -" shen.s))))) ((and (not (element? V1978 V1980)) (variable? V1978)) (cons shen.deref (cons V1978 (cons V1979 ())))) ((and (cons? V1978) (and (= lambda (hd V1978)) (and (cons? (tl V1978)) (and (cons? (tl (tl V1978))) (= () (tl (tl (tl V1978)))))))) (cons lambda (cons (hd (tl V1978)) (cons (shen.deref-terms (hd (tl (tl V1978))) V1979 (cons (hd (tl V1978)) V1980)) ())))) ((cons? V1978) (map (lambda Z1981 (shen.deref-terms Z1981 V1979 V1980)) V1978)) (true V1978))) +(defun shen.deref-terms (V1632 V1633 V1634) (cond ((and (cons? V1632) (and (= 0 (hd V1632)) (and (cons? (tl V1632)) (= () (tl (tl V1632)))))) (if (variable? (hd (tl V1632))) (hd (tl V1632)) (simple-error (cn "attempt to optimise a non-variable " (shen.app (hd (tl V1632)) " +" shen.s))))) ((and (cons? V1632) (and (= 1 (hd V1632)) (and (cons? (tl V1632)) (= () (tl (tl V1632)))))) (if (variable? (hd (tl V1632))) (cons shen.lazyderef (cons (hd (tl V1632)) (cons V1633 ()))) (simple-error (cn "attempt to optimise a non-variable " (shen.app (hd (tl V1632)) " +" shen.s))))) ((and (not (element? V1632 V1634)) (variable? V1632)) (cons shen.deref (cons V1632 (cons V1633 ())))) ((and (cons? V1632) (and (= lambda (hd V1632)) (and (cons? (tl V1632)) (and (cons? (tl (tl V1632))) (= () (tl (tl (tl V1632)))))))) (cons lambda (cons (hd (tl V1632)) (cons (shen.deref-terms (hd (tl (tl V1632))) V1633 (cons (hd (tl V1632)) V1634)) ())))) ((cons? V1632) (map (lambda Z1635 (shen.deref-terms Z1635 V1633 V1634)) V1632)) (true V1632))) -(defun shen.compile-head (V1999 V2000 V2001 V2002 V2003) (cond ((and (= () V2000) (= () V2001)) V2003) ((and (cons? V2000) (and (cons? (hd V2000)) (and (= shen.+m (hd (hd V2000))) (and (cons? (tl (hd V2000))) (= () (tl (tl (hd V2000)))))))) (shen.compile-head V1999 (cons shen.+m (cons (hd (tl (hd V2000))) (cons V1999 (tl V2000)))) V2001 V2002 V2003)) ((and (cons? V2000) (and (cons? (hd V2000)) (and (= shen.-m (hd (hd V2000))) (and (cons? (tl (hd V2000))) (= () (tl (tl (hd V2000)))))))) (shen.compile-head V1999 (cons shen.-m (cons (hd (tl (hd V2000))) (cons V1999 (tl V2000)))) V2001 V2002 V2003)) ((and (cons? V2000) (= shen.-m (hd V2000))) (shen.compile-head shen.-m (tl V2000) V2001 V2002 V2003)) ((and (cons? V2000) (= shen.+m (hd V2000))) (shen.compile-head shen.+m (tl V2000) V2001 V2002 V2003)) ((and (cons? V2000) (and (cons? V2001) (shen.wildcard? (hd V2000)))) (shen.compile-head V1999 (tl V2000) (tl V2001) V2002 V2003)) ((and (cons? V2000) (variable? (hd V2000))) (shen.variable-case V1999 V2000 V2001 V2002 V2003)) ((and (= shen.-m V1999) (and (cons? V2000) (atom? (hd V2000)))) (shen.atom-case-minus V2000 V2001 V2002 V2003)) ((and (= shen.-m V1999) (and (cons? V2000) (and (cons? (hd V2000)) (and (= cons (hd (hd V2000))) (and (cons? (tl (hd V2000))) (and (cons? (tl (tl (hd V2000)))) (= () (tl (tl (tl (hd V2000))))))))))) (shen.cons-case-minus V2000 V2001 V2002 V2003)) ((and (= shen.+m V1999) (and (cons? V2000) (atom? (hd V2000)))) (shen.atom-case-plus V2000 V2001 V2002 V2003)) ((and (= shen.+m V1999) (and (cons? V2000) (and (cons? (hd V2000)) (and (= cons (hd (hd V2000))) (and (cons? (tl (hd V2000))) (and (cons? (tl (tl (hd V2000)))) (= () (tl (tl (tl (hd V2000))))))))))) (shen.cons-case-plus V2000 V2001 V2002 V2003)) (true (simple-error "implementation error in shen.compile-head")))) +(defun shen.compile-head (V1653 V1654 V1655 V1656 V1657) (cond ((and (= () V1654) (= () V1655)) V1657) ((and (cons? V1654) (and (cons? (hd V1654)) (and (= shen.+m (hd (hd V1654))) (and (cons? (tl (hd V1654))) (= () (tl (tl (hd V1654)))))))) (shen.compile-head V1653 (cons shen.+m (cons (hd (tl (hd V1654))) (cons V1653 (tl V1654)))) V1655 V1656 V1657)) ((and (cons? V1654) (and (cons? (hd V1654)) (and (= shen.-m (hd (hd V1654))) (and (cons? (tl (hd V1654))) (= () (tl (tl (hd V1654)))))))) (shen.compile-head V1653 (cons shen.-m (cons (hd (tl (hd V1654))) (cons V1653 (tl V1654)))) V1655 V1656 V1657)) ((and (cons? V1654) (= shen.-m (hd V1654))) (shen.compile-head shen.-m (tl V1654) V1655 V1656 V1657)) ((and (cons? V1654) (= shen.+m (hd V1654))) (shen.compile-head shen.+m (tl V1654) V1655 V1656 V1657)) ((and (cons? V1654) (and (cons? V1655) (shen.wildcard? (hd V1654)))) (shen.compile-head V1653 (tl V1654) (tl V1655) V1656 V1657)) ((and (cons? V1654) (variable? (hd V1654))) (shen.variable-case V1653 V1654 V1655 V1656 V1657)) ((and (= shen.-m V1653) (and (cons? V1654) (atom? (hd V1654)))) (shen.atom-case-minus V1654 V1655 V1656 V1657)) ((and (= shen.-m V1653) (and (cons? V1654) (and (cons? (hd V1654)) (and (= cons (hd (hd V1654))) (and (cons? (tl (hd V1654))) (and (cons? (tl (tl (hd V1654)))) (= () (tl (tl (tl (hd V1654))))))))))) (shen.cons-case-minus V1654 V1655 V1656 V1657)) ((and (= shen.+m V1653) (and (cons? V1654) (atom? (hd V1654)))) (shen.atom-case-plus V1654 V1655 V1656 V1657)) ((and (= shen.+m V1653) (and (cons? V1654) (and (cons? (hd V1654)) (and (= cons (hd (hd V1654))) (and (cons? (tl (hd V1654))) (and (cons? (tl (tl (hd V1654)))) (= () (tl (tl (tl (hd V1654))))))))))) (shen.cons-case-plus V1654 V1655 V1656 V1657)) (true (simple-error "implementation error in shen.compile-head")))) -(defun shen.variable-case (V2014 V2015 V2016 V2017 V2018) (cond ((and (cons? V2015) (cons? V2016)) (if (variable? (hd V2016)) (shen.compile-head V2014 (tl V2015) (tl V2016) V2017 (subst (hd V2016) (hd V2015) V2018)) (cons let (cons (hd V2015) (cons (hd V2016) (cons (shen.compile-head V2014 (tl V2015) (tl V2016) V2017 V2018) ())))))) (true (simple-error "implementation error in shen.variable-case")))) +(defun shen.variable-case (V1668 V1669 V1670 V1671 V1672) (cond ((and (cons? V1669) (cons? V1670)) (if (variable? (hd V1670)) (shen.compile-head V1668 (tl V1669) (tl V1670) V1671 (subst (hd V1670) (hd V1669) V1672)) (cons let (cons (hd V1669) (cons (hd V1670) (cons (shen.compile-head V1668 (tl V1669) (tl V1670) V1671 V1672) ())))))) (true (simple-error "implementation error in shen.variable-case")))) -(defun shen.atom-case-minus (V2027 V2028 V2029 V2030) (cond ((and (cons? V2027) (cons? V2028)) (let W2031 (gensym Tm) (cons let (cons W2031 (cons (cons shen.lazyderef (cons (hd V2028) (cons V2029 ()))) (cons (cons if (cons (cons = (cons W2031 (cons (hd V2027) ()))) (cons (shen.compile-head shen.-m (tl V2027) (tl V2028) V2029 V2030) (cons false ())))) ())))))) (true (simple-error "implementation error in shen.atom-case-minus")))) +(defun shen.atom-case-minus (V1681 V1682 V1683 V1684) (cond ((and (cons? V1681) (cons? V1682)) (let W1685 (gensym Tm) (cons let (cons W1685 (cons (cons shen.lazyderef (cons (hd V1682) (cons V1683 ()))) (cons (cons if (cons (cons = (cons W1685 (cons (hd V1681) ()))) (cons (shen.compile-head shen.-m (tl V1681) (tl V1682) V1683 V1684) (cons false ())))) ())))))) (true (simple-error "implementation error in shen.atom-case-minus")))) -(defun shen.cons-case-minus (V2040 V2041 V2042 V2043) (cond ((and (cons? V2040) (and (cons? (hd V2040)) (and (= cons (hd (hd V2040))) (and (cons? (tl (hd V2040))) (and (cons? (tl (tl (hd V2040)))) (and (= () (tl (tl (tl (hd V2040))))) (cons? V2041))))))) (let W2044 (gensym Tm) (cons let (cons W2044 (cons (cons shen.lazyderef (cons (hd V2041) (cons V2042 ()))) (cons (cons if (cons (cons cons? (cons W2044 ())) (cons (shen.compile-head shen.-m (cons (hd (tl (hd V2040))) (cons (hd (tl (tl (hd V2040)))) (tl V2040))) (cons (cons hd (cons W2044 ())) (cons (cons tl (cons W2044 ())) (tl V2041))) V2042 V2043) (cons false ())))) ())))))) (true (simple-error "implementation error in shen.cons-case-minus")))) +(defun shen.cons-case-minus (V1694 V1695 V1696 V1697) (cond ((and (cons? V1694) (and (cons? (hd V1694)) (and (= cons (hd (hd V1694))) (and (cons? (tl (hd V1694))) (and (cons? (tl (tl (hd V1694)))) (and (= () (tl (tl (tl (hd V1694))))) (cons? V1695))))))) (let W1698 (gensym Tm) (cons let (cons W1698 (cons (cons shen.lazyderef (cons (hd V1695) (cons V1696 ()))) (cons (cons if (cons (cons cons? (cons W1698 ())) (cons (shen.compile-head shen.-m (cons (hd (tl (hd V1694))) (cons (hd (tl (tl (hd V1694)))) (tl V1694))) (cons (cons hd (cons W1698 ())) (cons (cons tl (cons W1698 ())) (tl V1695))) V1696 V1697) (cons false ())))) ())))))) (true (simple-error "implementation error in shen.cons-case-minus")))) -(defun shen.atom-case-plus (V2053 V2054 V2055 V2056) (cond ((and (cons? V2053) (cons? V2054)) (let W2057 (gensym Tm) (let W2058 (gensym GoTo) (cons let (cons W2057 (cons (cons shen.lazyderef (cons (hd V2054) (cons V2055 ()))) (cons W2058 (cons (cons freeze (cons (shen.compile-head shen.+m (tl V2053) (tl V2054) V2055 V2056) ())) (cons (cons if (cons (cons = (cons W2057 (cons (hd V2053) ()))) (cons (cons thaw (cons W2058 ())) (cons (cons if (cons (cons shen.pvar? (cons W2057 ())) (cons (cons shen.bind! (cons W2057 (cons (shen.demode (hd V2053)) (cons V2055 (cons W2058 ()))))) (cons false ())))) ())))) ()))))))))) (true (simple-error "implementation error in shen.atom-case-plus")))) +(defun shen.atom-case-plus (V1707 V1708 V1709 V1710) (cond ((and (cons? V1707) (cons? V1708)) (let W1711 (gensym Tm) (let W1712 (gensym GoTo) (cons let (cons W1711 (cons (cons shen.lazyderef (cons (hd V1708) (cons V1709 ()))) (cons W1712 (cons (cons freeze (cons (shen.compile-head shen.+m (tl V1707) (tl V1708) V1709 V1710) ())) (cons (cons if (cons (cons = (cons W1711 (cons (hd V1707) ()))) (cons (cons thaw (cons W1712 ())) (cons (cons if (cons (cons shen.pvar? (cons W1711 ())) (cons (cons shen.bind! (cons W1711 (cons (shen.demode (hd V1707)) (cons V1709 (cons W1712 ()))))) (cons false ())))) ())))) ()))))))))) (true (simple-error "implementation error in shen.atom-case-plus")))) -(defun shen.cons-case-plus (V2067 V2068 V2069 V2070) (cond ((and (cons? V2067) (and (cons? (hd V2067)) (and (= cons (hd (hd V2067))) (and (cons? (tl (hd V2067))) (and (cons? (tl (tl (hd V2067)))) (and (= () (tl (tl (tl (hd V2067))))) (cons? V2068))))))) (let W2071 (gensym Tm) (let W2072 (gensym GoTo) (let W2073 (shen.extract-vars (cons (hd (tl (hd V2067))) (hd (tl (tl (hd V2067)))))) (let W2074 (shen.tame (hd V2067)) (let W2075 (shen.extract-vars W2074) (cons let (cons W2071 (cons (cons shen.lazyderef (cons (hd V2068) (cons V2069 ()))) (cons W2072 (cons (shen.goto W2073 (shen.compile-head shen.+m (tl V2067) (tl V2068) V2069 V2070)) (cons (cons if (cons (cons cons? (cons W2071 ())) (cons (shen.compile-head shen.+m (tl (hd V2067)) (cons (cons hd (cons W2071 ())) (cons (cons tl (cons W2071 ())) ())) V2069 (shen.invoke W2072 W2073)) (cons (cons if (cons (cons shen.pvar? (cons W2071 ())) (cons (shen.stpart W2075 (cons shen.bind! (cons W2071 (cons (shen.demode W2074) (cons V2069 (cons (cons freeze (cons (shen.invoke W2072 W2073) ())) ()))))) V2069) (cons false ())))) ())))) ())))))))))))) (true (simple-error "implementation error in shen.cons-case-plus")))) +(defun shen.cons-case-plus (V1721 V1722 V1723 V1724) (cond ((and (cons? V1721) (and (cons? (hd V1721)) (and (= cons (hd (hd V1721))) (and (cons? (tl (hd V1721))) (and (cons? (tl (tl (hd V1721)))) (and (= () (tl (tl (tl (hd V1721))))) (cons? V1722))))))) (let W1725 (gensym Tm) (let W1726 (gensym GoTo) (let W1727 (shen.extract-vars (cons (hd (tl (hd V1721))) (hd (tl (tl (hd V1721)))))) (let W1728 (shen.tame (hd V1721)) (let W1729 (shen.extract-vars W1728) (cons let (cons W1725 (cons (cons shen.lazyderef (cons (hd V1722) (cons V1723 ()))) (cons W1726 (cons (shen.goto W1727 (shen.compile-head shen.+m (tl V1721) (tl V1722) V1723 V1724)) (cons (cons if (cons (cons cons? (cons W1725 ())) (cons (shen.compile-head shen.+m (tl (hd V1721)) (cons (cons hd (cons W1725 ())) (cons (cons tl (cons W1725 ())) ())) V1723 (shen.invoke W1726 W1727)) (cons (cons if (cons (cons shen.pvar? (cons W1725 ())) (cons (shen.stpart W1729 (cons shen.bind! (cons W1725 (cons (shen.demode W1728) (cons V1723 (cons (cons freeze (cons (shen.invoke W1726 W1727) ())) ()))))) V1723) (cons false ())))) ())))) ())))))))))))) (true (simple-error "implementation error in shen.cons-case-plus")))) -(defun shen.demode (V2076) (cond ((and (cons? V2076) (and (= shen.+m (hd V2076)) (and (cons? (tl V2076)) (= () (tl (tl V2076)))))) (shen.demode (hd (tl V2076)))) ((and (cons? V2076) (and (= shen.-m (hd V2076)) (and (cons? (tl V2076)) (= () (tl (tl V2076)))))) (shen.demode (hd (tl V2076)))) ((cons? V2076) (map (lambda Z2077 (shen.demode Z2077)) V2076)) (true V2076))) +(defun shen.demode (V1730) (cond ((and (cons? V1730) (and (= shen.+m (hd V1730)) (and (cons? (tl V1730)) (= () (tl (tl V1730)))))) (shen.demode (hd (tl V1730)))) ((and (cons? V1730) (and (= shen.-m (hd V1730)) (and (cons? (tl V1730)) (= () (tl (tl V1730)))))) (shen.demode (hd (tl V1730)))) ((cons? V1730) (map (lambda Z1731 (shen.demode Z1731)) V1730)) (true V1730))) -(defun shen.tame (V2078) (cond ((shen.wildcard? V2078) (gensym Y)) ((cons? V2078) (map (lambda Z2079 (shen.tame Z2079)) V2078)) (true V2078))) +(defun shen.tame (V1732) (cond ((shen.wildcard? V1732) (gensym Y)) ((cons? V1732) (map (lambda Z1733 (shen.tame Z1733)) V1732)) (true V1732))) -(defun shen.goto (V2080 V2081) (cond ((= () V2080) (cons freeze (cons V2081 ()))) (true (shen.goto-h V2080 V2081)))) +(defun shen.goto (V1734 V1735) (cond ((= () V1734) (cons freeze (cons V1735 ()))) (true (shen.goto-h V1734 V1735)))) -(defun shen.goto-h (V2082 V2083) (cond ((= () V2082) V2083) ((cons? V2082) (cons lambda (cons (hd V2082) (cons (shen.goto-h (tl V2082) V2083) ())))) (true (shen.f-error shen.goto-h)))) +(defun shen.goto-h (V1736 V1737) (cond ((= () V1736) V1737) ((cons? V1736) (cons lambda (cons (hd V1736) (cons (shen.goto-h (tl V1736) V1737) ())))) (true (simple-error "partial function shen.goto-h")))) -(defun shen.invoke (V2084 V2085) (cond ((= () V2085) (cons thaw (cons V2084 ()))) (true (cons V2084 V2085)))) +(defun shen.invoke (V1738 V1739) (cond ((= () V1739) (cons thaw (cons V1738 ()))) (true (cons V1738 V1739)))) -(defun shen.wildcard? (V2086) (= V2086 _)) +(defun shen.wildcard? (V1740) (= V1740 _)) -(defun shen.pvar? (V2087) (and (absvector? V2087) (= (trap-error (<-address V2087 0) (lambda Z2088 shen.not-pvar)) shen.pvar))) +(defun shen.pvar? (V1741) (trap-error (and (absvector? V1741) (= (<-address V1741 0) shen.pvar)) (lambda Z1742 false))) -(defun shen.lazyderef (V2089 V2090) (if (shen.pvar? V2089) (let W2091 (<-address V2090 (<-address V2089 1)) (if (= W2091 shen.-null-) V2089 (shen.lazyderef W2091 V2090))) V2089)) +(defun shen.lazyderef (V1743 V1744) (if (shen.pvar? V1743) (let W1745 (<-address V1744 (<-address V1743 1)) (if (= W1745 shen.-null-) V1743 (shen.lazyderef W1745 V1744))) V1743)) -(defun shen.deref (V2092 V2093) (cond ((cons? V2092) (cons (shen.deref (hd V2092) V2093) (shen.deref (tl V2092) V2093))) (true (if (shen.pvar? V2092) (let W2094 (<-address V2093 (<-address V2092 1)) (if (= W2094 shen.-null-) V2092 (shen.deref W2094 V2093))) V2092)))) +(defun shen.deref (V1746 V1747) (cond ((cons? V1746) (cons (shen.deref (hd V1746) V1747) (shen.deref (tl V1746) V1747))) (true (if (shen.pvar? V1746) (let W1748 (<-address V1747 (<-address V1746 1)) (if (= W1748 shen.-null-) V1746 (shen.deref W1748 V1747))) V1746)))) -(defun shen.bind! (V2095 V2096 V2097 V2098) (let W2099 (shen.bindv V2095 V2096 V2097) (let W2100 (thaw V2098) (if (= W2100 false) (shen.unwind V2095 V2097 W2100) W2100)))) +(defun shen.bind! (V1749 V1750 V1751 V1752) (let W1753 (shen.bindv V1749 V1750 V1751) (let W1754 (thaw V1752) (if (= W1754 false) (shen.unwind V1749 V1751 W1754) W1754)))) -(defun shen.bindv (V2101 V2102 V2103) (address-> V2103 (<-address V2101 1) V2102)) +(defun shen.bindv (V1755 V1756 V1757) (address-> V1757 (<-address V1755 1) V1756)) -(defun shen.unwind (V2104 V2105 V2106) (do (address-> V2105 (<-address V2104 1) shen.-null-) V2106)) +(defun shen.unwind (V1758 V1759 V1760) (do (address-> V1759 (<-address V1758 1) shen.-null-) V1760)) -(defun shen.stpart (V2115 V2116 V2117) (cond ((= () V2115) V2116) ((cons? V2115) (cons let (cons (hd V2115) (cons (cons shen.newpv (cons V2117 ())) (cons (cons shen.gc (cons V2117 (cons (shen.stpart (tl V2115) V2116 V2117) ()))) ()))))) (true (simple-error "implementation error in shen.stpart")))) +(defun shen.stpart (V1769 V1770 V1771) (cond ((= () V1769) V1770) ((cons? V1769) (cons let (cons (hd V1769) (cons (cons shen.newpv (cons V1771 ())) (cons (cons shen.gc (cons V1771 (cons (shen.stpart (tl V1769) V1770 V1771) ()))) ()))))) (true (simple-error "implementation error in shen.stpart")))) -(defun shen.gc (V2118 V2119) (if (= V2119 false) (let W2120 (shen.ticket-number V2118) (do (shen.decrement-ticket W2120 V2118) V2119)) V2119)) +(defun shen.gc (V1772 V1773) (if (= V1773 false) (let W1774 (shen.ticket-number V1772) (do (shen.decrement-ticket W1774 V1772) V1773)) V1773)) -(defun shen.decrement-ticket (V2121 V2122) (address-> V2122 1 (- V2121 1))) +(defun shen.decrement-ticket (V1775 V1776) (address-> V1776 1 (- V1775 1))) -(defun shen.newpv (V2123) (let W2124 (shen.ticket-number V2123) (let W2125 (shen.make-prolog-variable W2124) (let W2126 (shen.nextticket V2123 W2124) W2125)))) +(defun shen.newpv (V1777) (let W1778 (shen.ticket-number V1777) (let W1779 (shen.make-prolog-variable W1778) (let W1780 (shen.nextticket V1777 W1778) W1779)))) -(defun shen.ticket-number (V2127) (<-address V2127 1)) +(defun shen.ticket-number (V1781) (<-address V1781 1)) -(defun shen.nextticket (V2128 V2129) (let W2130 (address-> V2128 V2129 shen.-null-) (address-> W2130 1 (+ V2129 1)))) +(defun shen.nextticket (V1782 V1783) (let W1784 (address-> V1782 V1783 shen.-null-) (address-> W1784 1 (+ V1783 1)))) -(defun shen.make-prolog-variable (V2131) (address-> (address-> (absvector 2) 0 shen.pvar) 1 V2131)) +(defun shen.make-prolog-variable (V1785) (address-> (address-> (absvector 2) 0 shen.pvar) 1 V1785)) -(defun shen.pvar (V2132) (cn "Var" (shen.app (<-address V2132 1) "" shen.a))) +(defun shen.pvar (V1786) (cn "Var" (shen.app (<-address V1786 1) "" shen.a))) (defun shen.incinfs () (set shen.*infs* (+ 1 (value shen.*infs*)))) -(defun shen.prolog-vector-size (V2133) (if (and (integer? V2133) (> V2133 0)) (set shen.*size-prolog-vector* V2133) (simple-error (cn "prolog vector size: size should be a positive integer; not " (shen.app V2133 "" shen.a))))) +(defun shen.prolog-vector-size (V1787) (if (and (integer? V1787) (> V1787 0)) (set shen.*size-prolog-vector* V1787) (simple-error (cn "prolog vector size: size should be a positive integer; not " (shen.app V1787 "" shen.a))))) -(defun shen.lzy=! (V2145 V2146 V2147 V2148) (cond ((= V2145 V2146) (thaw V2148)) ((and (shen.pvar? V2145) (not (shen.occurs-check? V2145 (shen.deref V2146 V2147)))) (shen.bind! V2145 V2146 V2147 V2148)) ((and (shen.pvar? V2146) (not (shen.occurs-check? V2146 (shen.deref V2145 V2147)))) (shen.bind! V2146 V2145 V2147 V2148)) ((and (cons? V2145) (cons? V2146)) (shen.lzy=! (shen.lazyderef (hd V2145) V2147) (shen.lazyderef (hd V2146) V2147) V2147 (freeze (shen.lzy=! (shen.lazyderef (tl V2145) V2147) (shen.lazyderef (tl V2146) V2147) V2147 V2148)))) (true false))) +(defun shen.lzy=! (V1799 V1800 V1801 V1802) (cond ((= V1799 V1800) (thaw V1802)) ((and (shen.pvar? V1799) (not (shen.occurs-check? V1799 (shen.deref V1800 V1801)))) (shen.bind! V1799 V1800 V1801 V1802)) ((and (shen.pvar? V1800) (not (shen.occurs-check? V1800 (shen.deref V1799 V1801)))) (shen.bind! V1800 V1799 V1801 V1802)) ((and (cons? V1799) (cons? V1800)) (shen.lzy=! (shen.lazyderef (hd V1799) V1801) (shen.lazyderef (hd V1800) V1801) V1801 (freeze (shen.lzy=! (shen.lazyderef (tl V1799) V1801) (shen.lazyderef (tl V1800) V1801) V1801 V1802)))) (true false))) -(defun shen.lzy= (V2160 V2161 V2162 V2163) (cond ((= V2160 V2161) (thaw V2163)) ((shen.pvar? V2160) (shen.bind! V2160 V2161 V2162 V2163)) ((shen.pvar? V2161) (shen.bind! V2161 V2160 V2162 V2163)) ((and (cons? V2160) (cons? V2161)) (shen.lzy= (shen.lazyderef (hd V2160) V2162) (shen.lazyderef (hd V2161) V2162) V2162 (freeze (shen.lzy= (shen.lazyderef (tl V2160) V2162) (shen.lazyderef (tl V2161) V2162) V2162 V2163)))) (true false))) +(defun shen.lzy= (V1814 V1815 V1816 V1817) (cond ((= V1814 V1815) (thaw V1817)) ((shen.pvar? V1814) (shen.bind! V1814 V1815 V1816 V1817)) ((shen.pvar? V1815) (shen.bind! V1815 V1814 V1816 V1817)) ((and (cons? V1814) (cons? V1815)) (shen.lzy= (shen.lazyderef (hd V1814) V1816) (shen.lazyderef (hd V1815) V1816) V1816 (freeze (shen.lzy= (shen.lazyderef (tl V1814) V1816) (shen.lazyderef (tl V1815) V1816) V1816 V1817)))) (true false))) -(defun shen.occurs-check? (V2169 V2170) (cond ((= V2169 V2170) true) ((cons? V2170) (or (shen.occurs-check? V2169 (hd V2170)) (shen.occurs-check? V2169 (tl V2170)))) (true false))) +(defun shen.occurs-check? (V1823 V1824) (cond ((= V1823 V1824) true) ((cons? V1824) (or (shen.occurs-check? V1823 (hd V1824)) (shen.occurs-check? V1823 (tl V1824)))) (true false))) -(defun call (V2171 V2172 V2173 V2174 V2175) ((((V2171 V2172) V2173) V2174) V2175)) +(defun call (V1825 V1826 V1827 V1828 V1829) ((((V1825 V1826) V1827) V1828) V1829)) -(defun return (V2182 V2183 V2184 V2185 V2186) (shen.deref V2182 V2183)) +(defun return (V1836 V1837 V1838 V1839 V1840) (shen.deref V1836 V1837)) -(defun when (V2193 V2194 V2195 V2196 V2197) (if V2193 (thaw V2197) false)) +(defun when (V1847 V1848 V1849 V1850 V1851) (if V1847 (thaw V1851) false)) -(defun is (V2198 V2199 V2200 V2201 V2202 V2203) (shen.lzy= (shen.lazyderef V2198 V2200) (shen.lazyderef V2199 V2200) V2200 V2203)) +(defun is (V1852 V1853 V1854 V1855 V1856 V1857) (shen.lzy= (shen.lazyderef V1852 V1854) (shen.lazyderef V1853 V1854) V1854 V1857)) -(defun is! (V2204 V2205 V2206 V2207 V2208 V2209) (shen.lzy=! (shen.lazyderef V2204 V2206) (shen.lazyderef V2205 V2206) V2206 V2209)) +(defun is! (V1858 V1859 V1860 V1861 V1862 V1863) (shen.lzy=! (shen.lazyderef V1858 V1860) (shen.lazyderef V1859 V1860) V1860 V1863)) -(defun bind (V2214 V2215 V2216 V2217 V2218 V2219) (shen.bind! V2214 V2215 V2216 V2219)) +(defun bind (V1868 V1869 V1870 V1871 V1872 V1873) (shen.bind! V1868 V1869 V1870 V1873)) -(defun var? (V2220 V2221 V2222 V2223 V2224) (if (shen.pvar? (shen.lazyderef V2220 V2221)) (thaw V2224) false)) +(defun var? (V1874 V1875 V1876 V1877 V1878) (if (shen.pvar? (shen.lazyderef V1874 V1875)) (thaw V1878) false)) -(defun shen.print-prolog-vector (V2227) "|prolog vector|") +(defun shen.print-prolog-vector (V1881) "|prolog vector|") -(defun fork (V2246 V2247 V2248 V2249 V2250) (cond ((= () V2246) false) ((cons? V2246) (let W2251 (((((hd V2246) V2247) V2248) V2249) V2250) (if (= W2251 false) (fork (tl V2246) V2247 V2248 V2249 V2250) W2251))) (true (simple-error "fork expects a list of literals +(defun fork (V1900 V1901 V1902 V1903 V1904) (cond ((= () V1900) false) ((cons? V1900) (let W1905 (((((hd V1900) V1901) V1902) V1903) V1904) (if (= W1905 false) (fork (tl V1900) V1901 V1902 V1903 V1904) W1905))) (true (simple-error "fork expects a list of literals ")))) -(defun findall (V2252 V2253 V2254 V2255 V2256 V2257 V2258) (if (shen.unlocked? V2256) (let W2259 (shen.newpv V2255) (shen.gc V2255 (do (shen.incinfs) (is W2259 () V2255 V2256 V2257 (freeze (shen.findall-h V2252 V2253 V2254 W2259 V2255 V2256 V2257 V2258)))))) false)) +(defun findall (V1906 V1907 V1908 V1909 V1910 V1911 V1912) (if (shen.unlocked? V1910) (let W1913 (shen.newpv V1909) (shen.gc V1909 (do (shen.incinfs) (is W1913 () V1909 V1910 V1911 (freeze (shen.findall-h V1906 V1907 V1908 W1913 V1909 V1910 V1911 V1912)))))) false)) -(defun shen.findall-h (V2260 V2261 V2262 V2263 V2264 V2265 V2266 V2267) (let W2268 (if (shen.unlocked? V2265) (do (shen.incinfs) (call V2261 V2264 V2265 V2266 (freeze (shen.overbind V2260 V2263 V2264 V2265 V2266 V2267)))) false) (if (= W2268 false) (if (shen.unlocked? V2265) (do (shen.incinfs) (is! V2262 V2263 V2264 V2265 V2266 V2267)) false) W2268))) +(defun shen.findall-h (V1914 V1915 V1916 V1917 V1918 V1919 V1920 V1921) (let W1922 (if (shen.unlocked? V1919) (do (shen.incinfs) (call V1915 V1918 V1919 V1920 (freeze (shen.overbind V1914 V1917 V1918 V1919 V1920 V1921)))) false) (if (= W1922 false) (if (shen.unlocked? V1919) (do (shen.incinfs) (is! V1916 V1917 V1918 V1919 V1920 V1921)) false) W1922))) -(defun shen.overbind (V2275 V2276 V2277 V2278 V2279 V2280) (do (shen.bindv V2276 (cons (shen.deref V2275 V2277) (shen.lazyderef V2276 V2277)) V2277) false)) +(defun shen.overbind (V1929 V1930 V1931 V1932 V1933 V1934) (do (shen.bindv V1930 (cons (shen.deref V1929 V1931) (shen.lazyderef V1930 V1931)) V1931) false)) -(defun occurs-check (V2283) (cond ((= + V2283) (set shen.*occurs* true)) ((= - V2283) (set shen.*occurs* false)) (true (simple-error "occurs-check expects a + or a -. +(defun occurs-check (V1937) (cond ((= + V1937) (set shen.*occurs* true)) ((= - V1937) (set shen.*occurs* false)) (true (simple-error "occurs-check expects a + or a -. ")))) diff --git a/klambda/reader.kl b/klambda/reader.kl index f936cc7..ba23f33 100644 --- a/klambda/reader.kl +++ b/klambda/reader.kl @@ -1,275 +1,273 @@ -(defun read-file (V2528) (let W2529 (read-file-as-bytelist V2528) (let W2530 (trap-error (compile (lambda Z2531 (shen. Z2531)) W2529) (lambda Z2532 (shen.reader-error (value shen.*residue*)))) (let W2533 (shen.process-sexprs W2530) W2533)))) +(defun read-file (V2182) (let W2183 (read-file-as-bytelist V2182) (let W2184 (trap-error (compile (lambda Z2185 (shen. Z2185)) W2183) (lambda Z2186 (shen.reader-error (value shen.*residue*)))) (let W2187 (shen.process-sexprs W2184) W2187)))) -(defun shen.reader-error (V2534) (simple-error (shen.proc-nl (cn "reader error near here: " (shen.reader-error-message (value *maximum-print-sequence-size*) 0 V2534))))) +(defun shen.reader-error (V2188) (simple-error (shen.proc-nl (cn "reader error near here: " (shen.reader-error-message (value *maximum-print-sequence-size*) 0 V2188))))) -(defun shen.reader-error-message (V2542 V2543 V2544) (cond ((= () V2544) "") ((= V2542 V2543) "") ((cons? V2544) (cn (n->string (hd V2544)) (shen.reader-error-message V2542 (+ V2543 1) (tl V2544)))) (true (shen.f-error shen.reader-error-message)))) +(defun shen.reader-error-message (V2196 V2197 V2198) (cond ((= () V2198) "") ((= V2196 V2197) "") ((cons? V2198) (cn (n->string (hd V2198)) (shen.reader-error-message V2196 (+ V2197 1) (tl V2198)))) (true (simple-error "partial function shen.reader-error-message")))) (defun it () (value shen.*it*)) -(defun read-file-as-bytelist (V2545) (let W2546 (open V2545 in) (let W2547 (read-byte W2546) (let W2548 (shen.read-file-as-bytelist-help W2546 W2547 ()) (let W2549 (close W2546) (reverse W2548)))))) +(defun read-file-as-bytelist (V2199) (let W2200 (open V2199 in) (let W2201 (read-byte W2200) (let W2202 (shen.read-file-as-bytelist-help W2200 W2201 ()) (let W2203 (close W2200) (reverse W2202)))))) -(defun shen.read-file-as-bytelist-help (V2550 V2551 V2552) (cond ((= -1 V2551) V2552) (true (shen.read-file-as-bytelist-help V2550 (read-byte V2550) (cons V2551 V2552))))) +(defun shen.read-file-as-bytelist-help (V2204 V2205 V2206) (cond ((= -1 V2205) V2206) (true (shen.read-file-as-bytelist-help V2204 (read-byte V2204) (cons V2205 V2206))))) -(defun read-file-as-string (V2553) (let W2554 (open V2553 in) (shen.rfas-h W2554 (read-byte W2554) ""))) +(defun read-file-as-string (V2207) (let W2208 (open V2207 in) (shen.rfas-h W2208 (read-byte W2208) ""))) -(defun shen.rfas-h (V2555 V2556 V2557) (cond ((= -1 V2556) (do (close V2555) V2557)) (true (shen.rfas-h V2555 (read-byte V2555) (cn V2557 (n->string V2556)))))) +(defun shen.rfas-h (V2209 V2210 V2211) (cond ((= -1 V2210) (do (close V2209) V2211)) (true (shen.rfas-h V2209 (read-byte V2209) (cn V2211 (n->string V2210)))))) -(defun input (V2558) (eval-kl (read V2558))) +(defun input (V2212) (eval-kl (read V2212))) -(defun input+ (V2559 V2560) (let W2561 (shen.monotype V2559) (let W2562 (read V2560) (if (= false (shen.typecheck W2562 (shen.rectify-type V2559))) (simple-error (cn "type error: " (shen.app W2562 (cn " is not of type " (shen.app V2559 " -" shen.r)) shen.r))) (eval-kl W2562))))) +(defun shen.input-h+ (V2213 V2214) (let W2215 (shen.monotype V2213) (let W2216 (read V2214) (if (= false (shen.typecheck W2216 V2213)) (simple-error (cn "type error: " (shen.app W2216 (cn " is not of type " (shen.app V2213 " +" shen.r)) shen.r))) (eval-kl W2216))))) -(defun shen.monotype (V2563) (cond ((cons? V2563) (map (lambda Z2564 (shen.monotype Z2564)) V2563)) (true (if (variable? V2563) (simple-error (cn "input+ expects a monotype: not " (shen.app V2563 " -" shen.a))) V2563)))) +(defun shen.monotype (V2217) (cond ((cons? V2217) (map (lambda Z2218 (shen.monotype Z2218)) V2217)) (true (if (variable? V2217) (simple-error (cn "input+ expects a monotype: not " (shen.app V2217 " +" shen.a))) V2217)))) -(defun lineread (V2565) (shen.read-loop V2565 (shen.my-read-byte V2565) () (lambda Z2566 (shen.return? Z2566)))) +(defun lineread (V2219) (shen.read-loop V2219 (shen.my-read-byte V2219) () (lambda Z2220 (shen.return? Z2220)))) -(defun read-from-string (V2567) (let W2568 (shen.str->bytes V2567) (let W2569 (compile (lambda Z2570 (shen. Z2570)) W2568) (let W2571 (shen.process-sexprs W2569) W2571)))) +(defun read-from-string (V2221) (let W2222 (shen.str->bytes V2221) (let W2223 (compile (lambda Z2224 (shen. Z2224)) W2222) (let W2225 (shen.process-sexprs W2223) W2225)))) -(defun read-from-string-unprocessed (V2572) (let W2573 (shen.str->bytes V2572) (let W2574 (compile (lambda Z2575 (shen. Z2575)) W2573) W2574))) +(defun read-from-string-unprocessed (V2226) (let W2227 (shen.str->bytes V2226) (let W2228 (compile (lambda Z2229 (shen. Z2229)) W2227) W2228))) -(defun shen.str->bytes (V2576) (cond ((= "" V2576) ()) ((shen.+string? V2576) (cons (string->n (hdstr V2576)) (shen.str->bytes (tlstr V2576)))) (true (shen.f-error shen.str->bytes)))) +(defun shen.str->bytes (V2230) (cond ((= "" V2230) ()) ((shen.+string? V2230) (cons (string->n (hdstr V2230)) (shen.str->bytes (tlstr V2230)))) (true (simple-error "partial function shen.str->bytes")))) -(defun read (V2577) (hd (shen.read-loop V2577 (shen.my-read-byte V2577) () (lambda Z2578 (shen.whitespace? Z2578))))) +(defun read (V2231) (hd (shen.read-loop V2231 (shen.my-read-byte V2231) () (lambda Z2232 (shen.whitespace? Z2232))))) -(defun shen.my-read-byte (V2579) (if (shen.char-stinput? V2579) (string->n (shen.read-unit-string V2579)) (read-byte V2579))) +(defun shen.my-read-byte (V2233) (if (shen.char-stinput? V2233) (string->n (shen.read-unit-string V2233)) (read-byte V2233))) -(defun shen.read-loop (V2584 V2585 V2586 V2587) (cond ((= 94 V2585) (simple-error "read aborted")) ((= -1 V2585) (if (empty? V2586) (simple-error "error: empty stream") (compile (lambda Z2588 (shen. Z2588)) V2586))) ((= 0 V2585) (shen.read-loop V2584 (shen.my-read-byte V2584) V2586 V2587)) (true (if (V2587 V2585) (let W2589 (shen.try-parse V2586) (if (shen.nothing-doing? W2589) (shen.read-loop V2584 (shen.my-read-byte V2584) (append V2586 (cons V2585 ())) V2587) (do (shen.record-it V2586) W2589))) (shen.read-loop V2584 (shen.my-read-byte V2584) (append V2586 (cons V2585 ())) V2587))))) +(defun shen.read-loop (V2238 V2239 V2240 V2241) (cond ((= 94 V2239) (simple-error "read aborted")) ((= -1 V2239) (if (empty? V2240) (simple-error "error: empty stream") (compile (lambda Z2242 (shen. Z2242)) V2240))) ((= 0 V2239) (shen.read-loop V2238 (shen.my-read-byte V2238) V2240 V2241)) (true (if (V2241 V2239) (let W2243 (shen.try-parse V2240) (if (shen.nothing-doing? W2243) (shen.read-loop V2238 (shen.my-read-byte V2238) (append V2240 (cons V2239 ())) V2241) (do (shen.record-it V2240) W2243))) (shen.read-loop V2238 (shen.my-read-byte V2238) (append V2240 (cons V2239 ())) V2241))))) -(defun shen.try-parse (V2590) (let W2591 (trap-error (compile (lambda Z2592 (shen. Z2592)) V2590) (lambda Z2593 shen.i-failed!)) (if (shen.nothing-doing? W2591) shen.i-failed! (shen.process-sexprs W2591)))) +(defun shen.try-parse (V2244) (let W2245 (trap-error (compile (lambda Z2246 (shen. Z2246)) V2244) (lambda Z2247 shen.i-failed!)) (if (shen.nothing-doing? W2245) shen.i-failed! (shen.process-sexprs W2245)))) -(defun shen.nothing-doing? (V2596) (cond ((= shen.i-failed! V2596) true) ((= () V2596) true) (true false))) +(defun shen.nothing-doing? (V2250) (cond ((= shen.i-failed! V2250) true) ((= () V2250) true) (true false))) -(defun shen.record-it (V2597) (set shen.*it* (shen.bytes->string V2597))) +(defun shen.record-it (V2251) (set shen.*it* (shen.bytes->string V2251))) -(defun shen.bytes->string (V2598) (cond ((= () V2598) "") ((cons? V2598) (cn (n->string (hd V2598)) (shen.bytes->string (tl V2598)))) (true (shen.f-error shen.bytes->string)))) +(defun shen.bytes->string (V2252) (cond ((= () V2252) "") ((cons? V2252) (cn (n->string (hd V2252)) (shen.bytes->string (tl V2252)))) (true (simple-error "partial function shen.bytes->string")))) -(defun shen.process-sexprs (V2599) (let W2600 (shen.unpackage¯oexpand V2599) (let W2601 (shen.find-arities W2600) (let W2602 (shen.find-types W2600) (map (lambda Z2603 (shen.process-applications Z2603 W2602)) W2600))))) +(defun shen.process-sexprs (V2253) (let W2254 (shen.unpackage¯oexpand V2253) (let W2255 (shen.find-arities W2254) (let W2256 (shen.find-types W2254) (map (lambda Z2257 (shen.process-applications Z2257 W2256)) W2254))))) -(defun shen.find-types (V2604) (cond ((and (cons? V2604) (and (cons? (tl V2604)) (= (hd V2604) (intern ":")))) (cons (hd (tl V2604)) (shen.find-types (tl (tl V2604))))) ((cons? V2604) (append (shen.find-types (hd V2604)) (shen.find-types (tl V2604)))) (true ()))) +(defun shen.find-types (V2258) (cond ((and (cons? V2258) (and (cons? (tl V2258)) (= (hd V2258) (intern ":")))) (cons (hd (tl V2258)) (shen.find-types (tl (tl V2258))))) ((cons? V2258) (append (shen.find-types (hd V2258)) (shen.find-types (tl V2258)))) (true ()))) -(defun shen.find-arities (V2607) (cond ((and (cons? V2607) (and (= define (hd V2607)) (and (cons? (tl V2607)) (and (cons? (tl (tl V2607))) (= { (hd (tl (tl V2607)))))))) (shen.store-arity (hd (tl V2607)) (shen.find-arity (hd (tl V2607)) 1 (tl (tl (tl V2607)))))) ((and (cons? V2607) (and (= define (hd V2607)) (cons? (tl V2607)))) (shen.store-arity (hd (tl V2607)) (shen.find-arity (hd (tl V2607)) 0 (tl (tl V2607))))) ((cons? V2607) (map (lambda Z2608 (shen.find-arities Z2608)) V2607)) (true shen.skip))) +(defun shen.find-arities (V2261) (cond ((and (cons? V2261) (and (= define (hd V2261)) (and (cons? (tl V2261)) (and (cons? (tl (tl V2261))) (= { (hd (tl (tl V2261)))))))) (shen.store-arity (hd (tl V2261)) (shen.find-arity (hd (tl V2261)) 1 (tl (tl (tl V2261)))))) ((and (cons? V2261) (and (= define (hd V2261)) (cons? (tl V2261)))) (shen.store-arity (hd (tl V2261)) (shen.find-arity (hd (tl V2261)) 0 (tl (tl V2261))))) ((cons? V2261) (map (lambda Z2262 (shen.find-arities Z2262)) V2261)) (true shen.skip))) -(defun shen.store-arity (V2609 V2610) (let W2611 (arity V2609) (if (= W2611 -1) (shen.execute-store-arity V2609 V2610) (if (= W2611 V2610) shen.skip (if (shen.sysfunc? V2609) (simple-error (shen.app V2609 " is a system function -" shen.a)) (do (pr (cn "changing the arity of " (shen.app V2609 " may cause errors -" shen.a)) (stoutput)) (shen.execute-store-arity V2609 V2610))))))) +(defun shen.store-arity (V2263 V2264) (let W2265 (arity V2263) (if (= W2265 -1) (shen.execute-store-arity V2263 V2264) (if (= W2265 V2264) shen.skip (if (shen.sysfunc? V2263) (simple-error (shen.app V2263 " is a system function +" shen.a)) (do (pr (cn "changing the arity of " (shen.app V2263 " may cause errors +" shen.a)) (stoutput)) (shen.execute-store-arity V2263 V2264))))))) -(defun shen.execute-store-arity (V2612 V2613) (cond ((= 0 V2613) (put V2612 arity 0 (value *property-vector*))) (true (do (put V2612 arity V2613 (value *property-vector*)) (shen.update-lambdatable V2612 V2613))))) +(defun shen.execute-store-arity (V2266 V2267) (cond ((= 0 V2267) (put V2266 arity 0 (value *property-vector*))) (true (do (put V2266 arity V2267 (value *property-vector*)) (shen.update-lambdatable V2266 V2267))))) -(defun shen.update-lambdatable (V2614 V2615) (let W2616 (eval-kl (shen.lambda-function (cons V2614 ()) V2615)) (let W2617 (shen.set-lambda-form-entry (cons V2614 W2616)) V2615))) +(defun shen.update-lambdatable (V2268 V2269) (let W2270 (value shen.*lambdatable*) (let W2271 (eval-kl (shen.lambda-function (cons V2268 ()) V2269)) (let W2272 (shen.assoc-> V2268 W2271 W2270) (let W2273 (set shen.*lambdatable* W2272) W2273))))) -(defun shen.lambda-function (V2620 V2621) (cond ((= 0 V2621) shen.skip) ((= 1 V2621) (let W2622 (gensym Y) (cons lambda (cons W2622 (cons (append V2620 (cons W2622 ())) ()))))) (true (let W2623 (gensym Y) (cons lambda (cons W2623 (cons (shen.lambda-function (append V2620 (cons W2623 ())) (- V2621 1)) ()))))))) +(defun shen.lambda-function (V2276 V2277) (cond ((= 0 V2277) shen.skip) ((= 1 V2277) (let W2278 (gensym Y) (cons lambda (cons W2278 (cons (append V2276 (cons W2278 ())) ()))))) (true (let W2279 (gensym Y) (cons lambda (cons W2279 (cons (shen.lambda-function (append V2276 (cons W2279 ())) (- V2277 1)) ()))))))) -(defun shen.assoc-> (V2633 V2634 V2635) (cond ((= () V2635) (cons (cons V2633 V2634) ())) ((and (cons? V2635) (and (cons? (hd V2635)) (= V2633 (hd (hd V2635))))) (cons (cons (hd (hd V2635)) V2634) (tl V2635))) ((cons? V2635) (cons (hd V2635) (shen.assoc-> V2633 V2634 (tl V2635)))) (true (simple-error "implementation error in shen.assoc->")))) +(defun shen.assoc-> (V2289 V2290 V2291) (cond ((= () V2291) (cons (cons V2289 V2290) ())) ((and (cons? V2291) (and (cons? (hd V2291)) (= V2289 (hd (hd V2291))))) (cons (cons (hd (hd V2291)) V2290) (tl V2291))) ((cons? V2291) (cons (hd V2291) (shen.assoc-> V2289 V2290 (tl V2291)))) (true (simple-error "implementation error in shen.assoc->")))) -(defun shen.find-arity (V2650 V2651 V2652) (cond ((and (= 0 V2651) (and (cons? V2652) (= (hd V2652) ->))) 0) ((and (= 0 V2651) (and (cons? V2652) (= (hd V2652) <-))) 0) ((and (= 0 V2651) (cons? V2652)) (+ 1 (shen.find-arity V2650 0 (tl V2652)))) ((and (= 1 V2651) (and (cons? V2652) (= } (hd V2652)))) (shen.find-arity V2650 0 (tl V2652))) ((and (= 1 V2651) (cons? V2652)) (shen.find-arity V2650 1 (tl V2652))) ((= 1 V2651) (simple-error (cn "syntax error in " (shen.app V2650 " definition: missing } -" shen.a)))) (true (simple-error (cn "syntax error in " (shen.app V2650 " definition: missing -> or <- +(defun shen.find-arity (V2306 V2307 V2308) (cond ((and (= 0 V2307) (and (cons? V2308) (= (hd V2308) ->))) 0) ((and (= 0 V2307) (and (cons? V2308) (= (hd V2308) <-))) 0) ((and (= 0 V2307) (cons? V2308)) (+ 1 (shen.find-arity V2306 0 (tl V2308)))) ((and (= 1 V2307) (and (cons? V2308) (= } (hd V2308)))) (shen.find-arity V2306 0 (tl V2308))) ((and (= 1 V2307) (cons? V2308)) (shen.find-arity V2306 1 (tl V2308))) ((= 1 V2307) (simple-error (cn "syntax error in " (shen.app V2306 " definition: missing } +" shen.a)))) (true (simple-error (cn "syntax error in " (shen.app V2306 " definition: missing -> or <- " shen.a)))))) -(defun shen. (V2653) (let W2654 (let W2655 (shen. V2653) (if (shen.parse-failure? W2655) (shen.parse-failure) (let W2656 (shen.in-> W2655) (let W2657 (shen. W2656) (if (shen.parse-failure? W2657) (shen.parse-failure) (let W2658 (shen.<-out W2657) (let W2659 (shen.in-> W2657) (let W2660 (shen. W2659) (if (shen.parse-failure? W2660) (shen.parse-failure) (let W2661 (shen.in-> W2660) (let W2662 (shen. W2661) (if (shen.parse-failure? W2662) (shen.parse-failure) (let W2663 (shen.<-out W2662) (let W2664 (shen.in-> W2662) (shen.comb W2664 (cons (shen.cons-form W2658) W2663)))))))))))))))) (if (shen.parse-failure? W2654) (let W2665 (let W2666 (shen. V2653) (if (shen.parse-failure? W2666) (shen.parse-failure) (let W2667 (shen.in-> W2666) (let W2668 (shen. W2667) (if (shen.parse-failure? W2668) (shen.parse-failure) (let W2669 (shen.<-out W2668) (let W2670 (shen.in-> W2668) (let W2671 (shen. W2670) (if (shen.parse-failure? W2671) (shen.parse-failure) (let W2672 (shen.in-> W2671) (let W2673 (shen. W2672) (if (shen.parse-failure? W2673) (shen.parse-failure) (let W2674 (shen.<-out W2673) (let W2675 (shen.in-> W2673) (shen.comb W2675 (shen.add-sexpr W2669 W2674)))))))))))))))) (if (shen.parse-failure? W2665) (let W2676 (let W2677 (shen. V2653) (if (shen.parse-failure? W2677) (shen.parse-failure) (let W2678 (shen.in-> W2677) (let W2679 (shen. W2678) (if (shen.parse-failure? W2679) (shen.parse-failure) (let W2680 (shen.<-out W2679) (let W2681 (shen.in-> W2679) (shen.comb W2681 (cons { W2680))))))))) (if (shen.parse-failure? W2676) (let W2682 (let W2683 (shen. V2653) (if (shen.parse-failure? W2683) (shen.parse-failure) (let W2684 (shen.in-> W2683) (let W2685 (shen. W2684) (if (shen.parse-failure? W2685) (shen.parse-failure) (let W2686 (shen.<-out W2685) (let W2687 (shen.in-> W2685) (shen.comb W2687 (cons } W2686))))))))) (if (shen.parse-failure? W2682) (let W2688 (let W2689 (shen. V2653) (if (shen.parse-failure? W2689) (shen.parse-failure) (let W2690 (shen.in-> W2689) (let W2691 (shen. W2690) (if (shen.parse-failure? W2691) (shen.parse-failure) (let W2692 (shen.<-out W2691) (let W2693 (shen.in-> W2691) (shen.comb W2693 (cons bar! W2692))))))))) (if (shen.parse-failure? W2688) (let W2694 (let W2695 (shen. V2653) (if (shen.parse-failure? W2695) (shen.parse-failure) (let W2696 (shen.in-> W2695) (let W2697 (shen. W2696) (if (shen.parse-failure? W2697) (shen.parse-failure) (let W2698 (shen.<-out W2697) (let W2699 (shen.in-> W2697) (shen.comb W2699 (cons (intern ";") W2698))))))))) (if (shen.parse-failure? W2694) (let W2700 (let W2701 (shen. V2653) (if (shen.parse-failure? W2701) (shen.parse-failure) (let W2702 (shen.in-> W2701) (let W2703 (shen. W2702) (if (shen.parse-failure? W2703) (shen.parse-failure) (let W2704 (shen.in-> W2703) (let W2705 (shen. W2704) (if (shen.parse-failure? W2705) (shen.parse-failure) (let W2706 (shen.<-out W2705) (let W2707 (shen.in-> W2705) (shen.comb W2707 (cons (intern ":=") W2706)))))))))))) (if (shen.parse-failure? W2700) (let W2708 (let W2709 (shen. V2653) (if (shen.parse-failure? W2709) (shen.parse-failure) (let W2710 (shen.in-> W2709) (let W2711 (shen. W2710) (if (shen.parse-failure? W2711) (shen.parse-failure) (let W2712 (shen.<-out W2711) (let W2713 (shen.in-> W2711) (shen.comb W2713 (cons (intern ":") W2712))))))))) (if (shen.parse-failure? W2708) (let W2714 (let W2715 (shen. V2653) (if (shen.parse-failure? W2715) (shen.parse-failure) (let W2716 (shen.in-> W2715) (let W2717 (shen. W2716) (if (shen.parse-failure? W2717) (shen.parse-failure) (let W2718 (shen.<-out W2717) (let W2719 (shen.in-> W2717) (shen.comb W2719 (cons (intern ",") W2718))))))))) (if (shen.parse-failure? W2714) (let W2720 (let W2721 (shen. V2653) (if (shen.parse-failure? W2721) (shen.parse-failure) (let W2722 (shen.in-> W2721) (let W2723 (shen. W2722) (if (shen.parse-failure? W2723) (shen.parse-failure) (let W2724 (shen.<-out W2723) (let W2725 (shen.in-> W2723) (shen.comb W2725 W2724)))))))) (if (shen.parse-failure? W2720) (let W2726 (let W2727 (shen. V2653) (if (shen.parse-failure? W2727) (shen.parse-failure) (let W2728 (shen.<-out W2727) (let W2729 (shen.in-> W2727) (let W2730 (shen. W2729) (if (shen.parse-failure? W2730) (shen.parse-failure) (let W2731 (shen.<-out W2730) (let W2732 (shen.in-> W2730) (shen.comb W2732 (cons W2728 W2731)))))))))) (if (shen.parse-failure? W2726) (let W2733 (let W2734 (shen. V2653) (if (shen.parse-failure? W2734) (shen.parse-failure) (let W2735 (shen.in-> W2734) (let W2736 (shen. W2735) (if (shen.parse-failure? W2736) (shen.parse-failure) (let W2737 (shen.<-out W2736) (let W2738 (shen.in-> W2736) (shen.comb W2738 W2737)))))))) (if (shen.parse-failure? W2733) (let W2739 (let W2740 ( V2653) (if (shen.parse-failure? W2740) (shen.parse-failure) (let W2741 (shen.in-> W2740) (shen.comb W2741 ())))) (if (shen.parse-failure? W2739) (shen.parse-failure) W2739)) W2733)) W2726)) W2720)) W2714)) W2708)) W2700)) W2694)) W2688)) W2682)) W2676)) W2665)) W2654))) +(defun shen. (V2309) (let W2310 (let W2311 (shen. V2309) (if (shen.parse-failure? W2311) (shen.parse-failure) (let W2312 (shen.in-> W2311) (let W2313 (shen. W2312) (if (shen.parse-failure? W2313) (shen.parse-failure) (let W2314 (shen.<-out W2313) (let W2315 (shen.in-> W2313) (let W2316 (shen. W2315) (if (shen.parse-failure? W2316) (shen.parse-failure) (let W2317 (shen.in-> W2316) (let W2318 (shen. W2317) (if (shen.parse-failure? W2318) (shen.parse-failure) (let W2319 (shen.<-out W2318) (let W2320 (shen.in-> W2318) (shen.comb W2320 (cons (shen.cons-form W2314) W2319)))))))))))))))) (if (shen.parse-failure? W2310) (let W2321 (let W2322 (shen. V2309) (if (shen.parse-failure? W2322) (shen.parse-failure) (let W2323 (shen.in-> W2322) (let W2324 (shen. W2323) (if (shen.parse-failure? W2324) (shen.parse-failure) (let W2325 (shen.<-out W2324) (let W2326 (shen.in-> W2324) (let W2327 (shen. W2326) (if (shen.parse-failure? W2327) (shen.parse-failure) (let W2328 (shen.in-> W2327) (let W2329 (shen. W2328) (if (shen.parse-failure? W2329) (shen.parse-failure) (let W2330 (shen.<-out W2329) (let W2331 (shen.in-> W2329) (shen.comb W2331 (shen.add-sexpr W2325 W2330)))))))))))))))) (if (shen.parse-failure? W2321) (let W2332 (let W2333 (shen. V2309) (if (shen.parse-failure? W2333) (shen.parse-failure) (let W2334 (shen.in-> W2333) (let W2335 (shen. W2334) (if (shen.parse-failure? W2335) (shen.parse-failure) (let W2336 (shen.<-out W2335) (let W2337 (shen.in-> W2335) (shen.comb W2337 (cons { W2336))))))))) (if (shen.parse-failure? W2332) (let W2338 (let W2339 (shen. V2309) (if (shen.parse-failure? W2339) (shen.parse-failure) (let W2340 (shen.in-> W2339) (let W2341 (shen. W2340) (if (shen.parse-failure? W2341) (shen.parse-failure) (let W2342 (shen.<-out W2341) (let W2343 (shen.in-> W2341) (shen.comb W2343 (cons } W2342))))))))) (if (shen.parse-failure? W2338) (let W2344 (let W2345 (shen. V2309) (if (shen.parse-failure? W2345) (shen.parse-failure) (let W2346 (shen.in-> W2345) (let W2347 (shen. W2346) (if (shen.parse-failure? W2347) (shen.parse-failure) (let W2348 (shen.<-out W2347) (let W2349 (shen.in-> W2347) (shen.comb W2349 (cons bar! W2348))))))))) (if (shen.parse-failure? W2344) (let W2350 (let W2351 (shen. V2309) (if (shen.parse-failure? W2351) (shen.parse-failure) (let W2352 (shen.in-> W2351) (let W2353 (shen. W2352) (if (shen.parse-failure? W2353) (shen.parse-failure) (let W2354 (shen.<-out W2353) (let W2355 (shen.in-> W2353) (shen.comb W2355 (cons (intern ";") W2354))))))))) (if (shen.parse-failure? W2350) (let W2356 (let W2357 (shen. V2309) (if (shen.parse-failure? W2357) (shen.parse-failure) (let W2358 (shen.in-> W2357) (let W2359 (shen. W2358) (if (shen.parse-failure? W2359) (shen.parse-failure) (let W2360 (shen.in-> W2359) (let W2361 (shen. W2360) (if (shen.parse-failure? W2361) (shen.parse-failure) (let W2362 (shen.<-out W2361) (let W2363 (shen.in-> W2361) (shen.comb W2363 (cons (intern ":=") W2362)))))))))))) (if (shen.parse-failure? W2356) (let W2364 (let W2365 (shen. V2309) (if (shen.parse-failure? W2365) (shen.parse-failure) (let W2366 (shen.in-> W2365) (let W2367 (shen. W2366) (if (shen.parse-failure? W2367) (shen.parse-failure) (let W2368 (shen.<-out W2367) (let W2369 (shen.in-> W2367) (shen.comb W2369 (cons (intern ":") W2368))))))))) (if (shen.parse-failure? W2364) (let W2370 (let W2371 (shen. V2309) (if (shen.parse-failure? W2371) (shen.parse-failure) (let W2372 (shen.in-> W2371) (let W2373 (shen. W2372) (if (shen.parse-failure? W2373) (shen.parse-failure) (let W2374 (shen.<-out W2373) (let W2375 (shen.in-> W2373) (shen.comb W2375 (cons (intern ",") W2374))))))))) (if (shen.parse-failure? W2370) (let W2376 (let W2377 (shen. V2309) (if (shen.parse-failure? W2377) (shen.parse-failure) (let W2378 (shen.in-> W2377) (let W2379 (shen. W2378) (if (shen.parse-failure? W2379) (shen.parse-failure) (let W2380 (shen.<-out W2379) (let W2381 (shen.in-> W2379) (shen.comb W2381 W2380)))))))) (if (shen.parse-failure? W2376) (let W2382 (let W2383 (shen. V2309) (if (shen.parse-failure? W2383) (shen.parse-failure) (let W2384 (shen.<-out W2383) (let W2385 (shen.in-> W2383) (let W2386 (shen. W2385) (if (shen.parse-failure? W2386) (shen.parse-failure) (let W2387 (shen.<-out W2386) (let W2388 (shen.in-> W2386) (shen.comb W2388 (cons W2384 W2387)))))))))) (if (shen.parse-failure? W2382) (let W2389 (let W2390 (shen. V2309) (if (shen.parse-failure? W2390) (shen.parse-failure) (let W2391 (shen.in-> W2390) (let W2392 (shen. W2391) (if (shen.parse-failure? W2392) (shen.parse-failure) (let W2393 (shen.<-out W2392) (let W2394 (shen.in-> W2392) (shen.comb W2394 W2393)))))))) (if (shen.parse-failure? W2389) (let W2395 (let W2396 ( V2309) (if (shen.parse-failure? W2396) (shen.parse-failure) (let W2397 (shen.in-> W2396) (shen.comb W2397 ())))) (if (shen.parse-failure? W2395) (shen.parse-failure) W2395)) W2389)) W2382)) W2376)) W2370)) W2364)) W2356)) W2350)) W2344)) W2338)) W2332)) W2321)) W2310))) -(defun shen.add-sexpr (V2742 V2743) (cond ((and (cons? V2742) (and (= $ (hd V2742)) (and (cons? (tl V2742)) (= () (tl (tl V2742)))))) (append (explode (hd (tl V2742))) V2743)) (true (cons V2742 V2743)))) +(defun shen.add-sexpr (V2398 V2399) (cond ((and (cons? V2398) (and (= $ (hd V2398)) (and (cons? (tl V2398)) (= () (tl (tl V2398)))))) (append (explode (hd (tl V2398))) V2399)) (true (cons V2398 V2399)))) -(defun shen. (V2744) (let W2745 (if (shen.hds=? V2744 91) (let W2746 (tail V2744) (shen.comb W2746 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2745) (shen.parse-failure) W2745))) +(defun shen. (V2400) (let W2401 (if (shen.hds=? V2400 91) (let W2402 (tail V2400) (shen.comb W2402 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2401) (shen.parse-failure) W2401))) -(defun shen. (V2747) (let W2748 (if (shen.hds=? V2747 93) (let W2749 (tail V2747) (shen.comb W2749 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2748) (shen.parse-failure) W2748))) +(defun shen. (V2403) (let W2404 (if (shen.hds=? V2403 93) (let W2405 (tail V2403) (shen.comb W2405 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2404) (shen.parse-failure) W2404))) -(defun shen. (V2750) (let W2751 (let W2752 (shen. V2750) (if (shen.parse-failure? W2752) (shen.parse-failure) (let W2753 (shen.<-out W2752) (let W2754 (shen.in-> W2752) (shen.comb W2754 W2753))))) (if (shen.parse-failure? W2751) (shen.parse-failure) W2751))) +(defun shen. (V2406) (let W2407 (let W2408 (shen. V2406) (if (shen.parse-failure? W2408) (shen.parse-failure) (let W2409 (shen.<-out W2408) (let W2410 (shen.in-> W2408) (shen.comb W2410 W2409))))) (if (shen.parse-failure? W2407) (shen.parse-failure) W2407))) -(defun shen. (V2755) (let W2756 (let W2757 (shen. V2755) (if (shen.parse-failure? W2757) (shen.parse-failure) (let W2758 (shen.<-out W2757) (let W2759 (shen.in-> W2757) (shen.comb W2759 W2758))))) (if (shen.parse-failure? W2756) (shen.parse-failure) W2756))) +(defun shen. (V2411) (let W2412 (let W2413 (shen. V2411) (if (shen.parse-failure? W2413) (shen.parse-failure) (let W2414 (shen.<-out W2413) (let W2415 (shen.in-> W2413) (shen.comb W2415 W2414))))) (if (shen.parse-failure? W2412) (shen.parse-failure) W2412))) -(defun shen.cons-form (V2761) (cond ((= () V2761) ()) ((and (cons? V2761) (and (cons? (tl V2761)) (and (cons? (tl (tl V2761))) (and (= () (tl (tl (tl V2761)))) (= (hd (tl V2761)) bar!))))) (cons cons (cons (hd V2761) (tl (tl V2761))))) ((and (cons? V2761) (and (cons? (tl V2761)) (and (cons? (tl (tl V2761))) (and (cons? (tl (tl (tl V2761)))) (= (hd (tl V2761)) bar!))))) (simple-error "misapplication of | -")) ((cons? V2761) (cons cons (cons (hd V2761) (cons (shen.cons-form (tl V2761)) ())))) (true (shen.f-error shen.cons-form)))) +(defun shen.cons-form (V2417) (cond ((= () V2417) ()) ((and (cons? V2417) (and (cons? (tl V2417)) (and (cons? (tl (tl V2417))) (and (= () (tl (tl (tl V2417)))) (= (hd (tl V2417)) bar!))))) (cons cons (cons (hd V2417) (tl (tl V2417))))) ((and (cons? V2417) (and (cons? (tl V2417)) (and (cons? (tl (tl V2417))) (and (cons? (tl (tl (tl V2417)))) (= (hd (tl V2417)) bar!))))) (simple-error "misapplication of | +")) ((cons? V2417) (cons cons (cons (hd V2417) (cons (shen.cons-form (tl V2417)) ())))) (true (simple-error "partial function shen.cons-form")))) -(defun shen. (V2762) (let W2763 (if (shen.hds=? V2762 40) (let W2764 (tail V2762) (shen.comb W2764 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2763) (shen.parse-failure) W2763))) +(defun shen. (V2418) (let W2419 (if (shen.hds=? V2418 40) (let W2420 (tail V2418) (shen.comb W2420 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2419) (shen.parse-failure) W2419))) -(defun shen. (V2765) (let W2766 (if (shen.hds=? V2765 41) (let W2767 (tail V2765) (shen.comb W2767 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2766) (shen.parse-failure) W2766))) +(defun shen. (V2421) (let W2422 (if (shen.hds=? V2421 41) (let W2423 (tail V2421) (shen.comb W2423 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2422) (shen.parse-failure) W2422))) -(defun shen. (V2768) (let W2769 (if (shen.hds=? V2768 123) (let W2770 (tail V2768) (shen.comb W2770 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2769) (shen.parse-failure) W2769))) +(defun shen. (V2424) (let W2425 (if (shen.hds=? V2424 123) (let W2426 (tail V2424) (shen.comb W2426 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2425) (shen.parse-failure) W2425))) -(defun shen. (V2771) (let W2772 (if (shen.hds=? V2771 125) (let W2773 (tail V2771) (shen.comb W2773 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2772) (shen.parse-failure) W2772))) +(defun shen. (V2427) (let W2428 (if (shen.hds=? V2427 125) (let W2429 (tail V2427) (shen.comb W2429 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2428) (shen.parse-failure) W2428))) -(defun shen. (V2774) (let W2775 (if (shen.hds=? V2774 124) (let W2776 (tail V2774) (shen.comb W2776 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2775) (shen.parse-failure) W2775))) +(defun shen. (V2430) (let W2431 (if (shen.hds=? V2430 124) (let W2432 (tail V2430) (shen.comb W2432 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2431) (shen.parse-failure) W2431))) -(defun shen. (V2777) (let W2778 (if (shen.hds=? V2777 59) (let W2779 (tail V2777) (shen.comb W2779 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2778) (shen.parse-failure) W2778))) +(defun shen. (V2433) (let W2434 (if (shen.hds=? V2433 59) (let W2435 (tail V2433) (shen.comb W2435 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2434) (shen.parse-failure) W2434))) -(defun shen. (V2780) (let W2781 (if (shen.hds=? V2780 58) (let W2782 (tail V2780) (shen.comb W2782 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2781) (shen.parse-failure) W2781))) +(defun shen. (V2436) (let W2437 (if (shen.hds=? V2436 58) (let W2438 (tail V2436) (shen.comb W2438 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2437) (shen.parse-failure) W2437))) -(defun shen. (V2783) (let W2784 (if (shen.hds=? V2783 44) (let W2785 (tail V2783) (shen.comb W2785 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2784) (shen.parse-failure) W2784))) +(defun shen. (V2439) (let W2440 (if (shen.hds=? V2439 44) (let W2441 (tail V2439) (shen.comb W2441 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2440) (shen.parse-failure) W2440))) -(defun shen. (V2786) (let W2787 (if (shen.hds=? V2786 61) (let W2788 (tail V2786) (shen.comb W2788 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2787) (shen.parse-failure) W2787))) +(defun shen. (V2442) (let W2443 (if (shen.hds=? V2442 61) (let W2444 (tail V2442) (shen.comb W2444 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2443) (shen.parse-failure) W2443))) -(defun shen. (V2789) (let W2790 (let W2791 (shen. V2789) (if (shen.parse-failure? W2791) (shen.parse-failure) (let W2792 (shen.in-> W2791) (shen.comb W2792 shen.skip)))) (if (shen.parse-failure? W2790) (let W2793 (let W2794 (shen. V2789) (if (shen.parse-failure? W2794) (shen.parse-failure) (let W2795 (shen.in-> W2794) (shen.comb W2795 shen.skip)))) (if (shen.parse-failure? W2793) (shen.parse-failure) W2793)) W2790))) +(defun shen. (V2445) (let W2446 (let W2447 (shen. V2445) (if (shen.parse-failure? W2447) (shen.parse-failure) (let W2448 (shen.in-> W2447) (shen.comb W2448 shen.skip)))) (if (shen.parse-failure? W2446) (let W2449 (let W2450 (shen. V2445) (if (shen.parse-failure? W2450) (shen.parse-failure) (let W2451 (shen.in-> W2450) (shen.comb W2451 shen.skip)))) (if (shen.parse-failure? W2449) (shen.parse-failure) W2449)) W2446))) -(defun shen. (V2796) (let W2797 (let W2798 (shen. V2796) (if (shen.parse-failure? W2798) (shen.parse-failure) (let W2799 (shen.in-> W2798) (let W2800 (shen. W2799) (if (shen.parse-failure? W2800) (shen.parse-failure) (let W2801 (shen.in-> W2800) (let W2802 (shen. W2801) (if (shen.parse-failure? W2802) (shen.parse-failure) (let W2803 (shen.in-> W2802) (let W2804 (shen. W2803) (if (shen.parse-failure? W2804) (shen.parse-failure) (let W2805 (shen.in-> W2804) (shen.comb W2805 shen.skip))))))))))))) (if (shen.parse-failure? W2797) (shen.parse-failure) W2797))) +(defun shen. (V2452) (let W2453 (let W2454 (shen. V2452) (if (shen.parse-failure? W2454) (shen.parse-failure) (let W2455 (shen.in-> W2454) (let W2456 (shen. W2455) (if (shen.parse-failure? W2456) (shen.parse-failure) (let W2457 (shen.in-> W2456) (let W2458 (shen. W2457) (if (shen.parse-failure? W2458) (shen.parse-failure) (let W2459 (shen.in-> W2458) (let W2460 (shen. W2459) (if (shen.parse-failure? W2460) (shen.parse-failure) (let W2461 (shen.in-> W2460) (shen.comb W2461 shen.skip))))))))))))) (if (shen.parse-failure? W2453) (shen.parse-failure) W2453))) -(defun shen. (V2806) (let W2807 (if (shen.hds=? V2806 92) (let W2808 (tail V2806) (shen.comb W2808 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2807) (shen.parse-failure) W2807))) +(defun shen. (V2462) (let W2463 (if (shen.hds=? V2462 92) (let W2464 (tail V2462) (shen.comb W2464 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2463) (shen.parse-failure) W2463))) -(defun shen. (V2809) (let W2810 (let W2811 (shen. V2809) (if (shen.parse-failure? W2811) (shen.parse-failure) (let W2812 (shen.in-> W2811) (let W2813 (shen. W2812) (if (shen.parse-failure? W2813) (shen.parse-failure) (let W2814 (shen.in-> W2813) (shen.comb W2814 shen.skip))))))) (if (shen.parse-failure? W2810) (let W2815 (let W2816 ( V2809) (if (shen.parse-failure? W2816) (shen.parse-failure) (let W2817 (shen.in-> W2816) (shen.comb W2817 shen.skip)))) (if (shen.parse-failure? W2815) (shen.parse-failure) W2815)) W2810))) +(defun shen. (V2465) (let W2466 (let W2467 (shen. V2465) (if (shen.parse-failure? W2467) (shen.parse-failure) (let W2468 (shen.in-> W2467) (let W2469 (shen. W2468) (if (shen.parse-failure? W2469) (shen.parse-failure) (let W2470 (shen.in-> W2469) (shen.comb W2470 shen.skip))))))) (if (shen.parse-failure? W2466) (let W2471 (let W2472 ( V2465) (if (shen.parse-failure? W2472) (shen.parse-failure) (let W2473 (shen.in-> W2472) (shen.comb W2473 shen.skip)))) (if (shen.parse-failure? W2471) (shen.parse-failure) W2471)) W2466))) -(defun shen. (V2818) (let W2819 (if (cons? V2818) (let W2820 (head V2818) (let W2821 (tail V2818) (if (not (shen.return? W2820)) (shen.comb W2821 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2819) (shen.parse-failure) W2819))) +(defun shen. (V2474) (let W2475 (if (cons? V2474) (let W2476 (head V2474) (let W2477 (tail V2474) (if (not (shen.return? W2476)) (shen.comb W2477 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2475) (shen.parse-failure) W2475))) -(defun shen. (V2822) (let W2823 (let W2824 (shen. V2822) (if (shen.parse-failure? W2824) (shen.parse-failure) (let W2825 (shen.in-> W2824) (let W2826 (shen. W2825) (if (shen.parse-failure? W2826) (shen.parse-failure) (let W2827 (shen.in-> W2826) (shen.comb W2827 shen.skip))))))) (if (shen.parse-failure? W2823) (let W2828 (let W2829 (shen. V2822) (if (shen.parse-failure? W2829) (shen.parse-failure) (let W2830 (shen.in-> W2829) (shen.comb W2830 shen.skip)))) (if (shen.parse-failure? W2828) (shen.parse-failure) W2828)) W2823))) +(defun shen. (V2478) (let W2479 (let W2480 (shen. V2478) (if (shen.parse-failure? W2480) (shen.parse-failure) (let W2481 (shen.in-> W2480) (let W2482 (shen. W2481) (if (shen.parse-failure? W2482) (shen.parse-failure) (let W2483 (shen.in-> W2482) (shen.comb W2483 shen.skip))))))) (if (shen.parse-failure? W2479) (let W2484 (let W2485 (shen. V2478) (if (shen.parse-failure? W2485) (shen.parse-failure) (let W2486 (shen.in-> W2485) (shen.comb W2486 shen.skip)))) (if (shen.parse-failure? W2484) (shen.parse-failure) W2484)) W2479))) -(defun shen. (V2831) (let W2832 (if (cons? V2831) (let W2833 (head V2831) (let W2834 (tail V2831) (if (shen.return? W2833) (shen.comb W2834 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2832) (shen.parse-failure) W2832))) +(defun shen. (V2487) (let W2488 (if (cons? V2487) (let W2489 (head V2487) (let W2490 (tail V2487) (if (shen.return? W2489) (shen.comb W2490 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2488) (shen.parse-failure) W2488))) -(defun shen.return? (V2835) (element? V2835 (cons 9 (cons 10 (cons 13 ()))))) +(defun shen.return? (V2491) (element? V2491 (cons 9 (cons 10 (cons 13 ()))))) -(defun shen. (V2836) (let W2837 (let W2838 (shen. V2836) (if (shen.parse-failure? W2838) (shen.parse-failure) (let W2839 (shen.in-> W2838) (let W2840 (shen. W2839) (if (shen.parse-failure? W2840) (shen.parse-failure) (let W2841 (shen.in-> W2840) (let W2842 (shen. W2841) (if (shen.parse-failure? W2842) (shen.parse-failure) (let W2843 (shen.in-> W2842) (shen.comb W2843 shen.skip)))))))))) (if (shen.parse-failure? W2837) (shen.parse-failure) W2837))) +(defun shen. (V2492) (let W2493 (let W2494 (shen. V2492) (if (shen.parse-failure? W2494) (shen.parse-failure) (let W2495 (shen.in-> W2494) (let W2496 (shen. W2495) (if (shen.parse-failure? W2496) (shen.parse-failure) (let W2497 (shen.in-> W2496) (let W2498 (shen. W2497) (if (shen.parse-failure? W2498) (shen.parse-failure) (let W2499 (shen.in-> W2498) (shen.comb W2499 shen.skip)))))))))) (if (shen.parse-failure? W2493) (shen.parse-failure) W2493))) -(defun shen. (V2844) (let W2845 (if (shen.hds=? V2844 42) (let W2846 (tail V2844) (shen.comb W2846 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2845) (shen.parse-failure) W2845))) +(defun shen. (V2500) (let W2501 (if (shen.hds=? V2500 42) (let W2502 (tail V2500) (shen.comb W2502 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2501) (shen.parse-failure) W2501))) -(defun shen. (V2847) (let W2848 (let W2849 (shen. V2847) (if (shen.parse-failure? W2849) (shen.parse-failure) (let W2850 (shen.in-> W2849) (let W2851 (shen. W2850) (if (shen.parse-failure? W2851) (shen.parse-failure) (let W2852 (shen.in-> W2851) (shen.comb W2852 shen.skip))))))) (if (shen.parse-failure? W2848) (let W2853 (let W2854 (shen. V2847) (if (shen.parse-failure? W2854) (shen.parse-failure) (let W2855 (shen.in-> W2854) (let W2856 (shen. W2855) (if (shen.parse-failure? W2856) (shen.parse-failure) (let W2857 (shen.in-> W2856) (shen.comb W2857 shen.skip))))))) (if (shen.parse-failure? W2853) (let W2858 (if (cons? V2847) (let W2859 (tail V2847) (let W2860 (shen. W2859) (if (shen.parse-failure? W2860) (shen.parse-failure) (let W2861 (shen.in-> W2860) (shen.comb W2861 shen.skip))))) (shen.parse-failure)) (if (shen.parse-failure? W2858) (shen.parse-failure) W2858)) W2853)) W2848))) +(defun shen. (V2503) (let W2504 (let W2505 (shen. V2503) (if (shen.parse-failure? W2505) (shen.parse-failure) (let W2506 (shen.in-> W2505) (let W2507 (shen. W2506) (if (shen.parse-failure? W2507) (shen.parse-failure) (let W2508 (shen.in-> W2507) (shen.comb W2508 shen.skip))))))) (if (shen.parse-failure? W2504) (let W2509 (let W2510 (shen. V2503) (if (shen.parse-failure? W2510) (shen.parse-failure) (let W2511 (shen.in-> W2510) (let W2512 (shen. W2511) (if (shen.parse-failure? W2512) (shen.parse-failure) (let W2513 (shen.in-> W2512) (shen.comb W2513 shen.skip))))))) (if (shen.parse-failure? W2509) (let W2514 (if (cons? V2503) (let W2515 (tail V2503) (let W2516 (shen. W2515) (if (shen.parse-failure? W2516) (shen.parse-failure) (let W2517 (shen.in-> W2516) (shen.comb W2517 shen.skip))))) (shen.parse-failure)) (if (shen.parse-failure? W2514) (shen.parse-failure) W2514)) W2509)) W2504))) -(defun shen. (V2862) (let W2863 (let W2864 (shen. V2862) (if (shen.parse-failure? W2864) (shen.parse-failure) (let W2865 (shen.<-out W2864) (let W2866 (shen.in-> W2864) (shen.comb W2866 W2865))))) (if (shen.parse-failure? W2863) (let W2867 (let W2868 (shen. V2862) (if (shen.parse-failure? W2868) (shen.parse-failure) (let W2869 (shen.<-out W2868) (let W2870 (shen.in-> W2868) (shen.comb W2870 W2869))))) (if (shen.parse-failure? W2867) (let W2871 (let W2872 (shen. V2862) (if (shen.parse-failure? W2872) (shen.parse-failure) (let W2873 (shen.<-out W2872) (let W2874 (shen.in-> W2872) (shen.comb W2874 (if (= W2873 "<>") (cons vector (cons 0 ())) (intern W2873))))))) (if (shen.parse-failure? W2871) (shen.parse-failure) W2871)) W2867)) W2863))) +(defun shen. (V2518) (let W2519 (let W2520 (shen. V2518) (if (shen.parse-failure? W2520) (shen.parse-failure) (let W2521 (shen.<-out W2520) (let W2522 (shen.in-> W2520) (shen.comb W2522 W2521))))) (if (shen.parse-failure? W2519) (let W2523 (let W2524 (shen. V2518) (if (shen.parse-failure? W2524) (shen.parse-failure) (let W2525 (shen.<-out W2524) (let W2526 (shen.in-> W2524) (shen.comb W2526 W2525))))) (if (shen.parse-failure? W2523) (let W2527 (let W2528 (shen. V2518) (if (shen.parse-failure? W2528) (shen.parse-failure) (let W2529 (shen.<-out W2528) (let W2530 (shen.in-> W2528) (shen.comb W2530 (if (= W2529 "<>") (cons vector (cons 0 ())) (intern W2529))))))) (if (shen.parse-failure? W2527) (shen.parse-failure) W2527)) W2523)) W2519))) -(defun shen. (V2875) (let W2876 (let W2877 (shen. V2875) (if (shen.parse-failure? W2877) (shen.parse-failure) (let W2878 (shen.<-out W2877) (let W2879 (shen.in-> W2877) (let W2880 (shen. W2879) (if (shen.parse-failure? W2880) (shen.parse-failure) (let W2881 (shen.<-out W2880) (let W2882 (shen.in-> W2880) (shen.comb W2882 (cn W2878 W2881)))))))))) (if (shen.parse-failure? W2876) (shen.parse-failure) W2876))) +(defun shen. (V2531) (let W2532 (let W2533 (shen. V2531) (if (shen.parse-failure? W2533) (shen.parse-failure) (let W2534 (shen.<-out W2533) (let W2535 (shen.in-> W2533) (let W2536 (shen. W2535) (if (shen.parse-failure? W2536) (shen.parse-failure) (let W2537 (shen.<-out W2536) (let W2538 (shen.in-> W2536) (shen.comb W2538 (cn W2534 W2537)))))))))) (if (shen.parse-failure? W2532) (shen.parse-failure) W2532))) -(defun shen. (V2883) (let W2884 (if (cons? V2883) (let W2885 (head V2883) (let W2886 (tail V2883) (if (shen.alpha? W2885) (shen.comb W2886 (n->string W2885)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2884) (shen.parse-failure) W2884))) +(defun shen. (V2539) (let W2540 (if (cons? V2539) (let W2541 (head V2539) (let W2542 (tail V2539) (if (shen.alpha? W2541) (shen.comb W2542 (n->string W2541)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2540) (shen.parse-failure) W2540))) -(defun shen.alpha? (V2887) (or (shen.lowercase? V2887) (or (shen.uppercase? V2887) (shen.misc? V2887)))) +(defun shen.alpha? (V2543) (or (shen.lowercase? V2543) (or (shen.uppercase? V2543) (shen.misc? V2543)))) -(defun shen.lowercase? (V2888) (and (>= V2888 97) (<= V2888 122))) +(defun shen.lowercase? (V2544) (and (>= V2544 97) (<= V2544 122))) -(defun shen.uppercase? (V2889) (and (>= V2889 65) (<= V2889 90))) +(defun shen.uppercase? (V2545) (and (>= V2545 65) (<= V2545 90))) -(defun shen.misc? (V2890) (element? V2890 (cons 61 (cons 45 (cons 42 (cons 47 (cons 43 (cons 95 (cons 63 (cons 36 (cons 33 (cons 64 (cons 126 (cons 46 (cons 62 (cons 60 (cons 38 (cons 37 (cons 39 (cons 35 (cons 96 ()))))))))))))))))))))) +(defun shen.misc? (V2546) (element? V2546 (cons 61 (cons 45 (cons 42 (cons 47 (cons 43 (cons 95 (cons 63 (cons 36 (cons 33 (cons 64 (cons 126 (cons 46 (cons 62 (cons 60 (cons 38 (cons 37 (cons 39 (cons 35 (cons 96 ()))))))))))))))))))))) -(defun shen. (V2891) (let W2892 (let W2893 (shen. V2891) (if (shen.parse-failure? W2893) (shen.parse-failure) (let W2894 (shen.<-out W2893) (let W2895 (shen.in-> W2893) (let W2896 (shen. W2895) (if (shen.parse-failure? W2896) (shen.parse-failure) (let W2897 (shen.<-out W2896) (let W2898 (shen.in-> W2896) (shen.comb W2898 (cn W2894 W2897)))))))))) (if (shen.parse-failure? W2892) (let W2899 (let W2900 ( V2891) (if (shen.parse-failure? W2900) (shen.parse-failure) (let W2901 (shen.in-> W2900) (shen.comb W2901 "")))) (if (shen.parse-failure? W2899) (shen.parse-failure) W2899)) W2892))) +(defun shen. (V2547) (let W2548 (let W2549 (shen. V2547) (if (shen.parse-failure? W2549) (shen.parse-failure) (let W2550 (shen.<-out W2549) (let W2551 (shen.in-> W2549) (let W2552 (shen. W2551) (if (shen.parse-failure? W2552) (shen.parse-failure) (let W2553 (shen.<-out W2552) (let W2554 (shen.in-> W2552) (shen.comb W2554 (cn W2550 W2553)))))))))) (if (shen.parse-failure? W2548) (let W2555 (let W2556 ( V2547) (if (shen.parse-failure? W2556) (shen.parse-failure) (let W2557 (shen.in-> W2556) (shen.comb W2557 "")))) (if (shen.parse-failure? W2555) (shen.parse-failure) W2555)) W2548))) -(defun shen. (V2902) (let W2903 (let W2904 (shen. V2902) (if (shen.parse-failure? W2904) (shen.parse-failure) (let W2905 (shen.<-out W2904) (let W2906 (shen.in-> W2904) (shen.comb W2906 W2905))))) (if (shen.parse-failure? W2903) (let W2907 (let W2908 (shen. V2902) (if (shen.parse-failure? W2908) (shen.parse-failure) (let W2909 (shen.<-out W2908) (let W2910 (shen.in-> W2908) (shen.comb W2910 W2909))))) (if (shen.parse-failure? W2907) (shen.parse-failure) W2907)) W2903))) +(defun shen. (V2558) (let W2559 (let W2560 (shen. V2558) (if (shen.parse-failure? W2560) (shen.parse-failure) (let W2561 (shen.<-out W2560) (let W2562 (shen.in-> W2560) (shen.comb W2562 W2561))))) (if (shen.parse-failure? W2559) (let W2563 (let W2564 (shen. V2558) (if (shen.parse-failure? W2564) (shen.parse-failure) (let W2565 (shen.<-out W2564) (let W2566 (shen.in-> W2564) (shen.comb W2566 W2565))))) (if (shen.parse-failure? W2563) (shen.parse-failure) W2563)) W2559))) -(defun shen. (V2911) (let W2912 (if (cons? V2911) (let W2913 (head V2911) (let W2914 (tail V2911) (if (shen.digit? W2913) (shen.comb W2914 (n->string W2913)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2912) (shen.parse-failure) W2912))) +(defun shen. (V2567) (let W2568 (if (cons? V2567) (let W2569 (head V2567) (let W2570 (tail V2567) (if (shen.digit? W2569) (shen.comb W2570 (n->string W2569)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2568) (shen.parse-failure) W2568))) -(defun shen.digit? (V2915) (and (>= V2915 48) (<= V2915 57))) +(defun shen.digit? (V2571) (and (>= V2571 48) (<= V2571 57))) -(defun shen. (V2916) (let W2917 (let W2918 (shen. V2916) (if (shen.parse-failure? W2918) (shen.parse-failure) (let W2919 (shen.in-> W2918) (let W2920 (shen. W2919) (if (shen.parse-failure? W2920) (shen.parse-failure) (let W2921 (shen.<-out W2920) (let W2922 (shen.in-> W2920) (let W2923 (shen. W2922) (if (shen.parse-failure? W2923) (shen.parse-failure) (let W2924 (shen.in-> W2923) (shen.comb W2924 W2921))))))))))) (if (shen.parse-failure? W2917) (shen.parse-failure) W2917))) +(defun shen. (V2572) (let W2573 (let W2574 (shen. V2572) (if (shen.parse-failure? W2574) (shen.parse-failure) (let W2575 (shen.in-> W2574) (let W2576 (shen. W2575) (if (shen.parse-failure? W2576) (shen.parse-failure) (let W2577 (shen.<-out W2576) (let W2578 (shen.in-> W2576) (let W2579 (shen. W2578) (if (shen.parse-failure? W2579) (shen.parse-failure) (let W2580 (shen.in-> W2579) (shen.comb W2580 W2577))))))))))) (if (shen.parse-failure? W2573) (shen.parse-failure) W2573))) -(defun shen. (V2925) (let W2926 (if (shen.hds=? V2925 34) (let W2927 (tail V2925) (shen.comb W2927 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2926) (shen.parse-failure) W2926))) +(defun shen. (V2581) (let W2582 (if (shen.hds=? V2581 34) (let W2583 (tail V2581) (shen.comb W2583 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2582) (shen.parse-failure) W2582))) -(defun shen. (V2928) (let W2929 (let W2930 (shen. V2928) (if (shen.parse-failure? W2930) (shen.parse-failure) (let W2931 (shen.<-out W2930) (let W2932 (shen.in-> W2930) (let W2933 (shen. W2932) (if (shen.parse-failure? W2933) (shen.parse-failure) (let W2934 (shen.<-out W2933) (let W2935 (shen.in-> W2933) (shen.comb W2935 (cn W2931 W2934)))))))))) (if (shen.parse-failure? W2929) (let W2936 (let W2937 ( V2928) (if (shen.parse-failure? W2937) (shen.parse-failure) (let W2938 (shen.in-> W2937) (shen.comb W2938 "")))) (if (shen.parse-failure? W2936) (shen.parse-failure) W2936)) W2929))) +(defun shen. (V2584) (let W2585 (let W2586 (shen. V2584) (if (shen.parse-failure? W2586) (shen.parse-failure) (let W2587 (shen.<-out W2586) (let W2588 (shen.in-> W2586) (let W2589 (shen. W2588) (if (shen.parse-failure? W2589) (shen.parse-failure) (let W2590 (shen.<-out W2589) (let W2591 (shen.in-> W2589) (shen.comb W2591 (cn W2587 W2590)))))))))) (if (shen.parse-failure? W2585) (let W2592 (let W2593 ( V2584) (if (shen.parse-failure? W2593) (shen.parse-failure) (let W2594 (shen.in-> W2593) (shen.comb W2594 "")))) (if (shen.parse-failure? W2592) (shen.parse-failure) W2592)) W2585))) -(defun shen. (V2939) (let W2940 (let W2941 (shen. V2939) (if (shen.parse-failure? W2941) (shen.parse-failure) (let W2942 (shen.<-out W2941) (let W2943 (shen.in-> W2941) (shen.comb W2943 W2942))))) (if (shen.parse-failure? W2940) (let W2944 (let W2945 (shen. V2939) (if (shen.parse-failure? W2945) (shen.parse-failure) (let W2946 (shen.<-out W2945) (let W2947 (shen.in-> W2945) (shen.comb W2947 W2946))))) (if (shen.parse-failure? W2944) (shen.parse-failure) W2944)) W2940))) +(defun shen. (V2595) (let W2596 (let W2597 (shen. V2595) (if (shen.parse-failure? W2597) (shen.parse-failure) (let W2598 (shen.<-out W2597) (let W2599 (shen.in-> W2597) (shen.comb W2599 W2598))))) (if (shen.parse-failure? W2596) (let W2600 (let W2601 (shen. V2595) (if (shen.parse-failure? W2601) (shen.parse-failure) (let W2602 (shen.<-out W2601) (let W2603 (shen.in-> W2601) (shen.comb W2603 W2602))))) (if (shen.parse-failure? W2600) (shen.parse-failure) W2600)) W2596))) -(defun shen. (V2948) (let W2949 (let W2950 (shen. V2948) (if (shen.parse-failure? W2950) (shen.parse-failure) (let W2951 (shen.in-> W2950) (let W2952 (shen. W2951) (if (shen.parse-failure? W2952) (shen.parse-failure) (let W2953 (shen.in-> W2952) (let W2954 (shen. W2953) (if (shen.parse-failure? W2954) (shen.parse-failure) (let W2955 (shen.<-out W2954) (let W2956 (shen.in-> W2954) (let W2957 (shen. W2956) (if (shen.parse-failure? W2957) (shen.parse-failure) (let W2958 (shen.in-> W2957) (shen.comb W2958 (n->string W2955))))))))))))))) (if (shen.parse-failure? W2949) (shen.parse-failure) W2949))) +(defun shen. (V2604) (let W2605 (let W2606 (shen. V2604) (if (shen.parse-failure? W2606) (shen.parse-failure) (let W2607 (shen.in-> W2606) (let W2608 (shen. W2607) (if (shen.parse-failure? W2608) (shen.parse-failure) (let W2609 (shen.in-> W2608) (let W2610 (shen. W2609) (if (shen.parse-failure? W2610) (shen.parse-failure) (let W2611 (shen.<-out W2610) (let W2612 (shen.in-> W2610) (let W2613 (shen. W2612) (if (shen.parse-failure? W2613) (shen.parse-failure) (let W2614 (shen.in-> W2613) (shen.comb W2614 (n->string W2611))))))))))))))) (if (shen.parse-failure? W2605) (shen.parse-failure) W2605))) -(defun shen. (V2959) (let W2960 (if (cons? V2959) (let W2961 (head V2959) (let W2962 (tail V2959) (if (not (= W2961 34)) (shen.comb W2962 (n->string W2961)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2960) (shen.parse-failure) W2960))) +(defun shen. (V2615) (let W2616 (if (cons? V2615) (let W2617 (head V2615) (let W2618 (tail V2615) (if (not (= W2617 34)) (shen.comb W2618 (n->string W2617)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2616) (shen.parse-failure) W2616))) -(defun shen. (V2963) (let W2964 (if (shen.hds=? V2963 99) (let W2965 (tail V2963) (shen.comb W2965 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2964) (shen.parse-failure) W2964))) +(defun shen. (V2619) (let W2620 (if (shen.hds=? V2619 99) (let W2621 (tail V2619) (shen.comb W2621 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2620) (shen.parse-failure) W2620))) -(defun shen. (V2966) (let W2967 (if (shen.hds=? V2966 35) (let W2968 (tail V2966) (shen.comb W2968 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2967) (shen.parse-failure) W2967))) +(defun shen. (V2622) (let W2623 (if (shen.hds=? V2622 35) (let W2624 (tail V2622) (shen.comb W2624 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2623) (shen.parse-failure) W2623))) -(defun shen. (V2969) (let W2970 (let W2971 (shen. V2969) (if (shen.parse-failure? W2971) (shen.parse-failure) (let W2972 (shen.in-> W2971) (let W2973 (shen. W2972) (if (shen.parse-failure? W2973) (shen.parse-failure) (let W2974 (shen.<-out W2973) (let W2975 (shen.in-> W2973) (shen.comb W2975 (- 0 W2974))))))))) (if (shen.parse-failure? W2970) (let W2976 (let W2977 (shen. V2969) (if (shen.parse-failure? W2977) (shen.parse-failure) (let W2978 (shen.in-> W2977) (let W2979 (shen. W2978) (if (shen.parse-failure? W2979) (shen.parse-failure) (let W2980 (shen.<-out W2979) (let W2981 (shen.in-> W2979) (shen.comb W2981 W2980)))))))) (if (shen.parse-failure? W2976) (let W2982 (let W2983 (shen. V2969) (if (shen.parse-failure? W2983) (shen.parse-failure) (let W2984 (shen.<-out W2983) (let W2985 (shen.in-> W2983) (shen.comb W2985 W2984))))) (if (shen.parse-failure? W2982) (let W2986 (let W2987 (shen. V2969) (if (shen.parse-failure? W2987) (shen.parse-failure) (let W2988 (shen.<-out W2987) (let W2989 (shen.in-> W2987) (shen.comb W2989 W2988))))) (if (shen.parse-failure? W2986) (let W2990 (let W2991 (shen. V2969) (if (shen.parse-failure? W2991) (shen.parse-failure) (let W2992 (shen.<-out W2991) (let W2993 (shen.in-> W2991) (shen.comb W2993 W2992))))) (if (shen.parse-failure? W2990) (shen.parse-failure) W2990)) W2986)) W2982)) W2976)) W2970))) +(defun shen. (V2625) (let W2626 (let W2627 (shen. V2625) (if (shen.parse-failure? W2627) (shen.parse-failure) (let W2628 (shen.in-> W2627) (let W2629 (shen. W2628) (if (shen.parse-failure? W2629) (shen.parse-failure) (let W2630 (shen.<-out W2629) (let W2631 (shen.in-> W2629) (shen.comb W2631 (- 0 W2630))))))))) (if (shen.parse-failure? W2626) (let W2632 (let W2633 (shen. V2625) (if (shen.parse-failure? W2633) (shen.parse-failure) (let W2634 (shen.in-> W2633) (let W2635 (shen. W2634) (if (shen.parse-failure? W2635) (shen.parse-failure) (let W2636 (shen.<-out W2635) (let W2637 (shen.in-> W2635) (shen.comb W2637 W2636)))))))) (if (shen.parse-failure? W2632) (let W2638 (let W2639 (shen. V2625) (if (shen.parse-failure? W2639) (shen.parse-failure) (let W2640 (shen.<-out W2639) (let W2641 (shen.in-> W2639) (shen.comb W2641 W2640))))) (if (shen.parse-failure? W2638) (let W2642 (let W2643 (shen. V2625) (if (shen.parse-failure? W2643) (shen.parse-failure) (let W2644 (shen.<-out W2643) (let W2645 (shen.in-> W2643) (shen.comb W2645 W2644))))) (if (shen.parse-failure? W2642) (let W2646 (let W2647 (shen. V2625) (if (shen.parse-failure? W2647) (shen.parse-failure) (let W2648 (shen.<-out W2647) (let W2649 (shen.in-> W2647) (shen.comb W2649 W2648))))) (if (shen.parse-failure? W2646) (shen.parse-failure) W2646)) W2642)) W2638)) W2632)) W2626))) -(defun shen. (V2994) (let W2995 (if (shen.hds=? V2994 45) (let W2996 (tail V2994) (shen.comb W2996 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2995) (shen.parse-failure) W2995))) +(defun shen. (V2650) (let W2651 (if (shen.hds=? V2650 45) (let W2652 (tail V2650) (shen.comb W2652 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2651) (shen.parse-failure) W2651))) -(defun shen. (V2997) (let W2998 (if (shen.hds=? V2997 43) (let W2999 (tail V2997) (shen.comb W2999 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2998) (shen.parse-failure) W2998))) +(defun shen. (V2653) (let W2654 (if (shen.hds=? V2653 43) (let W2655 (tail V2653) (shen.comb W2655 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2654) (shen.parse-failure) W2654))) -(defun shen. (V3000) (let W3001 (let W3002 (shen. V3000) (if (shen.parse-failure? W3002) (shen.parse-failure) (let W3003 (shen.<-out W3002) (let W3004 (shen.in-> W3002) (shen.comb W3004 (shen.compute-integer W3003)))))) (if (shen.parse-failure? W3001) (shen.parse-failure) W3001))) +(defun shen. (V2656) (let W2657 (let W2658 (shen. V2656) (if (shen.parse-failure? W2658) (shen.parse-failure) (let W2659 (shen.<-out W2658) (let W2660 (shen.in-> W2658) (shen.comb W2660 (shen.compute-integer W2659)))))) (if (shen.parse-failure? W2657) (shen.parse-failure) W2657))) -(defun shen. (V3005) (let W3006 (let W3007 (shen. V3005) (if (shen.parse-failure? W3007) (shen.parse-failure) (let W3008 (shen.<-out W3007) (let W3009 (shen.in-> W3007) (let W3010 (shen. W3009) (if (shen.parse-failure? W3010) (shen.parse-failure) (let W3011 (shen.<-out W3010) (let W3012 (shen.in-> W3010) (shen.comb W3012 (cons W3008 W3011)))))))))) (if (shen.parse-failure? W3006) (let W3013 (let W3014 (shen. V3005) (if (shen.parse-failure? W3014) (shen.parse-failure) (let W3015 (shen.<-out W3014) (let W3016 (shen.in-> W3014) (shen.comb W3016 (cons W3015 ())))))) (if (shen.parse-failure? W3013) (shen.parse-failure) W3013)) W3006))) +(defun shen. (V2661) (let W2662 (let W2663 (shen. V2661) (if (shen.parse-failure? W2663) (shen.parse-failure) (let W2664 (shen.<-out W2663) (let W2665 (shen.in-> W2663) (let W2666 (shen. W2665) (if (shen.parse-failure? W2666) (shen.parse-failure) (let W2667 (shen.<-out W2666) (let W2668 (shen.in-> W2666) (shen.comb W2668 (cons W2664 W2667)))))))))) (if (shen.parse-failure? W2662) (let W2669 (let W2670 (shen. V2661) (if (shen.parse-failure? W2670) (shen.parse-failure) (let W2671 (shen.<-out W2670) (let W2672 (shen.in-> W2670) (shen.comb W2672 (cons W2671 ())))))) (if (shen.parse-failure? W2669) (shen.parse-failure) W2669)) W2662))) -(defun shen. (V3017) (let W3018 (if (cons? V3017) (let W3019 (head V3017) (let W3020 (tail V3017) (if (shen.digit? W3019) (shen.comb W3020 (shen.byte->digit W3019)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3018) (shen.parse-failure) W3018))) +(defun shen. (V2673) (let W2674 (if (cons? V2673) (let W2675 (head V2673) (let W2676 (tail V2673) (if (shen.digit? W2675) (shen.comb W2676 (shen.byte->digit W2675)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2674) (shen.parse-failure) W2674))) -(defun shen.byte->digit (V3021) (- V3021 48)) +(defun shen.byte->digit (V2677) (- V2677 48)) -(defun shen.compute-integer (V3022) (shen.compute-integer-h (reverse V3022) 0)) +(defun shen.compute-integer (V2678) (shen.compute-integer-h (reverse V2678) 0)) -(defun shen.compute-integer-h (V3025 V3026) (cond ((= () V3025) 0) ((cons? V3025) (+ (* (shen.expt 10 V3026) (hd V3025)) (shen.compute-integer-h (tl V3025) (+ V3026 1)))) (true (shen.f-error shen.compute-integer-h)))) +(defun shen.compute-integer-h (V2681 V2682) (cond ((= () V2681) 0) ((cons? V2681) (+ (* (shen.expt 10 V2682) (hd V2681)) (shen.compute-integer-h (tl V2681) (+ V2682 1)))) (true (simple-error "partial function shen.compute-integer-h")))) -(defun shen.expt (V3029 V3030) (cond ((= 0 V3030) 1) ((> V3030 0) (* V3029 (shen.expt V3029 (- V3030 1)))) (true (/ (shen.expt V3029 (+ V3030 1)) V3029)))) +(defun shen.expt (V2685 V2686) (cond ((= 0 V2686) 1) ((> V2686 0) (* V2685 (shen.expt V2685 (- V2686 1)))) (true (/ (shen.expt V2685 (+ V2686 1)) V2685)))) -(defun shen. (V3031) (let W3032 (let W3033 (shen. V3031) (if (shen.parse-failure? W3033) (shen.parse-failure) (let W3034 (shen.<-out W3033) (let W3035 (shen.in-> W3033) (let W3036 (shen. W3035) (if (shen.parse-failure? W3036) (shen.parse-failure) (let W3037 (shen.in-> W3036) (let W3038 (shen. W3037) (if (shen.parse-failure? W3038) (shen.parse-failure) (let W3039 (shen.<-out W3038) (let W3040 (shen.in-> W3038) (shen.comb W3040 (+ W3034 W3039))))))))))))) (if (shen.parse-failure? W3032) (let W3041 (let W3042 (shen. V3031) (if (shen.parse-failure? W3042) (shen.parse-failure) (let W3043 (shen.in-> W3042) (let W3044 (shen. W3043) (if (shen.parse-failure? W3044) (shen.parse-failure) (let W3045 (shen.<-out W3044) (let W3046 (shen.in-> W3044) (shen.comb W3046 W3045)))))))) (if (shen.parse-failure? W3041) (shen.parse-failure) W3041)) W3032))) +(defun shen. (V2687) (let W2688 (let W2689 (shen. V2687) (if (shen.parse-failure? W2689) (shen.parse-failure) (let W2690 (shen.<-out W2689) (let W2691 (shen.in-> W2689) (let W2692 (shen. W2691) (if (shen.parse-failure? W2692) (shen.parse-failure) (let W2693 (shen.in-> W2692) (let W2694 (shen. W2693) (if (shen.parse-failure? W2694) (shen.parse-failure) (let W2695 (shen.<-out W2694) (let W2696 (shen.in-> W2694) (shen.comb W2696 (+ W2690 W2695))))))))))))) (if (shen.parse-failure? W2688) (let W2697 (let W2698 (shen. V2687) (if (shen.parse-failure? W2698) (shen.parse-failure) (let W2699 (shen.in-> W2698) (let W2700 (shen. W2699) (if (shen.parse-failure? W2700) (shen.parse-failure) (let W2701 (shen.<-out W2700) (let W2702 (shen.in-> W2700) (shen.comb W2702 W2701)))))))) (if (shen.parse-failure? W2697) (shen.parse-failure) W2697)) W2688))) -(defun shen. (V3047) (let W3048 (if (shen.hds=? V3047 46) (let W3049 (tail V3047) (shen.comb W3049 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W3048) (shen.parse-failure) W3048))) +(defun shen. (V2703) (let W2704 (if (shen.hds=? V2703 46) (let W2705 (tail V2703) (shen.comb W2705 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2704) (shen.parse-failure) W2704))) -(defun shen. (V3050) (let W3051 (let W3052 (shen. V3050) (if (shen.parse-failure? W3052) (shen.parse-failure) (let W3053 (shen.<-out W3052) (let W3054 (shen.in-> W3052) (shen.comb W3054 (shen.compute-fraction W3053)))))) (if (shen.parse-failure? W3051) (shen.parse-failure) W3051))) +(defun shen. (V2706) (let W2707 (let W2708 (shen. V2706) (if (shen.parse-failure? W2708) (shen.parse-failure) (let W2709 (shen.<-out W2708) (let W2710 (shen.in-> W2708) (shen.comb W2710 (shen.compute-fraction W2709)))))) (if (shen.parse-failure? W2707) (shen.parse-failure) W2707))) -(defun shen.compute-fraction (V3055) (shen.compute-fraction-h V3055 -1)) +(defun shen.compute-fraction (V2711) (shen.compute-fraction-h V2711 -1)) -(defun shen.compute-fraction-h (V3058 V3059) (cond ((= () V3058) 0) ((cons? V3058) (+ (* (shen.expt 10 V3059) (hd V3058)) (shen.compute-fraction-h (tl V3058) (- V3059 1)))) (true (shen.f-error shen.compute-fraction-h)))) +(defun shen.compute-fraction-h (V2714 V2715) (cond ((= () V2714) 0) ((cons? V2714) (+ (* (shen.expt 10 V2715) (hd V2714)) (shen.compute-fraction-h (tl V2714) (- V2715 1)))) (true (simple-error "partial function shen.compute-fraction-h")))) -(defun shen. (V3060) (let W3061 (let W3062 (shen. V3060) (if (shen.parse-failure? W3062) (shen.parse-failure) (let W3063 (shen.<-out W3062) (let W3064 (shen.in-> W3062) (let W3065 (shen. W3064) (if (shen.parse-failure? W3065) (shen.parse-failure) (let W3066 (shen.in-> W3065) (let W3067 (shen. W3066) (if (shen.parse-failure? W3067) (shen.parse-failure) (let W3068 (shen.<-out W3067) (let W3069 (shen.in-> W3067) (shen.comb W3069 (shen.compute-E W3063 W3068))))))))))))) (if (shen.parse-failure? W3061) (let W3070 (let W3071 (shen. V3060) (if (shen.parse-failure? W3071) (shen.parse-failure) (let W3072 (shen.<-out W3071) (let W3073 (shen.in-> W3071) (let W3074 (shen. W3073) (if (shen.parse-failure? W3074) (shen.parse-failure) (let W3075 (shen.in-> W3074) (let W3076 (shen. W3075) (if (shen.parse-failure? W3076) (shen.parse-failure) (let W3077 (shen.<-out W3076) (let W3078 (shen.in-> W3076) (shen.comb W3078 (shen.compute-E W3072 W3077))))))))))))) (if (shen.parse-failure? W3070) (shen.parse-failure) W3070)) W3061))) +(defun shen. (V2716) (let W2717 (let W2718 (shen. V2716) (if (shen.parse-failure? W2718) (shen.parse-failure) (let W2719 (shen.<-out W2718) (let W2720 (shen.in-> W2718) (let W2721 (shen. W2720) (if (shen.parse-failure? W2721) (shen.parse-failure) (let W2722 (shen.in-> W2721) (let W2723 (shen. W2722) (if (shen.parse-failure? W2723) (shen.parse-failure) (let W2724 (shen.<-out W2723) (let W2725 (shen.in-> W2723) (shen.comb W2725 (shen.compute-E W2719 W2724))))))))))))) (if (shen.parse-failure? W2717) (let W2726 (let W2727 (shen. V2716) (if (shen.parse-failure? W2727) (shen.parse-failure) (let W2728 (shen.<-out W2727) (let W2729 (shen.in-> W2727) (let W2730 (shen. W2729) (if (shen.parse-failure? W2730) (shen.parse-failure) (let W2731 (shen.in-> W2730) (let W2732 (shen. W2731) (if (shen.parse-failure? W2732) (shen.parse-failure) (let W2733 (shen.<-out W2732) (let W2734 (shen.in-> W2732) (shen.comb W2734 (shen.compute-E W2728 W2733))))))))))))) (if (shen.parse-failure? W2726) (shen.parse-failure) W2726)) W2717))) -(defun shen. (V3079) (let W3080 (let W3081 (shen. V3079) (if (shen.parse-failure? W3081) (shen.parse-failure) (let W3082 (shen.in-> W3081) (let W3083 (shen. W3082) (if (shen.parse-failure? W3083) (shen.parse-failure) (let W3084 (shen.<-out W3083) (let W3085 (shen.in-> W3083) (shen.comb W3085 W3084)))))))) (if (shen.parse-failure? W3080) (let W3086 (let W3087 (shen. V3079) (if (shen.parse-failure? W3087) (shen.parse-failure) (let W3088 (shen.in-> W3087) (let W3089 (shen. W3088) (if (shen.parse-failure? W3089) (shen.parse-failure) (let W3090 (shen.<-out W3089) (let W3091 (shen.in-> W3089) (shen.comb W3091 (- 0 W3090))))))))) (if (shen.parse-failure? W3086) (let W3092 (let W3093 (shen. V3079) (if (shen.parse-failure? W3093) (shen.parse-failure) (let W3094 (shen.<-out W3093) (let W3095 (shen.in-> W3093) (shen.comb W3095 W3094))))) (if (shen.parse-failure? W3092) (shen.parse-failure) W3092)) W3086)) W3080))) +(defun shen. (V2735) (let W2736 (let W2737 (shen. V2735) (if (shen.parse-failure? W2737) (shen.parse-failure) (let W2738 (shen.in-> W2737) (let W2739 (shen. W2738) (if (shen.parse-failure? W2739) (shen.parse-failure) (let W2740 (shen.<-out W2739) (let W2741 (shen.in-> W2739) (shen.comb W2741 W2740)))))))) (if (shen.parse-failure? W2736) (let W2742 (let W2743 (shen. V2735) (if (shen.parse-failure? W2743) (shen.parse-failure) (let W2744 (shen.in-> W2743) (let W2745 (shen. W2744) (if (shen.parse-failure? W2745) (shen.parse-failure) (let W2746 (shen.<-out W2745) (let W2747 (shen.in-> W2745) (shen.comb W2747 (- 0 W2746))))))))) (if (shen.parse-failure? W2742) (let W2748 (let W2749 (shen. V2735) (if (shen.parse-failure? W2749) (shen.parse-failure) (let W2750 (shen.<-out W2749) (let W2751 (shen.in-> W2749) (shen.comb W2751 W2750))))) (if (shen.parse-failure? W2748) (shen.parse-failure) W2748)) W2742)) W2736))) -(defun shen. (V3096) (let W3097 (if (shen.hds=? V3096 101) (let W3098 (tail V3096) (shen.comb W3098 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W3097) (shen.parse-failure) W3097))) +(defun shen. (V2752) (let W2753 (if (shen.hds=? V2752 101) (let W2754 (tail V2752) (shen.comb W2754 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2753) (shen.parse-failure) W2753))) -(defun shen.compute-E (V3099 V3100) (* V3099 (shen.expt 10 V3100))) +(defun shen.compute-E (V2755 V2756) (* V2755 (shen.expt 10 V2756))) -(defun shen. (V3101) (let W3102 (let W3103 (shen. V3101) (if (shen.parse-failure? W3103) (shen.parse-failure) (let W3104 (shen.in-> W3103) (let W3105 (shen. W3104) (if (shen.parse-failure? W3105) (shen.parse-failure) (let W3106 (shen.in-> W3105) (shen.comb W3106 shen.skip))))))) (if (shen.parse-failure? W3102) (let W3107 (let W3108 (shen. V3101) (if (shen.parse-failure? W3108) (shen.parse-failure) (let W3109 (shen.in-> W3108) (shen.comb W3109 shen.skip)))) (if (shen.parse-failure? W3107) (shen.parse-failure) W3107)) W3102))) +(defun shen. (V2757) (let W2758 (let W2759 (shen. V2757) (if (shen.parse-failure? W2759) (shen.parse-failure) (let W2760 (shen.in-> W2759) (let W2761 (shen. W2760) (if (shen.parse-failure? W2761) (shen.parse-failure) (let W2762 (shen.in-> W2761) (shen.comb W2762 shen.skip))))))) (if (shen.parse-failure? W2758) (let W2763 (let W2764 (shen. V2757) (if (shen.parse-failure? W2764) (shen.parse-failure) (let W2765 (shen.in-> W2764) (shen.comb W2765 shen.skip)))) (if (shen.parse-failure? W2763) (shen.parse-failure) W2763)) W2758))) -(defun shen. (V3110) (let W3111 (if (cons? V3110) (let W3112 (head V3110) (let W3113 (tail V3110) (if (shen.whitespace? W3112) (shen.comb W3113 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3111) (shen.parse-failure) W3111))) +(defun shen. (V2766) (let W2767 (if (cons? V2766) (let W2768 (head V2766) (let W2769 (tail V2766) (if (shen.whitespace? W2768) (shen.comb W2769 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2767) (shen.parse-failure) W2767))) -(defun shen.whitespace? (V3116) (cond ((= 32 V3116) true) ((= 13 V3116) true) ((= 10 V3116) true) ((= 9 V3116) true) (true false))) +(defun shen.whitespace? (V2772) (cond ((= 32 V2772) true) ((= 13 V2772) true) ((= 10 V2772) true) ((= 9 V2772) true) (true false))) -(defun shen.unpackage¯oexpand (V3117) (cond ((= () V3117) ()) ((and (cons? V3117) (shen.packaged? (hd V3117))) (shen.unpackage¯oexpand (append (shen.unpackage (hd V3117)) (tl V3117)))) ((cons? V3117) (let W3118 (macroexpand (hd V3117)) (if (shen.packaged? W3118) (shen.unpackage¯oexpand (cons W3118 (tl V3117))) (cons W3118 (shen.unpackage¯oexpand (tl V3117)))))) (true (shen.f-error shen.unpackage¯oexpand)))) +(defun shen.unpackage¯oexpand (V2773) (cond ((= () V2773) ()) ((and (cons? V2773) (shen.packaged? (hd V2773))) (shen.unpackage¯oexpand (append (shen.unpackage (hd V2773)) (tl V2773)))) ((cons? V2773) (let W2774 (macroexpand (hd V2773)) (if (shen.packaged? W2774) (shen.unpackage¯oexpand (cons W2774 (tl V2773))) (cons W2774 (shen.unpackage¯oexpand (tl V2773)))))) (true (simple-error "partial function shen.unpackage¯oexpand")))) -(defun shen.packaged? (V3121) (cond ((and (cons? V3121) (and (= package (hd V3121)) (and (cons? (tl V3121)) (cons? (tl (tl V3121)))))) true) (true false))) +(defun shen.packaged? (V2777) (cond ((and (cons? V2777) (and (= package (hd V2777)) (and (cons? (tl V2777)) (cons? (tl (tl V2777)))))) true) (true false))) -(defun shen.unpackage (V3124) (cond ((and (cons? V3124) (and (= package (hd V3124)) (and (cons? (tl V3124)) (and (= null (hd (tl V3124))) (cons? (tl (tl V3124))))))) (tl (tl (tl V3124)))) ((and (cons? V3124) (and (= package (hd V3124)) (and (cons? (tl V3124)) (cons? (tl (tl V3124)))))) (let W3125 (eval (hd (tl (tl V3124)))) (let W3126 (shen.package-symbols (str (hd (tl V3124))) W3125 (tl (tl (tl V3124)))) (let W3127 (shen.record-external (hd (tl V3124)) W3125) (let W3128 (shen.record-internal (hd (tl V3124)) W3125 (tl (tl (tl V3124)))) W3126))))) (true (shen.f-error shen.unpackage)))) +(defun shen.unpackage (V2780) (cond ((and (cons? V2780) (and (= package (hd V2780)) (and (cons? (tl V2780)) (and (= null (hd (tl V2780))) (cons? (tl (tl V2780))))))) (tl (tl (tl V2780)))) ((and (cons? V2780) (and (= package (hd V2780)) (and (cons? (tl V2780)) (cons? (tl (tl V2780)))))) (let W2781 (eval (hd (tl (tl V2780)))) (let W2782 (shen.package-symbols (str (hd (tl V2780))) W2781 (tl (tl (tl V2780)))) (let W2783 (shen.record-external (hd (tl V2780)) W2781) (let W2784 (shen.record-internal (hd (tl V2780)) W2781 (tl (tl (tl V2780)))) W2782))))) (true (simple-error "partial function shen.unpackage")))) -(defun shen.record-internal (V3129 V3130 V3131) (let W3132 (trap-error (get V3129 shen.internal-symbols (value *property-vector*)) (lambda Z3133 ())) (let W3134 (shen.internal-symbols (str V3129) V3130 V3131) (put V3129 shen.internal-symbols (union W3134 W3132) (value *property-vector*))))) +(defun shen.record-internal (V2785 V2786 V2787) (let W2788 (trap-error (get V2785 shen.internal-symbols (value *property-vector*)) (lambda Z2789 ())) (let W2790 (shen.internal-symbols (str V2785) V2786 V2787) (put V2785 shen.internal-symbols (union W2790 W2788) (value *property-vector*))))) -(defun shen.internal-symbols (V3141 V3142 V3143) (cond ((cons? V3143) (union (shen.internal-symbols V3141 V3142 (hd V3143)) (shen.internal-symbols V3141 V3142 (tl V3143)))) ((shen.internal? V3143 V3141 V3142) (cons (shen.intern-in-package V3141 V3143) ())) (true ()))) +(defun shen.internal-symbols (V2797 V2798 V2799) (cond ((cons? V2799) (union (shen.internal-symbols V2797 V2798 (hd V2799)) (shen.internal-symbols V2797 V2798 (tl V2799)))) ((shen.internal? V2799 V2797 V2798) (cons (shen.intern-in-package V2797 V2799) ())) (true ()))) -(defun shen.record-external (V3144 V3145) (let W3146 (trap-error (get V3144 shen.external-symbols (value *property-vector*)) (lambda Z3147 ())) (put V3144 shen.external-symbols (union V3145 W3146) (value *property-vector*)))) +(defun shen.record-external (V2800 V2801) (let W2802 (trap-error (get V2800 shen.external-symbols (value *property-vector*)) (lambda Z2803 ())) (put V2800 shen.external-symbols (union V2801 W2802) (value *property-vector*)))) -(defun shen.package-symbols (V3152 V3153 V3154) (cond ((cons? V3154) (map (lambda Z3155 (shen.package-symbols V3152 V3153 Z3155)) V3154)) ((shen.internal? V3154 V3152 V3153) (shen.intern-in-package V3152 V3154)) (true V3154))) +(defun shen.package-symbols (V2808 V2809 V2810) (cond ((cons? V2810) (map (lambda Z2811 (shen.package-symbols V2808 V2809 Z2811)) V2810)) ((shen.internal? V2810 V2808 V2809) (shen.intern-in-package V2808 V2810)) (true V2810))) -(defun shen.intern-in-package (V3156 V3157) (intern (@s V3156 (@s "." (str V3157))))) +(defun shen.intern-in-package (V2812 V2813) (intern (@s V2812 (@s "." (str V2813))))) -(defun shen.internal? (V3158 V3159 V3160) (and (not (element? V3158 V3160)) (and (not (shen.sng? V3158)) (and (not (shen.dbl? V3158)) (and (symbol? V3158) (and (not (shen.sysfunc? V3158)) (and (not (variable? V3158)) (and (not (shen.internal-to-shen? (str V3158))) (not (shen.internal-to-P? V3159 (str V3158))))))))))) +(defun shen.internal? (V2814 V2815 V2816) (and (not (element? V2814 V2816)) (and (not (shen.sng? V2814)) (and (not (shen.dbl? V2814)) (and (symbol? V2814) (and (not (shen.sysfunc? V2814)) (and (not (variable? V2814)) (and (not (shen.internal-to-shen? (str V2814))) (not (shen.internal-to-P? V2815 (str V2814))))))))))) -(defun shen.internal-to-shen? (V3165) (cond ((and (shen.+string? V3165) (and (= "s" (hdstr V3165)) (and (shen.+string? (tlstr V3165)) (and (= "h" (hdstr (tlstr V3165))) (and (shen.+string? (tlstr (tlstr V3165))) (and (= "e" (hdstr (tlstr (tlstr V3165)))) (and (shen.+string? (tlstr (tlstr (tlstr V3165)))) (and (= "n" (hdstr (tlstr (tlstr (tlstr V3165))))) (and (shen.+string? (tlstr (tlstr (tlstr (tlstr V3165))))) (= "." (hdstr (tlstr (tlstr (tlstr (tlstr V3165))))))))))))))) true) (true false))) +(defun shen.internal-to-shen? (V2821) (cond ((and (shen.+string? V2821) (and (= "s" (hdstr V2821)) (and (shen.+string? (tlstr V2821)) (and (= "h" (hdstr (tlstr V2821))) (and (shen.+string? (tlstr (tlstr V2821))) (and (= "e" (hdstr (tlstr (tlstr V2821)))) (and (shen.+string? (tlstr (tlstr (tlstr V2821)))) (and (= "n" (hdstr (tlstr (tlstr (tlstr V2821))))) (and (shen.+string? (tlstr (tlstr (tlstr (tlstr V2821))))) (= "." (hdstr (tlstr (tlstr (tlstr (tlstr V2821))))))))))))))) true) (true false))) -(defun shen.sysfunc? (V3166) (element? V3166 (get shen shen.external-symbols (value *property-vector*)))) +(defun shen.sysfunc? (V2822) (element? V2822 (get shen shen.external-symbols (value *property-vector*)))) -(defun shen.internal-to-P? (V3174 V3175) (cond ((and (= "" V3174) (and (shen.+string? V3175) (= "." (hdstr V3175)))) true) ((and (shen.+string? V3174) (and (shen.+string? V3175) (= (hdstr V3174) (hdstr V3175)))) (shen.internal-to-P? (tlstr V3174) (tlstr V3175))) (true false))) +(defun shen.internal-to-P? (V2830 V2831) (cond ((and (= "" V2830) (and (shen.+string? V2831) (= "." (hdstr V2831)))) true) ((and (shen.+string? V2830) (and (shen.+string? V2831) (= (hdstr V2830) (hdstr V2831)))) (shen.internal-to-P? (tlstr V2830) (tlstr V2831))) (true false))) -(defun shen.process-applications (V3178 V3179) (cond ((element? V3178 V3179) V3178) ((and (cons? V3178) (= cond (hd V3178))) (cons cond (shen.process-cond-clauses (tl V3178) V3179))) ((and (cons? V3178) (shen.non-application? (hd V3178))) (shen.special-case (hd V3178) V3178 V3179)) ((cons? V3178) (shen.process-application (map (lambda Z3180 (shen.process-applications Z3180 V3179)) V3178) V3179)) (true V3178))) +(defun shen.process-applications (V2834 V2835) (cond ((element? V2834 V2835) V2834) ((and (cons? V2834) (shen.non-application? (hd V2834))) (shen.special-case (hd V2834) V2834 V2835)) ((cons? V2834) (shen.process-application (map (lambda Z2836 (shen.process-applications Z2836 V2835)) V2834) V2835)) (true V2834))) -(defun shen.non-application? (V3183) (cond ((= define V3183) true) ((= defun V3183) true) ((= synonyms V3183) true) ((shen.special? V3183) true) ((shen.extraspecial? V3183) true) (true false))) +(defun shen.non-application? (V2839) (cond ((= define V2839) true) ((= defun V2839) true) ((= synonyms V2839) true) ((shen.special? V2839) true) ((shen.extraspecial? V2839) true) (true false))) -(defun shen.special-case (V3188 V3189 V3190) (cond ((and (= lambda V3188) (and (cons? V3189) (and (= lambda (hd V3189)) (and (cons? (tl V3189)) (and (cons? (tl (tl V3189))) (= () (tl (tl (tl V3189))))))))) (cons lambda (cons (hd (tl V3189)) (cons (shen.process-applications (hd (tl (tl V3189))) V3190) ())))) ((and (= let V3188) (and (cons? V3189) (and (= let (hd V3189)) (and (cons? (tl V3189)) (and (cons? (tl (tl V3189))) (and (cons? (tl (tl (tl V3189)))) (= () (tl (tl (tl (tl V3189))))))))))) (cons let (cons (hd (tl V3189)) (cons (shen.process-applications (hd (tl (tl V3189))) V3190) (cons (shen.process-applications (hd (tl (tl (tl V3189)))) V3190) ()))))) ((and (= defun V3188) (and (cons? V3189) (and (= defun (hd V3189)) (and (cons? (tl V3189)) (and (cons? (tl (tl V3189))) (and (cons? (tl (tl (tl V3189)))) (= () (tl (tl (tl (tl V3189))))))))))) V3189) ((and (= define V3188) (and (cons? V3189) (and (= define (hd V3189)) (and (cons? (tl V3189)) (and (cons? (tl (tl V3189))) (= { (hd (tl (tl V3189))))))))) (cons define (cons (hd (tl V3189)) (cons { (shen.process-after-type (hd (tl V3189)) (tl (tl (tl V3189))) V3190))))) ((and (= define V3188) (and (cons? V3189) (and (= define (hd V3189)) (cons? (tl V3189))))) (cons define (cons (hd (tl V3189)) (map (lambda Z3191 (shen.process-applications Z3191 V3190)) (tl (tl V3189)))))) ((= synonyms V3188) (cons synonyms V3189)) ((and (= type V3188) (and (cons? V3189) (and (= type (hd V3189)) (and (cons? (tl V3189)) (and (cons? (tl (tl V3189))) (= () (tl (tl (tl V3189))))))))) (cons type (cons (shen.process-applications (hd (tl V3189)) V3190) (tl (tl V3189))))) ((and (= input+ V3188) (and (cons? V3189) (and (= input+ (hd V3189)) (and (cons? (tl V3189)) (and (cons? (tl (tl V3189))) (= () (tl (tl (tl V3189))))))))) (cons input+ (cons (hd (tl V3189)) (cons (shen.process-applications (hd (tl (tl V3189))) V3190) ())))) ((and (cons? V3189) (shen.special? (hd V3189))) (cons (hd V3189) (map (lambda Z3192 (shen.process-applications Z3192 V3190)) (tl V3189)))) ((and (cons? V3189) (shen.extraspecial? (hd V3189))) V3189) (true (shen.f-error shen.special-case)))) +(defun shen.special-case (V2844 V2845 V2846) (cond ((and (= lambda V2844) (and (cons? V2845) (and (= lambda (hd V2845)) (and (cons? (tl V2845)) (and (cons? (tl (tl V2845))) (= () (tl (tl (tl V2845))))))))) (cons lambda (cons (hd (tl V2845)) (cons (shen.process-applications (hd (tl (tl V2845))) V2846) ())))) ((and (= let V2844) (and (cons? V2845) (and (= let (hd V2845)) (and (cons? (tl V2845)) (and (cons? (tl (tl V2845))) (and (cons? (tl (tl (tl V2845)))) (= () (tl (tl (tl (tl V2845))))))))))) (cons let (cons (hd (tl V2845)) (cons (shen.process-applications (hd (tl (tl V2845))) V2846) (cons (shen.process-applications (hd (tl (tl (tl V2845)))) V2846) ()))))) ((and (= defun V2844) (and (cons? V2845) (and (= defun (hd V2845)) (and (cons? (tl V2845)) (and (cons? (tl (tl V2845))) (and (cons? (tl (tl (tl V2845)))) (= () (tl (tl (tl (tl V2845))))))))))) V2845) ((and (= define V2844) (and (cons? V2845) (and (= define (hd V2845)) (and (cons? (tl V2845)) (and (cons? (tl (tl V2845))) (= { (hd (tl (tl V2845))))))))) (cons define (cons (hd (tl V2845)) (cons { (shen.process-after-type (hd (tl V2845)) (tl (tl (tl V2845))) V2846))))) ((and (= define V2844) (and (cons? V2845) (and (= define (hd V2845)) (cons? (tl V2845))))) (cons define (cons (hd (tl V2845)) (map (lambda Z2847 (shen.process-applications Z2847 V2846)) (tl (tl V2845)))))) ((= synonyms V2844) (cons synonyms V2845)) ((and (= type V2844) (and (cons? V2845) (and (= type (hd V2845)) (and (cons? (tl V2845)) (and (cons? (tl (tl V2845))) (= () (tl (tl (tl V2845))))))))) (cons type (cons (shen.process-applications (hd (tl V2845)) V2846) (tl (tl V2845))))) ((and (= input+ V2844) (and (cons? V2845) (and (= input+ (hd V2845)) (and (cons? (tl V2845)) (and (cons? (tl (tl V2845))) (= () (tl (tl (tl V2845))))))))) (cons input+ (cons (hd (tl V2845)) (cons (shen.process-applications (hd (tl (tl V2845))) V2846) ())))) ((and (cons? V2845) (shen.special? (hd V2845))) (cons (hd V2845) (map (lambda Z2848 (shen.process-applications Z2848 V2846)) (tl V2845)))) ((and (cons? V2845) (shen.extraspecial? (hd V2845))) V2845) (true (simple-error "partial function shen.special-case")))) -(defun shen.process-cond-clauses (V3195 V3196) (cond ((= () V3195) ()) ((and (cons? V3195) (and (cons? (hd V3195)) (and (cons? (tl (hd V3195))) (= () (tl (tl (hd V3195))))))) (cons (cons (shen.process-applications (hd (hd V3195)) V3196) (cons (shen.process-applications (hd (tl (hd V3195))) V3196) ())) (shen.process-cond-clauses (tl V3195) V3196))) (true (shen.f-error shen.process-cond-clauses)))) - -(defun shen.process-after-type (V3199 V3200 V3201) (cond ((and (cons? V3200) (= } (hd V3200))) (cons } (map (lambda Z3202 (shen.process-applications Z3202 V3201)) (tl V3200)))) ((cons? V3200) (cons (hd V3200) (shen.process-after-type V3199 (tl V3200) V3201))) (true (simple-error (cn "missing } in " (shen.app V3199 " +(defun shen.process-after-type (V2851 V2852 V2853) (cond ((and (cons? V2852) (= } (hd V2852))) (cons } (map (lambda Z2854 (shen.process-applications Z2854 V2853)) (tl V2852)))) ((cons? V2852) (cons (hd V2852) (shen.process-after-type V2851 (tl V2852) V2853))) (true (simple-error (cn "missing } in " (shen.app V2851 " " shen.a)))))) -(defun shen.process-application (V3203 V3204) (cond ((cons? V3203) (let W3205 (arity (hd V3203)) (let W3206 (length (tl V3203)) (if (element? V3203 V3204) V3203 (if (shen.shen-call? (hd V3203)) V3203 (if (shen.foreign? V3203) (shen.unpack-foreign V3203) (if (shen.fn-call? V3203) (shen.fn-call V3203) (if (shen.zero-place? V3203) V3203 (if (shen.undefined-f? (hd V3203) W3205) (shen.simple-curry (cons (cons fn (cons (hd V3203) ())) (tl V3203))) (if (variable? (hd V3203)) (shen.simple-curry V3203) (if (shen.application? (hd V3203)) (shen.simple-curry V3203) (if (shen.partial-application*? (hd V3203) W3205 W3206) (shen.lambda-function V3203 (- W3205 W3206)) (if (shen.overapplication? (hd V3203) W3205 W3206) (shen.simple-curry (cons (cons fn (cons (hd V3203) ())) (tl V3203))) V3203))))))))))))) (true (shen.f-error shen.process-application)))) +(defun shen.process-application (V2855 V2856) (cond ((cons? V2855) (let W2857 (arity (hd V2855)) (let W2858 (length (tl V2855)) (if (element? V2855 V2856) V2855 (if (shen.shen-call? (hd V2855)) V2855 (if (shen.foreign? V2855) (shen.unpack-foreign V2855) (if (shen.fn-call? V2855) (shen.fn-call V2855) (if (shen.zero-place? V2855) V2855 (if (shen.undefined-f? (hd V2855) W2857) (shen.simple-curry (cons (cons fn (cons (hd V2855) ())) (tl V2855))) (if (variable? (hd V2855)) (shen.simple-curry V2855) (if (shen.application? (hd V2855)) (shen.simple-curry V2855) (if (shen.partial-application*? (hd V2855) W2857 W2858) (shen.lambda-function V2855 (- W2857 W2858)) (if (shen.overapplication? (hd V2855) W2857 W2858) (shen.simple-curry (cons (cons fn (cons (hd V2855) ())) (tl V2855))) V2855))))))))))))) (true (simple-error "partial function shen.process-application")))) -(defun shen.unpack-foreign (V3207) (cond ((and (cons? V3207) (and (cons? (hd V3207)) (and (= foreign (hd (hd V3207))) (and (cons? (tl (hd V3207))) (= () (tl (tl (hd V3207)))))))) (cons (hd (tl (hd V3207))) (tl V3207))) (true (shen.f-error shen.unpack-foreign)))) +(defun shen.unpack-foreign (V2859) (cond ((and (cons? V2859) (and (cons? (hd V2859)) (and (= foreign (hd (hd V2859))) (and (cons? (tl (hd V2859))) (= () (tl (tl (hd V2859)))))))) (cons (hd (tl (hd V2859))) (tl V2859))) (true (simple-error "partial function shen.unpack-foreign")))) -(defun shen.foreign? (V3210) (cond ((and (cons? V3210) (and (cons? (hd V3210)) (and (= foreign (hd (hd V3210))) (and (cons? (tl (hd V3210))) (= () (tl (tl (hd V3210)))))))) true) (true false))) +(defun shen.foreign? (V2862) (cond ((and (cons? V2862) (and (cons? (hd V2862)) (and (= foreign (hd (hd V2862))) (and (cons? (tl (hd V2862))) (= () (tl (tl (hd V2862)))))))) true) (true false))) -(defun shen.zero-place? (V3213) (cond ((and (cons? V3213) (= () (tl V3213))) true) (true false))) +(defun shen.zero-place? (V2865) (cond ((and (cons? V2865) (= () (tl V2865))) true) (true false))) -(defun shen.shen-call? (V3214) (and (symbol? V3214) (shen.internal-to-shen? (str V3214)))) +(defun shen.shen-call? (V2866) (and (symbol? V2866) (shen.internal-to-shen? (str V2866)))) -(defun shen.application? (V3219) (cond ((and (cons? V3219) (and (= protect (hd V3219)) (and (cons? (tl V3219)) (= () (tl (tl V3219)))))) false) ((and (cons? V3219) (and (= foreign (hd V3219)) (and (cons? (tl V3219)) (= () (tl (tl V3219)))))) false) (true (cons? V3219)))) +(defun shen.application? (V2871) (cond ((and (cons? V2871) (and (= protect (hd V2871)) (and (cons? (tl V2871)) (= () (tl (tl V2871)))))) false) ((and (cons? V2871) (and (= foreign (hd V2871)) (and (cons? (tl V2871)) (= () (tl (tl V2871)))))) false) (true (cons? V2871)))) -(defun shen.undefined-f? (V3224 V3225) (cond ((= -1 V3225) (and (shen.lowercase-symbol? V3224) (not (element? V3224 (external shen))))) (true false))) +(defun shen.undefined-f? (V2876 V2877) (cond ((= -1 V2877) (and (shen.lowercase-symbol? V2876) (not (element? V2876 (external shen))))) (true false))) -(defun shen.lowercase-symbol? (V3226) (and (symbol? V3226) (not (variable? V3226)))) +(defun shen.lowercase-symbol? (V2878) (and (symbol? V2878) (not (variable? V2878)))) -(defun shen.simple-curry (V3227) (cond ((and (cons? V3227) (and (cons? (tl V3227)) (= () (tl (tl V3227))))) V3227) ((and (cons? V3227) (and (cons? (tl V3227)) (cons? (tl (tl V3227))))) (shen.simple-curry (cons (cons (hd V3227) (cons (hd (tl V3227)) ())) (tl (tl V3227))))) (true V3227))) +(defun shen.simple-curry (V2879) (cond ((and (cons? V2879) (and (cons? (tl V2879)) (= () (tl (tl V2879))))) V2879) ((and (cons? V2879) (and (cons? (tl V2879)) (cons? (tl (tl V2879))))) (shen.simple-curry (cons (cons (hd V2879) (cons (hd (tl V2879)) ())) (tl (tl V2879))))) (true V2879))) -(defun function (V3228) (fn V3228)) +(defun function (V2880) (fn V2880)) -(defun fn (V3229) (cond ((= (arity V3229) 0) (V3229)) (true (trap-error (get V3229 shen.lambda-form (value *property-vector*)) (lambda Z3230 (simple-error (cn "fn: " (shen.app V3229 " is undefined -" shen.a)))))))) +(defun fn (V2881) (cond ((= (arity V2881) 0) (V2881)) (true (let W2882 (assoc V2881 (value shen.*lambdatable*)) (if (empty? W2882) (simple-error (cn "fn: " (shen.app V2881 " is undefined +" shen.a))) (tl W2882)))))) -(defun shen.fn-call? (V3233) (cond ((and (cons? V3233) (and (= fn (hd V3233)) (and (cons? (tl V3233)) (= () (tl (tl V3233)))))) true) ((and (cons? V3233) (and (= function (hd V3233)) (and (cons? (tl V3233)) (= () (tl (tl V3233)))))) true) (true false))) +(defun shen.fn-call? (V2885) (cond ((and (cons? V2885) (and (= fn (hd V2885)) (and (cons? (tl V2885)) (= () (tl (tl V2885)))))) true) ((and (cons? V2885) (and (= function (hd V2885)) (and (cons? (tl V2885)) (= () (tl (tl V2885)))))) true) (true false))) -(defun shen.fn-call (V3234) (cond ((and (cons? V3234) (and (= function (hd V3234)) (and (cons? (tl V3234)) (= () (tl (tl V3234)))))) (shen.fn-call (cons fn (tl V3234)))) ((and (cons? V3234) (and (= fn (hd V3234)) (and (cons? (tl V3234)) (= () (tl (tl V3234)))))) (let W3235 (arity (hd (tl V3234))) (if (= W3235 -1) V3234 (if (= W3235 0) (tl V3234) (shen.lambda-function (tl V3234) W3235))))) (true (shen.f-error shen.fn-call)))) +(defun shen.fn-call (V2886) (cond ((and (cons? V2886) (and (= function (hd V2886)) (and (cons? (tl V2886)) (= () (tl (tl V2886)))))) (shen.fn-call (cons fn (tl V2886)))) ((and (cons? V2886) (and (= fn (hd V2886)) (and (cons? (tl V2886)) (= () (tl (tl V2886)))))) (let W2887 (arity (hd (tl V2886))) (if (= W2887 -1) V2886 (if (= W2887 0) (tl V2886) (shen.lambda-function (tl V2886) W2887))))) (true (simple-error "partial function shen.fn-call")))) -(defun shen.partial-application*? (V3236 V3237 V3238) (let W3239 (> V3237 V3238) (let W3240 (if (and W3239 (and (shen.loading?) (not (element? V3236 (cons + (cons - ())))))) (pr (cn "partial application of " (shen.app V3236 " -" shen.a)) (stoutput)) shen.skip) W3239))) +(defun shen.partial-application*? (V2888 V2889 V2890) (let W2891 (> V2889 V2890) (let W2892 (if (and W2891 (and (shen.loading?) (not (element? V2888 (cons + (cons - ())))))) (pr (cn "partial application of " (shen.app V2888 " +" shen.a)) (stoutput)) shen.skip) W2891))) (defun shen.loading? () (value shen.*loading?*)) -(defun shen.overapplication? (V3245 V3246 V3247) (cond ((= -1 V3246) false) (true (let W3248 (< V3246 V3247) (let W3249 (if (and W3248 (shen.loading?)) (pr (shen.app V3245 (cn " might not like " (shen.app V3247 (cn " argument" (shen.app (if (= V3247 1) "" "s") " -" shen.a)) shen.a)) shen.a) (stoutput)) shen.skip) W3248))))) +(defun shen.overapplication? (V2897 V2898 V2899) (cond ((= -1 V2898) false) (true (let W2900 (< V2898 V2899) (let W2901 (if (and W2900 (shen.loading?)) (pr (shen.app V2897 (cn " might not like " (shen.app V2899 (cn " argument" (shen.app (if (= V2899 1) "" "s") " +" shen.a)) shen.a)) shen.a) (stoutput)) shen.skip) W2900))))) diff --git a/klambda/sequent.kl b/klambda/sequent.kl index f9df594..30101b5 100644 --- a/klambda/sequent.kl +++ b/klambda/sequent.kl @@ -1,102 +1,102 @@ -(defun shen. (V3365) (let W3366 (if (cons? V3365) (let W3367 (head V3365) (let W3368 (tail V3365) (let W3369 (shen. W3368) (if (shen.parse-failure? W3369) (shen.parse-failure) (let W3370 (shen.<-out W3369) (let W3371 (shen.in-> W3369) (shen.comb W3371 (let W3372 (shen.rules->prolog W3367 W3370) (shen.remember-datatype W3367 (fn W3367)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W3366) (shen.parse-failure) W3366))) +(defun shen. (V3019) (let W3020 (if (cons? V3019) (let W3021 (head V3019) (let W3022 (tail V3019) (let W3023 (shen. W3022) (if (shen.parse-failure? W3023) (shen.parse-failure) (let W3024 (shen.<-out W3023) (let W3025 (shen.in-> W3023) (shen.comb W3025 (let W3026 (shen.rules->prolog W3021 W3024) (shen.remember-datatype W3021 (fn W3021)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W3020) (shen.parse-failure) W3020))) -(defun shen.remember-datatype (V3373 V3374) (do (set shen.*datatypes* (shen.assoc-> V3373 V3374 (value shen.*datatypes*))) (do (set shen.*alldatatypes* (shen.assoc-> V3373 V3374 (value shen.*alldatatypes*))) V3373))) +(defun shen.remember-datatype (V3027 V3028) (do (set shen.*datatypes* (shen.assoc-> V3027 V3028 (value shen.*datatypes*))) (do (set shen.*alldatatypes* (shen.assoc-> V3027 V3028 (value shen.*alldatatypes*))) V3027))) -(defun shen. (V3375) (let W3376 (let W3377 (shen. V3375) (if (shen.parse-failure? W3377) (shen.parse-failure) (let W3378 (shen.<-out W3377) (let W3379 (shen.in-> W3377) (let W3380 (shen. W3379) (if (shen.parse-failure? W3380) (shen.parse-failure) (let W3381 (shen.<-out W3380) (let W3382 (shen.in-> W3380) (shen.comb W3382 (append W3378 W3381)))))))))) (if (shen.parse-failure? W3376) (let W3383 (let W3384 ( V3375) (if (shen.parse-failure? W3384) (shen.parse-failure) (let W3385 (shen.<-out W3384) (let W3386 (shen.in-> W3384) (shen.comb W3386 (if (empty? W3385) () (simple-error (cn "datatype syntax error here: - " (shen.app W3385 " - ..." shen.r))))))))) (if (shen.parse-failure? W3383) (shen.parse-failure) W3383)) W3376))) +(defun shen. (V3029) (let W3030 (let W3031 (shen. V3029) (if (shen.parse-failure? W3031) (shen.parse-failure) (let W3032 (shen.<-out W3031) (let W3033 (shen.in-> W3031) (let W3034 (shen. W3033) (if (shen.parse-failure? W3034) (shen.parse-failure) (let W3035 (shen.<-out W3034) (let W3036 (shen.in-> W3034) (shen.comb W3036 (append W3032 W3035)))))))))) (if (shen.parse-failure? W3030) (let W3037 (let W3038 ( V3029) (if (shen.parse-failure? W3038) (shen.parse-failure) (let W3039 (shen.<-out W3038) (let W3040 (shen.in-> W3038) (shen.comb W3040 (if (empty? W3039) () (simple-error (cn "datatype syntax error here: + " (shen.app W3039 " + ..." shen.r))))))))) (if (shen.parse-failure? W3037) (shen.parse-failure) W3037)) W3030))) -(defun shen. (V3387) (let W3388 (let W3389 (shen. V3387) (if (shen.parse-failure? W3389) (shen.parse-failure) (let W3390 (shen.<-out W3389) (let W3391 (shen.in-> W3389) (shen.comb W3391 W3390))))) (if (shen.parse-failure? W3388) (let W3392 (let W3393 (shen. V3387) (if (shen.parse-failure? W3393) (shen.parse-failure) (let W3394 (shen.<-out W3393) (let W3395 (shen.in-> W3393) (shen.comb W3395 W3394))))) (if (shen.parse-failure? W3392) (shen.parse-failure) W3392)) W3388))) +(defun shen. (V3041) (let W3042 (let W3043 (shen. V3041) (if (shen.parse-failure? W3043) (shen.parse-failure) (let W3044 (shen.<-out W3043) (let W3045 (shen.in-> W3043) (shen.comb W3045 W3044))))) (if (shen.parse-failure? W3042) (let W3046 (let W3047 (shen. V3041) (if (shen.parse-failure? W3047) (shen.parse-failure) (let W3048 (shen.<-out W3047) (let W3049 (shen.in-> W3047) (shen.comb W3049 W3048))))) (if (shen.parse-failure? W3046) (shen.parse-failure) W3046)) W3042))) -(defun shen. (V3396) (let W3397 (let W3398 (shen. V3396) (if (shen.parse-failure? W3398) (shen.parse-failure) (let W3399 (shen.<-out W3398) (let W3400 (shen.in-> W3398) (let W3401 (shen. W3400) (if (shen.parse-failure? W3401) (shen.parse-failure) (let W3402 (shen.<-out W3401) (let W3403 (shen.in-> W3401) (let W3404 (shen. W3403) (if (shen.parse-failure? W3404) (shen.parse-failure) (let W3405 (shen.in-> W3404) (let W3406 (shen. W3405) (if (shen.parse-failure? W3406) (shen.parse-failure) (let W3407 (shen.<-out W3406) (let W3408 (shen.in-> W3406) (let W3409 (shen. W3408) (if (shen.parse-failure? W3409) (shen.parse-failure) (let W3410 (shen.in-> W3409) (shen.comb W3410 (cons (cons W3399 (cons W3402 (cons W3407 ()))) ())))))))))))))))))))) (if (shen.parse-failure? W3397) (shen.parse-failure) W3397))) +(defun shen. (V3050) (let W3051 (let W3052 (shen. V3050) (if (shen.parse-failure? W3052) (shen.parse-failure) (let W3053 (shen.<-out W3052) (let W3054 (shen.in-> W3052) (let W3055 (shen. W3054) (if (shen.parse-failure? W3055) (shen.parse-failure) (let W3056 (shen.<-out W3055) (let W3057 (shen.in-> W3055) (let W3058 (shen. W3057) (if (shen.parse-failure? W3058) (shen.parse-failure) (let W3059 (shen.in-> W3058) (let W3060 (shen. W3059) (if (shen.parse-failure? W3060) (shen.parse-failure) (let W3061 (shen.<-out W3060) (let W3062 (shen.in-> W3060) (let W3063 (shen. W3062) (if (shen.parse-failure? W3063) (shen.parse-failure) (let W3064 (shen.in-> W3063) (shen.comb W3064 (cons (cons W3053 (cons W3056 (cons W3061 ()))) ())))))))))))))))))))) (if (shen.parse-failure? W3051) (shen.parse-failure) W3051))) -(defun shen. (V3411) (let W3412 (let W3413 (shen. V3411) (if (shen.parse-failure? W3413) (shen.parse-failure) (let W3414 (shen.<-out W3413) (let W3415 (shen.in-> W3413) (let W3416 (shen. W3415) (if (shen.parse-failure? W3416) (shen.parse-failure) (let W3417 (shen.<-out W3416) (let W3418 (shen.in-> W3416) (let W3419 (shen. W3418) (if (shen.parse-failure? W3419) (shen.parse-failure) (let W3420 (shen.in-> W3419) (let W3421 (shen. W3420) (if (shen.parse-failure? W3421) (shen.parse-failure) (let W3422 (shen.<-out W3421) (let W3423 (shen.in-> W3421) (let W3424 (shen. W3423) (if (shen.parse-failure? W3424) (shen.parse-failure) (let W3425 (shen.in-> W3424) (shen.comb W3425 (shen.lr-rule W3414 W3417 (cons () (cons W3422 ())))))))))))))))))))))) (if (shen.parse-failure? W3412) (shen.parse-failure) W3412))) +(defun shen. (V3065) (let W3066 (let W3067 (shen. V3065) (if (shen.parse-failure? W3067) (shen.parse-failure) (let W3068 (shen.<-out W3067) (let W3069 (shen.in-> W3067) (let W3070 (shen. W3069) (if (shen.parse-failure? W3070) (shen.parse-failure) (let W3071 (shen.<-out W3070) (let W3072 (shen.in-> W3070) (let W3073 (shen. W3072) (if (shen.parse-failure? W3073) (shen.parse-failure) (let W3074 (shen.in-> W3073) (let W3075 (shen. W3074) (if (shen.parse-failure? W3075) (shen.parse-failure) (let W3076 (shen.<-out W3075) (let W3077 (shen.in-> W3075) (let W3078 (shen. W3077) (if (shen.parse-failure? W3078) (shen.parse-failure) (let W3079 (shen.in-> W3078) (shen.comb W3079 (shen.lr-rule W3068 W3071 (cons () (cons W3076 ())))))))))))))))))))))) (if (shen.parse-failure? W3066) (shen.parse-failure) W3066))) -(defun shen. (V3426) (let W3427 (let W3428 (shen. V3426) (if (shen.parse-failure? W3428) (shen.parse-failure) (let W3429 (shen.<-out W3428) (let W3430 (shen.in-> W3428) (let W3431 (shen. W3430) (if (shen.parse-failure? W3431) (shen.parse-failure) (let W3432 (shen.in-> W3431) (let W3433 (shen. W3432) (if (shen.parse-failure? W3433) (shen.parse-failure) (let W3434 (shen.<-out W3433) (let W3435 (shen.in-> W3433) (shen.comb W3435 (cons (cons () (cons W3429 ())) W3434))))))))))))) (if (shen.parse-failure? W3427) (let W3436 (let W3437 (shen. V3426) (if (shen.parse-failure? W3437) (shen.parse-failure) (let W3438 (shen.<-out W3437) (let W3439 (shen.in-> W3437) (let W3440 (shen. W3439) (if (shen.parse-failure? W3440) (shen.parse-failure) (let W3441 (shen.in-> W3440) (shen.comb W3441 (cons (cons () (cons W3438 ())) ()))))))))) (if (shen.parse-failure? W3436) (shen.parse-failure) W3436)) W3427))) +(defun shen. (V3080) (let W3081 (let W3082 (shen. V3080) (if (shen.parse-failure? W3082) (shen.parse-failure) (let W3083 (shen.<-out W3082) (let W3084 (shen.in-> W3082) (let W3085 (shen. W3084) (if (shen.parse-failure? W3085) (shen.parse-failure) (let W3086 (shen.in-> W3085) (let W3087 (shen. W3086) (if (shen.parse-failure? W3087) (shen.parse-failure) (let W3088 (shen.<-out W3087) (let W3089 (shen.in-> W3087) (shen.comb W3089 (cons (cons () (cons W3083 ())) W3088))))))))))))) (if (shen.parse-failure? W3081) (let W3090 (let W3091 (shen. V3080) (if (shen.parse-failure? W3091) (shen.parse-failure) (let W3092 (shen.<-out W3091) (let W3093 (shen.in-> W3091) (let W3094 (shen. W3093) (if (shen.parse-failure? W3094) (shen.parse-failure) (let W3095 (shen.in-> W3094) (shen.comb W3095 (cons (cons () (cons W3092 ())) ()))))))))) (if (shen.parse-failure? W3090) (shen.parse-failure) W3090)) W3081))) -(defun shen. (V3442) (let W3443 (let W3444 (shen. V3442) (if (shen.parse-failure? W3444) (shen.parse-failure) (let W3445 (shen.<-out W3444) (let W3446 (shen.in-> W3444) (if (shen.hds=? W3446 >>) (let W3447 (tail W3446) (let W3448 (shen. W3447) (if (shen.parse-failure? W3448) (shen.parse-failure) (let W3449 (shen.<-out W3448) (let W3450 (shen.in-> W3448) (shen.comb W3450 (cons W3445 (cons W3449 ())))))))) (shen.parse-failure)))))) (if (shen.parse-failure? W3443) (let W3451 (let W3452 (shen. V3442) (if (shen.parse-failure? W3452) (shen.parse-failure) (let W3453 (shen.<-out W3452) (let W3454 (shen.in-> W3452) (shen.comb W3454 (cons () (cons W3453 ()))))))) (if (shen.parse-failure? W3451) (shen.parse-failure) W3451)) W3443))) +(defun shen. (V3096) (let W3097 (let W3098 (shen. V3096) (if (shen.parse-failure? W3098) (shen.parse-failure) (let W3099 (shen.<-out W3098) (let W3100 (shen.in-> W3098) (if (shen.hds=? W3100 >>) (let W3101 (tail W3100) (let W3102 (shen. W3101) (if (shen.parse-failure? W3102) (shen.parse-failure) (let W3103 (shen.<-out W3102) (let W3104 (shen.in-> W3102) (shen.comb W3104 (cons W3099 (cons W3103 ())))))))) (shen.parse-failure)))))) (if (shen.parse-failure? W3097) (let W3105 (let W3106 (shen. V3096) (if (shen.parse-failure? W3106) (shen.parse-failure) (let W3107 (shen.<-out W3106) (let W3108 (shen.in-> W3106) (shen.comb W3108 (cons () (cons W3107 ()))))))) (if (shen.parse-failure? W3105) (shen.parse-failure) W3105)) W3097))) -(defun shen. (V3455) (let W3456 (let W3457 (shen. V3455) (if (shen.parse-failure? W3457) (shen.parse-failure) (let W3458 (shen.<-out W3457) (let W3459 (shen.in-> W3457) (let W3460 (shen. W3459) (if (shen.parse-failure? W3460) (shen.parse-failure) (let W3461 (shen.in-> W3460) (let W3462 (shen. W3461) (if (shen.parse-failure? W3462) (shen.parse-failure) (let W3463 (shen.<-out W3462) (let W3464 (shen.in-> W3462) (shen.comb W3464 (cons W3458 W3463))))))))))))) (if (shen.parse-failure? W3456) (let W3465 (let W3466 ( V3455) (if (shen.parse-failure? W3466) (shen.parse-failure) (let W3467 (shen.in-> W3466) (shen.comb W3467 ())))) (if (shen.parse-failure? W3465) (shen.parse-failure) W3465)) W3456))) +(defun shen. (V3109) (let W3110 (let W3111 (shen. V3109) (if (shen.parse-failure? W3111) (shen.parse-failure) (let W3112 (shen.<-out W3111) (let W3113 (shen.in-> W3111) (let W3114 (shen. W3113) (if (shen.parse-failure? W3114) (shen.parse-failure) (let W3115 (shen.in-> W3114) (let W3116 (shen. W3115) (if (shen.parse-failure? W3116) (shen.parse-failure) (let W3117 (shen.<-out W3116) (let W3118 (shen.in-> W3116) (shen.comb W3118 (cons W3112 W3117))))))))))))) (if (shen.parse-failure? W3110) (let W3119 (let W3120 ( V3109) (if (shen.parse-failure? W3120) (shen.parse-failure) (let W3121 (shen.in-> W3120) (shen.comb W3121 ())))) (if (shen.parse-failure? W3119) (shen.parse-failure) W3119)) W3110))) -(defun shen. (V3468) (let W3469 (if (shen.hds=? V3468 !) (let W3470 (tail V3468) (shen.comb W3470 !)) (shen.parse-failure)) (if (shen.parse-failure? W3469) (let W3471 (let W3472 (shen. V3468) (if (shen.parse-failure? W3472) (shen.parse-failure) (let W3473 (shen.<-out W3472) (let W3474 (shen.in-> W3472) (if (shen.hds=? W3474 >>) (let W3475 (tail W3474) (let W3476 (shen. W3475) (if (shen.parse-failure? W3476) (shen.parse-failure) (let W3477 (shen.<-out W3476) (let W3478 (shen.in-> W3476) (shen.comb W3478 (cons W3473 (cons W3477 ())))))))) (shen.parse-failure)))))) (if (shen.parse-failure? W3471) (let W3479 (let W3480 (shen. V3468) (if (shen.parse-failure? W3480) (shen.parse-failure) (let W3481 (shen.<-out W3480) (let W3482 (shen.in-> W3480) (shen.comb W3482 (cons () (cons W3481 ()))))))) (if (shen.parse-failure? W3479) (shen.parse-failure) W3479)) W3471)) W3469))) +(defun shen. (V3122) (let W3123 (if (shen.hds=? V3122 !) (let W3124 (tail V3122) (shen.comb W3124 !)) (shen.parse-failure)) (if (shen.parse-failure? W3123) (let W3125 (let W3126 (shen. V3122) (if (shen.parse-failure? W3126) (shen.parse-failure) (let W3127 (shen.<-out W3126) (let W3128 (shen.in-> W3126) (if (shen.hds=? W3128 >>) (let W3129 (tail W3128) (let W3130 (shen. W3129) (if (shen.parse-failure? W3130) (shen.parse-failure) (let W3131 (shen.<-out W3130) (let W3132 (shen.in-> W3130) (shen.comb W3132 (cons W3127 (cons W3131 ())))))))) (shen.parse-failure)))))) (if (shen.parse-failure? W3125) (let W3133 (let W3134 (shen. V3122) (if (shen.parse-failure? W3134) (shen.parse-failure) (let W3135 (shen.<-out W3134) (let W3136 (shen.in-> W3134) (shen.comb W3136 (cons () (cons W3135 ()))))))) (if (shen.parse-failure? W3133) (shen.parse-failure) W3133)) W3125)) W3123))) -(defun shen. (V3483) (let W3484 (let W3485 (shen. V3483) (if (shen.parse-failure? W3485) (shen.parse-failure) (let W3486 (shen.<-out W3485) (let W3487 (shen.in-> W3485) (let W3488 (shen. W3487) (if (shen.parse-failure? W3488) (shen.parse-failure) (let W3489 (shen.in-> W3488) (let W3490 (shen. W3489) (if (shen.parse-failure? W3490) (shen.parse-failure) (let W3491 (shen.<-out W3490) (let W3492 (shen.in-> W3490) (shen.comb W3492 (cons W3486 W3491))))))))))))) (if (shen.parse-failure? W3484) (let W3493 (let W3494 (shen. V3483) (if (shen.parse-failure? W3494) (shen.parse-failure) (let W3495 (shen.<-out W3494) (let W3496 (shen.in-> W3494) (shen.comb W3496 (cons W3495 ())))))) (if (shen.parse-failure? W3493) (let W3497 (let W3498 ( V3483) (if (shen.parse-failure? W3498) (shen.parse-failure) (let W3499 (shen.in-> W3498) (shen.comb W3499 ())))) (if (shen.parse-failure? W3497) (shen.parse-failure) W3497)) W3493)) W3484))) +(defun shen. (V3137) (let W3138 (let W3139 (shen. V3137) (if (shen.parse-failure? W3139) (shen.parse-failure) (let W3140 (shen.<-out W3139) (let W3141 (shen.in-> W3139) (let W3142 (shen. W3141) (if (shen.parse-failure? W3142) (shen.parse-failure) (let W3143 (shen.in-> W3142) (let W3144 (shen. W3143) (if (shen.parse-failure? W3144) (shen.parse-failure) (let W3145 (shen.<-out W3144) (let W3146 (shen.in-> W3144) (shen.comb W3146 (cons W3140 W3145))))))))))))) (if (shen.parse-failure? W3138) (let W3147 (let W3148 (shen. V3137) (if (shen.parse-failure? W3148) (shen.parse-failure) (let W3149 (shen.<-out W3148) (let W3150 (shen.in-> W3148) (shen.comb W3150 (cons W3149 ())))))) (if (shen.parse-failure? W3147) (let W3151 (let W3152 ( V3137) (if (shen.parse-failure? W3152) (shen.parse-failure) (let W3153 (shen.in-> W3152) (shen.comb W3153 ())))) (if (shen.parse-failure? W3151) (shen.parse-failure) W3151)) W3147)) W3138))) -(defun shen. (V3500) (let W3501 (if (cons? V3500) (let W3502 (head V3500) (let W3503 (tail V3500) (if (= W3502 (intern ",")) (shen.comb W3503 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3501) (shen.parse-failure) W3501))) +(defun shen. (V3154) (let W3155 (if (cons? V3154) (let W3156 (head V3154) (let W3157 (tail V3154) (if (= W3156 (intern ",")) (shen.comb W3157 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3155) (shen.parse-failure) W3155))) -(defun shen. (V3504) (let W3505 (let W3506 (shen. V3504) (if (shen.parse-failure? W3506) (shen.parse-failure) (let W3507 (shen.<-out W3506) (let W3508 (shen.in-> W3506) (let W3509 (shen. W3508) (if (shen.parse-failure? W3509) (shen.parse-failure) (let W3510 (shen.in-> W3509) (let W3511 (shen. W3510) (if (shen.parse-failure? W3511) (shen.parse-failure) (let W3512 (shen.<-out W3511) (let W3513 (shen.in-> W3511) (shen.comb W3513 (cons (shen.curry W3507) (cons (intern ":") (cons (shen.rectify-type W3512) ()))))))))))))))) (if (shen.parse-failure? W3505) (let W3514 (let W3515 (shen. V3504) (if (shen.parse-failure? W3515) (shen.parse-failure) (let W3516 (shen.<-out W3515) (let W3517 (shen.in-> W3515) (shen.comb W3517 W3516))))) (if (shen.parse-failure? W3514) (shen.parse-failure) W3514)) W3505))) +(defun shen. (V3158) (let W3159 (let W3160 (shen. V3158) (if (shen.parse-failure? W3160) (shen.parse-failure) (let W3161 (shen.<-out W3160) (let W3162 (shen.in-> W3160) (let W3163 (shen. W3162) (if (shen.parse-failure? W3163) (shen.parse-failure) (let W3164 (shen.in-> W3163) (let W3165 (shen. W3164) (if (shen.parse-failure? W3165) (shen.parse-failure) (let W3166 (shen.<-out W3165) (let W3167 (shen.in-> W3165) (shen.comb W3167 (cons (shen.curry W3161) (cons (intern ":") (cons (shen.rectify-type W3166) ()))))))))))))))) (if (shen.parse-failure? W3159) (let W3168 (let W3169 (shen. V3158) (if (shen.parse-failure? W3169) (shen.parse-failure) (let W3170 (shen.<-out W3169) (let W3171 (shen.in-> W3169) (shen.comb W3171 W3170))))) (if (shen.parse-failure? W3168) (shen.parse-failure) W3168)) W3159))) -(defun shen. (V3518) (let W3519 (if (cons? V3518) (let W3520 (head V3518) (let W3521 (tail V3518) (if (= W3520 (intern ":")) (shen.comb W3521 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3519) (shen.parse-failure) W3519))) +(defun shen. (V3172) (let W3173 (if (cons? V3172) (let W3174 (head V3172) (let W3175 (tail V3172) (if (= W3174 (intern ":")) (shen.comb W3175 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3173) (shen.parse-failure) W3173))) -(defun shen. (V3522) (let W3523 (let W3524 (shen. V3522) (if (shen.parse-failure? W3524) (shen.parse-failure) (let W3525 (shen.<-out W3524) (let W3526 (shen.in-> W3524) (let W3527 (shen. W3526) (if (shen.parse-failure? W3527) (shen.parse-failure) (let W3528 (shen.<-out W3527) (let W3529 (shen.in-> W3527) (shen.comb W3529 (cons W3525 W3528)))))))))) (if (shen.parse-failure? W3523) (let W3530 (let W3531 ( V3522) (if (shen.parse-failure? W3531) (shen.parse-failure) (let W3532 (shen.in-> W3531) (shen.comb W3532 ())))) (if (shen.parse-failure? W3530) (shen.parse-failure) W3530)) W3523))) +(defun shen. (V3176) (let W3177 (let W3178 (shen. V3176) (if (shen.parse-failure? W3178) (shen.parse-failure) (let W3179 (shen.<-out W3178) (let W3180 (shen.in-> W3178) (let W3181 (shen. W3180) (if (shen.parse-failure? W3181) (shen.parse-failure) (let W3182 (shen.<-out W3181) (let W3183 (shen.in-> W3181) (shen.comb W3183 (cons W3179 W3182)))))))))) (if (shen.parse-failure? W3177) (let W3184 (let W3185 ( V3176) (if (shen.parse-failure? W3185) (shen.parse-failure) (let W3186 (shen.in-> W3185) (shen.comb W3186 ())))) (if (shen.parse-failure? W3184) (shen.parse-failure) W3184)) W3177))) -(defun shen. (V3533) (let W3534 (if (shen.hds=? V3533 if) (let W3535 (tail V3533) (if (cons? W3535) (let W3536 (head W3535) (let W3537 (tail W3535) (shen.comb W3537 (cons if (cons W3536 ()))))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W3534) (let W3538 (if (shen.hds=? V3533 let) (let W3539 (tail V3533) (if (cons? W3539) (let W3540 (head W3539) (let W3541 (tail W3539) (if (cons? W3541) (let W3542 (head W3541) (let W3543 (tail W3541) (shen.comb W3543 (cons let (cons W3540 (cons W3542 ())))))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W3538) (let W3544 (if (shen.hds=? V3533 ctxt) (let W3545 (tail V3533) (if (cons? W3545) (let W3546 (head W3545) (let W3547 (tail W3545) (if (variable? W3546) (shen.comb W3547 (cons ctxt (cons W3546 ()))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W3544) (shen.parse-failure) W3544)) W3538)) W3534))) +(defun shen. (V3187) (let W3188 (if (shen.hds=? V3187 if) (let W3189 (tail V3187) (if (cons? W3189) (let W3190 (head W3189) (let W3191 (tail W3189) (shen.comb W3191 (cons if (cons W3190 ()))))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W3188) (let W3192 (if (shen.hds=? V3187 let) (let W3193 (tail V3187) (if (cons? W3193) (let W3194 (head W3193) (let W3195 (tail W3193) (if (cons? W3195) (let W3196 (head W3195) (let W3197 (tail W3195) (shen.comb W3197 (cons let (cons W3194 (cons W3196 ())))))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W3192) (let W3198 (if (shen.hds=? V3187 ctxt) (let W3199 (tail V3187) (if (cons? W3199) (let W3200 (head W3199) (let W3201 (tail W3199) (if (variable? W3200) (shen.comb W3201 (cons ctxt (cons W3200 ()))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W3198) (let W3202 (if (shen.hds=? V3187 sqts) (let W3203 (tail V3187) (if (cons? W3203) (let W3204 (head W3203) (let W3205 (tail W3203) (if (variable? W3204) (shen.comb W3205 (cons sqts (cons W3204 ()))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W3202) (shen.parse-failure) W3202)) W3198)) W3192)) W3188))) -(defun shen.lr-rule (V3554 V3555 V3556) (cond ((and (cons? V3556) (and (= () (hd V3556)) (and (cons? (tl V3556)) (= () (tl (tl V3556)))))) (let W3557 (gensym P) (let W3558 (cons (tl V3556) (cons W3557 ())) (let W3559 (cons (shen.coll-formulae V3555) (cons W3557 ())) (let W3560 (cons V3554 (cons (cons W3559 ()) (cons W3558 ()))) (let W3561 (cons V3554 (cons V3555 (cons V3556 ()))) (cons W3561 (cons W3560 ())))))))) (true (simple-error "implementation error in shen.lr-rule")))) +(defun shen.lr-rule (V3212 V3213 V3214) (cond ((and (cons? V3214) (and (= () (hd V3214)) (and (cons? (tl V3214)) (= () (tl (tl V3214)))))) (let W3215 (gensym P) (let W3216 (cons (tl V3214) (cons W3215 ())) (let W3217 (cons (shen.coll-formulae V3213) (cons W3215 ())) (let W3218 (cons V3212 (cons (cons W3217 ()) (cons W3216 ()))) (let W3219 (cons V3212 (cons V3213 (cons V3214 ()))) (cons W3219 (cons W3218 ())))))))) (true (simple-error "implementation error in shen.lr-rule")))) -(defun shen.coll-formulae (V3564) (cond ((= () V3564) ()) ((and (cons? V3564) (and (cons? (hd V3564)) (and (= () (hd (hd V3564))) (and (cons? (tl (hd V3564))) (= () (tl (tl (hd V3564)))))))) (cons (hd (tl (hd V3564))) (shen.coll-formulae (tl V3564)))) (true (simple-error "implementation error in shen.coll-formulae")))) +(defun shen.coll-formulae (V3222) (cond ((= () V3222) ()) ((and (cons? V3222) (and (cons? (hd V3222)) (and (= () (hd (hd V3222))) (and (cons? (tl (hd V3222))) (= () (tl (tl (hd V3222)))))))) (cons (hd (tl (hd V3222))) (shen.coll-formulae (tl V3222)))) (true (simple-error "implementation error in shen.coll-formulae")))) -(defun shen. (V3565) (let W3566 (if (cons? V3565) (let W3567 (head V3565) (let W3568 (tail V3565) (if (not (shen.key-in-sequent-calculus? W3567)) (shen.comb W3568 (macroexpand W3567)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3566) (shen.parse-failure) W3566))) +(defun shen. (V3223) (let W3224 (if (cons? V3223) (let W3225 (head V3223) (let W3226 (tail V3223) (if (not (shen.key-in-sequent-calculus? W3225)) (shen.comb W3226 (macroexpand W3225)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3224) (shen.parse-failure) W3224))) -(defun shen.key-in-sequent-calculus? (V3569) (or (element? V3569 (cons >> (cons (intern ";") (cons (intern ",") (cons (intern ":") (cons <-- ())))))) (or (shen.sng? V3569) (shen.dbl? V3569)))) +(defun shen.key-in-sequent-calculus? (V3227) (or (element? V3227 (cons >> (cons (intern ";") (cons (intern ",") (cons (intern ":") (cons <-- ())))))) (or (shen.sng? V3227) (shen.dbl? V3227)))) -(defun shen. (V3570) (let W3571 (let W3572 (shen. V3570) (if (shen.parse-failure? W3572) (shen.parse-failure) (let W3573 (shen.<-out W3572) (let W3574 (shen.in-> W3572) (shen.comb W3574 W3573))))) (if (shen.parse-failure? W3571) (shen.parse-failure) W3571))) +(defun shen. (V3228) (let W3229 (let W3230 (shen. V3228) (if (shen.parse-failure? W3230) (shen.parse-failure) (let W3231 (shen.<-out W3230) (let W3232 (shen.in-> W3230) (shen.comb W3232 W3231))))) (if (shen.parse-failure? W3229) (shen.parse-failure) W3229))) -(defun shen. (V3575) (let W3576 (if (cons? V3575) (let W3577 (head V3575) (let W3578 (tail V3575) (if (shen.dbl? W3577) (shen.comb W3578 W3577) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3576) (shen.parse-failure) W3576))) +(defun shen. (V3233) (let W3234 (if (cons? V3233) (let W3235 (head V3233) (let W3236 (tail V3233) (if (shen.dbl? W3235) (shen.comb W3236 W3235) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3234) (shen.parse-failure) W3234))) -(defun shen. (V3579) (let W3580 (if (cons? V3579) (let W3581 (head V3579) (let W3582 (tail V3579) (if (shen.sng? W3581) (shen.comb W3582 W3581) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3580) (shen.parse-failure) W3580))) +(defun shen. (V3237) (let W3238 (if (cons? V3237) (let W3239 (head V3237) (let W3240 (tail V3237) (if (shen.sng? W3239) (shen.comb W3240 W3239) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3238) (shen.parse-failure) W3238))) -(defun shen.sng? (V3583) (and (symbol? V3583) (shen.sng-h? (str V3583)))) +(defun shen.sng? (V3241) (and (symbol? V3241) (shen.sng-h? (str V3241)))) -(defun shen.sng-h? (V3586) (cond ((= "___" V3586) true) ((and (shen.+string? V3586) (= "_" (hdstr V3586))) (shen.sng-h? (tlstr V3586))) (true false))) +(defun shen.sng-h? (V3244) (cond ((= "___" V3244) true) ((and (shen.+string? V3244) (= "_" (hdstr V3244))) (shen.sng-h? (tlstr V3244))) (true false))) -(defun shen.dbl? (V3587) (and (symbol? V3587) (shen.dbl-h? (str V3587)))) +(defun shen.dbl? (V3245) (and (symbol? V3245) (shen.dbl-h? (str V3245)))) -(defun shen.dbl-h? (V3590) (cond ((= "===" V3590) true) ((and (shen.+string? V3590) (= "=" (hdstr V3590))) (shen.dbl-h? (tlstr V3590))) (true false))) +(defun shen.dbl-h? (V3248) (cond ((= "===" V3248) true) ((and (shen.+string? V3248) (= "=" (hdstr V3248))) (shen.dbl-h? (tlstr V3248))) (true false))) -(defun shen.rules->prolog (V3591 V3592) (let W3593 (mapcan (lambda Z3594 (shen.rule->clause Z3594)) V3592) (let W3595 (cons defprolog (cons V3591 W3593)) (eval W3595)))) +(defun shen.rules->prolog (V3249 V3250) (let W3251 (mapcan (lambda Z3252 (shen.rule->clause Z3252)) V3250) (let W3253 (cons defprolog (cons V3249 W3251)) (eval W3253)))) -(defun shen.rule->clause (V3596) (cond ((and (cons? V3596) (and (cons? (tl V3596)) (and (cons? (tl (tl V3596))) (and (cons? (hd (tl (tl V3596)))) (and (cons? (tl (hd (tl (tl V3596))))) (and (= () (tl (tl (hd (tl (tl V3596)))))) (= () (tl (tl (tl V3596)))))))))) (let W3597 (shen.extract-vars (hd (tl (hd (tl (tl V3596)))))) (append (shen.rule->head (hd (tl (hd (tl (tl V3596)))))) (append (cons <-- ()) (shen.rule->body W3597 Assumptions (hd V3596) (hd (tl V3596)) (hd (hd (tl (tl V3596))))))))) (true (shen.f-error shen.rule->clause)))) +(defun shen.rule->clause (V3254) (cond ((and (cons? V3254) (and (cons? (tl V3254)) (and (cons? (tl (tl V3254))) (and (cons? (hd (tl (tl V3254)))) (and (cons? (tl (hd (tl (tl V3254))))) (and (= () (tl (tl (hd (tl (tl V3254)))))) (= () (tl (tl (tl V3254)))))))))) (let W3255 (shen.extract-vars (hd (tl (hd (tl (tl V3254)))))) (append (shen.rule->head (hd (tl (hd (tl (tl V3254)))))) (append (cons <-- ()) (shen.rule->body W3255 Assumptions (hd V3254) (hd (tl V3254)) (hd (hd (tl (tl V3254))))))))) (true (simple-error "partial function shen.rule->clause")))) -(defun shen.rule->head (V3598) (cons (shen.macro-@ch V3598) (cons Assumptions ()))) +(defun shen.rule->head (V3256) (cons (shen.macro-@ch V3256) (cons Assumptions ()))) -(defun shen.macro-@ch (V3599) (cons shen.@ch (cons V3599 ()))) +(defun shen.macro-@ch (V3257) (cons shen.@ch (cons V3257 ()))) -(defun shen.macro-@c (V3600) (cons shen.@c (cons V3600 ()))) +(defun shen.macro-@c (V3258) (cons shen.@c (cons V3258 ()))) -(defun shen.rule->body (V3601 V3602 V3603 V3604 V3605) (cond ((= () V3605) (shen.side-conditions->goals () V3601 V3602 V3603 V3604)) ((and (= () V3604) (and (cons? V3605) (= () (tl V3605)))) (let W3606 (shen.passive-variables (hd V3605) V3601) (let W3607 (shen.remove-bystanders V3601 (hd V3605)) (cons (shen.specialise-member (hd V3605) V3602 W3607 W3606) (shen.side-conditions->goals () V3601 V3602 V3603 ()))))) ((cons? V3605) (let W3608 (gensym NewAssumptions) (let W3609 (shen.passive-variables (hd V3605) V3601) (let W3610 (shen.remove-bystanders V3601 (hd V3605)) (cons (shen.specialise-consume (hd V3605) V3602 W3610 W3609 W3608) (shen.rule->body (append V3601 W3609) W3608 V3603 V3604 (tl V3605))))))) (true (shen.f-error shen.rule->body)))) +(defun shen.rule->body (V3259 V3260 V3261 V3262 V3263) (cond ((= () V3263) (shen.side-conditions->goals () V3259 V3260 V3261 V3262)) ((and (= () V3262) (and (cons? V3263) (= () (tl V3263)))) (let W3264 (shen.passive-variables (hd V3263) V3259) (let W3265 (shen.remove-bystanders V3259 (hd V3263)) (cons (shen.specialise-member (hd V3263) V3260 W3265 W3264) (shen.side-conditions->goals () V3259 V3260 V3261 ()))))) ((cons? V3263) (let W3266 (gensym NewAssumptions) (let W3267 (shen.passive-variables (hd V3263) V3259) (let W3268 (shen.remove-bystanders V3259 (hd V3263)) (cons (shen.specialise-consume (hd V3263) V3260 W3268 W3267 W3266) (shen.rule->body (append V3259 W3267) W3266 V3261 V3262 (tl V3263))))))) (true (simple-error "partial function shen.rule->body")))) -(defun shen.specialise-member (V3611 V3612 V3613 V3614) (let W3615 (gensym shen.member) (let W3616 (shen.member-clause W3615 V3611 V3613 V3614) (cons W3615 (cons V3612 (append V3613 V3614)))))) +(defun shen.specialise-member (V3269 V3270 V3271 V3272) (let W3273 (gensym shen.member) (let W3274 (shen.member-clause W3273 V3269 V3271 V3272) (cons W3273 (cons V3270 (append V3271 V3272)))))) -(defun shen.remove-bystanders (V3619 V3620) (cond ((= () V3619) ()) ((and (cons? V3619) (shen.occurs-check? (hd V3619) V3620)) (cons (hd V3619) (shen.remove-bystanders (tl V3619) V3620))) ((cons? V3619) (shen.remove-bystanders (tl V3619) V3620)) (true (shen.f-error shen.remove-bystanders)))) +(defun shen.remove-bystanders (V3277 V3278) (cond ((= () V3277) ()) ((and (cons? V3277) (shen.occurs-check? (hd V3277) V3278)) (cons (hd V3277) (shen.remove-bystanders (tl V3277) V3278))) ((cons? V3277) (shen.remove-bystanders (tl V3277) V3278)) (true (simple-error "partial function shen.remove-bystanders")))) -(defun shen.member-clause (V3621 V3622 V3623 V3624) (let W3625 (shen.nvars (length V3624)) (let W3626 (append (cons (cons - (cons (cons cons (cons (shen.macro-@ch V3622) (cons _ ()))) ())) ()) (append V3623 (append W3625 (append (cons <-- ()) (append (shen.passive-bind V3624 W3625) (cons (intern ";") ())))))) (let W3627 (let W3628 (gensym Hypotheses) (let W3629 (append V3623 V3624) (let W3630 (append (cons (cons - (cons (cons cons (cons _ (cons W3628 ()))) ())) ()) W3629) (let W3631 (cons (cons V3621 (cons W3628 W3629)) ()) (append W3630 (append (cons <-- ()) (append W3631 (cons (intern ";") ())))))))) (let W3632 (cons defprolog (cons V3621 (append W3626 W3627))) (eval W3632)))))) +(defun shen.member-clause (V3279 V3280 V3281 V3282) (let W3283 (shen.nvars (length V3282)) (let W3284 (append (cons (cons - (cons (cons cons (cons (shen.macro-@ch V3280) (cons _ ()))) ())) ()) (append V3281 (append W3283 (append (cons <-- ()) (append (shen.passive-bind V3282 W3283) (cons (intern ";") ())))))) (let W3285 (let W3286 (gensym Hypotheses) (let W3287 (append V3281 V3282) (let W3288 (append (cons (cons - (cons (cons cons (cons _ (cons W3286 ()))) ())) ()) W3287) (let W3289 (cons (cons V3279 (cons W3286 W3287)) ()) (append W3288 (append (cons <-- ()) (append W3289 (cons (intern ";") ())))))))) (let W3290 (cons defprolog (cons V3279 (append W3284 W3285))) (eval W3290)))))) -(defun shen.nvars (V3633) (cond ((= 0 V3633) ()) (true (cons (gensym NewV) (shen.nvars (- V3633 1)))))) +(defun shen.nvars (V3291) (cond ((= 0 V3291) ()) (true (cons (gensym NewV) (shen.nvars (- V3291 1)))))) -(defun shen.passive-bind (V3634 V3635) (cond ((and (= () V3634) (= () V3635)) ()) ((and (cons? V3634) (cons? V3635)) (cons (cons bind (cons (hd V3635) (cons (hd V3634) ()))) (shen.passive-bind (tl V3634) (tl V3635)))) (true (shen.f-error shen.passive-bind)))) +(defun shen.passive-bind (V3292 V3293) (cond ((and (= () V3292) (= () V3293)) ()) ((and (cons? V3292) (cons? V3293)) (cons (cons bind (cons (hd V3293) (cons (hd V3292) ()))) (shen.passive-bind (tl V3292) (tl V3293)))) (true (simple-error "partial function shen.passive-bind")))) -(defun shen.specialise-consume (V3636 V3637 V3638 V3639 V3640) (let W3641 (gensym shen.consume) (let W3642 (shen.consume-clause W3641 V3636 V3638 V3639 V3640) (cons W3641 (cons V3637 (cons V3640 (append V3638 V3639))))))) +(defun shen.specialise-consume (V3294 V3295 V3296 V3297 V3298) (let W3299 (gensym shen.consume) (let W3300 (shen.consume-clause W3299 V3294 V3296 V3297 V3298) (cons W3299 (cons V3295 (cons V3298 (append V3296 V3297))))))) -(defun shen.consume-clause (V3643 V3644 V3645 V3646 V3647) (let W3648 (shen.nvars (length V3646)) (let W3649 (gensym Assumption) (let W3650 (cons (cons - (cons (cons cons (cons (shen.macro-@ch V3644) (cons W3649 ()))) ())) (cons V3647 (append V3645 (append W3648 (append (cons <-- ()) (append (shen.passive-bind V3646 W3648) (cons (cons bind (cons V3647 (cons W3649 ()))) (cons (intern ";") ())))))))) (let W3651 (let W3652 (gensym Hypotheses) (let W3653 (append V3645 V3646) (let W3654 (gensym Assumptions) (let W3655 (cons (cons - (cons (cons cons (cons W3649 (cons W3652 ()))) ())) (cons (cons cons (cons W3654 (cons V3647 ()))) W3653)) (let W3656 (cons (cons bind (cons W3654 (cons W3649 ()))) (cons (cons V3643 (cons W3652 (cons V3647 W3653))) ())) (append W3655 (append (cons <-- ()) (append W3656 (cons (intern ";") ()))))))))) (let W3657 (cons defprolog (cons V3643 (append W3650 W3651))) (eval W3657))))))) +(defun shen.consume-clause (V3301 V3302 V3303 V3304 V3305) (let W3306 (shen.nvars (length V3304)) (let W3307 (gensym Assumption) (let W3308 (cons (cons - (cons (cons cons (cons (shen.macro-@ch V3302) (cons W3307 ()))) ())) (cons V3305 (append V3303 (append W3306 (append (cons <-- ()) (append (shen.passive-bind V3304 W3306) (cons (cons bind (cons V3305 (cons W3307 ()))) (cons (intern ";") ())))))))) (let W3309 (let W3310 (gensym Hypotheses) (let W3311 (append V3303 V3304) (let W3312 (gensym Assumptions) (let W3313 (cons (cons - (cons (cons cons (cons W3307 (cons W3310 ()))) ())) (cons (cons cons (cons W3312 (cons V3305 ()))) W3311)) (let W3314 (cons (cons bind (cons W3312 (cons W3307 ()))) (cons (cons V3301 (cons W3310 (cons V3305 W3311))) ())) (append W3313 (append (cons <-- ()) (append W3314 (cons (intern ";") ()))))))))) (let W3315 (cons defprolog (cons V3301 (append W3308 W3309))) (eval W3315))))))) -(defun shen.passive-variables (V3658 V3659) (difference (shen.extract-vars V3658) V3659)) +(defun shen.passive-variables (V3316 V3317) (difference (shen.extract-vars V3316) V3317)) -(defun shen.side-conditions->goals (V3662 V3663 V3664 V3665 V3666) (cond ((= () V3665) (shen.premises->goals V3662 V3664 V3666)) ((and (cons? V3665) (and (cons? (hd V3665)) (and (= if (hd (hd V3665))) (and (cons? (tl (hd V3665))) (= () (tl (tl (hd V3665)))))))) (cons (cons when (tl (hd V3665))) (shen.side-conditions->goals V3662 V3663 V3664 (tl V3665) V3666))) ((and (cons? V3665) (and (cons? (hd V3665)) (and (= let (hd (hd V3665))) (and (cons? (tl (hd V3665))) (and (cons? (tl (tl (hd V3665)))) (= () (tl (tl (tl (hd V3665)))))))))) (if (element? (hd (tl (hd V3665))) V3663) (cons (cons is! (tl (hd V3665))) (shen.side-conditions->goals V3662 V3663 V3664 (tl V3665) V3666)) (cons (cons bind (tl (hd V3665))) (shen.side-conditions->goals V3662 (cons (hd (tl (hd V3665))) V3663) V3664 (tl V3665) V3666)))) ((and (cons? V3665) (and (cons? (hd V3665)) (and (= ctxt (hd (hd V3665))) (and (cons? (tl (hd V3665))) (= () (tl (tl (hd V3665)))))))) (if (element? (hd (tl (hd V3665))) V3663) (shen.side-conditions->goals (cons (hd (tl (hd V3665))) V3662) V3663 V3664 (tl V3665) V3666) (cons (cons bind (cons (hd (tl (hd V3665))) (cons V3664 ()))) (shen.side-conditions->goals (cons (hd (tl (hd V3665))) V3662) (cons (hd (tl (hd V3665))) V3663) (hd (tl (hd V3665))) (tl V3665) V3666)))) (true (shen.f-error shen.side-conditions->goals)))) +(defun shen.side-conditions->goals (V3322 V3323 V3324 V3325 V3326) (cond ((= () V3325) (shen.premises->goals V3322 V3324 V3326)) ((and (cons? V3325) (and (cons? (hd V3325)) (and (= if (hd (hd V3325))) (and (cons? (tl (hd V3325))) (= () (tl (tl (hd V3325)))))))) (cons (cons when (tl (hd V3325))) (shen.side-conditions->goals V3322 V3323 V3324 (tl V3325) V3326))) ((and (cons? V3325) (and (cons? (hd V3325)) (and (= let (hd (hd V3325))) (and (cons? (tl (hd V3325))) (and (cons? (tl (tl (hd V3325)))) (= () (tl (tl (tl (hd V3325)))))))))) (if (element? (hd (tl (hd V3325))) V3323) (cons (cons is! (tl (hd V3325))) (shen.side-conditions->goals V3322 V3323 V3324 (tl V3325) V3326)) (cons (cons bind (tl (hd V3325))) (shen.side-conditions->goals V3322 (cons (hd (tl (hd V3325))) V3323) V3324 (tl V3325) V3326)))) ((and (cons? V3325) (and (cons? (hd V3325)) (and (= ctxt (hd (hd V3325))) (and (cons? (tl (hd V3325))) (= () (tl (tl (hd V3325)))))))) (if (element? (hd (tl (hd V3325))) V3323) (shen.side-conditions->goals (cons (hd (tl (hd V3325))) V3322) V3323 V3324 (tl V3325) V3326) (cons (cons bind (cons (hd (tl (hd V3325))) (cons V3324 ()))) (shen.side-conditions->goals (cons (hd (tl (hd V3325))) V3322) (cons (hd (tl (hd V3325))) V3323) (hd (tl (hd V3325))) (tl V3325) V3326)))) ((and (cons? V3325) (and (cons? (hd V3325)) (and (= sqts (hd (hd V3325))) (and (cons? (tl (hd V3325))) (= () (tl (tl (hd V3325)))))))) (shen.side-conditions->goals V3322 V3323 V3324 (tl V3325) V3326)) (true (simple-error "partial function shen.side-conditions->goals")))) -(defun shen.premises->goals (V3671 V3672 V3673) (cond ((= () V3673) (cons (intern ";") ())) ((and (cons? V3673) (= ! (hd V3673))) (cons ! (shen.premises->goals V3671 V3672 (tl V3673)))) ((and (cons? V3673) (= fail (hd V3673))) (cons (cons when (cons false ())) (shen.premises->goals V3671 V3672 (tl V3673)))) ((and (cons? V3673) (and (cons? (hd V3673)) (and (cons? (tl (hd V3673))) (= () (tl (tl (hd V3673))))))) (cons (cons shen.system-S (cons (shen.macro-@c (hd (tl (hd V3673)))) (cons (shen.construct-context V3671 (hd (hd V3673)) V3672) ()))) (shen.premises->goals V3671 V3672 (tl V3673)))) (true (shen.f-error shen.premises->goals)))) +(defun shen.premises->goals (V3331 V3332 V3333) (cond ((= () V3333) (cons (intern ";") ())) ((and (cons? V3333) (= ! (hd V3333))) (cons ! (shen.premises->goals V3331 V3332 (tl V3333)))) ((and (cons? V3333) (= fail (hd V3333))) (cons (cons when (cons false ())) (shen.premises->goals V3331 V3332 (tl V3333)))) ((and (cons? V3333) (and (cons? (hd V3333)) (and (cons? (tl (hd V3333))) (= () (tl (tl (hd V3333))))))) (cons (cons shen.system-S (cons (shen.macro-@c (hd (tl (hd V3333)))) (cons (shen.construct-context V3331 (hd (hd V3333)) V3332) ()))) (shen.premises->goals V3331 V3332 (tl V3333)))) (true (simple-error "partial function shen.premises->goals")))) -(defun shen.construct-context (V3677 V3678 V3679) (cond ((= () V3678) V3679) ((and (cons? V3678) (and (= () (tl V3678)) (element? (hd V3678) V3677))) (hd V3678)) ((cons? V3678) (cons cons (cons (shen.macro-@c (hd V3678)) (cons (shen.construct-context V3677 (tl V3678) V3679) ())))) (true (shen.f-error shen.construct-context)))) +(defun shen.construct-context (V3337 V3338 V3339) (cond ((= () V3338) V3339) ((and (cons? V3338) (and (= () (tl V3338)) (element? (hd V3338) V3337))) (hd V3338)) ((cons? V3338) (cons cons (cons (shen.macro-@c (hd V3338)) (cons (shen.construct-context V3337 (tl V3338) V3339) ())))) (true (simple-error "partial function shen.construct-context")))) -(defun preclude (V3680) (let W3681 (map (lambda Z3682 (shen.intern-type Z3682)) V3680) (let W3683 (value shen.*datatypes*) (let W3684 (shen.remove-datatypes W3681 W3683) (let W3685 (set shen.*datatypes* W3684) (shen.show-datatypes W3685)))))) +(defun preclude (V3340) (let W3341 (map (lambda Z3342 (shen.intern-type Z3342)) V3340) (let W3343 (value shen.*datatypes*) (let W3344 (shen.remove-datatypes W3341 W3343) (let W3345 (set shen.*datatypes* W3344) (shen.show-datatypes W3345)))))) -(defun shen.remove-datatypes (V3690 V3691) (cond ((= () V3690) V3691) ((cons? V3690) (shen.remove-datatypes (tl V3690) (shen.unassoc (hd V3690) V3691))) (true (simple-error "implementation error in shen.remove-datatypes")))) +(defun shen.remove-datatypes (V3350 V3351) (cond ((= () V3350) V3351) ((cons? V3350) (shen.remove-datatypes (tl V3350) (shen.unassoc (hd V3350) V3351))) (true (simple-error "implementation error in shen.remove-datatypes")))) -(defun shen.show-datatypes (V3692) (map (lambda Z3693 (hd Z3693)) V3692)) +(defun shen.show-datatypes (V3352) (map (lambda Z3353 (hd Z3353)) V3352)) -(defun include (V3694) (let W3695 (map (lambda Z3696 (shen.intern-type Z3696)) V3694) (let W3697 (map (lambda Z3698 (shen.remember-datatype Z3698 (fn Z3698))) W3695) (let W3699 (value shen.*datatypes*) (shen.show-datatypes W3699))))) +(defun include (V3354) (let W3355 (map (lambda Z3356 (shen.intern-type Z3356)) V3354) (let W3357 (map (lambda Z3358 (shen.remember-datatype Z3358 (fn Z3358))) W3355) (let W3359 (value shen.*datatypes*) (shen.show-datatypes W3359))))) -(defun preclude-all-but (V3700) (let W3701 (set shen.*datatypes* ()) (let W3702 (map (lambda Z3703 (shen.intern-type Z3703)) V3700) (let W3704 (map (lambda Z3705 (shen.remember-datatype Z3705 (fn Z3705))) W3702) (shen.show-datatypes (value shen.*datatypes*)))))) +(defun preclude-all-but (V3360) (let W3361 (set shen.*datatypes* ()) (let W3362 (map (lambda Z3363 (shen.intern-type Z3363)) V3360) (let W3364 (map (lambda Z3365 (shen.remember-datatype Z3365 (fn Z3365))) W3362) (shen.show-datatypes (value shen.*datatypes*)))))) -(defun include-all-but (V3706) (let W3707 (map (lambda Z3708 (shen.intern-type Z3708)) V3706) (let W3709 (value shen.*alldatatypes*) (let W3710 (set shen.*datatypes* (shen.remove-datatypes W3707 W3709)) (shen.show-datatypes W3710))))) +(defun include-all-but (V3366) (let W3367 (map (lambda Z3368 (shen.intern-type Z3368)) V3366) (let W3369 (value shen.*alldatatypes*) (let W3370 (set shen.*datatypes* (shen.remove-datatypes W3367 W3369)) (shen.show-datatypes W3370))))) diff --git a/klambda/sys.kl b/klambda/sys.kl index d04fc79..e732b95 100644 --- a/klambda/sys.kl +++ b/klambda/sys.kl @@ -1,16 +1,16 @@ -(defun thaw (V3767) (V3767)) +(defun thaw (V3430) (V3430)) -(defun eval (V3768) (eval-kl (shen.shen->kl (shen.process-applications (macroexpand V3768) (shen.find-types V3768))))) +(defun eval (V3431) (eval-kl (shen.shen->kl (shen.process-applications (macroexpand V3431) (shen.find-types V3431))))) -(defun external (V3769) (cond ((= null V3769) ()) (true (trap-error (get V3769 shen.external-symbols (value *property-vector*)) (lambda Z3770 (simple-error (cn "package " (shen.app V3769 " does not exist. +(defun external (V3432) (cond ((= null V3432) ()) (true (trap-error (get V3432 shen.external-symbols (value *property-vector*)) (lambda Z3433 (simple-error (cn "package " (shen.app V3432 " does not exist. ;" shen.a)))))))) -(defun internal (V3771) (cond ((= null V3771) ()) (true (trap-error (get V3771 shen.internal-symbols (value *property-vector*)) (lambda Z3772 (simple-error (cn "package " (shen.app V3771 " does not exist. +(defun internal (V3434) (cond ((= null V3434) ()) (true (trap-error (get V3434 shen.internal-symbols (value *property-vector*)) (lambda Z3435 (simple-error (cn "package " (shen.app V3434 " does not exist. ;" shen.a)))))))) -(defun fail-if (V3773 V3774) (if (V3773 V3774) (fail) V3774)) +(defun fail-if (V3436 V3437) (if (V3436 V3437) (fail) V3437)) -(defun @s (V3775 V3776) (cn V3775 V3776)) +(defun @s (V3438 V3439) (cn V3438 V3439)) (defun tc? () (value shen.*tc*)) @@ -20,195 +20,191 @@ (defun tracked () (value shen.*tracking*)) -(defun ps (V3777) (trap-error (get V3777 shen.source (value *property-vector*)) (lambda Z3778 (simple-error (shen.app V3777 " not found. +(defun ps (V3440) (trap-error (get V3440 shen.source (value *property-vector*)) (lambda Z3441 (simple-error (shen.app V3440 " not found. " shen.a))))) (defun stinput () (value *stinput*)) -(defun vector (V3779) (let W3780 (absvector (+ V3779 1)) (let W3781 (address-> W3780 0 V3779) (let W3782 (if (= V3779 0) W3781 (shen.fillvector W3781 1 V3779 (fail))) W3782)))) +(defun vector (V3442) (let W3443 (absvector (+ V3442 1)) (let W3444 (address-> W3443 0 V3442) (let W3445 (if (= V3442 0) W3444 (shen.fillvector W3444 1 V3442 (fail))) W3445)))) -(defun shen.fillvector (V3784 V3785 V3786 V3787) (cond ((= V3785 V3786) (address-> V3784 V3786 V3787)) (true (shen.fillvector (address-> V3784 V3785 V3787) (+ 1 V3785) V3786 V3787)))) +(defun shen.fillvector (V3447 V3448 V3449 V3450) (cond ((= V3448 V3449) (address-> V3447 V3449 V3450)) (true (shen.fillvector (address-> V3447 V3448 V3450) (+ 1 V3448) V3449 V3450)))) -(defun vector? (V3788) (and (absvector? V3788) (let W3789 (trap-error (<-address V3788 0) (lambda Z3790 -1)) (and (number? W3789) (>= W3789 0))))) +(defun vector? (V3451) (and (absvector? V3451) (trap-error (>= (<-address V3451 0) 0) (lambda Z3452 false)))) -(defun vector-> (V3791 V3792 V3793) (if (= V3792 0) (simple-error "cannot access 0th element of a vector -") (address-> V3791 V3792 V3793))) +(defun vector-> (V3453 V3454 V3455) (if (= V3454 0) (simple-error "cannot access 0th element of a vector +") (address-> V3453 V3454 V3455))) -(defun <-vector (V3794 V3795) (if (= V3795 0) (simple-error "cannot access 0th element of a vector -") (let W3796 (<-address V3794 V3795) (if (= W3796 (fail)) (simple-error "vector element not found -") W3796)))) +(defun <-vector (V3456 V3457) (if (= V3457 0) (simple-error "cannot access 0th element of a vector +") (let W3458 (<-address V3456 V3457) (if (= W3458 (fail)) (simple-error "vector element not found +") W3458)))) -(defun shen.posint? (V3797) (and (integer? V3797) (>= V3797 0))) +(defun shen.posint? (V3459) (and (integer? V3459) (>= V3459 0))) -(defun limit (V3798) (<-address V3798 0)) +(defun limit (V3460) (<-address V3460 0)) -(defun symbol? (V3799) (cond ((or (boolean? V3799) (or (number? V3799) (or (string? V3799) (or (cons? V3799) (or (empty? V3799) (vector? V3799)))))) false) ((element? V3799 (cons { (cons } (cons (intern ":") (cons (intern ";") (cons (intern ",") ())))))) true) (true (trap-error (let W3800 (str V3799) (shen.analyse-symbol? W3800)) (lambda Z3801 false))))) +(defun symbol? (V3461) (cond ((or (boolean? V3461) (or (number? V3461) (or (string? V3461) (or (cons? V3461) (or (empty? V3461) (vector? V3461)))))) false) ((element? V3461 (cons { (cons } (cons (intern ":") (cons (intern ";") (cons (intern ",") ())))))) true) (true (trap-error (let W3462 (str V3461) (shen.analyse-symbol? W3462)) (lambda Z3463 false))))) -(defun shen.analyse-symbol? (V3804) (cond ((shen.+string? V3804) (and (shen.alpha? (string->n (hdstr V3804))) (shen.alphanums? (tlstr V3804)))) (true (simple-error "implementation error in shen.analyse-symbol?")))) +(defun shen.analyse-symbol? (V3466) (cond ((shen.+string? V3466) (and (shen.alpha? (string->n (hdstr V3466))) (shen.alphanums? (tlstr V3466)))) (true (simple-error "implementation error in shen.analyse-symbol?")))) -(defun shen.alphanums? (V3807) (cond ((= "" V3807) true) ((shen.+string? V3807) (let W3808 (string->n (hdstr V3807)) (and (or (shen.alpha? W3808) (shen.digit? W3808)) (shen.alphanums? (tlstr V3807))))) (true (simple-error "implementation error in shen.alphanums?")))) +(defun shen.alphanums? (V3469) (cond ((= "" V3469) true) ((shen.+string? V3469) (let W3470 (string->n (hdstr V3469)) (and (or (shen.alpha? W3470) (shen.digit? W3470)) (shen.alphanums? (tlstr V3469))))) (true (simple-error "implementation error in shen.alphanums?")))) -(defun variable? (V3809) (cond ((or (boolean? V3809) (or (number? V3809) (string? V3809))) false) (true (trap-error (let W3810 (str V3809) (shen.analyse-variable? W3810)) (lambda Z3811 false))))) +(defun variable? (V3471) (cond ((or (boolean? V3471) (or (number? V3471) (string? V3471))) false) (true (trap-error (let W3472 (str V3471) (shen.analyse-variable? W3472)) (lambda Z3473 false))))) -(defun shen.analyse-variable? (V3814) (cond ((shen.+string? V3814) (and (shen.uppercase? (string->n (hdstr V3814))) (shen.alphanums? (tlstr V3814)))) (true (simple-error "implementation error in shen.analyse-variable?")))) +(defun shen.analyse-variable? (V3476) (cond ((shen.+string? V3476) (and (shen.uppercase? (string->n (hdstr V3476))) (shen.alphanums? (tlstr V3476)))) (true (simple-error "implementation error in shen.analyse-variable?")))) -(defun gensym (V3815) (concat V3815 (set shen.*gensym* (+ 1 (value shen.*gensym*))))) +(defun gensym (V3477) (concat V3477 (set shen.*gensym* (+ 1 (value shen.*gensym*))))) -(defun concat (V3816 V3817) (intern (cn (str V3816) (str V3817)))) +(defun concat (V3478 V3479) (intern (cn (str V3478) (str V3479)))) -(defun @p (V3818 V3819) (let W3820 (absvector 3) (let W3821 (address-> W3820 0 shen.tuple) (let W3822 (address-> W3820 1 V3818) (let W3823 (address-> W3820 2 V3819) W3820))))) +(defun @p (V3480 V3481) (let W3482 (absvector 3) (let W3483 (address-> W3482 0 shen.tuple) (let W3484 (address-> W3482 1 V3480) (let W3485 (address-> W3482 2 V3481) W3482))))) -(defun fst (V3824) (<-address V3824 1)) +(defun fst (V3486) (<-address V3486 1)) -(defun snd (V3825) (<-address V3825 2)) +(defun snd (V3487) (<-address V3487 2)) -(defun tuple? (V3826) (and (absvector? V3826) (= shen.tuple (trap-error (<-address V3826 0) (lambda Z3827 shen.not-tuple))))) +(defun tuple? (V3488) (trap-error (and (absvector? V3488) (= shen.tuple (<-address V3488 0))) (lambda Z3489 false))) -(defun append (V3832 V3833) (cond ((= () V3832) V3833) ((cons? V3832) (cons (hd V3832) (append (tl V3832) V3833))) (true (simple-error "attempt to append a non-list")))) +(defun append (V3494 V3495) (cond ((= () V3494) V3495) ((cons? V3494) (cons (hd V3494) (append (tl V3494) V3495))) (true (simple-error "attempt to append a non-list")))) -(defun @v (V3834 V3835) (let W3836 (limit V3835) (let W3837 (vector (+ W3836 1)) (let W3838 (vector-> W3837 1 V3834) (if (= W3836 0) W3838 (shen.@v-help V3835 1 W3836 W3838)))))) +(defun @v (V3496 V3497) (let W3498 (limit V3497) (let W3499 (vector (+ W3498 1)) (let W3500 (vector-> W3499 1 V3496) (if (= W3498 0) W3500 (shen.@v-help V3497 1 W3498 W3500)))))) -(defun shen.@v-help (V3840 V3841 V3842 V3843) (cond ((= V3841 V3842) (shen.copyfromvector V3840 V3843 V3842 (+ V3842 1))) (true (shen.@v-help V3840 (+ V3841 1) V3842 (shen.copyfromvector V3840 V3843 V3841 (+ V3841 1)))))) +(defun shen.@v-help (V3502 V3503 V3504 V3505) (cond ((= V3503 V3504) (shen.copyfromvector V3502 V3505 V3504 (+ V3504 1))) (true (shen.@v-help V3502 (+ V3503 1) V3504 (shen.copyfromvector V3502 V3505 V3503 (+ V3503 1)))))) -(defun shen.copyfromvector (V3844 V3845 V3846 V3847) (trap-error (vector-> V3845 V3847 (<-vector V3844 V3846)) (lambda Z3848 V3845))) +(defun shen.copyfromvector (V3506 V3507 V3508 V3509) (trap-error (vector-> V3507 V3509 (<-vector V3506 V3508)) (lambda Z3510 V3507))) -(defun hdv (V3849) (trap-error (<-vector V3849 1) (lambda Z3850 (simple-error "hdv needs a non-empty vector as an argument +(defun hdv (V3511) (trap-error (<-vector V3511 1) (lambda Z3512 (simple-error "hdv needs a non-empty vector as an argument ")))) -(defun tlv (V3851) (let W3852 (limit V3851) (if (= W3852 0) (simple-error "cannot take the tail of the empty vector -") (if (= W3852 1) (vector 0) (let W3853 (vector (- W3852 1)) (shen.tlv-help V3851 2 W3852 (vector (- W3852 1)))))))) +(defun tlv (V3513) (let W3514 (limit V3513) (if (= W3514 0) (simple-error "cannot take the tail of the empty vector +") (if (= W3514 1) (vector 0) (let W3515 (vector (- W3514 1)) (shen.tlv-help V3513 2 W3514 (vector (- W3514 1)))))))) -(defun shen.tlv-help (V3855 V3856 V3857 V3858) (cond ((= V3856 V3857) (shen.copyfromvector V3855 V3858 V3857 (- V3857 1))) (true (shen.tlv-help V3855 (+ V3856 1) V3857 (shen.copyfromvector V3855 V3858 V3856 (- V3856 1)))))) +(defun shen.tlv-help (V3517 V3518 V3519 V3520) (cond ((= V3518 V3519) (shen.copyfromvector V3517 V3520 V3519 (- V3519 1))) (true (shen.tlv-help V3517 (+ V3518 1) V3519 (shen.copyfromvector V3517 V3520 V3518 (- V3518 1)))))) -(defun assoc (V3870 V3871) (cond ((= () V3871) ()) ((and (cons? V3871) (and (cons? (hd V3871)) (= V3870 (hd (hd V3871))))) (hd V3871)) ((cons? V3871) (assoc V3870 (tl V3871))) (true (simple-error "attempt to search a non-list with assoc +(defun assoc (V3532 V3533) (cond ((= () V3533) ()) ((and (cons? V3533) (and (cons? (hd V3533)) (= V3532 (hd (hd V3533))))) (hd V3533)) ((cons? V3533) (assoc V3532 (tl V3533))) (true (simple-error "attempt to search a non-list with assoc ")))) -(defun shen.assoc-set (V3875 V3876 V3877) (cond ((= () V3877) (cons (cons V3875 V3876) ())) ((and (cons? V3877) (and (cons? (hd V3877)) (= V3875 (hd (hd V3877))))) (cons (cons (hd (hd V3877)) V3876) (tl V3877))) ((cons? V3877) (cons (hd V3877) (shen.assoc-set V3875 V3876 (tl V3877)))) (true (shen.f-error shen.assoc-set)))) +(defun boolean? (V3536) (cond ((= true V3536) true) ((= false V3536) true) (true false))) -(defun shen.assoc-rm (V3881 V3882) (cond ((= () V3882) ()) ((and (cons? V3882) (and (cons? (hd V3882)) (= V3881 (hd (hd V3882))))) (tl V3882)) ((cons? V3882) (cons (hd V3882) (shen.assoc-rm V3881 (tl V3882)))) (true (shen.f-error shen.assoc-rm)))) +(defun nl (V3537) (cond ((= 0 V3537) 0) (true (do (pr " +" (stoutput)) (nl (- V3537 1)))))) -(defun boolean? (V3885) (cond ((= true V3885) true) ((= false V3885) true) (true false))) +(defun difference (V3544 V3545) (cond ((= () V3544) ()) ((cons? V3544) (if (element? (hd V3544) V3545) (difference (tl V3544) V3545) (cons (hd V3544) (difference (tl V3544) V3545)))) (true (simple-error "attempt to find the difference with a non-list +")))) -(defun nl (V3886) (cond ((= 0 V3886) 0) (true (do (pr " -" (stoutput)) (nl (- V3886 1)))))) +(defun do (V3546 V3547) V3547) -(defun difference (V3893 V3894) (cond ((= () V3893) ()) ((cons? V3893) (if (element? (hd V3893) V3894) (difference (tl V3893) V3894) (cons (hd V3893) (difference (tl V3893) V3894)))) (true (simple-error "attempt to find the difference with a non-list +(defun element? (V3559 V3560) (cond ((= () V3560) false) ((and (cons? V3560) (= V3559 (hd V3560))) true) ((cons? V3560) (element? V3559 (tl V3560))) (true (simple-error "attempt to find an element in a non-list ")))) -(defun do (V3895 V3896) V3896) +(defun empty? (V3563) (cond ((= () V3563) true) (true false))) -(defun element? (V3908 V3909) (cond ((= () V3909) false) ((and (cons? V3909) (= V3908 (hd V3909))) true) ((cons? V3909) (element? V3908 (tl V3909))) (true (simple-error "attempt to find an element in a non-list -")))) +(defun fix (V3564 V3565) (shen.fix-help V3564 V3565 (V3564 V3565))) -(defun empty? (V3912) (cond ((= () V3912) true) (true false))) +(defun shen.fix-help (V3571 V3572 V3573) (cond ((= V3572 V3573) V3573) (true (shen.fix-help V3571 V3573 (V3571 V3573))))) -(defun fix (V3913 V3914) (shen.fix-help V3913 V3914 (V3913 V3914))) +(defun put (V3574 V3575 V3576 V3577) (let W3578 (hash V3574 (limit V3577)) (let W3579 (trap-error (<-vector V3577 W3578) (lambda Z3580 ())) (let W3581 (vector-> V3577 W3578 (shen.change-pointer-value V3574 V3575 V3576 W3579)) V3576)))) -(defun shen.fix-help (V3920 V3921 V3922) (cond ((= V3921 V3922) V3922) (true (shen.fix-help V3920 V3922 (V3920 V3922))))) +(defun unput (V3582 V3583 V3584) (let W3585 (hash V3582 (limit V3584)) (let W3586 (trap-error (<-vector V3584 W3585) (lambda Z3587 ())) (let W3588 (vector-> V3584 W3585 (shen.remove-pointer V3582 V3583 W3586)) V3582)))) -(defun put (V3923 V3924 V3925 V3926) (let W3927 (trap-error (shen.<-dict V3926 V3923) (lambda Z3928 ())) (let W3929 (shen.assoc-set V3924 V3925 W3927) (let W3930 (shen.dict-> V3926 V3923 W3929) V3925)))) +(defun shen.remove-pointer (V3599 V3600 V3601) (cond ((= () V3601) ()) ((and (cons? V3601) (and (cons? (hd V3601)) (and (cons? (hd (hd V3601))) (and (cons? (tl (hd (hd V3601)))) (and (= () (tl (tl (hd (hd V3601))))) (and (= V3600 (hd (tl (hd (hd V3601))))) (= V3599 (hd (hd (hd V3601)))))))))) (tl V3601)) ((cons? V3601) (cons (hd V3601) (shen.remove-pointer V3599 V3600 (tl V3601)))) (true (simple-error "implementation error in shen.remove-pointer")))) -(defun unput (V3931 V3932 V3933) (let W3934 (trap-error (shen.<-dict V3933 V3931) (lambda Z3935 ())) (let W3936 (shen.assoc-rm V3932 W3934) (let W3937 (shen.dict-> V3933 V3931 W3936) V3931)))) +(defun shen.change-pointer-value (V3614 V3615 V3616 V3617) (cond ((= () V3617) (cons (cons (cons V3614 (cons V3615 ())) V3616) ())) ((and (cons? V3617) (and (cons? (hd V3617)) (and (cons? (hd (hd V3617))) (and (cons? (tl (hd (hd V3617)))) (and (= () (tl (tl (hd (hd V3617))))) (and (= V3615 (hd (tl (hd (hd V3617))))) (= V3614 (hd (hd (hd V3617)))))))))) (cons (cons (hd (hd V3617)) V3616) (tl V3617))) ((cons? V3617) (cons (hd V3617) (shen.change-pointer-value V3614 V3615 V3616 (tl V3617)))) (true (simple-error "implementation error in shen.change-pointer-value")))) -(defun get (V3938 V3939 V3940) (let W3941 (trap-error (shen.<-dict V3940 V3938) (lambda Z3942 (simple-error (shen.app V3938 (cn " has no attributes: " (shen.app V3939 " -" shen.s)) shen.a)))) (let W3943 (assoc V3939 W3941) (if (empty? W3943) (simple-error (cn "attribute " (shen.app V3939 (cn " not found for " (shen.app V3938 " -" shen.s)) shen.s))) (tl W3943))))) +(defun get (V3618 V3619 V3620) (let W3621 (hash V3618 (limit V3620)) (let W3622 (trap-error (<-vector V3620 W3621) (lambda Z3623 (simple-error (shen.app V3618 (cn " has no attributes: " (shen.app V3619 " +" shen.s)) shen.a)))) (let W3624 (assoc (cons V3618 (cons V3619 ())) W3622) (if (empty? W3624) (simple-error (cn "attribute " (shen.app V3619 (cn " not found for " (shen.app V3618 " +" shen.s)) shen.s))) (tl W3624)))))) -(defun hash (V3944 V3945) (let W3946 (shen.mod (shen.hashkey V3944) V3945) (if (= W3946 0) 1 W3946))) +(defun hash (V3625 V3626) (let W3627 (shen.mod (shen.hashkey V3625) V3626) (if (= W3627 0) 1 W3627))) -(defun shen.hashkey (V3947) (let W3948 (map (lambda Z3949 (string->n Z3949)) (explode V3947)) (shen.prodbutzero W3948 1))) +(defun shen.hashkey (V3628) (let W3629 (map (lambda Z3630 (string->n Z3630)) (explode V3628)) (shen.prodbutzero W3629 1))) -(defun shen.prodbutzero (V3950 V3951) (cond ((= () V3950) V3951) ((and (cons? V3950) (= 0 (hd V3950))) (shen.prodbutzero (tl V3950) V3951)) ((cons? V3950) (if (> V3951 10000000000) (shen.prodbutzero (tl V3950) (+ V3951 (hd V3950))) (shen.prodbutzero (tl V3950) (* V3951 (hd V3950))))) (true (shen.f-error shen.prodbutzero)))) +(defun shen.prodbutzero (V3631 V3632) (cond ((= () V3631) V3632) ((and (cons? V3631) (= 0 (hd V3631))) (shen.prodbutzero (tl V3631) V3632)) ((cons? V3631) (if (> V3632 10000000000) (shen.prodbutzero (tl V3631) (+ V3632 (hd V3631))) (shen.prodbutzero (tl V3631) (* V3632 (hd V3631))))) (true (simple-error "partial function shen.prodbutzero")))) -(defun shen.mod (V3952 V3953) (shen.modh V3952 (shen.multiples V3952 (cons V3953 ())))) +(defun shen.mod (V3633 V3634) (shen.modh V3633 (shen.multiples V3633 (cons V3634 ())))) -(defun shen.multiples (V3958 V3959) (cond ((and (cons? V3959) (> (hd V3959) V3958)) (tl V3959)) ((cons? V3959) (shen.multiples V3958 (cons (* 2 (hd V3959)) V3959))) (true (simple-error "implementation error in shen.multiples")))) +(defun shen.multiples (V3639 V3640) (cond ((and (cons? V3640) (> (hd V3640) V3639)) (tl V3640)) ((cons? V3640) (shen.multiples V3639 (cons (* 2 (hd V3640)) V3640))) (true (simple-error "implementation error in shen.multiples")))) -(defun shen.modh (V3966 V3967) (cond ((= 0 V3966) 0) ((= () V3967) V3966) ((and (cons? V3967) (> (hd V3967) V3966)) (if (empty? (tl V3967)) V3966 (shen.modh V3966 (tl V3967)))) ((cons? V3967) (shen.modh (- V3966 (hd V3967)) V3967)) (true (simple-error "implementation error in shen.modh")))) +(defun shen.modh (V3647 V3648) (cond ((= 0 V3647) 0) ((= () V3648) V3647) ((and (cons? V3648) (> (hd V3648) V3647)) (if (empty? (tl V3648)) V3647 (shen.modh V3647 (tl V3648)))) ((cons? V3648) (shen.modh (- V3647 (hd V3648)) V3648)) (true (simple-error "implementation error in shen.modh")))) -(defun sum (V3970) (cond ((= () V3970) 0) ((cons? V3970) (+ (hd V3970) (sum (tl V3970)))) (true (simple-error "attempt to sum a non-list +(defun sum (V3651) (cond ((= () V3651) 0) ((cons? V3651) (+ (hd V3651) (sum (tl V3651)))) (true (simple-error "attempt to sum a non-list ")))) -(defun head (V3975) (cond ((cons? V3975) (hd V3975)) (true (simple-error "head expects a non-empty list +(defun head (V3656) (cond ((cons? V3656) (hd V3656)) (true (simple-error "head expects a non-empty list ")))) -(defun tail (V3980) (cond ((cons? V3980) (tl V3980)) (true (simple-error "tail expects a non-empty list +(defun tail (V3661) (cond ((cons? V3661) (tl V3661)) (true (simple-error "tail expects a non-empty list ")))) -(defun hdstr (V3981) (pos V3981 0)) +(defun hdstr (V3662) (pos V3662 0)) -(defun intersection (V3988 V3989) (cond ((= () V3988) ()) ((cons? V3988) (if (element? (hd V3988) V3989) (cons (hd V3988) (intersection (tl V3988) V3989)) (intersection (tl V3988) V3989))) (true (simple-error "attempt to find the intersection with a non-list +(defun intersection (V3669 V3670) (cond ((= () V3669) ()) ((cons? V3669) (if (element? (hd V3669) V3670) (cons (hd V3669) (intersection (tl V3669) V3670)) (intersection (tl V3669) V3670))) (true (simple-error "attempt to find the intersection with a non-list ")))) -(defun reverse (V3990) (shen.reverse-help V3990 ())) +(defun reverse (V3671) (shen.reverse-help V3671 ())) -(defun shen.reverse-help (V3995 V3996) (cond ((= () V3995) V3996) ((cons? V3995) (shen.reverse-help (tl V3995) (cons (hd V3995) V3996))) (true (simple-error "attempt to reverse a non-list +(defun shen.reverse-help (V3676 V3677) (cond ((= () V3676) V3677) ((cons? V3676) (shen.reverse-help (tl V3676) (cons (hd V3676) V3677))) (true (simple-error "attempt to reverse a non-list ")))) -(defun union (V4001 V4002) (cond ((= () V4001) V4002) ((cons? V4001) (if (element? (hd V4001) V4002) (union (tl V4001) V4002) (cons (hd V4001) (union (tl V4001) V4002)))) (true (simple-error "attempt to find the union with a non-list +(defun union (V3682 V3683) (cond ((= () V3682) V3683) ((cons? V3682) (if (element? (hd V3682) V3683) (union (tl V3682) V3683) (cons (hd V3682) (union (tl V3682) V3683)))) (true (simple-error "attempt to find the union with a non-list ")))) -(defun y-or-n? (V4003) (let W4004 (pr (shen.proc-nl V4003) (stoutput)) (let W4005 (pr " (y/n) " (stoutput)) (let W4006 (shen.app (read (stinput)) "" shen.s) (if (= "y" W4006) true (if (= "n" W4006) false (do (pr "please answer y or n -" (stoutput)) (y-or-n? V4003)))))))) +(defun y-or-n? (V3684) (let W3685 (pr (shen.proc-nl V3684) (stoutput)) (let W3686 (pr " (y/n) " (stoutput)) (let W3687 (shen.app (read (stinput)) "" shen.s) (if (= "y" W3687) true (if (= "n" W3687) false (do (pr "please answer y or n +" (stoutput)) (y-or-n? V3684)))))))) -(defun not (V4007) (if V4007 false true)) +(defun not (V3688) (if V3688 false true)) (defun abort () (simple-error "")) -(defun subst (V4013 V4014 V4015) (cond ((= V4014 V4015) V4013) ((cons? V4015) (cons (subst V4013 V4014 (hd V4015)) (subst V4013 V4014 (tl V4015)))) (true V4015))) +(defun subst (V3694 V3695 V3696) (cond ((= V3695 V3696) V3694) ((cons? V3696) (cons (subst V3694 V3695 (hd V3696)) (subst V3694 V3695 (tl V3696)))) (true V3696))) -(defun explode (V4016) (shen.explode-h (shen.app V4016 "" shen.a))) +(defun explode (V3697) (shen.explode-h (shen.app V3697 "" shen.a))) -(defun shen.explode-h (V4019) (cond ((= "" V4019) ()) ((shen.+string? V4019) (cons (hdstr V4019) (shen.explode-h (tlstr V4019)))) (true (simple-error "implementation error in explode-h")))) +(defun shen.explode-h (V3700) (cond ((= "" V3700) ()) ((shen.+string? V3700) (cons (hdstr V3700) (shen.explode-h (tlstr V3700)))) (true (simple-error "implementation error in explode-h")))) -(defun cd (V4020) (set *home-directory* (if (= V4020 "") "" (shen.app V4020 "/" shen.a)))) +(defun cd (V3701) (set *home-directory* (if (= V3701 "") "" (shen.app V3701 "/" shen.a)))) -(defun shen.for-each (V4021 V4022) (cond ((= () V4022) true) ((cons? V4022) (let W4023 (V4021 (hd V4022)) (shen.for-each V4021 (tl V4022)))) (true (shen.f-error shen.for-each)))) +(defun map (V3702 V3703) (shen.map-h V3702 V3703 ())) -(defun map (V4024 V4025) (shen.map-h V4024 V4025 ())) +(defun shen.map-h (V3704 V3705 V3706) (cond ((= () V3705) (reverse V3706)) ((cons? V3705) (shen.map-h V3704 (tl V3705) (cons (V3704 (hd V3705)) V3706))) (true (simple-error "partial function shen.map-h")))) -(defun shen.map-h (V4026 V4027 V4028) (cond ((= () V4027) (reverse V4028)) ((cons? V4027) (shen.map-h V4026 (tl V4027) (cons (V4026 (hd V4027)) V4028))) (true (shen.f-error shen.map-h)))) +(defun length (V3707) (shen.length-h V3707 0)) -(defun length (V4029) (shen.length-h V4029 0)) +(defun shen.length-h (V3712 V3713) (cond ((= () V3712) V3713) (true (shen.length-h (tl V3712) (+ V3713 1))))) -(defun shen.length-h (V4034 V4035) (cond ((= () V4034) V4035) (true (shen.length-h (tl V4034) (+ V4035 1))))) +(defun occurrences (V3719 V3720) (cond ((= V3719 V3720) 1) ((cons? V3720) (+ (occurrences V3719 (hd V3720)) (occurrences V3719 (tl V3720)))) (true 0))) -(defun occurrences (V4041 V4042) (cond ((= V4041 V4042) 1) ((cons? V4042) (+ (occurrences V4041 (hd V4042)) (occurrences V4041 (tl V4042)))) (true 0))) - -(defun nth (V4047 V4048) (cond ((and (= 1 V4047) (cons? V4048)) (hd V4048)) ((cons? V4048) (nth (- V4047 1) (tl V4048))) (true (simple-error (cn "nth applied to " (shen.app V4047 (cn ", " (shen.app V4048 " +(defun nth (V3725 V3726) (cond ((and (= 1 V3725) (cons? V3726)) (hd V3726)) ((cons? V3726) (nth (- V3725 1) (tl V3726))) (true (simple-error (cn "nth applied to " (shen.app V3725 (cn ", " (shen.app V3726 " " shen.a)) shen.a)))))) -(defun integer? (V4049) (and (number? V4049) (let W4050 (shen.abs V4049) (shen.integer-test? W4050 (shen.magless W4050 1))))) +(defun integer? (V3727) (and (number? V3727) (let W3728 (shen.abs V3727) (shen.integer-test? W3728 (shen.magless W3728 1))))) -(defun shen.abs (V4051) (if (> V4051 0) V4051 (- 0 V4051))) +(defun shen.abs (V3729) (if (> V3729 0) V3729 (- 0 V3729))) -(defun shen.magless (V4052 V4053) (let W4054 (* V4053 2) (if (> W4054 V4052) V4053 (shen.magless V4052 W4054)))) +(defun shen.magless (V3730 V3731) (let W3732 (* V3731 2) (if (> W3732 V3730) V3731 (shen.magless V3730 W3732)))) -(defun shen.integer-test? (V4058 V4059) (cond ((= 0 V4058) true) ((> 1 V4058) false) (true (let W4060 (- V4058 V4059) (if (> 0 W4060) (integer? V4058) (shen.integer-test? W4060 V4059)))))) +(defun shen.integer-test? (V3736 V3737) (cond ((= 0 V3736) true) ((> 1 V3736) false) (true (let W3738 (- V3736 V3737) (if (> 0 W3738) (integer? V3736) (shen.integer-test? W3738 V3737)))))) -(defun mapcan (V4067 V4068) (cond ((= () V4068) ()) ((cons? V4068) (append (V4067 (hd V4068)) (mapcan V4067 (tl V4068)))) (true (simple-error "attempt to mapcan over a non-list +(defun mapcan (V3745 V3746) (cond ((= () V3746) ()) ((cons? V3746) (append (V3745 (hd V3746)) (mapcan V3745 (tl V3746)))) (true (simple-error "attempt to mapcan over a non-list ")))) -(defun == (V4074 V4075) (cond ((= V4074 V4075) true) (true false))) +(defun == (V3752 V3753) (cond ((= V3752 V3753) true) (true false))) -(defun bound? (V4076) (and (symbol? V4076) (let W4077 (trap-error (value V4076) (lambda Z4078 shen.this-symbol-is-unbound)) (if (= W4077 shen.this-symbol-is-unbound) false true)))) +(defun bound? (V3754) (and (symbol? V3754) (let W3755 (trap-error (value V3754) (lambda Z3756 shen.this-symbol-is-unbound)) (if (= W3755 shen.this-symbol-is-unbound) false true)))) -(defun shen.string->bytes (V4079) (cond ((= "" V4079) ()) (true (cons (string->n (pos V4079 0)) (shen.string->bytes (tlstr V4079)))))) +(defun shen.string->bytes (V3757) (cond ((= "" V3757) ()) (true (cons (string->n (pos V3757 0)) (shen.string->bytes (tlstr V3757)))))) -(defun maxinferences (V4080) (if (< V4080 0) (value shen.*maxinferences*) (if (integer? V4080) (set shen.*maxinferences* V4080) (simple-error "maxinferences expects an integer value +(defun maxinferences (V3758) (if (< V3758 0) (value shen.*maxinferences*) (if (integer? V3758) (set shen.*maxinferences* V3758) (simple-error "maxinferences expects an integer value ")))) (defun inferences () (value shen.*infs*)) -(defun protect (V4081) V4081) - -(defun sterror () (value *sterror*)) +(defun protect (V3759) V3759) (defun stoutput () (value *stoutput*)) -(defun string->symbol (V4082) (let W4083 (intern V4082) (if (symbol? W4083) W4083 (simple-error (cn "cannot intern " (shen.app V4082 " to a symbol" shen.s)))))) +(defun string->symbol (V3760) (let W3761 (intern V3760) (if (symbol? W3761) W3761 (simple-error (cn "cannot intern " (shen.app V3760 " to a symbol" shen.s)))))) -(defun optimise (V4086) (cond ((= + V4086) (set shen.*optimise* true)) ((= - V4086) (set shen.*optimise* false)) (true (simple-error "optimise expects a + or a -. +(defun optimise (V3764) (cond ((= + V3764) (set shen.*optimise* true)) ((= - V3764) (set shen.*optimise* false)) (true (simple-error "optimise expects a + or a -. ")))) (defun os () (value *os*)) @@ -225,7 +221,7 @@ (defun release () (value *release*)) -(defun package? (V4087) (cond ((= null V4087) true) (true (trap-error (do (external V4087) true) (lambda Z4088 false))))) +(defun package? (V3765) (cond ((= null V3765) true) (true (trap-error (do (external V3765) true) (lambda Z3766 false))))) (defun fail () shen.fail!)(defun userdefs () (value shen.*userdefs*)) @@ -235,31 +231,31 @@ (defun system-S? () (value shen.*shen-type-theory-enabled?*)) -(defun enable-type-theory (V4091) (cond ((= + V4091) (set shen.*shen-type-theory-enabled?* true)) ((= - V4091) (set shen.*shen-type-theory-enabled?* false)) (true (simple-error "enable-type-theory expects a + or a - +(defun enable-type-theory (V3769) (cond ((= + V3769) (set shen.*shen-type-theory-enabled?* true)) ((= - V3769) (set shen.*shen-type-theory-enabled?* false)) (true (simple-error "enable-type-theory expects a + or a - ")))) -(defun hush (V4094) (cond ((= + V4094) (set *hush* true)) ((= - V4094) (set *hush* false)) (true (simple-error "hush expects a + or a - +(defun shen.hush (V3772) (cond ((= + V3772) (set *hush* true)) ((= - V3772) (set *hush* false)) (true (simple-error "hush expects a + or a - ")))) -(defun tc (V4097) (cond ((= + V4097) (set shen.*tc* true)) ((= - V4097) (set shen.*tc* false)) (true (simple-error "tc expects a + or -")))) +(defun tc (V3775) (cond ((= + V3775) (set shen.*tc* true)) ((= - V3775) (set shen.*tc* false)) (true (simple-error "tc expects a + or -")))) -(defun destroy (V4098) (do (set shen.*sigf* (shen.unassoc V4098 (value shen.*sigf*))) V4098)) +(defun destroy (V3776) (do (set shen.*sigf* (shen.unassoc V3776 (value shen.*sigf*))) V3776)) -(defun shen.unassoc (V4108 V4109) (cond ((= () V4109) ()) ((and (cons? V4109) (and (cons? (hd V4109)) (= V4108 (hd (hd V4109))))) (tl V4109)) ((cons? V4109) (cons (hd V4109) (shen.unassoc V4108 (tl V4109)))) (true (simple-error "implementation error in shen.unassoc")))) +(defun shen.unassoc (V3786 V3787) (cond ((= () V3787) ()) ((and (cons? V3787) (and (cons? (hd V3787)) (= V3786 (hd (hd V3787))))) (tl V3787)) ((cons? V3787) (cons (hd V3787) (shen.unassoc V3786 (tl V3787)))) (true (simple-error "implementation error in shen.unassoc")))) -(defun in-package (V4110) (if (package? V4110) (set shen.*package* V4110) (simple-error (cn "package " (shen.app V4110 " does not exist +(defun in-package (V3788) (if (package? V3788) (set shen.*package* V3788) (simple-error (cn "package " (shen.app V3788 " does not exist " shen.a))))) -(defun write-to-file (V4111 V4112) (let W4113 (open V4111 out) (let W4114 (if (string? V4112) V4112 (shen.app V4112 "" shen.s)) (let W4115 (pr W4114 W4113) (let W4116 (close W4113) V4112))))) +(defun write-to-file (V3789 V3790) (let W3791 (open V3789 out) (let W3792 (if (string? V3790) V3790 (shen.app V3790 "" shen.s)) (let W3793 (pr W3792 W3791) (let W3794 (close W3791) V3790))))) (defun fresh () (shen.freshterm (gensym shen.t))) -(defun update-lambda-table (V4117 V4118) (let W4119 (put V4117 arity V4118 (value *property-vector*)) (let W4120 (shen.lambda-entry V4117) (let W4121 (shen.set-lambda-form-entry (cons V4117 W4120)) V4117)))) +(defun update-lambda-table (V3795 V3796) (let W3797 (put V3795 arity V3796 (value *property-vector*)) (let W3798 (shen.lambda-entry V3795) (let W3799 (set shen.*lambdatable* (cons W3798 (value shen.*lambdatable*))) V3795)))) -(defun specialise (V4124 V4125) (cond ((= 0 V4125) (do (set shen.*special* (remove V4124 (value shen.*special*))) (do (set shen.*extraspecial* (remove V4124 (value shen.*extraspecial*))) V4124))) ((= 1 V4125) (do (set shen.*special* (adjoin V4124 (value shen.*special*))) (do (set shen.*extraspecial* (remove V4124 (value shen.*extraspecial*))) V4124))) ((= 2 V4125) (do (set shen.*special* (remove V4124 (value shen.*special*))) (do (set shen.*extraspecial* (adjoin V4124 (value shen.*extraspecial*))) V4124))) (true (simple-error "specialise requires values of 0, 1 or 2 +(defun specialise (V3802 V3803) (cond ((= 0 V3803) (do (set shen.*special* (remove V3802 (value shen.*special*))) (do (set shen.*extraspecial* (remove V3802 (value shen.*extraspecial*))) V3802))) ((= 1 V3803) (do (set shen.*special* (adjoin V3802 (value shen.*special*))) (do (set shen.*extraspecial* (remove V3802 (value shen.*extraspecial*))) V3802))) ((= 2 V3803) (do (set shen.*special* (remove V3802 (value shen.*special*))) (do (set shen.*extraspecial* (adjoin V3802 (value shen.*extraspecial*))) V3802))) (true (simple-error "specialise requires values of 0, 1 or 2 ")))) -(defun absolute (V4126) (set *absolute* (cons V4126 (value *absolute*)))) +(defun absolute (V3804) (set *absolute* (cons V3804 (value *absolute*)))) -(defun unabsolute (V4127) (set *absolute* (remove V4127 (value *absolute*)))) +(defun unabsolute (V3805) (set *absolute* (remove V3805 (value *absolute*)))) diff --git a/klambda/t-star.kl b/klambda/t-star.kl index 4d88dff..0c6d2a6 100644 --- a/klambda/t-star.kl +++ b/klambda/t-star.kl @@ -1,102 +1,104 @@ -(defun shen.typecheck (V4853 V4854) (let W4855 (shen.extract-vars V4854) (let W4856 (shen.rectify-type V4854) (let W4857 (shen.curry V4853) (((((lambda Z4858 (lambda Z4859 (lambda Z4860 (lambda Z4861 (let W4862 (shen.newpv Z4858) (shen.gc Z4858 (do (shen.incinfs) (shen.insert-prolog-variables (receive (shen.deref W4855 Z4858)) (receive (shen.deref W4856 Z4858)) W4862 Z4858 Z4859 Z4860 (freeze (shen.toplevel-forms (receive (shen.deref W4857 Z4858)) W4862 Z4858 Z4859 Z4860 (freeze (return W4862 Z4858 Z4859 Z4860 Z4861)))))))))))) (shen.prolog-vector)) (@v true (@v 0 (vector 0)))) 0) (freeze true)))))) +(defun shen.typecheck (V4434 V4435) (let W4436 (shen.extract-vars V4435) (let W4437 (shen.rectify-type V4435) (let W4438 (shen.curry V4434) (((((lambda Z4439 (lambda Z4440 (lambda Z4441 (lambda Z4442 (let W4443 (shen.newpv Z4439) (shen.gc Z4439 (do (shen.incinfs) (shen.insert-prolog-variables (receive (shen.deref W4436 Z4439)) (receive (shen.deref W4437 Z4439)) W4443 Z4439 Z4440 Z4441 (freeze (shen.toplevel-forms (receive (shen.deref W4438 Z4439)) W4443 Z4439 Z4440 Z4441 (freeze (return W4443 Z4439 Z4440 Z4441 Z4442)))))))))))) (shen.prolog-vector)) (@v true (@v 0 (vector 0)))) 0) (freeze true)))))) -(defun shen.insert-prolog-variables (V4863 V4864 V4865 V4866 V4867 V4868 V4869) (let W4870 (if (shen.unlocked? V4867) (let W4871 (shen.lazyderef V4863 V4866) (if (= W4871 ()) (do (shen.incinfs) (is! V4864 V4865 V4866 V4867 V4868 V4869)) false)) false) (if (= W4870 false) (if (shen.unlocked? V4867) (let W4872 (shen.lazyderef V4863 V4866) (if (cons? W4872) (let W4873 (hd W4872) (let W4874 (tl W4872) (let W4875 (shen.newpv V4866) (shen.gc V4866 (do (shen.incinfs) (shen.insert-prolog-variables W4874 (subst (shen.deref W4875 V4866) W4873 V4864) V4865 V4866 V4867 V4868 V4869)))))) false)) false) W4870))) +(defun shen.insert-prolog-variables (V4444 V4445 V4446 V4447 V4448 V4449 V4450) (let W4451 (if (shen.unlocked? V4448) (let W4452 (shen.lazyderef V4444 V4447) (if (= W4452 ()) (do (shen.incinfs) (is! V4445 V4446 V4447 V4448 V4449 V4450)) false)) false) (if (= W4451 false) (if (shen.unlocked? V4448) (let W4453 (shen.lazyderef V4444 V4447) (if (cons? W4453) (let W4454 (hd W4453) (let W4455 (tl W4453) (let W4456 (shen.newpv V4447) (shen.gc V4447 (do (shen.incinfs) (shen.insert-prolog-variables W4455 (subst (shen.deref W4456 V4447) W4454 V4445) V4446 V4447 V4448 V4449 V4450)))))) false)) false) W4451))) -(defun shen.toplevel-forms (V4876 V4877 V4878 V4879 V4880 V4881) (let W4882 (+ V4880 1) (let W4883 (if (shen.unlocked? V4879) (let W4884 (shen.lazyderef V4876 V4878) (if (cons? W4884) (let W4885 (shen.lazyderef (hd W4884) V4878) (if (= W4885 define) (let W4886 (shen.lazyderef (tl W4884) V4878) (if (cons? W4886) (let W4887 (hd W4886) (let W4888 (tl W4886) (do (shen.incinfs) (when (shen.type-theory-enabled?) V4878 V4879 W4882 (freeze (shen.cut V4878 V4879 W4882 (freeze (shen.signal-def (value shen.*spy*) W4887 V4878 V4879 W4882 (freeze (shen.t* (cons define (cons W4887 W4888)) V4877 V4878 V4879 W4882 V4881)))))))))) false)) false)) false)) false) (if (= W4883 false) (let W4889 (if (shen.unlocked? V4879) (do (shen.incinfs) (shen.system-S (cons V4876 (cons (intern ":") (cons V4877 ()))) () V4878 V4879 W4882 V4881)) false) (if (= W4889 false) (shen.unlock V4879 W4882) W4889)) W4883)))) +(defun shen.toplevel-forms (V4457 V4458 V4459 V4460 V4461 V4462) (let W4463 (+ V4461 1) (let W4464 (if (shen.unlocked? V4460) (let W4465 (shen.lazyderef V4457 V4459) (if (cons? W4465) (let W4466 (shen.lazyderef (hd W4465) V4459) (if (= W4466 define) (let W4467 (shen.lazyderef (tl W4465) V4459) (if (cons? W4467) (let W4468 (hd W4467) (let W4469 (tl W4467) (do (shen.incinfs) (when (shen.type-theory-enabled?) V4459 V4460 W4463 (freeze (shen.cut V4459 V4460 W4463 (freeze (shen.signal-def (value shen.*spy*) W4468 V4459 V4460 W4463 (freeze (shen.t* (cons define (cons W4468 W4469)) V4458 V4459 V4460 W4463 V4462)))))))))) false)) false)) false)) false) (if (= W4464 false) (let W4470 (if (shen.unlocked? V4460) (do (shen.incinfs) (shen.system-S (cons V4457 (cons (intern ":") (cons V4458 ()))) () V4459 V4460 W4463 V4462)) false) (if (= W4470 false) (shen.unlock V4460 W4463) W4470)) W4464)))) -(defun shen.signal-def (V4890 V4891 V4892 V4893 V4894 V4895) (let W4896 (if (shen.unlocked? V4893) (let W4897 (shen.lazyderef V4890 V4892) (if (= W4897 false) (do (shen.incinfs) (thaw V4895)) false)) false) (if (= W4896 false) (if (shen.unlocked? V4893) (let W4898 (shen.lazyderef V4890 V4892) (if (= W4898 true) (let W4899 (shen.newpv V4892) (shen.gc V4892 (do (shen.incinfs) (is W4899 (pr (cn " -typechecking (fn " (shen.app (shen.deref V4891 V4892) ") -" shen.a)) (stoutput)) V4892 V4893 V4894 V4895)))) false)) false) W4896))) +(defun shen.signal-def (V4471 V4472 V4473 V4474 V4475 V4476) (let W4477 (if (shen.unlocked? V4474) (let W4478 (shen.lazyderef V4471 V4473) (if (= W4478 false) (do (shen.incinfs) (thaw V4476)) false)) false) (if (= W4477 false) (if (shen.unlocked? V4474) (let W4479 (shen.lazyderef V4471 V4473) (if (= W4479 true) (let W4480 (shen.newpv V4473) (shen.gc V4473 (do (shen.incinfs) (is W4480 (pr (cn " +typechecking (fn " (shen.app (shen.deref V4472 V4473) ") +" shen.a)) (stoutput)) V4473 V4474 V4475 V4476)))) false)) false) W4477))) -(defun shen.rectify-type (V4900) (shen.demodulate (shen.curry-type V4900))) +(defun shen.rectify-type (V4481) (shen.demodulate (shen.curry-type V4481))) -(defun shen.demodulate (V4901) (trap-error (let W4902 (shen.walk (lambda Z4903 (shen.demod Z4903)) V4901) (if (= W4902 V4901) V4901 (shen.demodulate W4902))) (lambda Z4904 V4901))) +(defun shen.demodulate (V4482) (trap-error (let W4483 (shen.walk (lambda Z4484 (shen.demod Z4484)) V4482) (if (= W4483 V4482) V4482 (shen.demodulate W4483))) (lambda Z4485 V4482))) -(defun shen.curry-type (V4905) (cond ((and (cons? V4905) (and (cons? (tl V4905)) (and (= --> (hd (tl V4905))) (and (cons? (tl (tl V4905))) (and (cons? (tl (tl (tl V4905)))) (= --> (hd (tl (tl (tl V4905)))))))))) (shen.curry-type (cons (hd V4905) (cons --> (cons (tl (tl V4905)) ()))))) ((and (cons? V4905) (and (cons? (hd V4905)) (and (= list (hd (hd V4905))) (and (cons? (tl (hd V4905))) (and (= () (tl (tl (hd V4905)))) (and (cons? (tl V4905)) (and (= ==> (hd (tl V4905))) (and (cons? (tl (tl V4905))) (= () (tl (tl (tl V4905)))))))))))) (shen.curry-type (cons (hd V4905) (cons --> (cons (cons str (cons (hd V4905) (tl (tl V4905)))) ()))))) ((and (cons? V4905) (and (cons? (tl V4905)) (and (= * (hd (tl V4905))) (and (cons? (tl (tl V4905))) (and (cons? (tl (tl (tl V4905)))) (= * (hd (tl (tl (tl V4905)))))))))) (shen.curry-type (cons (hd V4905) (cons * (cons (tl (tl V4905)) ()))))) ((cons? V4905) (map (lambda Z4906 (shen.curry-type Z4906)) V4905)) (true V4905))) +(defun shen.curry-type (V4486) (cond ((and (cons? V4486) (and (cons? (tl V4486)) (and (= --> (hd (tl V4486))) (and (cons? (tl (tl V4486))) (and (cons? (tl (tl (tl V4486)))) (= --> (hd (tl (tl (tl V4486)))))))))) (shen.curry-type (cons (hd V4486) (cons --> (cons (tl (tl V4486)) ()))))) ((and (cons? V4486) (and (cons? (hd V4486)) (and (= list (hd (hd V4486))) (and (cons? (tl (hd V4486))) (and (= () (tl (tl (hd V4486)))) (and (cons? (tl V4486)) (and (= ==> (hd (tl V4486))) (and (cons? (tl (tl V4486))) (= () (tl (tl (tl V4486)))))))))))) (shen.curry-type (cons (hd V4486) (cons --> (cons (cons str (cons (hd V4486) (tl (tl V4486)))) ()))))) ((and (cons? V4486) (and (cons? (tl V4486)) (and (= * (hd (tl V4486))) (and (cons? (tl (tl V4486))) (and (cons? (tl (tl (tl V4486)))) (= * (hd (tl (tl (tl V4486)))))))))) (shen.curry-type (cons (hd V4486) (cons * (cons (tl (tl V4486)) ()))))) ((cons? V4486) (map (lambda Z4487 (shen.curry-type Z4487)) V4486)) (true V4486))) -(defun shen.curry (V4907) (cond ((and (cons? V4907) (and (= define (hd V4907)) (cons? (tl V4907)))) V4907) ((and (cons? V4907) (and (= type (hd V4907)) (and (cons? (tl V4907)) (and (cons? (tl (tl V4907))) (= () (tl (tl (tl V4907)))))))) (cons type (cons (shen.curry (hd (tl V4907))) (tl (tl V4907))))) ((and (cons? V4907) (and (= input+ (hd V4907)) (and (cons? (tl V4907)) (and (cons? (tl (tl V4907))) (= () (tl (tl (tl V4907)))))))) (cons input+ (cons (hd (tl V4907)) (cons (shen.curry (hd (tl (tl V4907)))) ())))) ((and (cons? V4907) (shen.special? (hd V4907))) (cons (hd V4907) (map (lambda Z4908 (shen.curry Z4908)) (tl V4907)))) ((and (cons? V4907) (shen.extraspecial? (hd V4907))) V4907) ((and (cons? V4907) (and (cons? (tl V4907)) (cons? (tl (tl V4907))))) (shen.curry (cons (cons (hd V4907) (cons (hd (tl V4907)) ())) (tl (tl V4907))))) ((and (cons? V4907) (and (cons? (tl V4907)) (= () (tl (tl V4907))))) (cons (shen.curry (hd V4907)) (cons (shen.curry (hd (tl V4907))) ()))) (true V4907))) +(defun shen.curry (V4488) (cond ((and (cons? V4488) (and (= define (hd V4488)) (cons? (tl V4488)))) V4488) ((and (cons? V4488) (and (= type (hd V4488)) (and (cons? (tl V4488)) (and (cons? (tl (tl V4488))) (= () (tl (tl (tl V4488)))))))) (cons type (cons (shen.curry (hd (tl V4488))) (tl (tl V4488))))) ((and (cons? V4488) (shen.special? (hd V4488))) (cons (hd V4488) (map (lambda Z4489 (shen.curry Z4489)) (tl V4488)))) ((and (cons? V4488) (shen.extraspecial? (hd V4488))) V4488) ((and (cons? V4488) (and (cons? (tl V4488)) (cons? (tl (tl V4488))))) (shen.curry (cons (cons (hd V4488) (cons (hd (tl V4488)) ())) (tl (tl V4488))))) ((and (cons? V4488) (and (cons? (tl V4488)) (= () (tl (tl V4488))))) (cons (shen.curry (hd V4488)) (cons (shen.curry (hd (tl V4488))) ()))) (true V4488))) -(defun shen.special? (V4909) (element? V4909 (value shen.*special*))) +(defun shen.special? (V4490) (element? V4490 (value shen.*special*))) -(defun shen.extraspecial? (V4910) (element? V4910 (value shen.*extraspecial*))) +(defun shen.extraspecial? (V4491) (element? V4491 (value shen.*extraspecial*))) -(defun shen.system-S (V4911 V4912 V4913 V4914 V4915 V4916) (let W4917 (+ V4915 1) (let W4918 (if (shen.unlocked? V4914) (do (shen.incinfs) (when (shen.maxinfexceeded?) V4913 V4914 W4917 V4916)) false) (if (= W4918 false) (let W4919 (if (shen.unlocked? V4914) (let W4920 (shen.lazyderef V4911 V4913) (if (cons? W4920) (let W4921 (hd W4920) (let W4922 (shen.lazyderef (tl W4920) V4913) (if (cons? W4922) (let W4923 (hd W4922) (let W4924 (shen.lazyderef (tl W4922) V4913) (if (cons? W4924) (let W4925 (hd W4924) (let W4926 (shen.lazyderef (tl W4924) V4913) (if (= W4926 ()) (do (shen.incinfs) (when (= (shen.deref W4923 V4913) (intern ":")) V4913 V4914 W4917 (freeze (when (shen.type-theory-enabled?) V4913 V4914 W4917 (freeze (shen.cut V4913 V4914 W4917 (freeze (shen.system-S-h W4921 W4925 V4912 V4913 V4914 W4917 V4916)))))))) false))) false))) false))) false)) false) (if (= W4919 false) (let W4927 (if (shen.unlocked? V4914) (do (shen.incinfs) (when (value shen.*spy*) V4913 V4914 W4917 (freeze (shen.show V4911 V4912 V4913 V4914 W4917 V4916)))) false) (if (= W4927 false) (let W4928 (if (shen.unlocked? V4914) (do (shen.incinfs) (shen.search-user-datatypes V4911 V4912 (value shen.*datatypes*) V4913 V4914 W4917 V4916)) false) (if (= W4928 false) (shen.unlock V4914 W4917) W4928)) W4927)) W4919)) W4918)))) +(defun shen.system-S (V4492 V4493 V4494 V4495 V4496 V4497) (let W4498 (+ V4496 1) (let W4499 (if (shen.unlocked? V4495) (do (shen.incinfs) (when (shen.maxinfexceeded?) V4494 V4495 W4498 V4497)) false) (if (= W4499 false) (let W4500 (if (shen.unlocked? V4495) (let W4501 (shen.lazyderef V4492 V4494) (if (cons? W4501) (let W4502 (hd W4501) (let W4503 (shen.lazyderef (tl W4501) V4494) (if (cons? W4503) (let W4504 (hd W4503) (let W4505 (shen.lazyderef (tl W4503) V4494) (if (cons? W4505) (let W4506 (hd W4505) (let W4507 (shen.lazyderef (tl W4505) V4494) (if (= W4507 ()) (do (shen.incinfs) (when (= (shen.deref W4504 V4494) (intern ":")) V4494 V4495 W4498 (freeze (when (shen.type-theory-enabled?) V4494 V4495 W4498 (freeze (shen.cut V4494 V4495 W4498 (freeze (shen.system-S-h W4502 W4506 V4493 V4494 V4495 W4498 V4497)))))))) false))) false))) false))) false)) false) (if (= W4500 false) (let W4508 (if (shen.unlocked? V4495) (do (shen.incinfs) (when (value shen.*spy*) V4494 V4495 W4498 (freeze (shen.show V4492 V4493 V4494 V4495 W4498 V4497)))) false) (if (= W4508 false) (let W4509 (if (shen.unlocked? V4495) (do (shen.incinfs) (shen.search-user-datatypes V4492 V4493 (value shen.*datatypes*) V4494 V4495 W4498 V4497)) false) (if (= W4509 false) (shen.unlock V4495 W4498) W4509)) W4508)) W4500)) W4499)))) -(defun shen.show (V4935 V4936 V4937 V4938 V4939 V4940) (do (shen.line) (do (shen.show-p (shen.deref V4935 V4937)) (do (nl 2) (do (shen.show-assumptions (shen.deref V4936 V4937) 1) (do (shen.pause-for-user) false)))))) +(defun shen.show (V4516 V4517 V4518 V4519 V4520 V4521) (do (shen.line) (do (shen.show-p (shen.deref V4516 V4518)) (do (nl 2) (do (shen.show-assumptions (shen.deref V4517 V4518) 1) (do (shen.pause-for-user) false)))))) -(defun shen.line () (let W4941 (inferences) (pr (cn "____________________________________________________________ " (shen.app W4941 (cn " inference" (shen.app (if (= 1 W4941) "" "s") " +(defun shen.line () (let W4522 (inferences) (pr (cn "____________________________________________________________ " (shen.app W4522 (cn " inference" (shen.app (if (= 1 W4522) "" "s") " ?- " shen.a)) shen.a)) (stoutput)))) -(defun shen.show-p (V4942) (cond ((and (cons? V4942) (and (cons? (tl V4942)) (and (cons? (tl (tl V4942))) (and (= () (tl (tl (tl V4942)))) (= (hd (tl V4942)) (intern ":")))))) (do (shen.prterm (hd V4942)) (do (pr " : " (stoutput)) (pr (shen.app (hd (tl (tl V4942))) "" shen.r) (stoutput))))) (true (shen.prterm V4942)))) +(defun shen.show-p (V4523) (cond ((and (cons? V4523) (and (cons? (tl V4523)) (and (cons? (tl (tl V4523))) (and (= () (tl (tl (tl V4523)))) (= (hd (tl V4523)) (intern ":")))))) (do (shen.prterm (hd V4523)) (do (pr " : " (stoutput)) (pr (shen.app (hd (tl (tl V4523))) "" shen.r) (stoutput))))) (true (shen.prterm V4523)))) -(defun shen.prterm (V4943) (cond ((and (cons? V4943) (and (= cons (hd V4943)) (and (cons? (tl V4943)) (and (cons? (tl (tl V4943))) (= () (tl (tl (tl V4943)))))))) (do (pr "[" (stoutput)) (do (shen.prterm (hd (tl V4943))) (do (shen.prtl (hd (tl (tl V4943)))) (pr "]" (stoutput)))))) ((cons? V4943) (do (pr "(" (stoutput)) (do (shen.prterm (hd V4943)) (do (map (lambda Z4944 (do (pr " " (stoutput)) (shen.prterm Z4944))) (tl V4943)) (pr ")" (stoutput)))))) (true (print V4943)))) +(defun shen.prterm (V4524) (cond ((and (cons? V4524) (and (= cons (hd V4524)) (and (cons? (tl V4524)) (and (cons? (tl (tl V4524))) (= () (tl (tl (tl V4524)))))))) (do (pr "[" (stoutput)) (do (shen.prterm (hd (tl V4524))) (do (shen.prtl (hd (tl (tl V4524)))) (pr "]" (stoutput)))))) ((cons? V4524) (do (pr "(" (stoutput)) (do (shen.prterm (hd V4524)) (do (map (lambda Z4525 (do (pr " " (stoutput)) (shen.prterm Z4525))) (tl V4524)) (pr ")" (stoutput)))))) (true (print V4524)))) -(defun shen.prtl (V4945) (cond ((= () V4945) "") ((and (cons? V4945) (and (= cons (hd V4945)) (and (cons? (tl V4945)) (and (cons? (tl (tl V4945))) (= () (tl (tl (tl V4945)))))))) (do (pr " " (stoutput)) (do (shen.prterm (hd (tl V4945))) (shen.prtl (hd (tl (tl V4945))))))) (true (do (pr " | " (stoutput)) (shen.prterm V4945))))) +(defun shen.prtl (V4526) (cond ((= () V4526) "") ((and (cons? V4526) (and (= cons (hd V4526)) (and (cons? (tl V4526)) (and (cons? (tl (tl V4526))) (= () (tl (tl (tl V4526)))))))) (do (pr " " (stoutput)) (do (shen.prterm (hd (tl V4526))) (shen.prtl (hd (tl (tl V4526))))))) (true (do (pr " | " (stoutput)) (shen.prterm V4526))))) -(defun shen.show-assumptions (V4952 V4953) (cond ((= () V4952) (pr " -> " (stoutput))) ((cons? V4952) (do (pr (shen.app V4953 ". " shen.a) (stoutput)) (do (shen.show-p (hd V4952)) (do (nl 1) (shen.show-assumptions (tl V4952) (+ V4953 1)))))) (true (simple-error "implementation error in shen.show-assumptions")))) +(defun shen.show-assumptions (V4533 V4534) (cond ((= () V4533) (pr " +> " (stoutput))) ((cons? V4533) (do (pr (shen.app V4534 ". " shen.a) (stoutput)) (do (shen.show-p (hd V4533)) (do (nl 1) (shen.show-assumptions (tl V4533) (+ V4534 1)))))) (true (simple-error "implementation error in shen.show-assumptions")))) -(defun shen.pause-for-user () (let W4954 (read-byte (stinput)) (if (= W4954 94) (simple-error "input aborted +(defun shen.pause-for-user () (let W4535 (read-byte (stinput)) (if (= W4535 94) (simple-error "input aborted ") (nl 1)))) (defun shen.type-theory-enabled? () (value shen.*shen-type-theory-enabled?*)) (defun shen.maxinfexceeded? () (if (> (inferences) (value shen.*maxinferences*)) (simple-error "maximum inferences exceeded") false)) -(defun shen.system-S-h (V4955 V4956 V4957 V4958 V4959 V4960 V4961) (let W4962 (+ V4960 1) (let W4963 (if (shen.unlocked? V4959) (do (shen.incinfs) (when (value shen.*spy*) V4958 V4959 W4962 (freeze (shen.show (cons V4955 (cons (intern ":") (cons V4956 ()))) V4957 V4958 V4959 W4962 V4961)))) false) (if (= W4963 false) (let W4964 (if (shen.unlocked? V4959) (do (shen.incinfs) (when (not (cons? (shen.lazyderef V4955 V4958))) V4958 V4959 W4962 (freeze (shen.primitive V4955 V4956 V4958 V4959 W4962 V4961)))) false) (if (= W4964 false) (let W4965 (if (shen.unlocked? V4959) (do (shen.incinfs) (shen.by-hypothesis V4955 V4956 V4957 V4958 V4959 W4962 V4961)) false) (if (= W4965 false) (let W4966 (if (shen.unlocked? V4959) (let W4967 (shen.lazyderef V4955 V4958) (if (cons? W4967) (let W4968 (hd W4967) (let W4969 (shen.lazyderef (tl W4967) V4958) (if (= W4969 ()) (do (shen.incinfs) (shen.lookupsig W4968 (cons --> (cons V4956 ())) V4958 V4959 W4962 V4961)) false))) false)) false) (if (= W4966 false) (let W4970 (if (shen.unlocked? V4959) (let W4971 (shen.lazyderef V4955 V4958) (if (cons? W4971) (let W4972 (shen.lazyderef (hd W4971) V4958) (if (= W4972 fn) (let W4973 (shen.lazyderef (tl W4971) V4958) (if (cons? W4973) (let W4974 (hd W4973) (let W4975 (shen.lazyderef (tl W4973) V4958) (if (= W4975 ()) (do (shen.incinfs) (when (= (arity (shen.deref W4974 V4958)) 0) V4958 V4959 W4962 (freeze (shen.cut V4958 V4959 W4962 (freeze (shen.system-S-h (cons W4974 ()) V4956 V4957 V4958 V4959 W4962 V4961)))))) false))) false)) false)) false)) false) (if (= W4970 false) (let W4976 (if (shen.unlocked? V4959) (let W4977 (shen.lazyderef V4955 V4958) (if (cons? W4977) (let W4978 (shen.lazyderef (hd W4977) V4958) (if (= W4978 fn) (let W4979 (shen.lazyderef (tl W4977) V4958) (if (cons? W4979) (let W4980 (hd W4979) (let W4981 (shen.lazyderef (tl W4979) V4958) (if (= W4981 ()) (do (shen.incinfs) (shen.lookupsig W4980 V4956 V4958 V4959 W4962 V4961)) false))) false)) false)) false)) false) (if (= W4976 false) (let W4982 (if (shen.unlocked? V4959) (let W4983 (shen.lazyderef V4955 V4958) (if (cons? W4983) (let W4984 (hd W4983) (let W4985 (shen.lazyderef (tl W4983) V4958) (if (cons? W4985) (let W4986 (hd W4985) (let W4987 (shen.lazyderef (tl W4985) V4958) (if (= W4987 ()) (let W4988 (shen.newpv V4958) (shen.gc V4958 (do (shen.incinfs) (when (not (cons? (shen.lazyderef W4984 V4958))) V4958 V4959 W4962 (freeze (shen.lookupsig W4984 (cons W4988 (cons --> (cons V4956 ()))) V4958 V4959 W4962 (freeze (shen.system-S-h W4986 W4988 V4957 V4958 V4959 W4962 V4961)))))))) false))) false))) false)) false) (if (= W4982 false) (let W4989 (if (shen.unlocked? V4959) (let W4990 (shen.lazyderef V4955 V4958) (if (cons? W4990) (let W4991 (hd W4990) (let W4992 (shen.lazyderef (tl W4990) V4958) (if (cons? W4992) (let W4993 (hd W4992) (let W4994 (shen.lazyderef (tl W4992) V4958) (if (= W4994 ()) (let W4995 (shen.newpv V4958) (shen.gc V4958 (do (shen.incinfs) (shen.system-S-h W4991 (cons W4995 (cons --> (cons V4956 ()))) V4957 V4958 V4959 W4962 (freeze (shen.system-S-h W4993 W4995 V4957 V4958 V4959 W4962 V4961)))))) false))) false))) false)) false) (if (= W4989 false) (let W4996 (if (shen.unlocked? V4959) (let W4997 (shen.lazyderef V4955 V4958) (if (cons? W4997) (let W4998 (shen.lazyderef (hd W4997) V4958) (if (= W4998 cons) (let W4999 (shen.lazyderef (tl W4997) V4958) (if (cons? W4999) (let W5000 (hd W4999) (let W5001 (shen.lazyderef (tl W4999) V4958) (if (cons? W5001) (let W5002 (hd W5001) (let W5003 (shen.lazyderef (tl W5001) V4958) (if (= W5003 ()) (let W5004 (shen.lazyderef V4956 V4958) (let W5005 (lambda Z5006 (do (shen.incinfs) (shen.system-S-h W5000 Z5006 V4957 V4958 V4959 W4962 (freeze (shen.system-S-h W5002 (cons list (cons Z5006 ())) V4957 V4958 V4959 W4962 V4961))))) (if (cons? W5004) (let W5007 (shen.lazyderef (hd W5004) V4958) (let W5008 (freeze (let W5009 (shen.lazyderef (tl W5004) V4958) (let W5010 (lambda Z5011 (W5005 Z5011)) (if (cons? W5009) (let W5012 (hd W5009) (let W5013 (shen.lazyderef (tl W5009) V4958) (let W5014 (freeze (W5010 W5012)) (if (= W5013 ()) (thaw W5014) (if (shen.pvar? W5013) (shen.bind! W5013 () V4958 W5014) false))))) (if (shen.pvar? W5009) (let W5015 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5009 (cons W5015 ()) V4958 (freeze (W5010 W5015))))) false))))) (if (= W5007 list) (thaw W5008) (if (shen.pvar? W5007) (shen.bind! W5007 list V4958 W5008) false)))) (if (shen.pvar? W5004) (let W5016 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5004 (cons list (cons W5016 ())) V4958 (freeze (W5005 W5016))))) false)))) false))) false))) false)) false)) false)) false) (if (= W4996 false) (let W5017 (if (shen.unlocked? V4959) (let W5018 (shen.lazyderef V4955 V4958) (if (cons? W5018) (let W5019 (shen.lazyderef (hd W5018) V4958) (if (= W5019 @p) (let W5020 (shen.lazyderef (tl W5018) V4958) (if (cons? W5020) (let W5021 (hd W5020) (let W5022 (shen.lazyderef (tl W5020) V4958) (if (cons? W5022) (let W5023 (hd W5022) (let W5024 (shen.lazyderef (tl W5022) V4958) (if (= W5024 ()) (let W5025 (shen.lazyderef V4956 V4958) (let W5026 (lambda Z5027 (lambda Z5028 (do (shen.incinfs) (shen.system-S-h W5021 Z5027 V4957 V4958 V4959 W4962 (freeze (shen.system-S-h W5023 Z5028 V4957 V4958 V4959 W4962 V4961)))))) (if (cons? W5025) (let W5029 (hd W5025) (let W5030 (shen.lazyderef (tl W5025) V4958) (let W5031 (lambda Z5032 ((W5026 W5029) Z5032)) (if (cons? W5030) (let W5033 (shen.lazyderef (hd W5030) V4958) (let W5034 (freeze (let W5035 (shen.lazyderef (tl W5030) V4958) (let W5036 (lambda Z5037 (W5031 Z5037)) (if (cons? W5035) (let W5038 (hd W5035) (let W5039 (shen.lazyderef (tl W5035) V4958) (let W5040 (freeze (W5036 W5038)) (if (= W5039 ()) (thaw W5040) (if (shen.pvar? W5039) (shen.bind! W5039 () V4958 W5040) false))))) (if (shen.pvar? W5035) (let W5041 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5035 (cons W5041 ()) V4958 (freeze (W5036 W5041))))) false))))) (if (= W5033 *) (thaw W5034) (if (shen.pvar? W5033) (shen.bind! W5033 * V4958 W5034) false)))) (if (shen.pvar? W5030) (let W5042 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5030 (cons * (cons W5042 ())) V4958 (freeze (W5031 W5042))))) false))))) (if (shen.pvar? W5025) (let W5043 (shen.newpv V4958) (shen.gc V4958 (let W5044 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5025 (cons W5043 (cons * (cons W5044 ()))) V4958 (freeze ((W5026 W5043) W5044))))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5017 false) (let W5045 (if (shen.unlocked? V4959) (let W5046 (shen.lazyderef V4955 V4958) (if (cons? W5046) (let W5047 (shen.lazyderef (hd W5046) V4958) (if (= W5047 @v) (let W5048 (shen.lazyderef (tl W5046) V4958) (if (cons? W5048) (let W5049 (hd W5048) (let W5050 (shen.lazyderef (tl W5048) V4958) (if (cons? W5050) (let W5051 (hd W5050) (let W5052 (shen.lazyderef (tl W5050) V4958) (if (= W5052 ()) (let W5053 (shen.lazyderef V4956 V4958) (let W5054 (lambda Z5055 (do (shen.incinfs) (shen.system-S-h W5049 Z5055 V4957 V4958 V4959 W4962 (freeze (shen.system-S-h W5051 (cons vector (cons Z5055 ())) V4957 V4958 V4959 W4962 V4961))))) (if (cons? W5053) (let W5056 (shen.lazyderef (hd W5053) V4958) (let W5057 (freeze (let W5058 (shen.lazyderef (tl W5053) V4958) (let W5059 (lambda Z5060 (W5054 Z5060)) (if (cons? W5058) (let W5061 (hd W5058) (let W5062 (shen.lazyderef (tl W5058) V4958) (let W5063 (freeze (W5059 W5061)) (if (= W5062 ()) (thaw W5063) (if (shen.pvar? W5062) (shen.bind! W5062 () V4958 W5063) false))))) (if (shen.pvar? W5058) (let W5064 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5058 (cons W5064 ()) V4958 (freeze (W5059 W5064))))) false))))) (if (= W5056 vector) (thaw W5057) (if (shen.pvar? W5056) (shen.bind! W5056 vector V4958 W5057) false)))) (if (shen.pvar? W5053) (let W5065 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5053 (cons vector (cons W5065 ())) V4958 (freeze (W5054 W5065))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5045 false) (let W5066 (if (shen.unlocked? V4959) (let W5067 (shen.lazyderef V4955 V4958) (if (cons? W5067) (let W5068 (shen.lazyderef (hd W5067) V4958) (if (= W5068 @s) (let W5069 (shen.lazyderef (tl W5067) V4958) (if (cons? W5069) (let W5070 (hd W5069) (let W5071 (shen.lazyderef (tl W5069) V4958) (if (cons? W5071) (let W5072 (hd W5071) (let W5073 (shen.lazyderef (tl W5071) V4958) (if (= W5073 ()) (let W5074 (shen.lazyderef V4956 V4958) (let W5075 (freeze (do (shen.incinfs) (shen.system-S-h W5070 string V4957 V4958 V4959 W4962 (freeze (shen.system-S-h W5072 string V4957 V4958 V4959 W4962 V4961))))) (if (= W5074 string) (thaw W5075) (if (shen.pvar? W5074) (shen.bind! W5074 string V4958 W5075) false)))) false))) false))) false)) false)) false)) false) (if (= W5066 false) (let W5076 (if (shen.unlocked? V4959) (let W5077 (shen.lazyderef V4955 V4958) (if (cons? W5077) (let W5078 (shen.lazyderef (hd W5077) V4958) (if (= W5078 lambda) (let W5079 (shen.lazyderef (tl W5077) V4958) (if (cons? W5079) (let W5080 (hd W5079) (let W5081 (shen.lazyderef (tl W5079) V4958) (if (cons? W5081) (let W5082 (hd W5081) (let W5083 (shen.lazyderef (tl W5081) V4958) (if (= W5083 ()) (let W5084 (shen.lazyderef V4956 V4958) (let W5085 (lambda Z5086 (lambda Z5087 (let W5088 (shen.newpv V4958) (shen.gc V4958 (let W5089 (shen.newpv V4958) (shen.gc V4958 (do (shen.incinfs) (bind W5089 (shen.freshterm (shen.lazyderef W5080 V4958)) V4958 V4959 W4962 (freeze (bind W5088 (shen.beta (shen.lazyderef W5080 V4958) (shen.deref W5089 V4958) (shen.deref W5082 V4958)) V4958 V4959 W4962 (freeze (shen.system-S-h W5088 Z5087 (cons (cons W5089 (cons (intern ":") (cons Z5086 ()))) V4957) V4958 V4959 W4962 V4961)))))))))))) (if (cons? W5084) (let W5090 (hd W5084) (let W5091 (shen.lazyderef (tl W5084) V4958) (let W5092 (lambda Z5093 ((W5085 W5090) Z5093)) (if (cons? W5091) (let W5094 (shen.lazyderef (hd W5091) V4958) (let W5095 (freeze (let W5096 (shen.lazyderef (tl W5091) V4958) (let W5097 (lambda Z5098 (W5092 Z5098)) (if (cons? W5096) (let W5099 (hd W5096) (let W5100 (shen.lazyderef (tl W5096) V4958) (let W5101 (freeze (W5097 W5099)) (if (= W5100 ()) (thaw W5101) (if (shen.pvar? W5100) (shen.bind! W5100 () V4958 W5101) false))))) (if (shen.pvar? W5096) (let W5102 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5096 (cons W5102 ()) V4958 (freeze (W5097 W5102))))) false))))) (if (= W5094 -->) (thaw W5095) (if (shen.pvar? W5094) (shen.bind! W5094 --> V4958 W5095) false)))) (if (shen.pvar? W5091) (let W5103 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5091 (cons --> (cons W5103 ())) V4958 (freeze (W5092 W5103))))) false))))) (if (shen.pvar? W5084) (let W5104 (shen.newpv V4958) (shen.gc V4958 (let W5105 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5084 (cons W5104 (cons --> (cons W5105 ()))) V4958 (freeze ((W5085 W5104) W5105))))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5076 false) (let W5106 (if (shen.unlocked? V4959) (let W5107 (shen.lazyderef V4955 V4958) (if (cons? W5107) (let W5108 (shen.lazyderef (hd W5107) V4958) (if (= W5108 let) (let W5109 (shen.lazyderef (tl W5107) V4958) (if (cons? W5109) (let W5110 (hd W5109) (let W5111 (shen.lazyderef (tl W5109) V4958) (if (cons? W5111) (let W5112 (hd W5111) (let W5113 (shen.lazyderef (tl W5111) V4958) (if (cons? W5113) (let W5114 (hd W5113) (let W5115 (shen.lazyderef (tl W5113) V4958) (if (= W5115 ()) (let W5116 (shen.newpv V4958) (shen.gc V4958 (let W5117 (shen.newpv V4958) (shen.gc V4958 (let W5118 (shen.newpv V4958) (shen.gc V4958 (do (shen.incinfs) (shen.system-S-h W5112 W5118 V4957 V4958 V4959 W4962 (freeze (bind W5117 (shen.freshterm (shen.lazyderef W5110 V4958)) V4958 V4959 W4962 (freeze (bind W5116 (shen.beta (shen.lazyderef W5110 V4958) (shen.lazyderef W5117 V4958) (shen.lazyderef W5114 V4958)) V4958 V4959 W4962 (freeze (shen.system-S-h W5116 V4956 (cons (cons W5117 (cons (intern ":") (cons W5118 ()))) V4957) V4958 V4959 W4962 V4961)))))))))))))) false))) false))) false))) false)) false)) false)) false) (if (= W5106 false) (let W5119 (if (shen.unlocked? V4959) (let W5120 (shen.lazyderef V4955 V4958) (if (cons? W5120) (let W5121 (shen.lazyderef (hd W5120) V4958) (if (= W5121 open) (let W5122 (shen.lazyderef (tl W5120) V4958) (if (cons? W5122) (let W5123 (hd W5122) (let W5124 (shen.lazyderef (tl W5122) V4958) (if (cons? W5124) (let W5125 (hd W5124) (let W5126 (shen.lazyderef (tl W5124) V4958) (if (= W5126 ()) (let W5127 (shen.lazyderef V4956 V4958) (let W5128 (lambda Z5129 (do (shen.incinfs) (is! W5125 Z5129 V4958 V4959 W4962 (freeze (when (element? (shen.lazyderef Z5129 V4958) (cons in (cons out ()))) V4958 V4959 W4962 (freeze (shen.system-S-h W5123 string V4957 V4958 V4959 W4962 V4961))))))) (if (cons? W5127) (let W5130 (shen.lazyderef (hd W5127) V4958) (let W5131 (freeze (let W5132 (shen.lazyderef (tl W5127) V4958) (let W5133 (lambda Z5134 (W5128 Z5134)) (if (cons? W5132) (let W5135 (hd W5132) (let W5136 (shen.lazyderef (tl W5132) V4958) (let W5137 (freeze (W5133 W5135)) (if (= W5136 ()) (thaw W5137) (if (shen.pvar? W5136) (shen.bind! W5136 () V4958 W5137) false))))) (if (shen.pvar? W5132) (let W5138 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5132 (cons W5138 ()) V4958 (freeze (W5133 W5138))))) false))))) (if (= W5130 stream) (thaw W5131) (if (shen.pvar? W5130) (shen.bind! W5130 stream V4958 W5131) false)))) (if (shen.pvar? W5127) (let W5139 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5127 (cons stream (cons W5139 ())) V4958 (freeze (W5128 W5139))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5119 false) (let W5140 (if (shen.unlocked? V4959) (let W5141 (shen.lazyderef V4955 V4958) (if (cons? W5141) (let W5142 (shen.lazyderef (hd W5141) V4958) (if (= W5142 type) (let W5143 (shen.lazyderef (tl W5141) V4958) (if (cons? W5143) (let W5144 (hd W5143) (let W5145 (shen.lazyderef (tl W5143) V4958) (if (cons? W5145) (let W5146 (hd W5145) (let W5147 (shen.lazyderef (tl W5145) V4958) (if (= W5147 ()) (do (shen.incinfs) (shen.cut V4958 V4959 W4962 (freeze (is! (shen.rectify-type (shen.deref W5146 V4958)) V4956 V4958 V4959 W4962 (freeze (shen.system-S-h W5144 V4956 V4957 V4958 V4959 W4962 V4961)))))) false))) false))) false)) false)) false)) false) (if (= W5140 false) (let W5148 (if (shen.unlocked? V4959) (let W5149 (shen.lazyderef V4955 V4958) (if (cons? W5149) (let W5150 (shen.lazyderef (hd W5149) V4958) (if (= W5150 input+) (let W5151 (shen.lazyderef (tl W5149) V4958) (if (cons? W5151) (let W5152 (hd W5151) (let W5153 (shen.lazyderef (tl W5151) V4958) (if (cons? W5153) (let W5154 (hd W5153) (let W5155 (shen.lazyderef (tl W5153) V4958) (if (= W5155 ()) (do (shen.incinfs) (is! V4956 (shen.rectify-type (shen.deref W5152 V4958)) V4958 V4959 W4962 (freeze (shen.system-S-h W5154 (cons stream (cons in ())) V4957 V4958 V4959 W4962 V4961)))) false))) false))) false)) false)) false)) false) (if (= W5148 false) (let W5156 (if (shen.unlocked? V4959) (let W5157 (shen.lazyderef V4955 V4958) (if (cons? W5157) (let W5158 (shen.lazyderef (hd W5157) V4958) (if (= W5158 set) (let W5159 (shen.lazyderef (tl W5157) V4958) (if (cons? W5159) (let W5160 (hd W5159) (let W5161 (shen.lazyderef (tl W5159) V4958) (if (cons? W5161) (let W5162 (hd W5161) (let W5163 (shen.lazyderef (tl W5161) V4958) (if (= W5163 ()) (do (shen.incinfs) (shen.system-S-h W5160 symbol V4957 V4958 V4959 W4962 (freeze (shen.system-S-h (cons value (cons W5160 ())) V4956 V4957 V4958 V4959 W4962 (freeze (shen.system-S-h W5162 V4956 V4957 V4958 V4959 W4962 V4961)))))) false))) false))) false)) false)) false)) false) (if (= W5156 false) (let W5164 (if (shen.unlocked? V4959) (let W5165 (shen.newpv V4958) (shen.gc V4958 (do (shen.incinfs) (shen.l-rules V4957 W5165 false V4958 V4959 W4962 (freeze (shen.cut V4958 V4959 W4962 (freeze (shen.system-S-h V4955 V4956 W5165 V4958 V4959 W4962 V4961)))))))) false) (if (= W5164 false) (let W5166 (if (shen.unlocked? V4959) (do (shen.incinfs) (shen.search-user-datatypes (cons V4955 (cons (intern ":") (cons V4956 ()))) V4957 (value shen.*datatypes*) V4958 V4959 W4962 V4961)) false) (if (= W5166 false) (shen.unlock V4959 W4962) W5166)) W5164)) W5156)) W5148)) W5140)) W5119)) W5106)) W5076)) W5066)) W5045)) W5017)) W4996)) W4989)) W4982)) W4976)) W4970)) W4966)) W4965)) W4964)) W4963)))) +(defun shen.system-S-h (V4536 V4537 V4538 V4539 V4540 V4541 V4542) (let W4543 (+ V4541 1) (let W4544 (if (shen.unlocked? V4540) (do (shen.incinfs) (when (value shen.*spy*) V4539 V4540 W4543 (freeze (shen.show (cons V4536 (cons (intern ":") (cons V4537 ()))) V4538 V4539 V4540 W4543 V4542)))) false) (if (= W4544 false) (let W4545 (if (shen.unlocked? V4540) (do (shen.incinfs) (when (not (cons? (shen.lazyderef V4536 V4539))) V4539 V4540 W4543 (freeze (shen.primitive V4536 V4537 V4539 V4540 W4543 V4542)))) false) (if (= W4545 false) (let W4546 (if (shen.unlocked? V4540) (do (shen.incinfs) (shen.by-hypothesis V4536 V4537 V4538 V4539 V4540 W4543 V4542)) false) (if (= W4546 false) (let W4547 (if (shen.unlocked? V4540) (let W4548 (shen.lazyderef V4536 V4539) (if (cons? W4548) (let W4549 (hd W4548) (let W4550 (shen.lazyderef (tl W4548) V4539) (if (= W4550 ()) (do (shen.incinfs) (shen.lookupsig W4549 (cons --> (cons V4537 ())) V4539 V4540 W4543 V4542)) false))) false)) false) (if (= W4547 false) (let W4551 (if (shen.unlocked? V4540) (let W4552 (shen.lazyderef V4536 V4539) (if (cons? W4552) (let W4553 (shen.lazyderef (hd W4552) V4539) (if (= W4553 fn) (let W4554 (shen.lazyderef (tl W4552) V4539) (if (cons? W4554) (let W4555 (hd W4554) (let W4556 (shen.lazyderef (tl W4554) V4539) (if (= W4556 ()) (do (shen.incinfs) (when (= (arity (shen.deref W4555 V4539)) 0) V4539 V4540 W4543 (freeze (shen.cut V4539 V4540 W4543 (freeze (shen.system-S-h (cons W4555 ()) V4537 V4538 V4539 V4540 W4543 V4542)))))) false))) false)) false)) false)) false) (if (= W4551 false) (let W4557 (if (shen.unlocked? V4540) (let W4558 (shen.lazyderef V4536 V4539) (if (cons? W4558) (let W4559 (shen.lazyderef (hd W4558) V4539) (if (= W4559 fn) (let W4560 (shen.lazyderef (tl W4558) V4539) (if (cons? W4560) (let W4561 (hd W4560) (let W4562 (shen.lazyderef (tl W4560) V4539) (if (= W4562 ()) (do (shen.incinfs) (shen.lookupsig W4561 V4537 V4539 V4540 W4543 V4542)) false))) false)) false)) false)) false) (if (= W4557 false) (let W4563 (if (shen.unlocked? V4540) (let W4564 (shen.lazyderef V4536 V4539) (if (cons? W4564) (let W4565 (hd W4564) (let W4566 (shen.lazyderef (tl W4564) V4539) (if (cons? W4566) (let W4567 (hd W4566) (let W4568 (shen.lazyderef (tl W4566) V4539) (if (= W4568 ()) (let W4569 (shen.newpv V4539) (shen.gc V4539 (do (shen.incinfs) (when (not (cons? (shen.lazyderef W4565 V4539))) V4539 V4540 W4543 (freeze (shen.lookupsig W4565 (cons W4569 (cons --> (cons V4537 ()))) V4539 V4540 W4543 (freeze (shen.system-S-h W4567 W4569 V4538 V4539 V4540 W4543 V4542)))))))) false))) false))) false)) false) (if (= W4563 false) (let W4570 (if (shen.unlocked? V4540) (let W4571 (shen.lazyderef V4536 V4539) (if (cons? W4571) (let W4572 (hd W4571) (let W4573 (shen.lazyderef (tl W4571) V4539) (if (cons? W4573) (let W4574 (hd W4573) (let W4575 (shen.lazyderef (tl W4573) V4539) (if (= W4575 ()) (let W4576 (shen.newpv V4539) (shen.gc V4539 (do (shen.incinfs) (shen.system-S-h W4572 (cons W4576 (cons --> (cons V4537 ()))) V4538 V4539 V4540 W4543 (freeze (shen.system-S-h W4574 W4576 V4538 V4539 V4540 W4543 V4542)))))) false))) false))) false)) false) (if (= W4570 false) (let W4577 (if (shen.unlocked? V4540) (let W4578 (shen.lazyderef V4536 V4539) (if (cons? W4578) (let W4579 (shen.lazyderef (hd W4578) V4539) (if (= W4579 cons) (let W4580 (shen.lazyderef (tl W4578) V4539) (if (cons? W4580) (let W4581 (hd W4580) (let W4582 (shen.lazyderef (tl W4580) V4539) (if (cons? W4582) (let W4583 (hd W4582) (let W4584 (shen.lazyderef (tl W4582) V4539) (if (= W4584 ()) (let W4585 (shen.lazyderef V4537 V4539) (let W4586 (lambda Z4587 (do (shen.incinfs) (shen.system-S-h W4581 Z4587 V4538 V4539 V4540 W4543 (freeze (shen.system-S-h W4583 (cons list (cons Z4587 ())) V4538 V4539 V4540 W4543 V4542))))) (if (cons? W4585) (let W4588 (shen.lazyderef (hd W4585) V4539) (let W4589 (freeze (let W4590 (shen.lazyderef (tl W4585) V4539) (let W4591 (lambda Z4592 (W4586 Z4592)) (if (cons? W4590) (let W4593 (hd W4590) (let W4594 (shen.lazyderef (tl W4590) V4539) (let W4595 (freeze (W4591 W4593)) (if (= W4594 ()) (thaw W4595) (if (shen.pvar? W4594) (shen.bind! W4594 () V4539 W4595) false))))) (if (shen.pvar? W4590) (let W4596 (shen.newpv V4539) (shen.gc V4539 (shen.bind! W4590 (cons W4596 ()) V4539 (freeze (W4591 W4596))))) false))))) (if (= W4588 list) (thaw W4589) (if (shen.pvar? W4588) (shen.bind! W4588 list V4539 W4589) false)))) (if (shen.pvar? W4585) (let W4597 (shen.newpv V4539) (shen.gc V4539 (shen.bind! W4585 (cons list (cons W4597 ())) V4539 (freeze (W4586 W4597))))) false)))) false))) false))) false)) false)) false)) false) (if (= W4577 false) (let W4598 (if (shen.unlocked? V4540) (let W4599 (shen.lazyderef V4536 V4539) (if (cons? W4599) (let W4600 (shen.lazyderef (hd W4599) V4539) (if (= W4600 @p) (let W4601 (shen.lazyderef (tl W4599) V4539) (if (cons? W4601) (let W4602 (hd W4601) (let W4603 (shen.lazyderef (tl W4601) V4539) (if (cons? W4603) (let W4604 (hd W4603) (let W4605 (shen.lazyderef (tl W4603) V4539) (if (= W4605 ()) (let W4606 (shen.lazyderef V4537 V4539) (let W4607 (lambda Z4608 (lambda Z4609 (do (shen.incinfs) (shen.system-S-h W4602 Z4608 V4538 V4539 V4540 W4543 (freeze (shen.system-S-h W4604 Z4609 V4538 V4539 V4540 W4543 V4542)))))) (if (cons? W4606) (let W4610 (hd W4606) (let W4611 (shen.lazyderef (tl W4606) V4539) (let W4612 (lambda Z4613 ((W4607 W4610) Z4613)) (if (cons? W4611) (let W4614 (shen.lazyderef (hd W4611) V4539) (let W4615 (freeze (let W4616 (shen.lazyderef (tl W4611) V4539) (let W4617 (lambda Z4618 (W4612 Z4618)) (if (cons? W4616) (let W4619 (hd W4616) (let W4620 (shen.lazyderef (tl W4616) V4539) (let W4621 (freeze (W4617 W4619)) (if (= W4620 ()) (thaw W4621) (if (shen.pvar? W4620) (shen.bind! W4620 () V4539 W4621) false))))) (if (shen.pvar? W4616) (let W4622 (shen.newpv V4539) (shen.gc V4539 (shen.bind! W4616 (cons W4622 ()) V4539 (freeze (W4617 W4622))))) false))))) (if (= W4614 *) (thaw W4615) (if (shen.pvar? W4614) (shen.bind! W4614 * V4539 W4615) false)))) (if (shen.pvar? W4611) (let W4623 (shen.newpv V4539) (shen.gc V4539 (shen.bind! W4611 (cons * (cons W4623 ())) V4539 (freeze (W4612 W4623))))) false))))) (if (shen.pvar? W4606) (let W4624 (shen.newpv V4539) (shen.gc V4539 (let W4625 (shen.newpv V4539) (shen.gc V4539 (shen.bind! W4606 (cons W4624 (cons * (cons W4625 ()))) V4539 (freeze ((W4607 W4624) W4625))))))) false)))) false))) false))) false)) false)) false)) false) (if (= W4598 false) (let W4626 (if (shen.unlocked? V4540) (let W4627 (shen.lazyderef V4536 V4539) (if (cons? W4627) (let W4628 (shen.lazyderef (hd W4627) V4539) (if (= W4628 @v) (let W4629 (shen.lazyderef (tl W4627) V4539) (if (cons? W4629) (let W4630 (hd W4629) (let W4631 (shen.lazyderef (tl W4629) V4539) (if (cons? W4631) (let W4632 (hd W4631) (let W4633 (shen.lazyderef (tl W4631) V4539) (if (= W4633 ()) (let W4634 (shen.lazyderef V4537 V4539) (let W4635 (lambda Z4636 (do (shen.incinfs) (shen.system-S-h W4630 Z4636 V4538 V4539 V4540 W4543 (freeze (shen.system-S-h W4632 (cons vector (cons Z4636 ())) V4538 V4539 V4540 W4543 V4542))))) (if (cons? W4634) (let W4637 (shen.lazyderef (hd W4634) V4539) (let W4638 (freeze (let W4639 (shen.lazyderef (tl W4634) V4539) (let W4640 (lambda Z4641 (W4635 Z4641)) (if (cons? W4639) (let W4642 (hd W4639) (let W4643 (shen.lazyderef (tl W4639) V4539) (let W4644 (freeze (W4640 W4642)) (if (= W4643 ()) (thaw W4644) (if (shen.pvar? W4643) (shen.bind! W4643 () V4539 W4644) false))))) (if (shen.pvar? W4639) (let W4645 (shen.newpv V4539) (shen.gc V4539 (shen.bind! W4639 (cons W4645 ()) V4539 (freeze (W4640 W4645))))) false))))) (if (= W4637 vector) (thaw W4638) (if (shen.pvar? W4637) (shen.bind! W4637 vector V4539 W4638) false)))) (if (shen.pvar? W4634) (let W4646 (shen.newpv V4539) (shen.gc V4539 (shen.bind! W4634 (cons vector (cons W4646 ())) V4539 (freeze (W4635 W4646))))) false)))) false))) false))) false)) false)) false)) false) (if (= W4626 false) (let W4647 (if (shen.unlocked? V4540) (let W4648 (shen.lazyderef V4536 V4539) (if (cons? W4648) (let W4649 (shen.lazyderef (hd W4648) V4539) (if (= W4649 @s) (let W4650 (shen.lazyderef (tl W4648) V4539) (if (cons? W4650) (let W4651 (hd W4650) (let W4652 (shen.lazyderef (tl W4650) V4539) (if (cons? W4652) (let W4653 (hd W4652) (let W4654 (shen.lazyderef (tl W4652) V4539) (if (= W4654 ()) (let W4655 (shen.lazyderef V4537 V4539) (let W4656 (freeze (do (shen.incinfs) (shen.system-S-h W4651 string V4538 V4539 V4540 W4543 (freeze (shen.system-S-h W4653 string V4538 V4539 V4540 W4543 V4542))))) (if (= W4655 string) (thaw W4656) (if (shen.pvar? W4655) (shen.bind! W4655 string V4539 W4656) false)))) false))) false))) false)) false)) false)) false) (if (= W4647 false) (let W4657 (if (shen.unlocked? V4540) (let W4658 (shen.lazyderef V4536 V4539) (if (cons? W4658) (let W4659 (shen.lazyderef (hd W4658) V4539) (if (= W4659 lambda) (let W4660 (shen.lazyderef (tl W4658) V4539) (if (cons? W4660) (let W4661 (hd W4660) (let W4662 (shen.lazyderef (tl W4660) V4539) (if (cons? W4662) (let W4663 (hd W4662) (let W4664 (shen.lazyderef (tl W4662) V4539) (if (= W4664 ()) (let W4665 (shen.lazyderef V4537 V4539) (let W4666 (lambda Z4667 (lambda Z4668 (let W4669 (shen.newpv V4539) (shen.gc V4539 (let W4670 (shen.newpv V4539) (shen.gc V4539 (do (shen.incinfs) (bind W4670 (shen.freshterm (shen.lazyderef W4661 V4539)) V4539 V4540 W4543 (freeze (bind W4669 (shen.beta (shen.lazyderef W4661 V4539) (shen.deref W4670 V4539) (shen.deref W4663 V4539)) V4539 V4540 W4543 (freeze (shen.system-S-h W4669 Z4668 (cons (cons W4670 (cons (intern ":") (cons Z4667 ()))) V4538) V4539 V4540 W4543 V4542)))))))))))) (if (cons? W4665) (let W4671 (hd W4665) (let W4672 (shen.lazyderef (tl W4665) V4539) (let W4673 (lambda Z4674 ((W4666 W4671) Z4674)) (if (cons? W4672) (let W4675 (shen.lazyderef (hd W4672) V4539) (let W4676 (freeze (let W4677 (shen.lazyderef (tl W4672) V4539) (let W4678 (lambda Z4679 (W4673 Z4679)) (if (cons? W4677) (let W4680 (hd W4677) (let W4681 (shen.lazyderef (tl W4677) V4539) (let W4682 (freeze (W4678 W4680)) (if (= W4681 ()) (thaw W4682) (if (shen.pvar? W4681) (shen.bind! W4681 () V4539 W4682) false))))) (if (shen.pvar? W4677) (let W4683 (shen.newpv V4539) (shen.gc V4539 (shen.bind! W4677 (cons W4683 ()) V4539 (freeze (W4678 W4683))))) false))))) (if (= W4675 -->) (thaw W4676) (if (shen.pvar? W4675) (shen.bind! W4675 --> V4539 W4676) false)))) (if (shen.pvar? W4672) (let W4684 (shen.newpv V4539) (shen.gc V4539 (shen.bind! W4672 (cons --> (cons W4684 ())) V4539 (freeze (W4673 W4684))))) false))))) (if (shen.pvar? W4665) (let W4685 (shen.newpv V4539) (shen.gc V4539 (let W4686 (shen.newpv V4539) (shen.gc V4539 (shen.bind! W4665 (cons W4685 (cons --> (cons W4686 ()))) V4539 (freeze ((W4666 W4685) W4686))))))) false)))) false))) false))) false)) false)) false)) false) (if (= W4657 false) (let W4687 (if (shen.unlocked? V4540) (let W4688 (shen.lazyderef V4536 V4539) (if (cons? W4688) (let W4689 (shen.lazyderef (hd W4688) V4539) (if (= W4689 let) (let W4690 (shen.lazyderef (tl W4688) V4539) (if (cons? W4690) (let W4691 (hd W4690) (let W4692 (shen.lazyderef (tl W4690) V4539) (if (cons? W4692) (let W4693 (hd W4692) (let W4694 (shen.lazyderef (tl W4692) V4539) (if (cons? W4694) (let W4695 (hd W4694) (let W4696 (shen.lazyderef (tl W4694) V4539) (if (= W4696 ()) (let W4697 (shen.newpv V4539) (shen.gc V4539 (let W4698 (shen.newpv V4539) (shen.gc V4539 (let W4699 (shen.newpv V4539) (shen.gc V4539 (do (shen.incinfs) (shen.system-S-h W4693 W4699 V4538 V4539 V4540 W4543 (freeze (bind W4698 (shen.freshterm (shen.lazyderef W4691 V4539)) V4539 V4540 W4543 (freeze (bind W4697 (shen.beta (shen.lazyderef W4691 V4539) (shen.lazyderef W4698 V4539) (shen.lazyderef W4695 V4539)) V4539 V4540 W4543 (freeze (shen.system-S-h W4697 V4537 (cons (cons W4698 (cons (intern ":") (cons W4699 ()))) V4538) V4539 V4540 W4543 V4542)))))))))))))) false))) false))) false))) false)) false)) false)) false) (if (= W4687 false) (let W4700 (if (shen.unlocked? V4540) (let W4701 (shen.lazyderef V4536 V4539) (if (cons? W4701) (let W4702 (shen.lazyderef (hd W4701) V4539) (if (= W4702 open) (let W4703 (shen.lazyderef (tl W4701) V4539) (if (cons? W4703) (let W4704 (hd W4703) (let W4705 (shen.lazyderef (tl W4703) V4539) (if (cons? W4705) (let W4706 (hd W4705) (let W4707 (shen.lazyderef (tl W4705) V4539) (if (= W4707 ()) (let W4708 (shen.lazyderef V4537 V4539) (let W4709 (lambda Z4710 (do (shen.incinfs) (is! W4706 Z4710 V4539 V4540 W4543 (freeze (when (element? (shen.lazyderef Z4710 V4539) (cons in (cons out ()))) V4539 V4540 W4543 (freeze (shen.system-S-h W4704 string V4538 V4539 V4540 W4543 V4542))))))) (if (cons? W4708) (let W4711 (shen.lazyderef (hd W4708) V4539) (let W4712 (freeze (let W4713 (shen.lazyderef (tl W4708) V4539) (let W4714 (lambda Z4715 (W4709 Z4715)) (if (cons? W4713) (let W4716 (hd W4713) (let W4717 (shen.lazyderef (tl W4713) V4539) (let W4718 (freeze (W4714 W4716)) (if (= W4717 ()) (thaw W4718) (if (shen.pvar? W4717) (shen.bind! W4717 () V4539 W4718) false))))) (if (shen.pvar? W4713) (let W4719 (shen.newpv V4539) (shen.gc V4539 (shen.bind! W4713 (cons W4719 ()) V4539 (freeze (W4714 W4719))))) false))))) (if (= W4711 stream) (thaw W4712) (if (shen.pvar? W4711) (shen.bind! W4711 stream V4539 W4712) false)))) (if (shen.pvar? W4708) (let W4720 (shen.newpv V4539) (shen.gc V4539 (shen.bind! W4708 (cons stream (cons W4720 ())) V4539 (freeze (W4709 W4720))))) false)))) false))) false))) false)) false)) false)) false) (if (= W4700 false) (let W4721 (if (shen.unlocked? V4540) (let W4722 (shen.lazyderef V4536 V4539) (if (cons? W4722) (let W4723 (shen.lazyderef (hd W4722) V4539) (if (= W4723 type) (let W4724 (shen.lazyderef (tl W4722) V4539) (if (cons? W4724) (let W4725 (hd W4724) (let W4726 (shen.lazyderef (tl W4724) V4539) (if (cons? W4726) (let W4727 (hd W4726) (let W4728 (shen.lazyderef (tl W4726) V4539) (if (= W4728 ()) (do (shen.incinfs) (shen.cut V4539 V4540 W4543 (freeze (is! (shen.rectify-type (shen.deref W4727 V4539)) V4537 V4539 V4540 W4543 (freeze (shen.system-S-h W4725 V4537 V4538 V4539 V4540 W4543 V4542)))))) false))) false))) false)) false)) false)) false) (if (= W4721 false) (let W4729 (if (shen.unlocked? V4540) (let W4730 (shen.lazyderef V4536 V4539) (if (cons? W4730) (let W4731 (shen.lazyderef (hd W4730) V4539) (if (= W4731 shen.input-h+) (let W4732 (shen.lazyderef (tl W4730) V4539) (if (cons? W4732) (let W4733 (hd W4732) (let W4734 (shen.lazyderef (tl W4732) V4539) (if (cons? W4734) (let W4735 (hd W4734) (let W4736 (shen.lazyderef (tl W4734) V4539) (if (= W4736 ()) (do (shen.incinfs) (is V4537 (shen.rectify-type (shen.rdecons (shen.deref W4733 V4539))) V4539 V4540 W4543 (freeze (shen.system-S-h W4735 (cons stream (cons in ())) V4538 V4539 V4540 W4543 V4542)))) false))) false))) false)) false)) false)) false) (if (= W4729 false) (let W4737 (if (shen.unlocked? V4540) (let W4738 (shen.lazyderef V4536 V4539) (if (cons? W4738) (let W4739 (shen.lazyderef (hd W4738) V4539) (if (= W4739 set) (let W4740 (shen.lazyderef (tl W4738) V4539) (if (cons? W4740) (let W4741 (hd W4740) (let W4742 (shen.lazyderef (tl W4740) V4539) (if (cons? W4742) (let W4743 (hd W4742) (let W4744 (shen.lazyderef (tl W4742) V4539) (if (= W4744 ()) (do (shen.incinfs) (shen.system-S-h W4741 symbol V4538 V4539 V4540 W4543 (freeze (shen.system-S-h (cons value (cons W4741 ())) V4537 V4538 V4539 V4540 W4543 (freeze (shen.system-S-h W4743 V4537 V4538 V4539 V4540 W4543 V4542)))))) false))) false))) false)) false)) false)) false) (if (= W4737 false) (let W4745 (if (shen.unlocked? V4540) (let W4746 (shen.newpv V4539) (shen.gc V4539 (do (shen.incinfs) (shen.l-rules V4538 W4746 false V4539 V4540 W4543 (freeze (shen.cut V4539 V4540 W4543 (freeze (shen.system-S-h V4536 V4537 W4746 V4539 V4540 W4543 V4542)))))))) false) (if (= W4745 false) (let W4747 (if (shen.unlocked? V4540) (do (shen.incinfs) (shen.search-user-datatypes (cons V4536 (cons (intern ":") (cons V4537 ()))) V4538 (value shen.*datatypes*) V4539 V4540 W4543 V4542)) false) (if (= W4747 false) (shen.unlock V4540 W4543) W4747)) W4745)) W4737)) W4729)) W4721)) W4700)) W4687)) W4657)) W4647)) W4626)) W4598)) W4577)) W4570)) W4563)) W4557)) W4551)) W4547)) W4546)) W4545)) W4544)))) -(defun shen.primitive (V5167 V5168 V5169 V5170 V5171 V5172) (let W5173 (if (shen.unlocked? V5170) (let W5174 (shen.lazyderef V5168 V5169) (let W5175 (freeze (do (shen.incinfs) (when (number? (shen.lazyderef V5167 V5169)) V5169 V5170 V5171 V5172))) (if (= W5174 number) (thaw W5175) (if (shen.pvar? W5174) (shen.bind! W5174 number V5169 W5175) false)))) false) (if (= W5173 false) (let W5176 (if (shen.unlocked? V5170) (let W5177 (shen.lazyderef V5168 V5169) (let W5178 (freeze (do (shen.incinfs) (when (boolean? (shen.lazyderef V5167 V5169)) V5169 V5170 V5171 V5172))) (if (= W5177 boolean) (thaw W5178) (if (shen.pvar? W5177) (shen.bind! W5177 boolean V5169 W5178) false)))) false) (if (= W5176 false) (let W5179 (if (shen.unlocked? V5170) (let W5180 (shen.lazyderef V5168 V5169) (let W5181 (freeze (do (shen.incinfs) (when (string? (shen.lazyderef V5167 V5169)) V5169 V5170 V5171 V5172))) (if (= W5180 string) (thaw W5181) (if (shen.pvar? W5180) (shen.bind! W5180 string V5169 W5181) false)))) false) (if (= W5179 false) (let W5182 (if (shen.unlocked? V5170) (let W5183 (shen.lazyderef V5168 V5169) (let W5184 (freeze (do (shen.incinfs) (when (symbol? (shen.lazyderef V5167 V5169)) V5169 V5170 V5171 V5172))) (if (= W5183 symbol) (thaw W5184) (if (shen.pvar? W5183) (shen.bind! W5183 symbol V5169 W5184) false)))) false) (if (= W5182 false) (if (shen.unlocked? V5170) (let W5185 (shen.lazyderef V5167 V5169) (if (= W5185 ()) (let W5186 (shen.lazyderef V5168 V5169) (let W5187 (lambda Z5188 (do (shen.incinfs) (thaw V5172))) (if (cons? W5186) (let W5189 (shen.lazyderef (hd W5186) V5169) (let W5190 (freeze (let W5191 (shen.lazyderef (tl W5186) V5169) (let W5192 (lambda Z5193 (W5187 Z5193)) (if (cons? W5191) (let W5194 (hd W5191) (let W5195 (shen.lazyderef (tl W5191) V5169) (let W5196 (freeze (W5192 W5194)) (if (= W5195 ()) (thaw W5196) (if (shen.pvar? W5195) (shen.bind! W5195 () V5169 W5196) false))))) (if (shen.pvar? W5191) (let W5197 (shen.newpv V5169) (shen.gc V5169 (shen.bind! W5191 (cons W5197 ()) V5169 (freeze (W5192 W5197))))) false))))) (if (= W5189 list) (thaw W5190) (if (shen.pvar? W5189) (shen.bind! W5189 list V5169 W5190) false)))) (if (shen.pvar? W5186) (let W5198 (shen.newpv V5169) (shen.gc V5169 (shen.bind! W5186 (cons list (cons W5198 ())) V5169 (freeze (W5187 W5198))))) false)))) false)) false) W5182)) W5179)) W5176)) W5173))) +(defun shen.rdecons (V4748) (cond ((and (cons? V4748) (and (= cons (hd V4748)) (and (cons? (tl V4748)) (and (cons? (tl (tl V4748))) (= () (tl (tl (tl V4748)))))))) (cons (shen.rdecons (hd (tl V4748))) (shen.rdecons (hd (tl (tl V4748)))))) ((cons? V4748) (cons (shen.rdecons (hd V4748)) (shen.rdecons (tl V4748)))) (true V4748))) -(defun shen.by-hypothesis (V5199 V5200 V5201 V5202 V5203 V5204 V5205) (let W5206 (if (shen.unlocked? V5203) (let W5207 (shen.lazyderef V5201 V5202) (if (cons? W5207) (let W5208 (shen.lazyderef (hd W5207) V5202) (if (cons? W5208) (let W5209 (hd W5208) (let W5210 (shen.lazyderef (tl W5208) V5202) (if (cons? W5210) (let W5211 (hd W5210) (let W5212 (shen.lazyderef (tl W5210) V5202) (if (cons? W5212) (let W5213 (hd W5212) (let W5214 (shen.lazyderef (tl W5212) V5202) (if (= W5214 ()) (do (shen.incinfs) (when (= (shen.deref W5211 V5202) (intern ":")) V5202 V5203 V5204 (freeze (when (= (shen.deref V5199 V5202) (shen.deref W5209 V5202)) V5202 V5203 V5204 (freeze (is! V5200 W5213 V5202 V5203 V5204 V5205)))))) false))) false))) false))) false)) false)) false) (if (= W5206 false) (if (shen.unlocked? V5203) (let W5215 (shen.lazyderef V5201 V5202) (if (cons? W5215) (let W5216 (tl W5215) (do (shen.incinfs) (shen.by-hypothesis V5199 V5200 W5216 V5202 V5203 V5204 V5205))) false)) false) W5206))) +(defun shen.primitive (V4749 V4750 V4751 V4752 V4753 V4754) (let W4755 (if (shen.unlocked? V4752) (let W4756 (shen.lazyderef V4750 V4751) (let W4757 (freeze (do (shen.incinfs) (when (number? (shen.lazyderef V4749 V4751)) V4751 V4752 V4753 V4754))) (if (= W4756 number) (thaw W4757) (if (shen.pvar? W4756) (shen.bind! W4756 number V4751 W4757) false)))) false) (if (= W4755 false) (let W4758 (if (shen.unlocked? V4752) (let W4759 (shen.lazyderef V4750 V4751) (let W4760 (freeze (do (shen.incinfs) (when (boolean? (shen.lazyderef V4749 V4751)) V4751 V4752 V4753 V4754))) (if (= W4759 boolean) (thaw W4760) (if (shen.pvar? W4759) (shen.bind! W4759 boolean V4751 W4760) false)))) false) (if (= W4758 false) (let W4761 (if (shen.unlocked? V4752) (let W4762 (shen.lazyderef V4750 V4751) (let W4763 (freeze (do (shen.incinfs) (when (string? (shen.lazyderef V4749 V4751)) V4751 V4752 V4753 V4754))) (if (= W4762 string) (thaw W4763) (if (shen.pvar? W4762) (shen.bind! W4762 string V4751 W4763) false)))) false) (if (= W4761 false) (let W4764 (if (shen.unlocked? V4752) (let W4765 (shen.lazyderef V4750 V4751) (let W4766 (freeze (do (shen.incinfs) (when (symbol? (shen.lazyderef V4749 V4751)) V4751 V4752 V4753 V4754))) (if (= W4765 symbol) (thaw W4766) (if (shen.pvar? W4765) (shen.bind! W4765 symbol V4751 W4766) false)))) false) (if (= W4764 false) (if (shen.unlocked? V4752) (let W4767 (shen.lazyderef V4749 V4751) (if (= W4767 ()) (let W4768 (shen.lazyderef V4750 V4751) (let W4769 (lambda Z4770 (do (shen.incinfs) (thaw V4754))) (if (cons? W4768) (let W4771 (shen.lazyderef (hd W4768) V4751) (let W4772 (freeze (let W4773 (shen.lazyderef (tl W4768) V4751) (let W4774 (lambda Z4775 (W4769 Z4775)) (if (cons? W4773) (let W4776 (hd W4773) (let W4777 (shen.lazyderef (tl W4773) V4751) (let W4778 (freeze (W4774 W4776)) (if (= W4777 ()) (thaw W4778) (if (shen.pvar? W4777) (shen.bind! W4777 () V4751 W4778) false))))) (if (shen.pvar? W4773) (let W4779 (shen.newpv V4751) (shen.gc V4751 (shen.bind! W4773 (cons W4779 ()) V4751 (freeze (W4774 W4779))))) false))))) (if (= W4771 list) (thaw W4772) (if (shen.pvar? W4771) (shen.bind! W4771 list V4751 W4772) false)))) (if (shen.pvar? W4768) (let W4780 (shen.newpv V4751) (shen.gc V4751 (shen.bind! W4768 (cons list (cons W4780 ())) V4751 (freeze (W4769 W4780))))) false)))) false)) false) W4764)) W4761)) W4758)) W4755))) -(defun shen.lookupsig (V5217 V5218 V5219 V5220 V5221 V5222) (if (shen.unlocked? V5220) (do (shen.incinfs) (shen.sigf (assoc V5217 (value shen.*sigf*)) V5218 V5219 V5220 V5221 V5222)) false)) +(defun shen.by-hypothesis (V4781 V4782 V4783 V4784 V4785 V4786 V4787) (let W4788 (if (shen.unlocked? V4785) (let W4789 (shen.lazyderef V4783 V4784) (if (cons? W4789) (let W4790 (shen.lazyderef (hd W4789) V4784) (if (cons? W4790) (let W4791 (hd W4790) (let W4792 (shen.lazyderef (tl W4790) V4784) (if (cons? W4792) (let W4793 (hd W4792) (let W4794 (shen.lazyderef (tl W4792) V4784) (if (cons? W4794) (let W4795 (hd W4794) (let W4796 (shen.lazyderef (tl W4794) V4784) (if (= W4796 ()) (do (shen.incinfs) (when (= (shen.deref W4793 V4784) (intern ":")) V4784 V4785 V4786 (freeze (when (= (shen.deref V4781 V4784) (shen.deref W4791 V4784)) V4784 V4785 V4786 (freeze (is! V4782 W4795 V4784 V4785 V4786 V4787)))))) false))) false))) false))) false)) false)) false) (if (= W4788 false) (if (shen.unlocked? V4785) (let W4797 (shen.lazyderef V4783 V4784) (if (cons? W4797) (let W4798 (tl W4797) (do (shen.incinfs) (shen.by-hypothesis V4781 V4782 W4798 V4784 V4785 V4786 V4787))) false)) false) W4788))) -(defun shen.sigf (V5237 V5238 V5239 V5240 V5241 V5242) (cond ((cons? V5237) ((((((tl V5237) V5238) V5239) V5240) V5241) V5242)) (true false))) +(defun shen.lookupsig (V4799 V4800 V4801 V4802 V4803 V4804) (if (shen.unlocked? V4802) (do (shen.incinfs) (shen.sigf (assoc V4799 (value shen.*sigf*)) V4800 V4801 V4802 V4803 V4804)) false)) -(defun shen.freshterm (V5243) (let W5244 (absvector 3) (let W5245 (address-> W5244 0 shen.print-freshterm) (let W5246 (address-> W5245 1 V5243) (let W5247 (address-> W5246 2 (set shen.*gensym* (+ 1 (value shen.*gensym*)))) W5247))))) +(defun shen.sigf (V4819 V4820 V4821 V4822 V4823 V4824) (cond ((cons? V4819) ((((((tl V4819) V4820) V4821) V4822) V4823) V4824)) (true false))) -(defun shen.print-freshterm (V5248) (cn "&&" (str (<-address V5248 1)))) +(defun shen.freshterm (V4825) (let W4826 (absvector 3) (let W4827 (address-> W4826 0 shen.print-freshterm) (let W4828 (address-> W4827 1 V4825) (let W4829 (address-> W4828 2 (set shen.*gensym* (+ 1 (value shen.*gensym*)))) W4829))))) -(defun shen.search-user-datatypes (V5249 V5250 V5251 V5252 V5253 V5254 V5255) (let W5256 (if (shen.unlocked? V5253) (let W5257 (shen.lazyderef V5251 V5252) (if (cons? W5257) (let W5258 (shen.lazyderef (hd W5257) V5252) (if (cons? W5258) (let W5259 (tl W5258) (do (shen.incinfs) (call (((shen.deref W5259 V5252) (shen.deref V5249 V5252)) (shen.deref V5250 V5252)) V5252 V5253 V5254 V5255))) false)) false)) false) (if (= W5256 false) (if (shen.unlocked? V5253) (let W5260 (shen.lazyderef V5251 V5252) (if (cons? W5260) (let W5261 (tl W5260) (do (shen.incinfs) (shen.search-user-datatypes V5249 V5250 W5261 V5252 V5253 V5254 V5255))) false)) false) W5256))) +(defun shen.print-freshterm (V4830) (cn "&&" (shen.app (<-address V4830 1) "" shen.a))) -(defun shen.l-rules (V5262 V5263 V5264 V5265 V5266 V5267 V5268) (let W5269 (+ V5267 1) (let W5270 (if (shen.unlocked? V5266) (let W5271 (shen.lazyderef V5262 V5265) (if (= W5271 ()) (let W5272 (shen.lazyderef V5264 V5265) (if (= W5272 true) (do (shen.incinfs) (shen.cut V5265 V5266 W5269 (freeze (bind V5263 () V5265 V5266 W5269 V5268)))) false)) false)) false) (if (= W5270 false) (let W5273 (if (shen.unlocked? V5266) (let W5274 (shen.lazyderef V5262 V5265) (if (cons? W5274) (let W5275 (shen.lazyderef (hd W5274) V5265) (if (cons? W5275) (let W5276 (shen.lazyderef (hd W5275) V5265) (if (cons? W5276) (let W5277 (shen.lazyderef (hd W5276) V5265) (if (= W5277 cons) (let W5278 (shen.lazyderef (tl W5276) V5265) (if (cons? W5278) (let W5279 (hd W5278) (let W5280 (shen.lazyderef (tl W5278) V5265) (if (cons? W5280) (let W5281 (hd W5280) (let W5282 (shen.lazyderef (tl W5280) V5265) (if (= W5282 ()) (let W5283 (shen.lazyderef (tl W5275) V5265) (if (cons? W5283) (let W5284 (hd W5283) (let W5285 (shen.lazyderef (tl W5283) V5265) (if (cons? W5285) (let W5286 (shen.lazyderef (hd W5285) V5265) (if (cons? W5286) (let W5287 (shen.lazyderef (hd W5286) V5265) (if (= W5287 list) (let W5288 (shen.lazyderef (tl W5286) V5265) (if (cons? W5288) (let W5289 (hd W5288) (let W5290 (shen.lazyderef (tl W5288) V5265) (if (= W5290 ()) (let W5291 (shen.lazyderef (tl W5285) V5265) (if (= W5291 ()) (let W5292 (tl W5274) (do (shen.incinfs) (when (= (shen.deref W5284 V5265) (intern ":")) V5265 V5266 W5269 (freeze (shen.cut V5265 V5266 W5269 (freeze (shen.l-rules (cons (cons W5279 (cons W5284 (cons W5289 ()))) (cons (cons W5281 (cons W5284 (cons (cons list (cons W5289 ())) ()))) W5292)) V5263 true V5265 V5266 W5269 V5268))))))) false)) false))) false)) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W5273 false) (let W5293 (if (shen.unlocked? V5266) (let W5294 (shen.lazyderef V5262 V5265) (if (cons? W5294) (let W5295 (shen.lazyderef (hd W5294) V5265) (if (cons? W5295) (let W5296 (shen.lazyderef (hd W5295) V5265) (if (cons? W5296) (let W5297 (shen.lazyderef (hd W5296) V5265) (if (= W5297 @p) (let W5298 (shen.lazyderef (tl W5296) V5265) (if (cons? W5298) (let W5299 (hd W5298) (let W5300 (shen.lazyderef (tl W5298) V5265) (if (cons? W5300) (let W5301 (hd W5300) (let W5302 (shen.lazyderef (tl W5300) V5265) (if (= W5302 ()) (let W5303 (shen.lazyderef (tl W5295) V5265) (if (cons? W5303) (let W5304 (hd W5303) (let W5305 (shen.lazyderef (tl W5303) V5265) (if (cons? W5305) (let W5306 (shen.lazyderef (hd W5305) V5265) (if (cons? W5306) (let W5307 (hd W5306) (let W5308 (shen.lazyderef (tl W5306) V5265) (if (cons? W5308) (let W5309 (shen.lazyderef (hd W5308) V5265) (if (= W5309 *) (let W5310 (shen.lazyderef (tl W5308) V5265) (if (cons? W5310) (let W5311 (hd W5310) (let W5312 (shen.lazyderef (tl W5310) V5265) (if (= W5312 ()) (let W5313 (shen.lazyderef (tl W5305) V5265) (if (= W5313 ()) (let W5314 (tl W5294) (do (shen.incinfs) (when (= (shen.deref W5304 V5265) (intern ":")) V5265 V5266 W5269 (freeze (shen.cut V5265 V5266 W5269 (freeze (shen.l-rules (cons (cons W5299 (cons W5304 (cons W5307 ()))) (cons (cons W5301 (cons W5304 (cons W5311 ()))) W5314)) V5263 true V5265 V5266 W5269 V5268))))))) false)) false))) false)) false)) false))) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W5293 false) (let W5315 (if (shen.unlocked? V5266) (let W5316 (shen.lazyderef V5262 V5265) (if (cons? W5316) (let W5317 (shen.lazyderef (hd W5316) V5265) (if (cons? W5317) (let W5318 (shen.lazyderef (hd W5317) V5265) (if (cons? W5318) (let W5319 (shen.lazyderef (hd W5318) V5265) (if (= W5319 @s) (let W5320 (shen.lazyderef (tl W5318) V5265) (if (cons? W5320) (let W5321 (hd W5320) (let W5322 (shen.lazyderef (tl W5320) V5265) (if (cons? W5322) (let W5323 (hd W5322) (let W5324 (shen.lazyderef (tl W5322) V5265) (if (= W5324 ()) (let W5325 (shen.lazyderef (tl W5317) V5265) (if (cons? W5325) (let W5326 (hd W5325) (let W5327 (shen.lazyderef (tl W5325) V5265) (if (cons? W5327) (let W5328 (shen.lazyderef (hd W5327) V5265) (if (= W5328 string) (let W5329 (shen.lazyderef (tl W5327) V5265) (if (= W5329 ()) (let W5330 (tl W5316) (do (shen.incinfs) (when (= (shen.deref W5326 V5265) (intern ":")) V5265 V5266 W5269 (freeze (shen.cut V5265 V5266 W5269 (freeze (shen.l-rules (cons (cons W5321 (cons W5326 (cons string ()))) (cons (cons W5323 (cons W5326 (cons string ()))) W5330)) V5263 true V5265 V5266 W5269 V5268))))))) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W5315 false) (let W5331 (if (shen.unlocked? V5266) (let W5332 (shen.lazyderef V5262 V5265) (if (cons? W5332) (let W5333 (shen.lazyderef (hd W5332) V5265) (if (cons? W5333) (let W5334 (shen.lazyderef (hd W5333) V5265) (if (cons? W5334) (let W5335 (shen.lazyderef (hd W5334) V5265) (if (= W5335 @v) (let W5336 (shen.lazyderef (tl W5334) V5265) (if (cons? W5336) (let W5337 (hd W5336) (let W5338 (shen.lazyderef (tl W5336) V5265) (if (cons? W5338) (let W5339 (hd W5338) (let W5340 (shen.lazyderef (tl W5338) V5265) (if (= W5340 ()) (let W5341 (shen.lazyderef (tl W5333) V5265) (if (cons? W5341) (let W5342 (hd W5341) (let W5343 (shen.lazyderef (tl W5341) V5265) (if (cons? W5343) (let W5344 (shen.lazyderef (hd W5343) V5265) (if (cons? W5344) (let W5345 (shen.lazyderef (hd W5344) V5265) (if (= W5345 vector) (let W5346 (shen.lazyderef (tl W5344) V5265) (if (cons? W5346) (let W5347 (hd W5346) (let W5348 (shen.lazyderef (tl W5346) V5265) (if (= W5348 ()) (let W5349 (shen.lazyderef (tl W5343) V5265) (if (= W5349 ()) (let W5350 (tl W5332) (do (shen.incinfs) (when (= (shen.deref W5342 V5265) (intern ":")) V5265 V5266 W5269 (freeze (shen.cut V5265 V5266 W5269 (freeze (shen.l-rules (cons (cons W5337 (cons W5342 (cons W5347 ()))) (cons (cons W5339 (cons W5342 (cons (cons vector (cons W5347 ())) ()))) W5350)) V5263 true V5265 V5266 W5269 V5268))))))) false)) false))) false)) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W5331 false) (let W5351 (if (shen.unlocked? V5266) (let W5352 (shen.lazyderef V5262 V5265) (if (cons? W5352) (let W5353 (hd W5352) (let W5354 (tl W5352) (let W5355 (shen.lazyderef V5263 V5265) (let W5356 (lambda Z5357 (lambda Z5358 (do (shen.incinfs) (bind Z5357 W5353 V5265 V5266 W5269 (freeze (shen.l-rules W5354 Z5358 V5264 V5265 V5266 W5269 V5268)))))) (if (cons? W5355) (let W5359 (hd W5355) (let W5360 (tl W5355) ((W5356 W5359) W5360))) (if (shen.pvar? W5355) (let W5361 (shen.newpv V5265) (shen.gc V5265 (let W5362 (shen.newpv V5265) (shen.gc V5265 (shen.bind! W5355 (cons W5361 W5362) V5265 (freeze ((W5356 W5361) W5362))))))) false)))))) false)) false) (if (= W5351 false) (shen.unlock V5266 W5269) W5351)) W5331)) W5315)) W5293)) W5273)) W5270)))) +(defun shen.search-user-datatypes (V4831 V4832 V4833 V4834 V4835 V4836 V4837) (let W4838 (if (shen.unlocked? V4835) (let W4839 (shen.lazyderef V4833 V4834) (if (cons? W4839) (let W4840 (shen.lazyderef (hd W4839) V4834) (if (cons? W4840) (let W4841 (tl W4840) (do (shen.incinfs) (call (((shen.deref W4841 V4834) (shen.deref V4831 V4834)) (shen.deref V4832 V4834)) V4834 V4835 V4836 V4837))) false)) false)) false) (if (= W4838 false) (if (shen.unlocked? V4835) (let W4842 (shen.lazyderef V4833 V4834) (if (cons? W4842) (let W4843 (tl W4842) (do (shen.incinfs) (shen.search-user-datatypes V4831 V4832 W4843 V4834 V4835 V4836 V4837))) false)) false) W4838))) -(defun shen.t* (V5363 V5364 V5365 V5366 V5367 V5368) (let W5369 (+ V5367 1) (let W5370 (if (shen.unlocked? V5366) (let W5371 (shen.lazyderef V5363 V5365) (if (cons? W5371) (let W5372 (shen.lazyderef (hd W5371) V5365) (if (= W5372 define) (let W5373 (shen.lazyderef (tl W5371) V5365) (if (cons? W5373) (let W5374 (hd W5373) (let W5375 (tl W5373) (let W5376 (shen.newpv V5365) (shen.gc V5365 (let W5377 (shen.newpv V5365) (shen.gc V5365 (let W5378 (shen.newpv V5365) (shen.gc V5365 (let W5379 (shen.newpv V5365) (shen.gc V5365 (do (shen.incinfs) (shen.cut V5365 V5366 W5369 (freeze (bind W5376 (shen.sigxrules (cons W5374 W5375)) V5365 V5366 W5369 (freeze (bind W5379 (fst (shen.lazyderef W5376 V5365)) V5365 V5366 W5369 (freeze (bind W5377 (snd (shen.lazyderef W5376 V5365)) V5365 V5366 W5369 (freeze (bind W5378 (shen.freshen-sig (shen.deref W5379 V5365)) V5365 V5366 W5369 (freeze (shen.t*-rules W5374 W5377 W5378 1 V5365 V5366 W5369 (freeze (is W5379 V5364 V5365 V5366 W5369 V5368)))))))))))))))))))))))) false)) false)) false)) false) (if (= W5370 false) (shen.unlock V5366 W5369) W5370)))) +(defun shen.l-rules (V4844 V4845 V4846 V4847 V4848 V4849 V4850) (let W4851 (+ V4849 1) (let W4852 (if (shen.unlocked? V4848) (let W4853 (shen.lazyderef V4844 V4847) (if (= W4853 ()) (let W4854 (shen.lazyderef V4846 V4847) (if (= W4854 true) (do (shen.incinfs) (shen.cut V4847 V4848 W4851 (freeze (bind V4845 () V4847 V4848 W4851 V4850)))) false)) false)) false) (if (= W4852 false) (let W4855 (if (shen.unlocked? V4848) (let W4856 (shen.lazyderef V4844 V4847) (if (cons? W4856) (let W4857 (shen.lazyderef (hd W4856) V4847) (if (cons? W4857) (let W4858 (shen.lazyderef (hd W4857) V4847) (if (cons? W4858) (let W4859 (shen.lazyderef (hd W4858) V4847) (if (= W4859 cons) (let W4860 (shen.lazyderef (tl W4858) V4847) (if (cons? W4860) (let W4861 (hd W4860) (let W4862 (shen.lazyderef (tl W4860) V4847) (if (cons? W4862) (let W4863 (hd W4862) (let W4864 (shen.lazyderef (tl W4862) V4847) (if (= W4864 ()) (let W4865 (shen.lazyderef (tl W4857) V4847) (if (cons? W4865) (let W4866 (hd W4865) (let W4867 (shen.lazyderef (tl W4865) V4847) (if (cons? W4867) (let W4868 (shen.lazyderef (hd W4867) V4847) (if (cons? W4868) (let W4869 (shen.lazyderef (hd W4868) V4847) (if (= W4869 list) (let W4870 (shen.lazyderef (tl W4868) V4847) (if (cons? W4870) (let W4871 (hd W4870) (let W4872 (shen.lazyderef (tl W4870) V4847) (if (= W4872 ()) (let W4873 (shen.lazyderef (tl W4867) V4847) (if (= W4873 ()) (let W4874 (tl W4856) (do (shen.incinfs) (when (= (shen.deref W4866 V4847) (intern ":")) V4847 V4848 W4851 (freeze (shen.cut V4847 V4848 W4851 (freeze (shen.l-rules (cons (cons W4861 (cons W4866 (cons W4871 ()))) (cons (cons W4863 (cons W4866 (cons (cons list (cons W4871 ())) ()))) W4874)) V4845 true V4847 V4848 W4851 V4850))))))) false)) false))) false)) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W4855 false) (let W4875 (if (shen.unlocked? V4848) (let W4876 (shen.lazyderef V4844 V4847) (if (cons? W4876) (let W4877 (shen.lazyderef (hd W4876) V4847) (if (cons? W4877) (let W4878 (shen.lazyderef (hd W4877) V4847) (if (cons? W4878) (let W4879 (shen.lazyderef (hd W4878) V4847) (if (= W4879 @p) (let W4880 (shen.lazyderef (tl W4878) V4847) (if (cons? W4880) (let W4881 (hd W4880) (let W4882 (shen.lazyderef (tl W4880) V4847) (if (cons? W4882) (let W4883 (hd W4882) (let W4884 (shen.lazyderef (tl W4882) V4847) (if (= W4884 ()) (let W4885 (shen.lazyderef (tl W4877) V4847) (if (cons? W4885) (let W4886 (hd W4885) (let W4887 (shen.lazyderef (tl W4885) V4847) (if (cons? W4887) (let W4888 (shen.lazyderef (hd W4887) V4847) (if (cons? W4888) (let W4889 (hd W4888) (let W4890 (shen.lazyderef (tl W4888) V4847) (if (cons? W4890) (let W4891 (shen.lazyderef (hd W4890) V4847) (if (= W4891 *) (let W4892 (shen.lazyderef (tl W4890) V4847) (if (cons? W4892) (let W4893 (hd W4892) (let W4894 (shen.lazyderef (tl W4892) V4847) (if (= W4894 ()) (let W4895 (shen.lazyderef (tl W4887) V4847) (if (= W4895 ()) (let W4896 (tl W4876) (do (shen.incinfs) (when (= (shen.deref W4886 V4847) (intern ":")) V4847 V4848 W4851 (freeze (shen.cut V4847 V4848 W4851 (freeze (shen.l-rules (cons (cons W4881 (cons W4886 (cons W4889 ()))) (cons (cons W4883 (cons W4886 (cons W4893 ()))) W4896)) V4845 true V4847 V4848 W4851 V4850))))))) false)) false))) false)) false)) false))) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W4875 false) (let W4897 (if (shen.unlocked? V4848) (let W4898 (shen.lazyderef V4844 V4847) (if (cons? W4898) (let W4899 (shen.lazyderef (hd W4898) V4847) (if (cons? W4899) (let W4900 (shen.lazyderef (hd W4899) V4847) (if (cons? W4900) (let W4901 (shen.lazyderef (hd W4900) V4847) (if (= W4901 @s) (let W4902 (shen.lazyderef (tl W4900) V4847) (if (cons? W4902) (let W4903 (hd W4902) (let W4904 (shen.lazyderef (tl W4902) V4847) (if (cons? W4904) (let W4905 (hd W4904) (let W4906 (shen.lazyderef (tl W4904) V4847) (if (= W4906 ()) (let W4907 (shen.lazyderef (tl W4899) V4847) (if (cons? W4907) (let W4908 (hd W4907) (let W4909 (shen.lazyderef (tl W4907) V4847) (if (cons? W4909) (let W4910 (shen.lazyderef (hd W4909) V4847) (if (= W4910 string) (let W4911 (shen.lazyderef (tl W4909) V4847) (if (= W4911 ()) (let W4912 (tl W4898) (do (shen.incinfs) (when (= (shen.deref W4908 V4847) (intern ":")) V4847 V4848 W4851 (freeze (shen.cut V4847 V4848 W4851 (freeze (shen.l-rules (cons (cons W4903 (cons W4908 (cons string ()))) (cons (cons W4905 (cons W4908 (cons string ()))) W4912)) V4845 true V4847 V4848 W4851 V4850))))))) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W4897 false) (let W4913 (if (shen.unlocked? V4848) (let W4914 (shen.lazyderef V4844 V4847) (if (cons? W4914) (let W4915 (shen.lazyderef (hd W4914) V4847) (if (cons? W4915) (let W4916 (shen.lazyderef (hd W4915) V4847) (if (cons? W4916) (let W4917 (shen.lazyderef (hd W4916) V4847) (if (= W4917 @v) (let W4918 (shen.lazyderef (tl W4916) V4847) (if (cons? W4918) (let W4919 (hd W4918) (let W4920 (shen.lazyderef (tl W4918) V4847) (if (cons? W4920) (let W4921 (hd W4920) (let W4922 (shen.lazyderef (tl W4920) V4847) (if (= W4922 ()) (let W4923 (shen.lazyderef (tl W4915) V4847) (if (cons? W4923) (let W4924 (hd W4923) (let W4925 (shen.lazyderef (tl W4923) V4847) (if (cons? W4925) (let W4926 (shen.lazyderef (hd W4925) V4847) (if (cons? W4926) (let W4927 (shen.lazyderef (hd W4926) V4847) (if (= W4927 vector) (let W4928 (shen.lazyderef (tl W4926) V4847) (if (cons? W4928) (let W4929 (hd W4928) (let W4930 (shen.lazyderef (tl W4928) V4847) (if (= W4930 ()) (let W4931 (shen.lazyderef (tl W4925) V4847) (if (= W4931 ()) (let W4932 (tl W4914) (do (shen.incinfs) (when (= (shen.deref W4924 V4847) (intern ":")) V4847 V4848 W4851 (freeze (shen.cut V4847 V4848 W4851 (freeze (shen.l-rules (cons (cons W4919 (cons W4924 (cons W4929 ()))) (cons (cons W4921 (cons W4924 (cons (cons vector (cons W4929 ())) ()))) W4932)) V4845 true V4847 V4848 W4851 V4850))))))) false)) false))) false)) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W4913 false) (let W4933 (if (shen.unlocked? V4848) (let W4934 (shen.lazyderef V4844 V4847) (if (cons? W4934) (let W4935 (hd W4934) (let W4936 (tl W4934) (let W4937 (shen.lazyderef V4845 V4847) (let W4938 (lambda Z4939 (lambda Z4940 (do (shen.incinfs) (bind Z4939 W4935 V4847 V4848 W4851 (freeze (shen.l-rules W4936 Z4940 V4846 V4847 V4848 W4851 V4850)))))) (if (cons? W4937) (let W4941 (hd W4937) (let W4942 (tl W4937) ((W4938 W4941) W4942))) (if (shen.pvar? W4937) (let W4943 (shen.newpv V4847) (shen.gc V4847 (let W4944 (shen.newpv V4847) (shen.gc V4847 (shen.bind! W4937 (cons W4943 W4944) V4847 (freeze ((W4938 W4943) W4944))))))) false)))))) false)) false) (if (= W4933 false) (shen.unlock V4848 W4851) W4933)) W4913)) W4897)) W4875)) W4855)) W4852)))) -(defun shen.sigxrules (V5380) (compile (lambda Z5381 (shen. Z5381)) V5380)) +(defun shen.t* (V4945 V4946 V4947 V4948 V4949 V4950) (let W4951 (+ V4949 1) (let W4952 (if (shen.unlocked? V4948) (let W4953 (shen.lazyderef V4945 V4947) (if (cons? W4953) (let W4954 (shen.lazyderef (hd W4953) V4947) (if (= W4954 define) (let W4955 (shen.lazyderef (tl W4953) V4947) (if (cons? W4955) (let W4956 (hd W4955) (let W4957 (tl W4955) (let W4958 (shen.newpv V4947) (shen.gc V4947 (let W4959 (shen.newpv V4947) (shen.gc V4947 (let W4960 (shen.newpv V4947) (shen.gc V4947 (let W4961 (shen.newpv V4947) (shen.gc V4947 (do (shen.incinfs) (shen.cut V4947 V4948 W4951 (freeze (bind W4958 (shen.sigxrules (cons W4956 W4957)) V4947 V4948 W4951 (freeze (bind W4961 (fst (shen.lazyderef W4958 V4947)) V4947 V4948 W4951 (freeze (bind W4959 (snd (shen.lazyderef W4958 V4947)) V4947 V4948 W4951 (freeze (bind W4960 (shen.freshen-sig (shen.deref W4961 V4947)) V4947 V4948 W4951 (freeze (shen.t*-rules W4956 W4959 W4960 1 V4947 V4948 W4951 (freeze (is W4961 V4946 V4947 V4948 W4951 V4950)))))))))))))))))))))))) false)) false)) false)) false) (if (= W4952 false) (shen.unlock V4948 W4951) W4952)))) -(defun shen. (V5382) (let W5383 (if (cons? V5382) (let W5384 (tail V5382) (if (shen.hds=? W5384 {) (let W5385 (tail W5384) (let W5386 (shen. W5385) (if (shen.parse-failure? W5386) (shen.parse-failure) (let W5387 (shen.<-out W5386) (let W5388 (shen.in-> W5386) (if (shen.hds=? W5388 }) (let W5389 (tail W5388) (let W5390 (shen. W5389) (if (shen.parse-failure? W5390) (shen.parse-failure) (let W5391 (shen.<-out W5390) (let W5392 (shen.in-> W5390) (shen.comb W5392 (let W5393 (shen.rectify-type W5387) (@p W5393 W5391)))))))) (shen.parse-failure))))))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W5383) (shen.parse-failure) W5383))) +(defun shen.sigxrules (V4962) (compile (lambda Z4963 (shen. Z4963)) V4962)) -(defun shen.freshen-sig (V5394) (let W5395 (shen.extract-vars V5394) (let W5396 (map (lambda Z5397 (cons Z5397 (shen.freshterm (concat & Z5397)))) W5395) (shen.freshen-type W5396 V5394)))) +(defun shen. (V4964) (let W4965 (if (cons? V4964) (let W4966 (tail V4964) (if (shen.hds=? W4966 {) (let W4967 (tail W4966) (let W4968 (shen. W4967) (if (shen.parse-failure? W4968) (shen.parse-failure) (let W4969 (shen.<-out W4968) (let W4970 (shen.in-> W4968) (if (shen.hds=? W4970 }) (let W4971 (tail W4970) (let W4972 (shen. W4971) (if (shen.parse-failure? W4972) (shen.parse-failure) (let W4973 (shen.<-out W4972) (let W4974 (shen.in-> W4972) (shen.comb W4974 (let W4975 (shen.rectify-type W4969) (@p W4975 W4973)))))))) (shen.parse-failure))))))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W4965) (shen.parse-failure) W4965))) -(defun shen.freshen-type (V5398 V5399) (cond ((= () V5398) V5399) ((and (cons? V5398) (cons? (hd V5398))) (shen.freshen-type (tl V5398) (subst (tl (hd V5398)) (hd (hd V5398)) V5399))) (true (shen.f-error shen.freshen-type)))) +(defun shen.freshen-sig (V4976) (let W4977 (shen.extract-vars V4976) (let W4978 (map (lambda Z4979 (cons Z4979 (shen.freshterm (concat & Z4979)))) W4977) (shen.freshen-type W4978 V4976)))) -(defun shen. (V5400) (let W5401 (let W5402 (shen. V5400) (if (shen.parse-failure? W5402) (shen.parse-failure) (let W5403 (shen.<-out W5402) (let W5404 (shen.in-> W5402) (let W5405 (shen. W5404) (if (shen.parse-failure? W5405) (shen.parse-failure) (let W5406 (shen.<-out W5405) (let W5407 (shen.in-> W5405) (shen.comb W5407 (cons W5403 W5406)))))))))) (if (shen.parse-failure? W5401) (let W5408 (let W5409 (shen. V5400) (if (shen.parse-failure? W5409) (shen.parse-failure) (let W5410 (shen.<-out W5409) (let W5411 (shen.in-> W5409) (shen.comb W5411 (cons W5410 ())))))) (if (shen.parse-failure? W5408) (shen.parse-failure) W5408)) W5401))) +(defun shen.freshen-type (V4980 V4981) (cond ((= () V4980) V4981) ((and (cons? V4980) (cons? (hd V4980))) (shen.freshen-type (tl V4980) (subst (tl (hd V4980)) (hd (hd V4980)) V4981))) (true (simple-error "partial function shen.freshen-type")))) -(defun shen. (V5412) (let W5413 (let W5414 (shen. V5412) (if (shen.parse-failure? W5414) (shen.parse-failure) (let W5415 (shen.<-out W5414) (let W5416 (shen.in-> W5414) (if (shen.hds=? W5416 ->) (let W5417 (tail W5416) (if (cons? W5417) (let W5418 (head W5417) (let W5419 (tail W5417) (if (shen.hds=? W5419 where) (let W5420 (tail W5419) (if (cons? W5420) (let W5421 (head W5420) (let W5422 (tail W5420) (shen.comb W5422 (@p W5415 (cons where (cons W5421 (cons W5418 ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5413) (let W5423 (let W5424 (shen. V5412) (if (shen.parse-failure? W5424) (shen.parse-failure) (let W5425 (shen.<-out W5424) (let W5426 (shen.in-> W5424) (if (shen.hds=? W5426 <-) (let W5427 (tail W5426) (if (cons? W5427) (let W5428 (head W5427) (let W5429 (tail W5427) (if (shen.hds=? W5429 where) (let W5430 (tail W5429) (if (cons? W5430) (let W5431 (head W5430) (let W5432 (tail W5430) (shen.comb W5432 (@p W5425 (shen.correct (cons where (cons W5431 (cons W5428 ())))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5423) (let W5433 (let W5434 (shen. V5412) (if (shen.parse-failure? W5434) (shen.parse-failure) (let W5435 (shen.<-out W5434) (let W5436 (shen.in-> W5434) (if (shen.hds=? W5436 <-) (let W5437 (tail W5436) (if (cons? W5437) (let W5438 (head W5437) (let W5439 (tail W5437) (shen.comb W5439 (@p W5435 (shen.correct W5438))))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5433) (let W5440 (let W5441 (shen. V5412) (if (shen.parse-failure? W5441) (shen.parse-failure) (let W5442 (shen.<-out W5441) (let W5443 (shen.in-> W5441) (if (shen.hds=? W5443 ->) (let W5444 (tail W5443) (if (cons? W5444) (let W5445 (head W5444) (let W5446 (tail W5444) (shen.comb W5446 (@p W5442 W5445)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5440) (shen.parse-failure) W5440)) W5433)) W5423)) W5413))) +(defun shen. (V4982) (let W4983 (let W4984 (shen. V4982) (if (shen.parse-failure? W4984) (shen.parse-failure) (let W4985 (shen.<-out W4984) (let W4986 (shen.in-> W4984) (let W4987 (shen. W4986) (if (shen.parse-failure? W4987) (shen.parse-failure) (let W4988 (shen.<-out W4987) (let W4989 (shen.in-> W4987) (shen.comb W4989 (cons W4985 W4988)))))))))) (if (shen.parse-failure? W4983) (let W4990 (let W4991 (shen. V4982) (if (shen.parse-failure? W4991) (shen.parse-failure) (let W4992 (shen.<-out W4991) (let W4993 (shen.in-> W4991) (shen.comb W4993 (cons W4992 ())))))) (if (shen.parse-failure? W4990) (shen.parse-failure) W4990)) W4983))) -(defun shen.correct (V5447) (cond ((and (cons? V5447) (and (= where (hd V5447)) (and (cons? (tl V5447)) (and (cons? (tl (tl V5447))) (and (cons? (hd (tl (tl V5447)))) (and (= fail-if (hd (hd (tl (tl V5447))))) (and (cons? (tl (hd (tl (tl V5447))))) (and (cons? (tl (tl (hd (tl (tl V5447)))))) (and (= () (tl (tl (tl (hd (tl (tl V5447))))))) (= () (tl (tl (tl V5447))))))))))))) (cons where (cons (cons and (cons (hd (tl V5447)) (cons (cons not (cons (tl (hd (tl (tl V5447)))) ())) ()))) (tl (tl (hd (tl (tl V5447)))))))) ((and (cons? V5447) (and (= where (hd V5447)) (and (cons? (tl V5447)) (and (cons? (tl (tl V5447))) (= () (tl (tl (tl V5447)))))))) (cons where (cons (cons and (cons (hd (tl V5447)) (cons (cons not (cons (cons = (cons (hd (tl (tl V5447))) (cons (cons fail ()) ()))) ())) ()))) (tl (tl V5447))))) ((and (cons? V5447) (and (= fail-if (hd V5447)) (and (cons? (tl V5447)) (and (cons? (tl (tl V5447))) (= () (tl (tl (tl V5447)))))))) (cons where (cons (cons not (cons (tl V5447) ())) (tl (tl V5447))))) (true (cons where (cons (cons not (cons (cons = (cons V5447 (cons (cons fail ()) ()))) ())) (cons V5447 ())))))) +(defun shen. (V4994) (let W4995 (let W4996 (shen. V4994) (if (shen.parse-failure? W4996) (shen.parse-failure) (let W4997 (shen.<-out W4996) (let W4998 (shen.in-> W4996) (if (shen.hds=? W4998 ->) (let W4999 (tail W4998) (if (cons? W4999) (let W5000 (head W4999) (let W5001 (tail W4999) (if (shen.hds=? W5001 where) (let W5002 (tail W5001) (if (cons? W5002) (let W5003 (head W5002) (let W5004 (tail W5002) (shen.comb W5004 (@p W4997 (cons where (cons W5003 (cons W5000 ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W4995) (let W5005 (let W5006 (shen. V4994) (if (shen.parse-failure? W5006) (shen.parse-failure) (let W5007 (shen.<-out W5006) (let W5008 (shen.in-> W5006) (if (shen.hds=? W5008 <-) (let W5009 (tail W5008) (if (cons? W5009) (let W5010 (head W5009) (let W5011 (tail W5009) (if (shen.hds=? W5011 where) (let W5012 (tail W5011) (if (cons? W5012) (let W5013 (head W5012) (let W5014 (tail W5012) (shen.comb W5014 (@p W5007 (shen.correct (cons where (cons W5013 (cons W5010 ())))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5005) (let W5015 (let W5016 (shen. V4994) (if (shen.parse-failure? W5016) (shen.parse-failure) (let W5017 (shen.<-out W5016) (let W5018 (shen.in-> W5016) (if (shen.hds=? W5018 <-) (let W5019 (tail W5018) (if (cons? W5019) (let W5020 (head W5019) (let W5021 (tail W5019) (shen.comb W5021 (@p W5017 (shen.correct W5020))))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5015) (let W5022 (let W5023 (shen. V4994) (if (shen.parse-failure? W5023) (shen.parse-failure) (let W5024 (shen.<-out W5023) (let W5025 (shen.in-> W5023) (if (shen.hds=? W5025 ->) (let W5026 (tail W5025) (if (cons? W5026) (let W5027 (head W5026) (let W5028 (tail W5026) (shen.comb W5028 (@p W5024 W5027)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5022) (shen.parse-failure) W5022)) W5015)) W5005)) W4995))) -(defun shen.t*-rules (V5448 V5449 V5450 V5451 V5452 V5453 V5454 V5455) (let W5456 (+ V5454 1) (let W5457 (if (shen.unlocked? V5453) (let W5458 (shen.lazyderef V5449 V5452) (if (= W5458 ()) (do (shen.incinfs) (thaw V5455)) false)) false) (if (= W5457 false) (let W5459 (if (shen.unlocked? V5453) (let W5460 (shen.lazyderef V5449 V5452) (if (cons? W5460) (let W5461 (hd W5460) (let W5462 (tl W5460) (let W5463 (shen.newpv V5452) (shen.gc V5452 (do (shen.incinfs) (bind W5463 (shen.freshen-rule (shen.deref W5461 V5452)) V5452 V5453 W5456 (freeze (shen.t*-rule V5448 V5451 (fst (shen.lazyderef W5463 V5452)) (snd (shen.lazyderef W5463 V5452)) V5450 V5452 V5453 W5456 (freeze (shen.cut V5452 V5453 W5456 (freeze (shen.t*-rules V5448 W5462 V5450 (+ V5451 1) V5452 V5453 W5456 V5455)))))))))))) false)) false) (if (= W5459 false) (shen.unlock V5453 W5456) W5459)) W5457)))) +(defun shen.correct (V5029) (cond ((and (cons? V5029) (and (= where (hd V5029)) (and (cons? (tl V5029)) (and (cons? (tl (tl V5029))) (and (cons? (hd (tl (tl V5029)))) (and (= fail-if (hd (hd (tl (tl V5029))))) (and (cons? (tl (hd (tl (tl V5029))))) (and (cons? (tl (tl (hd (tl (tl V5029)))))) (and (= () (tl (tl (tl (hd (tl (tl V5029))))))) (= () (tl (tl (tl V5029))))))))))))) (cons where (cons (cons and (cons (hd (tl V5029)) (cons (cons not (cons (tl (hd (tl (tl V5029)))) ())) ()))) (tl (tl (hd (tl (tl V5029)))))))) ((and (cons? V5029) (and (= where (hd V5029)) (and (cons? (tl V5029)) (and (cons? (tl (tl V5029))) (= () (tl (tl (tl V5029)))))))) (cons where (cons (cons and (cons (hd (tl V5029)) (cons (cons not (cons (cons == (cons (hd (tl (tl V5029))) (cons (cons fail ()) ()))) ())) ()))) (tl (tl V5029))))) ((and (cons? V5029) (and (= fail-if (hd V5029)) (and (cons? (tl V5029)) (and (cons? (tl (tl V5029))) (= () (tl (tl (tl V5029)))))))) (cons where (cons (cons not (cons (tl V5029) ())) (tl (tl V5029))))) (true (cons where (cons (cons not (cons (cons == (cons V5029 (cons (cons fail ()) ()))) ())) (cons V5029 ())))))) -(defun shen.freshen-rule (V5464) (cond ((tuple? V5464) (let W5465 (shen.extract-vars (fst V5464)) (let W5466 (map (lambda Z5467 (cons Z5467 (shen.freshterm Z5467))) W5465) (@p (shen.freshen W5466 (fst V5464)) (shen.freshen W5466 (snd V5464)))))) (true (shen.f-error shen.freshen-rule)))) +(defun shen.t*-rules (V5030 V5031 V5032 V5033 V5034 V5035 V5036 V5037) (let W5038 (+ V5036 1) (let W5039 (if (shen.unlocked? V5035) (let W5040 (shen.lazyderef V5031 V5034) (if (= W5040 ()) (do (shen.incinfs) (thaw V5037)) false)) false) (if (= W5039 false) (let W5041 (if (shen.unlocked? V5035) (let W5042 (shen.lazyderef V5031 V5034) (if (cons? W5042) (let W5043 (hd W5042) (let W5044 (tl W5042) (let W5045 (shen.newpv V5034) (shen.gc V5034 (do (shen.incinfs) (bind W5045 (shen.freshen-rule (shen.deref W5043 V5034)) V5034 V5035 W5038 (freeze (shen.t*-rule V5030 V5033 (fst (shen.lazyderef W5045 V5034)) (snd (shen.lazyderef W5045 V5034)) V5032 V5034 V5035 W5038 (freeze (shen.cut V5034 V5035 W5038 (freeze (shen.t*-rules V5030 W5044 V5032 (+ V5033 1) V5034 V5035 W5038 V5037)))))))))))) false)) false) (if (= W5041 false) (shen.unlock V5035 W5038) W5041)) W5039)))) -(defun shen.freshen (V5468 V5469) (cond ((= () V5468) V5469) ((and (cons? V5468) (cons? (hd V5468))) (shen.freshen (tl V5468) (shen.beta (hd (hd V5468)) (tl (hd V5468)) V5469))) (true (shen.f-error shen.freshen)))) +(defun shen.freshen-rule (V5046) (cond ((tuple? V5046) (let W5047 (shen.extract-vars (fst V5046)) (let W5048 (map (lambda Z5049 (cons Z5049 (shen.freshterm Z5049))) W5047) (@p (shen.freshen W5048 (fst V5046)) (shen.freshen W5048 (snd V5046)))))) (true (simple-error "partial function shen.freshen-rule")))) -(defun shen.t*-rule (V5470 V5471 V5472 V5473 V5474 V5475 V5476 V5477 V5478) (let W5479 (if (shen.unlocked? V5476) (do (shen.incinfs) (shen.t*-rule-h V5472 V5473 V5474 V5475 V5476 V5477 V5478)) false) (if (= W5479 false) (if (shen.unlocked? V5476) (let W5480 (shen.newpv V5475) (shen.gc V5475 (do (shen.incinfs) (bind W5480 (simple-error (cn "type error in rule " (shen.app V5471 (cn " of " (shen.app V5470 " -" shen.a)) shen.a))) V5475 V5476 V5477 V5478)))) false) W5479))) +(defun shen.freshen (V5050 V5051) (cond ((= () V5050) V5051) ((and (cons? V5050) (cons? (hd V5050))) (shen.freshen (tl V5050) (shen.beta (hd (hd V5050)) (tl (hd V5050)) V5051))) (true (simple-error "partial function shen.freshen")))) -(defun shen.t*-rule-h (V5481 V5482 V5483 V5484 V5485 V5486 V5487) (let W5488 (+ V5486 1) (let W5489 (if (shen.unlocked? V5485) (let W5490 (shen.lazyderef V5481 V5484) (if (= W5490 ()) (let W5491 (shen.lazyderef V5483 V5484) (if (cons? W5491) (let W5492 (shen.lazyderef (hd W5491) V5484) (if (= W5492 -->) (let W5493 (shen.lazyderef (tl W5491) V5484) (if (cons? W5493) (let W5494 (hd W5493) (let W5495 (shen.lazyderef (tl W5493) V5484) (if (= W5495 ()) (do (shen.incinfs) (shen.cut V5484 V5485 W5488 (freeze (shen.t*-correct V5482 W5494 () V5484 V5485 W5488 V5487)))) false))) false)) false)) false)) false)) false) (if (= W5489 false) (let W5496 (if (shen.unlocked? V5485) (let W5497 (shen.newpv V5484) (shen.gc V5484 (let W5498 (shen.newpv V5484) (shen.gc V5484 (let W5499 (shen.newpv V5484) (shen.gc V5484 (do (shen.incinfs) (shen.p-hyps (shen.freshterms V5481) W5497 V5484 V5485 W5488 (freeze (shen.t*-integrity V5481 V5483 W5497 W5498 V5484 V5485 W5488 (freeze (shen.cut V5484 V5485 W5488 (freeze (shen.myassume V5481 V5483 W5499 V5484 V5485 W5488 (freeze (shen.t*-correct V5482 W5498 W5499 V5484 V5485 W5488 V5487)))))))))))))))) false) (if (= W5496 false) (shen.unlock V5485 W5488) W5496)) W5489)))) +(defun shen.t*-rule (V5052 V5053 V5054 V5055 V5056 V5057 V5058 V5059 V5060) (let W5061 (if (shen.unlocked? V5058) (do (shen.incinfs) (shen.t*-rule-h V5054 V5055 V5056 V5057 V5058 V5059 V5060)) false) (if (= W5061 false) (if (shen.unlocked? V5058) (let W5062 (shen.newpv V5057) (shen.gc V5057 (do (shen.incinfs) (bind W5062 (simple-error (cn "type error in rule " (shen.app V5053 (cn " of " (shen.app V5052 " +" shen.a)) shen.a))) V5057 V5058 V5059 V5060)))) false) W5061))) -(defun shen.myassume (V5500 V5501 V5502 V5503 V5504 V5505 V5506) (let W5507 (if (shen.unlocked? V5504) (let W5508 (shen.lazyderef V5500 V5503) (if (= W5508 ()) (let W5509 (shen.lazyderef V5502 V5503) (let W5510 (freeze (do (shen.incinfs) (thaw V5506))) (if (= W5509 ()) (thaw W5510) (if (shen.pvar? W5509) (shen.bind! W5509 () V5503 W5510) false)))) false)) false) (if (= W5507 false) (if (shen.unlocked? V5504) (let W5511 (shen.lazyderef V5500 V5503) (if (cons? W5511) (let W5512 (hd W5511) (let W5513 (tl W5511) (let W5514 (shen.lazyderef V5501 V5503) (if (cons? W5514) (let W5515 (hd W5514) (let W5516 (shen.lazyderef (tl W5514) V5503) (if (cons? W5516) (let W5517 (shen.lazyderef (hd W5516) V5503) (if (= W5517 -->) (let W5518 (shen.lazyderef (tl W5516) V5503) (if (cons? W5518) (let W5519 (hd W5518) (let W5520 (shen.lazyderef (tl W5518) V5503) (if (= W5520 ()) (let W5521 (shen.lazyderef V5502 V5503) (let W5522 (lambda Z5523 (lambda Z5524 (lambda Z5525 (lambda Z5526 (do (shen.incinfs) (is! W5515 Z5525 V5503 V5504 V5505 (freeze (is! W5512 Z5523 V5503 V5504 V5505 (freeze (bind Z5524 (intern ":") V5503 V5504 V5505 (freeze (shen.myassume W5513 W5519 Z5526 V5503 V5504 V5505 V5506)))))))))))) (if (cons? W5521) (let W5527 (shen.lazyderef (hd W5521) V5503) (let W5528 (lambda Z5529 (lambda Z5530 (lambda Z5531 (let W5532 (tl W5521) ((((W5522 Z5529) Z5530) Z5531) W5532))))) (if (cons? W5527) (let W5533 (hd W5527) (let W5534 (shen.lazyderef (tl W5527) V5503) (let W5535 (lambda Z5536 (lambda Z5537 (((W5528 W5533) Z5536) Z5537))) (if (cons? W5534) (let W5538 (hd W5534) (let W5539 (shen.lazyderef (tl W5534) V5503) (let W5540 (lambda Z5541 ((W5535 W5538) Z5541)) (if (cons? W5539) (let W5542 (hd W5539) (let W5543 (shen.lazyderef (tl W5539) V5503) (let W5544 (freeze (W5540 W5542)) (if (= W5543 ()) (thaw W5544) (if (shen.pvar? W5543) (shen.bind! W5543 () V5503 W5544) false))))) (if (shen.pvar? W5539) (let W5545 (shen.newpv V5503) (shen.gc V5503 (shen.bind! W5539 (cons W5545 ()) V5503 (freeze (W5540 W5545))))) false))))) (if (shen.pvar? W5534) (let W5546 (shen.newpv V5503) (shen.gc V5503 (let W5547 (shen.newpv V5503) (shen.gc V5503 (shen.bind! W5534 (cons W5546 (cons W5547 ())) V5503 (freeze ((W5535 W5546) W5547))))))) false))))) (if (shen.pvar? W5527) (let W5548 (shen.newpv V5503) (shen.gc V5503 (let W5549 (shen.newpv V5503) (shen.gc V5503 (let W5550 (shen.newpv V5503) (shen.gc V5503 (shen.bind! W5527 (cons W5548 (cons W5549 (cons W5550 ()))) V5503 (freeze (((W5528 W5548) W5549) W5550))))))))) false)))) (if (shen.pvar? W5521) (let W5551 (shen.newpv V5503) (shen.gc V5503 (let W5552 (shen.newpv V5503) (shen.gc V5503 (let W5553 (shen.newpv V5503) (shen.gc V5503 (let W5554 (shen.newpv V5503) (shen.gc V5503 (shen.bind! W5521 (cons (cons W5551 (cons W5552 (cons W5553 ()))) W5554) V5503 (freeze ((((W5522 W5551) W5552) W5553) W5554))))))))))) false)))) false))) false)) false)) false))) false)))) false)) false) W5507))) +(defun shen.t*-rule-h (V5063 V5064 V5065 V5066 V5067 V5068 V5069) (let W5070 (+ V5068 1) (let W5071 (if (shen.unlocked? V5067) (let W5072 (shen.lazyderef V5063 V5066) (if (= W5072 ()) (let W5073 (shen.lazyderef V5065 V5066) (if (cons? W5073) (let W5074 (shen.lazyderef (hd W5073) V5066) (if (= W5074 -->) (let W5075 (shen.lazyderef (tl W5073) V5066) (if (cons? W5075) (let W5076 (hd W5075) (let W5077 (shen.lazyderef (tl W5075) V5066) (if (= W5077 ()) (do (shen.incinfs) (shen.cut V5066 V5067 W5070 (freeze (shen.t*-correct V5064 W5076 () V5066 V5067 W5070 V5069)))) false))) false)) false)) false)) false)) false) (if (= W5071 false) (let W5078 (if (shen.unlocked? V5067) (let W5079 (shen.newpv V5066) (shen.gc V5066 (let W5080 (shen.newpv V5066) (shen.gc V5066 (let W5081 (shen.newpv V5066) (shen.gc V5066 (do (shen.incinfs) (shen.p-hyps (shen.freshterms V5063) W5079 V5066 V5067 W5070 (freeze (shen.t*-integrity V5063 V5065 W5079 W5080 V5066 V5067 W5070 (freeze (shen.cut V5066 V5067 W5070 (freeze (shen.myassume V5063 V5065 W5081 V5066 V5067 W5070 (freeze (shen.t*-correct V5064 W5080 W5081 V5066 V5067 W5070 V5069)))))))))))))))) false) (if (= W5078 false) (shen.unlock V5067 W5070) W5078)) W5071)))) -(defun shen.freshterms (V5557) (cond ((= () V5557) ()) ((and (cons? V5557) (cons? (hd V5557))) (shen.freshterms (append (hd V5557) (tl V5557)))) ((and (cons? V5557) (shen.freshterm? (hd V5557))) (adjoin (hd V5557) (shen.freshterms (tl V5557)))) ((cons? V5557) (shen.freshterms (tl V5557))) (true (shen.f-error shen.freshterms)))) +(defun shen.myassume (V5082 V5083 V5084 V5085 V5086 V5087 V5088) (let W5089 (if (shen.unlocked? V5086) (let W5090 (shen.lazyderef V5082 V5085) (if (= W5090 ()) (let W5091 (shen.lazyderef V5084 V5085) (let W5092 (freeze (do (shen.incinfs) (thaw V5088))) (if (= W5091 ()) (thaw W5092) (if (shen.pvar? W5091) (shen.bind! W5091 () V5085 W5092) false)))) false)) false) (if (= W5089 false) (if (shen.unlocked? V5086) (let W5093 (shen.lazyderef V5082 V5085) (if (cons? W5093) (let W5094 (hd W5093) (let W5095 (tl W5093) (let W5096 (shen.lazyderef V5083 V5085) (if (cons? W5096) (let W5097 (hd W5096) (let W5098 (shen.lazyderef (tl W5096) V5085) (if (cons? W5098) (let W5099 (shen.lazyderef (hd W5098) V5085) (if (= W5099 -->) (let W5100 (shen.lazyderef (tl W5098) V5085) (if (cons? W5100) (let W5101 (hd W5100) (let W5102 (shen.lazyderef (tl W5100) V5085) (if (= W5102 ()) (let W5103 (shen.lazyderef V5084 V5085) (let W5104 (lambda Z5105 (lambda Z5106 (lambda Z5107 (lambda Z5108 (do (shen.incinfs) (is! W5097 Z5107 V5085 V5086 V5087 (freeze (is! W5094 Z5105 V5085 V5086 V5087 (freeze (bind Z5106 (intern ":") V5085 V5086 V5087 (freeze (shen.myassume W5095 W5101 Z5108 V5085 V5086 V5087 V5088)))))))))))) (if (cons? W5103) (let W5109 (shen.lazyderef (hd W5103) V5085) (let W5110 (lambda Z5111 (lambda Z5112 (lambda Z5113 (let W5114 (tl W5103) ((((W5104 Z5111) Z5112) Z5113) W5114))))) (if (cons? W5109) (let W5115 (hd W5109) (let W5116 (shen.lazyderef (tl W5109) V5085) (let W5117 (lambda Z5118 (lambda Z5119 (((W5110 W5115) Z5118) Z5119))) (if (cons? W5116) (let W5120 (hd W5116) (let W5121 (shen.lazyderef (tl W5116) V5085) (let W5122 (lambda Z5123 ((W5117 W5120) Z5123)) (if (cons? W5121) (let W5124 (hd W5121) (let W5125 (shen.lazyderef (tl W5121) V5085) (let W5126 (freeze (W5122 W5124)) (if (= W5125 ()) (thaw W5126) (if (shen.pvar? W5125) (shen.bind! W5125 () V5085 W5126) false))))) (if (shen.pvar? W5121) (let W5127 (shen.newpv V5085) (shen.gc V5085 (shen.bind! W5121 (cons W5127 ()) V5085 (freeze (W5122 W5127))))) false))))) (if (shen.pvar? W5116) (let W5128 (shen.newpv V5085) (shen.gc V5085 (let W5129 (shen.newpv V5085) (shen.gc V5085 (shen.bind! W5116 (cons W5128 (cons W5129 ())) V5085 (freeze ((W5117 W5128) W5129))))))) false))))) (if (shen.pvar? W5109) (let W5130 (shen.newpv V5085) (shen.gc V5085 (let W5131 (shen.newpv V5085) (shen.gc V5085 (let W5132 (shen.newpv V5085) (shen.gc V5085 (shen.bind! W5109 (cons W5130 (cons W5131 (cons W5132 ()))) V5085 (freeze (((W5110 W5130) W5131) W5132))))))))) false)))) (if (shen.pvar? W5103) (let W5133 (shen.newpv V5085) (shen.gc V5085 (let W5134 (shen.newpv V5085) (shen.gc V5085 (let W5135 (shen.newpv V5085) (shen.gc V5085 (let W5136 (shen.newpv V5085) (shen.gc V5085 (shen.bind! W5103 (cons (cons W5133 (cons W5134 (cons W5135 ()))) W5136) V5085 (freeze ((((W5104 W5133) W5134) W5135) W5136))))))))))) false)))) false))) false)) false)) false))) false)))) false)) false) W5089))) -(defun shen.p-hyps (V5558 V5559 V5560 V5561 V5562 V5563) (let W5564 (if (shen.unlocked? V5561) (let W5565 (shen.lazyderef V5558 V5560) (if (= W5565 ()) (let W5566 (shen.lazyderef V5559 V5560) (let W5567 (freeze (do (shen.incinfs) (thaw V5563))) (if (= W5566 ()) (thaw W5567) (if (shen.pvar? W5566) (shen.bind! W5566 () V5560 W5567) false)))) false)) false) (if (= W5564 false) (if (shen.unlocked? V5561) (let W5568 (shen.lazyderef V5558 V5560) (if (cons? W5568) (let W5569 (hd W5568) (let W5570 (tl W5568) (let W5571 (shen.lazyderef V5559 V5560) (let W5572 (lambda Z5573 (lambda Z5574 (lambda Z5575 (lambda Z5576 (do (shen.incinfs) (bind Z5573 W5569 V5560 V5561 V5562 (freeze (bind Z5574 (intern ":") V5560 V5561 V5562 (freeze (shen.p-hyps W5570 Z5576 V5560 V5561 V5562 V5563)))))))))) (if (cons? W5571) (let W5577 (shen.lazyderef (hd W5571) V5560) (let W5578 (lambda Z5579 (lambda Z5580 (lambda Z5581 (let W5582 (tl W5571) ((((W5572 Z5579) Z5580) Z5581) W5582))))) (if (cons? W5577) (let W5583 (hd W5577) (let W5584 (shen.lazyderef (tl W5577) V5560) (let W5585 (lambda Z5586 (lambda Z5587 (((W5578 W5583) Z5586) Z5587))) (if (cons? W5584) (let W5588 (hd W5584) (let W5589 (shen.lazyderef (tl W5584) V5560) (let W5590 (lambda Z5591 ((W5585 W5588) Z5591)) (if (cons? W5589) (let W5592 (hd W5589) (let W5593 (shen.lazyderef (tl W5589) V5560) (let W5594 (freeze (W5590 W5592)) (if (= W5593 ()) (thaw W5594) (if (shen.pvar? W5593) (shen.bind! W5593 () V5560 W5594) false))))) (if (shen.pvar? W5589) (let W5595 (shen.newpv V5560) (shen.gc V5560 (shen.bind! W5589 (cons W5595 ()) V5560 (freeze (W5590 W5595))))) false))))) (if (shen.pvar? W5584) (let W5596 (shen.newpv V5560) (shen.gc V5560 (let W5597 (shen.newpv V5560) (shen.gc V5560 (shen.bind! W5584 (cons W5596 (cons W5597 ())) V5560 (freeze ((W5585 W5596) W5597))))))) false))))) (if (shen.pvar? W5577) (let W5598 (shen.newpv V5560) (shen.gc V5560 (let W5599 (shen.newpv V5560) (shen.gc V5560 (let W5600 (shen.newpv V5560) (shen.gc V5560 (shen.bind! W5577 (cons W5598 (cons W5599 (cons W5600 ()))) V5560 (freeze (((W5578 W5598) W5599) W5600))))))))) false)))) (if (shen.pvar? W5571) (let W5601 (shen.newpv V5560) (shen.gc V5560 (let W5602 (shen.newpv V5560) (shen.gc V5560 (let W5603 (shen.newpv V5560) (shen.gc V5560 (let W5604 (shen.newpv V5560) (shen.gc V5560 (shen.bind! W5571 (cons (cons W5601 (cons W5602 (cons W5603 ()))) W5604) V5560 (freeze ((((W5572 W5601) W5602) W5603) W5604))))))))))) false)))))) false)) false) W5564))) +(defun shen.freshterms (V5139) (cond ((= () V5139) ()) ((and (cons? V5139) (cons? (hd V5139))) (shen.freshterms (append (hd V5139) (tl V5139)))) ((and (cons? V5139) (shen.freshterm? (hd V5139))) (adjoin (hd V5139) (shen.freshterms (tl V5139)))) ((cons? V5139) (shen.freshterms (tl V5139))) (true (simple-error "partial function shen.freshterms")))) -(defun shen.t*-correct (V5605 V5606 V5607 V5608 V5609 V5610 V5611) (let W5612 (+ V5610 1) (let W5613 (if (shen.unlocked? V5609) (let W5614 (shen.lazyderef V5605 V5608) (if (cons? W5614) (let W5615 (shen.lazyderef (hd W5614) V5608) (if (= W5615 where) (let W5616 (shen.lazyderef (tl W5614) V5608) (if (cons? W5616) (let W5617 (hd W5616) (let W5618 (shen.lazyderef (tl W5616) V5608) (if (cons? W5618) (let W5619 (hd W5618) (let W5620 (shen.lazyderef (tl W5618) V5608) (if (= W5620 ()) (let W5621 (shen.newpv V5608) (shen.gc V5608 (do (shen.incinfs) (shen.cut V5608 V5609 W5612 (freeze (bind W5621 (shen.curry W5617) V5608 V5609 W5612 (freeze (shen.system-S-h W5621 boolean V5607 V5608 V5609 W5612 (freeze (shen.cut V5608 V5609 W5612 (freeze (shen.t*-correct W5619 V5606 (cons (cons W5621 (cons (intern ":") (cons verified ()))) V5607) V5608 V5609 W5612 V5611)))))))))))) false))) false))) false)) false)) false)) false) (if (= W5613 false) (let W5622 (if (shen.unlocked? V5609) (do (shen.incinfs) (shen.system-S-h (shen.curry V5605) V5606 V5607 V5608 V5609 W5612 V5611)) false) (if (= W5622 false) (shen.unlock V5609 W5612) W5622)) W5613)))) +(defun shen.p-hyps (V5140 V5141 V5142 V5143 V5144 V5145) (let W5146 (if (shen.unlocked? V5143) (let W5147 (shen.lazyderef V5140 V5142) (if (= W5147 ()) (let W5148 (shen.lazyderef V5141 V5142) (let W5149 (freeze (do (shen.incinfs) (thaw V5145))) (if (= W5148 ()) (thaw W5149) (if (shen.pvar? W5148) (shen.bind! W5148 () V5142 W5149) false)))) false)) false) (if (= W5146 false) (if (shen.unlocked? V5143) (let W5150 (shen.lazyderef V5140 V5142) (if (cons? W5150) (let W5151 (hd W5150) (let W5152 (tl W5150) (let W5153 (shen.lazyderef V5141 V5142) (let W5154 (lambda Z5155 (lambda Z5156 (lambda Z5157 (lambda Z5158 (do (shen.incinfs) (bind Z5155 W5151 V5142 V5143 V5144 (freeze (bind Z5156 (intern ":") V5142 V5143 V5144 (freeze (shen.p-hyps W5152 Z5158 V5142 V5143 V5144 V5145)))))))))) (if (cons? W5153) (let W5159 (shen.lazyderef (hd W5153) V5142) (let W5160 (lambda Z5161 (lambda Z5162 (lambda Z5163 (let W5164 (tl W5153) ((((W5154 Z5161) Z5162) Z5163) W5164))))) (if (cons? W5159) (let W5165 (hd W5159) (let W5166 (shen.lazyderef (tl W5159) V5142) (let W5167 (lambda Z5168 (lambda Z5169 (((W5160 W5165) Z5168) Z5169))) (if (cons? W5166) (let W5170 (hd W5166) (let W5171 (shen.lazyderef (tl W5166) V5142) (let W5172 (lambda Z5173 ((W5167 W5170) Z5173)) (if (cons? W5171) (let W5174 (hd W5171) (let W5175 (shen.lazyderef (tl W5171) V5142) (let W5176 (freeze (W5172 W5174)) (if (= W5175 ()) (thaw W5176) (if (shen.pvar? W5175) (shen.bind! W5175 () V5142 W5176) false))))) (if (shen.pvar? W5171) (let W5177 (shen.newpv V5142) (shen.gc V5142 (shen.bind! W5171 (cons W5177 ()) V5142 (freeze (W5172 W5177))))) false))))) (if (shen.pvar? W5166) (let W5178 (shen.newpv V5142) (shen.gc V5142 (let W5179 (shen.newpv V5142) (shen.gc V5142 (shen.bind! W5166 (cons W5178 (cons W5179 ())) V5142 (freeze ((W5167 W5178) W5179))))))) false))))) (if (shen.pvar? W5159) (let W5180 (shen.newpv V5142) (shen.gc V5142 (let W5181 (shen.newpv V5142) (shen.gc V5142 (let W5182 (shen.newpv V5142) (shen.gc V5142 (shen.bind! W5159 (cons W5180 (cons W5181 (cons W5182 ()))) V5142 (freeze (((W5160 W5180) W5181) W5182))))))))) false)))) (if (shen.pvar? W5153) (let W5183 (shen.newpv V5142) (shen.gc V5142 (let W5184 (shen.newpv V5142) (shen.gc V5142 (let W5185 (shen.newpv V5142) (shen.gc V5142 (let W5186 (shen.newpv V5142) (shen.gc V5142 (shen.bind! W5153 (cons (cons W5183 (cons W5184 (cons W5185 ()))) W5186) V5142 (freeze ((((W5154 W5183) W5184) W5185) W5186))))))))))) false)))))) false)) false) W5146))) -(defun shen.t*-integrity (V5623 V5624 V5625 V5626 V5627 V5628 V5629 V5630) (let W5631 (if (shen.unlocked? V5628) (let W5632 (shen.lazyderef V5623 V5627) (if (= W5632 ()) (do (shen.incinfs) (is! V5624 V5626 V5627 V5628 V5629 V5630)) false)) false) (if (= W5631 false) (if (shen.unlocked? V5628) (let W5633 (shen.lazyderef V5623 V5627) (if (cons? W5633) (let W5634 (hd W5633) (let W5635 (tl W5633) (let W5636 (shen.lazyderef V5624 V5627) (if (cons? W5636) (let W5637 (hd W5636) (let W5638 (shen.lazyderef (tl W5636) V5627) (if (cons? W5638) (let W5639 (shen.lazyderef (hd W5638) V5627) (if (= W5639 -->) (let W5640 (shen.lazyderef (tl W5638) V5627) (if (cons? W5640) (let W5641 (hd W5640) (let W5642 (shen.lazyderef (tl W5640) V5627) (if (= W5642 ()) (do (shen.incinfs) (shen.system-S-h W5634 W5637 V5625 V5627 V5628 V5629 (freeze (shen.t*-integrity W5635 W5641 V5625 V5626 V5627 V5628 V5629 V5630)))) false))) false)) false)) false))) false)))) false)) false) W5631))) +(defun shen.t*-correct (V5187 V5188 V5189 V5190 V5191 V5192 V5193) (let W5194 (+ V5192 1) (let W5195 (if (shen.unlocked? V5191) (let W5196 (shen.lazyderef V5187 V5190) (if (cons? W5196) (let W5197 (shen.lazyderef (hd W5196) V5190) (if (= W5197 where) (let W5198 (shen.lazyderef (tl W5196) V5190) (if (cons? W5198) (let W5199 (hd W5198) (let W5200 (shen.lazyderef (tl W5198) V5190) (if (cons? W5200) (let W5201 (hd W5200) (let W5202 (shen.lazyderef (tl W5200) V5190) (if (= W5202 ()) (let W5203 (shen.newpv V5190) (shen.gc V5190 (do (shen.incinfs) (shen.cut V5190 V5191 W5194 (freeze (bind W5203 (shen.curry W5199) V5190 V5191 W5194 (freeze (shen.system-S-h W5203 boolean V5189 V5190 V5191 W5194 (freeze (shen.cut V5190 V5191 W5194 (freeze (shen.t*-correct W5201 V5188 (cons (cons W5203 (cons (intern ":") (cons verified ()))) V5189) V5190 V5191 W5194 V5193)))))))))))) false))) false))) false)) false)) false)) false) (if (= W5195 false) (let W5204 (if (shen.unlocked? V5191) (do (shen.incinfs) (shen.system-S-h (shen.curry V5187) V5188 V5189 V5190 V5191 W5194 V5193)) false) (if (= W5204 false) (shen.unlock V5191 W5194) W5204)) W5195)))) -(defun shen.freshterm? (V5643) (and (absvector? V5643) (and (not (string? V5643)) (= (<-address V5643 0) shen.print-freshterm)))) +(defun shen.t*-integrity (V5205 V5206 V5207 V5208 V5209 V5210 V5211 V5212) (let W5213 (if (shen.unlocked? V5210) (let W5214 (shen.lazyderef V5205 V5209) (if (= W5214 ()) (do (shen.incinfs) (is! V5206 V5208 V5209 V5210 V5211 V5212)) false)) false) (if (= W5213 false) (if (shen.unlocked? V5210) (let W5215 (shen.lazyderef V5205 V5209) (if (cons? W5215) (let W5216 (hd W5215) (let W5217 (tl W5215) (let W5218 (shen.lazyderef V5206 V5209) (if (cons? W5218) (let W5219 (hd W5218) (let W5220 (shen.lazyderef (tl W5218) V5209) (if (cons? W5220) (let W5221 (shen.lazyderef (hd W5220) V5209) (if (= W5221 -->) (let W5222 (shen.lazyderef (tl W5220) V5209) (if (cons? W5222) (let W5223 (hd W5222) (let W5224 (shen.lazyderef (tl W5222) V5209) (if (= W5224 ()) (do (shen.incinfs) (shen.system-S-h W5216 W5219 V5207 V5209 V5210 V5211 (freeze (shen.t*-integrity W5217 W5223 V5207 V5208 V5209 V5210 V5211 V5212)))) false))) false)) false)) false))) false)))) false)) false) W5213))) + +(defun shen.freshterm? (V5225) (and (absvector? V5225) (and (not (string? V5225)) (= (<-address V5225 0) shen.print-freshterm)))) diff --git a/klambda/toplevel.kl b/klambda/toplevel.kl index f22863a..4730661 100644 --- a/klambda/toplevel.kl +++ b/klambda/toplevel.kl @@ -1,8 +1,6 @@ -(defun shen.repl () (do (shen.credits) (shen.loop))) +(defun shen.shen () (do (shen.credits) (shen.loop))) -(defun shen.loop () (do (shen.initialise_environment) (do (shen.prompt) (do (trap-error (shen.read-evaluate-print) (lambda Z5667 (shen.toplevel-display-exception Z5667))) (shen.loop))))) - -(defun shen.toplevel-display-exception (V5668) (do (pr (error-to-string V5668) (stoutput)) (nl 0))) +(defun shen.loop () (do (shen.initialise_environment) (do (shen.prompt) (do (trap-error (shen.read-evaluate-print) (lambda Z5248 (do (pr (error-to-string Z5248) (stoutput)) (nl 0)))) (shen.loop))))) (defun shen.credits () (do (pr " Shen, www.shenlanguage.org, copyright (C) 2010-2024, Mark Tarver @@ -17,32 +15,32 @@ Shen, www.shenlanguage.org, copyright (C) 2010-2024, Mark Tarver (" (shen.app (length (value shen.*history*)) "+) " shen.a)) (stoutput)) (pr (cn " (" (shen.app (length (value shen.*history*)) "-) " shen.a)) (stoutput)))) -(defun shen.read-evaluate-print () (let W5669 (value shen.*package*) (let W5670 (shen.package-user-input W5669 (lineread (stinput))) (let W5671 (shen.update-history) (shen.evaluate-lineread W5670 W5671 (value shen.*tc*)))))) +(defun shen.read-evaluate-print () (let W5249 (value shen.*package*) (let W5250 (shen.package-user-input W5249 (lineread (stinput))) (let W5251 (shen.update-history) (shen.evaluate-lineread W5250 W5251 (value shen.*tc*)))))) -(defun shen.package-user-input (V5672 V5673) (cond ((= null V5672) V5673) (true (let W5674 (str V5672) (let W5675 (external V5672) (map (lambda Z5676 (shen.pui-h W5674 W5675 Z5676)) V5673)))))) +(defun shen.package-user-input (V5252 V5253) (cond ((= null V5252) V5253) (true (let W5254 (str V5252) (let W5255 (external V5252) (map (lambda Z5256 (shen.pui-h W5254 W5255 Z5256)) V5253)))))) -(defun shen.pui-h (V5681 V5682 V5683) (cond ((and (cons? V5683) (and (= fn (hd V5683)) (and (cons? (tl V5683)) (= () (tl (tl V5683)))))) (if (shen.internal? (hd (tl V5683)) V5681 V5682) (cons fn (cons (shen.intern-in-package V5681 (hd (tl V5683))) ())) V5683)) ((cons? V5683) (if (shen.internal? (hd V5683) V5681 V5682) (cons (shen.intern-in-package V5681 (hd V5683)) (map (lambda Z5684 (shen.pui-h V5681 V5682 Z5684)) (tl V5683))) (if (cons? (hd V5683)) (map (lambda Z5685 (shen.pui-h V5681 V5682 Z5685)) V5683) (cons (hd V5683) (map (lambda Z5686 (shen.pui-h V5681 V5682 Z5686)) (tl V5683)))))) (true V5683))) +(defun shen.pui-h (V5261 V5262 V5263) (cond ((and (cons? V5263) (and (= fn (hd V5263)) (and (cons? (tl V5263)) (= () (tl (tl V5263)))))) (if (shen.internal? (hd (tl V5263)) V5261 V5262) (cons fn (cons (shen.intern-in-package V5261 (hd (tl V5263))) ())) V5263)) ((cons? V5263) (if (shen.internal? (hd V5263) V5261 V5262) (cons (shen.intern-in-package V5261 (hd V5263)) (map (lambda Z5264 (shen.pui-h V5261 V5262 Z5264)) (tl V5263))) (if (cons? (hd V5263)) (map (lambda Z5265 (shen.pui-h V5261 V5262 Z5265)) V5263) (cons (hd V5263) (map (lambda Z5266 (shen.pui-h V5261 V5262 Z5266)) (tl V5263)))))) (true V5263))) (defun shen.update-history () (set shen.*history* (cons (shen.trim-it (it)) (value shen.*history*)))) -(defun shen.trim-it (V5687) (cond ((and (shen.+string? V5687) (shen.whitespace? (string->n (hdstr V5687)))) (shen.trim-it (tlstr V5687))) (true V5687))) +(defun shen.trim-it (V5267) (cond ((and (shen.+string? V5267) (shen.whitespace? (string->n (hdstr V5267)))) (shen.trim-it (tlstr V5267))) (true V5267))) -(defun shen.evaluate-lineread (V5706 V5707 V5708) (cond ((and (cons? V5706) (and (= () (tl V5706)) (and (cons? V5707) (and (shen.+string? (hd V5707)) (and (= "!" (hdstr (hd V5707))) (and (shen.+string? (tlstr (hd V5707))) (and (= "!" (hdstr (tlstr (hd V5707)))) (cons? (tl V5707))))))))) (let W5709 (read-from-string (hd (tl V5707))) (let W5710 (set shen.*history* (cons (hd (tl V5707)) (tl V5707))) (let W5711 (pr (shen.app (hd (tl V5707)) " -" shen.a) (stoutput)) (shen.evaluate-lineread W5709 W5710 V5708))))) ((and (cons? V5706) (and (= () (tl V5706)) (and (cons? V5707) (and (shen.+string? (hd V5707)) (= "!" (hdstr (hd V5707))))))) (let W5712 (if (= (tlstr (hd V5707)) "") () (hd (read-from-string (tlstr (hd V5707))))) (let W5713 (shen.use-history W5712 (tlstr (hd V5707)) (tl V5707)) (let W5714 (pr (shen.app W5713 " -" shen.a) (stoutput)) (let W5715 (read-from-string W5713) (let W5716 (set shen.*history* (cons W5713 (tl V5707))) (shen.evaluate-lineread W5715 W5716 V5708))))))) ((and (cons? V5706) (and (= () (tl V5706)) (and (cons? V5707) (and (shen.+string? (hd V5707)) (= "%" (hdstr (hd V5707))))))) (let W5717 (if (= (tlstr (hd V5707)) "") () (hd (read-from-string (tlstr (hd V5707))))) (let W5718 (shen.peek-history W5717 (tlstr (hd V5707)) (tl V5707)) (let W5719 (set shen.*history* (tl V5707)) (abort))))) ((= true V5708) (shen.check-eval-and-print V5706)) ((= false V5708) (shen.eval-and-print V5706)) (true (simple-error "implementation error in shen.evaluate-lineread")))) +(defun shen.evaluate-lineread (V5286 V5287 V5288) (cond ((and (cons? V5286) (and (= () (tl V5286)) (and (cons? V5287) (and (shen.+string? (hd V5287)) (and (= "!" (hdstr (hd V5287))) (and (shen.+string? (tlstr (hd V5287))) (and (= "!" (hdstr (tlstr (hd V5287)))) (cons? (tl V5287))))))))) (let W5289 (read-from-string (hd (tl V5287))) (let W5290 (set shen.*history* (cons (hd (tl V5287)) (tl V5287))) (let W5291 (pr (shen.app (hd (tl V5287)) " +" shen.a) (stoutput)) (shen.evaluate-lineread W5289 W5290 V5288))))) ((and (cons? V5286) (and (= () (tl V5286)) (and (cons? V5287) (and (shen.+string? (hd V5287)) (= "!" (hdstr (hd V5287))))))) (let W5292 (if (= (tlstr (hd V5287)) "") () (hd (read-from-string (tlstr (hd V5287))))) (let W5293 (shen.use-history W5292 (tlstr (hd V5287)) (tl V5287)) (let W5294 (pr (shen.app W5293 " +" shen.a) (stoutput)) (let W5295 (read-from-string W5293) (let W5296 (set shen.*history* (cons W5293 (tl V5287))) (shen.evaluate-lineread W5295 W5296 V5288))))))) ((and (cons? V5286) (and (= () (tl V5286)) (and (cons? V5287) (and (shen.+string? (hd V5287)) (= "%" (hdstr (hd V5287))))))) (let W5297 (if (= (tlstr (hd V5287)) "") () (hd (read-from-string (tlstr (hd V5287))))) (let W5298 (shen.peek-history W5297 (tlstr (hd V5287)) (tl V5287)) (let W5299 (set shen.*history* (tl V5287)) (abort))))) ((= true V5288) (shen.check-eval-and-print V5286)) ((= false V5288) (shen.eval-and-print V5286)) (true (simple-error "implementation error in shen.evaluate-lineread")))) -(defun shen.use-history (V5720 V5721 V5722) (if (integer? V5720) (nth (+ 1 V5720) (reverse V5722)) (if (symbol? V5720) (shen.string-match V5721 V5722) (simple-error "! expects a number or a symbol +(defun shen.use-history (V5300 V5301 V5302) (if (integer? V5300) (nth (+ 1 V5300) (reverse V5302)) (if (symbol? V5300) (shen.string-match V5301 V5302) (simple-error "! expects a number or a symbol ")))) -(defun shen.peek-history (V5723 V5724 V5725) (if (integer? V5723) (pr (cn " -" (shen.app (nth (+ 1 V5723) (reverse V5725)) "" shen.a)) (stoutput)) (if (or (= V5724 "") (symbol? V5723)) (shen.recursive-string-match 0 V5724 (reverse V5725)) (simple-error "% expects a number or a symbol +(defun shen.peek-history (V5303 V5304 V5305) (if (integer? V5303) (pr (cn " +" (shen.app (nth (+ 1 V5303) (reverse V5305)) "" shen.a)) (stoutput)) (if (or (= V5304 "") (symbol? V5303)) (shen.recursive-string-match 0 V5304 (reverse V5305)) (simple-error "% expects a number or a symbol ")))) -(defun shen.string-match (V5735 V5736) (cond ((= () V5736) (simple-error " -input not found")) ((and (cons? V5736) (shen.string-prefix? V5735 (hd V5736))) (hd V5736)) ((cons? V5736) (shen.string-match V5735 (tl V5736))) (true (simple-error "implementation error in shen.string-match")))) +(defun shen.string-match (V5315 V5316) (cond ((= () V5316) (simple-error " +input not found")) ((and (cons? V5316) (shen.string-prefix? V5315 (hd V5316))) (hd V5316)) ((cons? V5316) (shen.string-match V5315 (tl V5316))) (true (simple-error "implementation error in shen.string-match")))) -(defun shen.string-prefix? (V5744 V5745) (cond ((= "" V5744) true) ((and (shen.+string? V5744) (shen.whitespace? (string->n (hdstr V5744)))) (shen.string-prefix? (tlstr V5744) V5745)) ((and (shen.+string? V5745) (shen.whitespace? (string->n (hdstr V5745)))) (shen.string-prefix? V5744 (tlstr V5745))) ((and (shen.+string? V5745) (= "(" (hdstr V5745))) (shen.string-prefix? V5744 (tlstr V5745))) ((and (shen.+string? V5744) (and (shen.+string? V5745) (= (hdstr V5744) (hdstr V5745)))) (shen.string-prefix? (tlstr V5744) (tlstr V5745))) (true false))) +(defun shen.string-prefix? (V5324 V5325) (cond ((= "" V5324) true) ((and (shen.+string? V5324) (shen.whitespace? (string->n (hdstr V5324)))) (shen.string-prefix? (tlstr V5324) V5325)) ((and (shen.+string? V5325) (shen.whitespace? (string->n (hdstr V5325)))) (shen.string-prefix? V5324 (tlstr V5325))) ((and (shen.+string? V5325) (= "(" (hdstr V5325))) (shen.string-prefix? V5324 (tlstr V5325))) ((and (shen.+string? V5324) (and (shen.+string? V5325) (= (hdstr V5324) (hdstr V5325)))) (shen.string-prefix? (tlstr V5324) (tlstr V5325))) (true false))) -(defun shen.recursive-string-match (V5756 V5757 V5758) (cond ((= () V5758) shen.skip) ((cons? V5758) (do (if (shen.string-prefix? V5757 (hd V5758)) (pr (shen.app V5756 (cn ". " (shen.app (hd V5758) " -" shen.a)) shen.a) (stoutput)) shen.skip) (shen.recursive-string-match (+ V5756 1) V5757 (tl V5758)))) (true (simple-error "implementation error in shen.recursive-string-match")))) +(defun shen.recursive-string-match (V5336 V5337 V5338) (cond ((= () V5338) shen.skip) ((cons? V5338) (do (if (shen.string-prefix? V5337 (hd V5338)) (pr (shen.app V5336 (cn ". " (shen.app (hd V5338) " +" shen.a)) shen.a) (stoutput)) shen.skip) (shen.recursive-string-match (+ V5336 1) V5337 (tl V5338)))) (true (simple-error "implementation error in shen.recursive-string-match")))) diff --git a/klambda/track.kl b/klambda/track.kl index 4281580..5522a98 100644 --- a/klambda/track.kl +++ b/klambda/track.kl @@ -1,66 +1,66 @@ -(defun shen.f-error (V5790) (do (pr (cn "partial function " (shen.app V5790 "; -" shen.a)) (stoutput)) (do (if (and (not (shen.tracked? V5790)) (y-or-n? (cn "track " (shen.app V5790 "? " shen.a)))) (shen.track-function (ps V5790)) shen.ok) (simple-error "aborted")))) +(defun shen.f-error (V5370) (do (pr (cn "partial function " (shen.app V5370 "; +" shen.a)) (stoutput)) (do (if (and (not (shen.tracked? V5370)) (y-or-n? (cn "track " (shen.app V5370 "? " shen.a)))) (shen.track-function (ps V5370)) shen.ok) (simple-error "aborted")))) -(defun shen.tracked? (V5791) (element? V5791 (value shen.*tracking*))) +(defun shen.tracked? (V5371) (element? V5371 (value shen.*tracking*))) -(defun track (V5792) (let W5793 (ps V5792) (shen.track-function W5793))) +(defun track (V5372) (let W5373 (ps V5372) (shen.track-function W5373))) -(defun shen.track-function (V5796) (cond ((and (cons? V5796) (and (= defun (hd V5796)) (and (cons? (tl V5796)) (and (cons? (tl (tl V5796))) (and (cons? (tl (tl (tl V5796)))) (= () (tl (tl (tl (tl V5796)))))))))) (let W5797 (cons defun (cons (hd (tl V5796)) (cons (hd (tl (tl V5796))) (cons (shen.insert-tracking-code (hd (tl V5796)) (hd (tl (tl V5796))) (hd (tl (tl (tl V5796))))) ())))) (let W5798 (eval-kl W5797) (let W5799 (set shen.*tracking* (adjoin (hd (tl V5796)) (value shen.*tracking*))) (hd (tl V5796)))))) (true (simple-error "implementation error in shen.track-function")))) +(defun shen.track-function (V5376) (cond ((and (cons? V5376) (and (= defun (hd V5376)) (and (cons? (tl V5376)) (and (cons? (tl (tl V5376))) (and (cons? (tl (tl (tl V5376)))) (= () (tl (tl (tl (tl V5376)))))))))) (let W5377 (cons defun (cons (hd (tl V5376)) (cons (hd (tl (tl V5376))) (cons (shen.insert-tracking-code (hd (tl V5376)) (hd (tl (tl V5376))) (hd (tl (tl (tl V5376))))) ())))) (let W5378 (eval-kl W5377) (let W5379 (set shen.*tracking* (adjoin (hd (tl V5376)) (value shen.*tracking*))) (hd (tl V5376)))))) (true (simple-error "implementation error in shen.track-function")))) -(defun shen.insert-tracking-code (V5800 V5801 V5802) (cons do (cons (cons set (cons shen.*call* (cons (cons + (cons (cons value (cons shen.*call* ())) (cons 1 ()))) ()))) (cons (cons do (cons (cons shen.input-track (cons (cons value (cons shen.*call* ())) (cons V5800 (cons (shen.cons-form (shen.prolog-track V5802 V5801)) ())))) (cons (cons do (cons (cons shen.terpri-or-read-char ()) (cons (cons let (cons Result (cons V5802 (cons (cons do (cons (cons shen.output-track (cons (cons value (cons shen.*call* ())) (cons V5800 (cons Result ())))) (cons (cons do (cons (cons set (cons shen.*call* (cons (cons - (cons (cons value (cons shen.*call* ())) (cons 1 ()))) ()))) (cons (cons do (cons (cons shen.terpri-or-read-char ()) (cons Result ()))) ()))) ()))) ())))) ()))) ()))) ())))) +(defun shen.insert-tracking-code (V5380 V5381 V5382) (cons do (cons (cons set (cons shen.*call* (cons (cons + (cons (cons value (cons shen.*call* ())) (cons 1 ()))) ()))) (cons (cons do (cons (cons shen.input-track (cons (cons value (cons shen.*call* ())) (cons V5380 (cons (shen.cons-form (shen.prolog-track V5382 V5381)) ())))) (cons (cons do (cons (cons shen.terpri-or-read-char ()) (cons (cons let (cons Result (cons V5382 (cons (cons do (cons (cons shen.output-track (cons (cons value (cons shen.*call* ())) (cons V5380 (cons Result ())))) (cons (cons do (cons (cons set (cons shen.*call* (cons (cons - (cons (cons value (cons shen.*call* ())) (cons 1 ()))) ()))) (cons (cons do (cons (cons shen.terpri-or-read-char ()) (cons Result ()))) ()))) ()))) ())))) ()))) ()))) ())))) -(defun shen.prolog-track (V5803 V5804) (cond ((= (occurrences shen.incinfs V5803) 0) V5804) (true (shen.vector-dereference V5804 (shen.vector-parameter V5804))))) +(defun shen.prolog-track (V5383 V5384) (cond ((= (occurrences shen.incinfs V5383) 0) V5384) (true (shen.vector-dereference V5384 (shen.vector-parameter V5384))))) -(defun shen.vector-parameter (V5807) (cond ((= () V5807) ()) ((and (cons? V5807) (and (cons? (tl V5807)) (and (cons? (tl (tl V5807))) (and (cons? (tl (tl (tl V5807)))) (= () (tl (tl (tl (tl V5807))))))))) (hd V5807)) ((cons? V5807) (shen.vector-parameter (tl V5807))) (true (shen.f-error shen.vector-parameter)))) +(defun shen.vector-parameter (V5387) (cond ((= () V5387) ()) ((and (cons? V5387) (and (cons? (tl V5387)) (and (cons? (tl (tl V5387))) (and (cons? (tl (tl (tl V5387)))) (= () (tl (tl (tl (tl V5387))))))))) (hd V5387)) ((cons? V5387) (shen.vector-parameter (tl V5387))) (true (simple-error "partial function shen.vector-parameter")))) -(defun shen.vector-dereference (V5810 V5811) (cond ((= () V5811) V5810) ((and (cons? V5810) (and (cons? (tl V5810)) (and (cons? (tl (tl V5810))) (and (cons? (tl (tl (tl V5810)))) (= () (tl (tl (tl (tl V5810))))))))) V5810) ((cons? V5810) (cons (cons shen.deref (cons (hd V5810) (cons V5811 ()))) (shen.vector-dereference (tl V5810) V5811))) (true (shen.f-error shen.vector-dereference)))) +(defun shen.vector-dereference (V5390 V5391) (cond ((= () V5391) V5390) ((and (cons? V5390) (and (cons? (tl V5390)) (and (cons? (tl (tl V5390))) (and (cons? (tl (tl (tl V5390)))) (= () (tl (tl (tl (tl V5390))))))))) V5390) ((cons? V5390) (cons (cons shen.deref (cons (hd V5390) (cons V5391 ()))) (shen.vector-dereference (tl V5390) V5391))) (true (simple-error "partial function shen.vector-dereference")))) -(defun step (V5814) (cond ((= + V5814) (set shen.*step* true)) ((= - V5814) (set shen.*step* false)) (true (simple-error "step expects a + or a -. +(defun step (V5394) (cond ((= + V5394) (set shen.*step* true)) ((= - V5394) (set shen.*step* false)) (true (simple-error "step expects a + or a -. ")))) -(defun shen.step? () (value shen.*step*)) +(defun step? () (value shen.*step*)) -(defun spy (V5817) (cond ((= + V5817) (set shen.*spy* true)) ((= - V5817) (set shen.*spy* false)) (true (simple-error "spy expects a + or a -. +(defun spy (V5397) (cond ((= + V5397) (set shen.*spy* true)) ((= - V5397) (set shen.*spy* false)) (true (simple-error "spy expects a + or a -. ")))) -(defun shen.spy? () (value shen.*spy*)) +(defun spy? () (value shen.*spy*)) (defun shen.terpri-or-read-char () (if (value shen.*step*) (shen.check-byte (read-byte (value *stinput*))) (nl 1))) -(defun shen.check-byte (V5820) (cond ((= 94 V5820) (simple-error "aborted")) (true true))) +(defun shen.check-byte (V5400) (cond ((= 94 V5400) (simple-error "aborted")) (true true))) -(defun shen.input-track (V5821 V5822 V5823) (do (pr (cn " -" (shen.app (shen.spaces V5821) (cn "<" (shen.app V5821 (cn "> Inputs to " (shen.app V5822 (cn " -" (shen.app (shen.spaces V5821) "" shen.a)) shen.a)) shen.a)) shen.a)) (stoutput)) (shen.recursively-print V5823))) +(defun shen.input-track (V5401 V5402 V5403) (do (pr (cn " +" (shen.app (shen.spaces V5401) (cn "<" (shen.app V5401 (cn "> Inputs to " (shen.app V5402 (cn " +" (shen.app (shen.spaces V5401) "" shen.a)) shen.a)) shen.a)) shen.a)) (stoutput)) (shen.recursively-print V5403))) -(defun shen.recursively-print (V5826) (cond ((= () V5826) (pr " ==>" (stoutput))) ((cons? V5826) (do (print (hd V5826)) (do (pr ", " (stoutput)) (shen.recursively-print (tl V5826))))) (true (simple-error "implementation error in shen.recursively-print")))) +(defun shen.recursively-print (V5406) (cond ((= () V5406) (pr " ==>" (stoutput))) ((cons? V5406) (do (print (hd V5406)) (do (pr ", " (stoutput)) (shen.recursively-print (tl V5406))))) (true (simple-error "implementation error in shen.recursively-print")))) -(defun shen.spaces (V5827) (cond ((= 0 V5827) "") (true (cn " " (shen.spaces (- V5827 1)))))) +(defun shen.spaces (V5407) (cond ((= 0 V5407) "") (true (cn " " (shen.spaces (- V5407 1)))))) -(defun shen.output-track (V5828 V5829 V5830) (pr (cn " -" (shen.app (shen.spaces V5828) (cn "<" (shen.app V5828 (cn "> Output from " (shen.app V5829 (cn " -" (shen.app (shen.spaces V5828) (cn "==> " (shen.app V5830 "" shen.s)) shen.a)) shen.a)) shen.a)) shen.a)) (stoutput))) +(defun shen.output-track (V5408 V5409 V5410) (pr (cn " +" (shen.app (shen.spaces V5408) (cn "<" (shen.app V5408 (cn "> Output from " (shen.app V5409 (cn " +" (shen.app (shen.spaces V5408) (cn "==> " (shen.app V5410 "" shen.s)) shen.a)) shen.a)) shen.a)) shen.a)) (stoutput))) -(defun untrack (V5831) (do (set shen.*tracking* (remove V5831 (value shen.*tracking*))) (do (trap-error (eval (ps V5831)) (lambda Z5832 V5831)) V5831))) +(defun untrack (V5411) (do (set shen.*tracking* (remove V5411 (value shen.*tracking*))) (do (trap-error (eval (ps V5411)) (lambda Z5412 V5411)) V5411))) -(defun remove (V5833 V5834) (shen.remove-h V5833 V5834 ())) +(defun remove (V5413 V5414) (shen.remove-h V5413 V5414 ())) -(defun shen.remove-h (V5844 V5845 V5846) (cond ((= () V5845) (reverse V5846)) ((and (cons? V5845) (= V5844 (hd V5845))) (shen.remove-h (hd V5845) (tl V5845) V5846)) ((cons? V5845) (shen.remove-h V5844 (tl V5845) (cons (hd V5845) V5846))) (true (simple-error "implementation error in shen.remove-h")))) +(defun shen.remove-h (V5424 V5425 V5426) (cond ((= () V5425) (reverse V5426)) ((and (cons? V5425) (= V5424 (hd V5425))) (shen.remove-h (hd V5425) (tl V5425) V5426)) ((cons? V5425) (shen.remove-h V5424 (tl V5425) (cons (hd V5425) V5426))) (true (simple-error "implementation error in shen.remove-h")))) -(defun profile (V5847) (do (set shen.*profiled* (cons V5847 (value shen.*profiled*))) (shen.profile-help (ps V5847)))) +(defun profile (V5427) (do (set shen.*profiled* (cons V5427 (value shen.*profiled*))) (shen.profile-help (ps V5427)))) -(defun shen.profile-help (V5850) (cond ((and (cons? V5850) (and (= defun (hd V5850)) (and (cons? (tl V5850)) (and (cons? (tl (tl V5850))) (and (cons? (tl (tl (tl V5850)))) (= () (tl (tl (tl (tl V5850)))))))))) (let W5851 (gensym shen.f) (let W5852 (cons defun (cons (hd (tl V5850)) (cons (hd (tl (tl V5850))) (cons (shen.profile-func (hd (tl V5850)) (hd (tl (tl V5850))) (cons W5851 (hd (tl (tl V5850))))) ())))) (let W5853 (cons defun (cons W5851 (cons (hd (tl (tl V5850))) (cons (subst W5851 (hd (tl V5850)) (hd (tl (tl (tl V5850))))) ())))) (let W5854 (eval-kl W5852) (let W5855 (eval-kl W5853) (hd (tl V5850)))))))) (true (simple-error "Cannot profile. +(defun shen.profile-help (V5430) (cond ((and (cons? V5430) (and (= defun (hd V5430)) (and (cons? (tl V5430)) (and (cons? (tl (tl V5430))) (and (cons? (tl (tl (tl V5430)))) (= () (tl (tl (tl (tl V5430)))))))))) (let W5431 (gensym shen.f) (let W5432 (cons defun (cons (hd (tl V5430)) (cons (hd (tl (tl V5430))) (cons (shen.profile-func (hd (tl V5430)) (hd (tl (tl V5430))) (cons W5431 (hd (tl (tl V5430))))) ())))) (let W5433 (cons defun (cons W5431 (cons (hd (tl (tl V5430))) (cons (subst W5431 (hd (tl V5430)) (hd (tl (tl (tl V5430))))) ())))) (let W5434 (eval-kl W5432) (let W5435 (eval-kl W5433) (hd (tl V5430)))))))) (true (simple-error "Cannot profile. ")))) -(defun unprofile (V5856) (do (set shen.*profiled* (remove V5856 (value shen.*profiled*))) (trap-error (eval (ps V5856)) (lambda Z5857 V5856)))) +(defun unprofile (V5436) (do (set shen.*profiled* (remove V5436 (value shen.*profiled*))) (trap-error (eval (ps V5436)) (lambda Z5437 V5436)))) -(defun shen.profiled? (V5858) (element? V5858 (value shen.*profiled*))) +(defun shen.profiled? (V5438) (element? V5438 (value shen.*profiled*))) -(defun shen.profile-func (V5859 V5860 V5861) (cons let (cons Start (cons (cons get-time (cons run ())) (cons (cons let (cons Result (cons V5861 (cons (cons let (cons Finish (cons (cons - (cons (cons get-time (cons run ())) (cons Start ()))) (cons (cons let (cons Record (cons (cons shen.put-profile (cons V5859 (cons (cons + (cons (cons shen.get-profile (cons V5859 ())) (cons Finish ()))) ()))) (cons Result ())))) ())))) ())))) ()))))) +(defun shen.profile-func (V5439 V5440 V5441) (cons let (cons Start (cons (cons get-time (cons run ())) (cons (cons let (cons Result (cons V5441 (cons (cons let (cons Finish (cons (cons - (cons (cons get-time (cons run ())) (cons Start ()))) (cons (cons let (cons Record (cons (cons shen.put-profile (cons V5439 (cons (cons + (cons (cons shen.get-profile (cons V5439 ())) (cons Finish ()))) ()))) (cons Result ())))) ())))) ())))) ()))))) -(defun profile-results (V5862) (let W5863 (shen.get-profile V5862) (let W5864 (shen.put-profile V5862 0) (@p V5862 W5863)))) +(defun profile-results (V5442) (let W5443 (shen.get-profile V5442) (let W5444 (shen.put-profile V5442 0) (@p V5442 W5443)))) -(defun shen.get-profile (V5865) (trap-error (get V5865 profile (value *property-vector*)) (lambda Z5866 0))) +(defun shen.get-profile (V5445) (trap-error (get V5445 profile (value *property-vector*)) (lambda Z5446 0))) -(defun shen.put-profile (V5867 V5868) (put V5867 profile V5868 (value *property-vector*))) +(defun shen.put-profile (V5447 V5448) (put V5447 profile V5448 (value *property-vector*))) diff --git a/klambda/types.kl b/klambda/types.kl index 88c6fac..d23a10e 100644 --- a/klambda/types.kl +++ b/klambda/types.kl @@ -1,11 +1,333 @@ -(defun declare (V5907 V5908) (let W5909 (shen.rectify-type V5908) (let W5910 (((((lambda Z5911 (lambda Z5912 (lambda Z5913 (lambda Z5914 (do (shen.incinfs) (shen.variancy (receive (shen.deref V5907 Z5911)) (receive (shen.deref W5909 Z5911)) Z5911 Z5912 Z5913 Z5914)))))) (shen.prolog-vector)) (@v true (@v 0 (vector 0)))) 0) (freeze true)) (let W5915 (eval-kl (shen.prolog-abstraction V5908)) (let W5916 (set shen.*sigf* (shen.assoc-> V5907 W5915 (value shen.*sigf*))) V5907))))) +(defun declare (V5483 V5484) (let W5485 (shen.rectify-type V5484) (let W5486 (((((lambda Z5487 (lambda Z5488 (lambda Z5489 (lambda Z5490 (do (shen.incinfs) (shen.variancy (receive (shen.deref V5483 Z5487)) (receive (shen.deref W5485 Z5487)) Z5487 Z5488 Z5489 Z5490)))))) (shen.prolog-vector)) (@v true (@v 0 (vector 0)))) 0) (freeze true)) (let W5491 (eval-kl (shen.prolog-abstraction V5484)) (let W5492 (set shen.*sigf* (shen.assoc-> V5483 W5491 (value shen.*sigf*))) V5483))))) -(defun shen.variancy (V5917 V5918 V5919 V5920 V5921 V5922) (if (shen.unlocked? V5920) (let W5923 (shen.newpv V5919) (shen.gc V5919 (do (shen.incinfs) (shen.system-S-h V5917 W5923 () V5919 V5920 V5921 (freeze (shen.variants? V5917 W5923 V5918 V5919 V5920 V5921 V5922)))))) false)) +(defun shen.variancy (V5493 V5494 V5495 V5496 V5497 V5498) (if (shen.unlocked? V5496) (let W5499 (shen.newpv V5495) (shen.gc V5495 (do (shen.incinfs) (shen.system-S-h (cons fn (cons V5493 ())) W5499 () V5495 V5496 V5497 (freeze (shen.variants? V5493 W5499 V5494 V5495 V5496 V5497 V5498)))))) false)) -(defun shen.variants? (V5924 V5925 V5926 V5927 V5928 V5929 V5930) (let W5931 (+ V5929 1) (let W5932 (if (shen.unlocked? V5928) (let W5933 (shen.lazyderef V5925 V5927) (let W5934 (freeze (do (shen.incinfs) (shen.cut V5927 V5928 W5931 V5930))) (if (= W5933 symbol) (thaw W5934) (if (shen.pvar? W5933) (shen.bind! W5933 symbol V5927 W5934) false)))) false) (if (= W5932 false) (let W5935 (if (shen.unlocked? V5928) (do (shen.incinfs) (is! V5925 V5926 V5927 V5928 W5931 V5930)) false) (if (= W5935 false) (let W5936 (if (shen.unlocked? V5928) (let W5937 (shen.newpv V5927) (shen.gc V5927 (do (shen.incinfs) (is W5937 (pr (cn "warning: changing the type of " (shen.app (shen.deref V5924 V5927) " may create errors -" shen.a)) (stoutput)) V5927 V5928 W5931 V5930)))) false) (if (= W5936 false) (shen.unlock V5928 W5931) W5936)) W5935)) W5932)))) +(defun shen.variants? (V5500 V5501 V5502 V5503 V5504 V5505 V5506) (let W5507 (if (shen.unlocked? V5504) (do (shen.incinfs) (is! V5501 V5502 V5503 V5504 V5505 V5506)) false) (if (= W5507 false) (if (shen.unlocked? V5504) (let W5508 (shen.newpv V5503) (shen.gc V5503 (do (shen.incinfs) (is W5508 (pr (cn "warning: changing the type of " (shen.app (shen.deref V5500 V5503) " may create errors +" shen.a)) (stoutput)) V5503 V5504 V5505 V5506)))) false) W5507))) -(defun shen.prolog-abstraction (V5938) (let W5939 (gensym B) (let W5940 (gensym L) (let W5941 (gensym Key) (let W5942 (gensym C) (let W5943 (gensym V) (let W5944 (shen.extract-vars V5938) (cons lambda (cons W5943 (cons (cons lambda (cons W5939 (cons (cons lambda (cons W5940 (cons (cons lambda (cons W5941 (cons (cons lambda (cons W5942 (cons (shen.stpart W5944 (cons is! (cons W5943 (cons (shen.rcons_form V5938) (cons W5939 (cons W5940 (cons W5941 (cons W5942 ()))))))) W5939) ()))) ()))) ()))) ()))) ())))))))))) +(defun shen.prolog-abstraction (V5509) (let W5510 (gensym B) (let W5511 (gensym L) (let W5512 (gensym Key) (let W5513 (gensym C) (let W5514 (gensym V) (let W5515 (shen.extract-vars V5509) (cons lambda (cons W5514 (cons (cons lambda (cons W5510 (cons (cons lambda (cons W5511 (cons (cons lambda (cons W5512 (cons (cons lambda (cons W5513 (cons (shen.stpart W5515 (cons is! (cons W5514 (cons (shen.rcons_form V5509) (cons W5510 (cons W5511 (cons W5512 (cons W5513 ()))))))) W5510) ()))) ()))) ()))) ()))) ())))))))))) -(defun shen.demod (V5945) (let W5946 (value shen.*demodulation-function*) (W5946 V5945))) +(defun shen.demod (V5516) V5516) + +(declare abort (cons --> (cons A ()))) + +(declare absolute (cons string (cons --> (cons (cons list (cons string ())) ())))) + +(declare absvector? (cons A (cons --> (cons boolean ())))) + +(declare adjoin (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ())))) + +(declare and (cons boolean (cons --> (cons (cons boolean (cons --> (cons boolean ()))) ())))) + +(declare shen.app (cons A (cons --> (cons (cons string (cons --> (cons (cons symbol (cons --> (cons string ()))) ()))) ())))) + +(declare append (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ())))) + +(declare arity (cons A (cons --> (cons number ())))) + +(declare assoc (cons A (cons --> (cons (cons (cons list (cons (cons list (cons A ())) ())) (cons --> (cons (cons list (cons A ())) ()))) ())))) + +(declare atom? (cons A (cons --> (cons boolean ())))) + +(declare boolean? (cons A (cons --> (cons boolean ())))) + +(declare bootstrap (cons string (cons --> (cons string ())))) + +(declare bound? (cons symbol (cons --> (cons boolean ())))) + +(declare shen.ccons? (cons (cons list (cons A ())) (cons --> (cons boolean ())))) + +(declare cd (cons string (cons --> (cons string ())))) + +(declare close (cons (cons stream (cons A ())) (cons --> (cons (cons list (cons B ())) ())))) + +(declare cn (cons string (cons --> (cons (cons string (cons --> (cons string ()))) ())))) + +(declare compile (cons (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons B ()))) ())))) + +(declare cons? (cons A (cons --> (cons boolean ())))) + +(declare datatypes (cons --> (cons (cons list (cons symbol ())) ()))) + +(declare destroy (cons symbol (cons --> (cons symbol ())))) + +(declare difference (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ())))) + +(declare do (cons A (cons --> (cons (cons B (cons --> (cons B ()))) ())))) + +(declare (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons (cons list (cons B ())) ()))) ())))) + +(declare (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons B ())) (cons (cons list (cons A ())) ()))) ())))) + +(declare (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons (cons list (cons B ())) ()))) ())))) + +(declare shen.parse-failure? (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons boolean ())))) + +(declare shen.parse-failure (cons --> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) ()))) + +(declare shen.<-out (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons B ())))) + +(declare shen.in-> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons (cons list (cons A ())) ())))) + +(declare shen.comb (cons (cons list (cons A ())) (cons --> (cons (cons B (cons --> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) ()))) ())))) + +(declare element? (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons boolean ()))) ())))) + +(declare empty? (cons A (cons --> (cons boolean ())))) + +(declare enable-type-theory (cons symbol (cons --> (cons boolean ())))) + +(declare external (cons symbol (cons --> (cons (cons list (cons symbol ())) ())))) + +(declare error-to-string (cons exception (cons --> (cons string ())))) + +(declare explode (cons A (cons --> (cons (cons list (cons string ())) ())))) + +(declare factorise (cons symbol (cons --> (cons symbol ())))) + +(declare factorise? (cons --> (cons boolean ()))) + +(declare fail (cons --> (cons symbol ()))) + +(declare fix (cons (cons A (cons --> (cons A ()))) (cons --> (cons (cons A (cons --> (cons A ()))) ())))) + +(declare freeze (cons A (cons --> (cons (cons lazy (cons A ())) ())))) + +(declare fst (cons (cons A (cons * (cons B ()))) (cons --> (cons A ())))) + +(declare gensym (cons symbol (cons --> (cons symbol ())))) + +(declare shen.hds=? (cons (cons list (cons A ())) (cons --> (cons (cons A (cons --> (cons boolean ()))) ())))) + +(declare hush (cons symbol (cons --> (cons boolean ())))) + +(declare hush? (cons --> (cons boolean ()))) + +(declare <-vector (cons (cons vector (cons A ())) (cons --> (cons (cons number (cons --> (cons A ()))) ())))) + +(declare vector-> (cons (cons vector (cons A ())) (cons --> (cons (cons number (cons --> (cons (cons A (cons --> (cons (cons vector (cons A ())) ()))) ()))) ())))) + +(declare vector (cons number (cons --> (cons (cons vector (cons A ())) ())))) + +(declare get-time (cons symbol (cons --> (cons number ())))) + +(declare hash (cons A (cons --> (cons (cons number (cons --> (cons number ()))) ())))) + +(declare head (cons (cons list (cons A ())) (cons --> (cons A ())))) + +(declare hdv (cons (cons vector (cons A ())) (cons --> (cons A ())))) + +(declare hdstr (cons string (cons --> (cons string ())))) + +(declare if (cons boolean (cons --> (cons (cons A (cons --> (cons (cons A (cons --> (cons A ()))) ()))) ())))) + +(declare in-package (cons symbol (cons --> (cons symbol ())))) + +(declare it (cons --> (cons string ()))) + +(declare implementation (cons --> (cons string ()))) + +(declare include (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ())))) + +(declare include-all-but (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ())))) + +(declare included (cons --> (cons (cons list (cons symbol ())) ()))) + +(declare inferences (cons --> (cons number ()))) + +(declare shen.insert (cons A (cons --> (cons (cons string (cons --> (cons string ()))) ())))) + +(declare integer? (cons A (cons --> (cons boolean ())))) + +(declare internal (cons symbol (cons --> (cons (cons list (cons symbol ())) ())))) + +(declare intersection (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ())))) + +(declare language (cons --> (cons string ()))) + +(declare length (cons (cons list (cons A ())) (cons --> (cons number ())))) + +(declare limit (cons (cons vector (cons A ())) (cons --> (cons number ())))) + +(declare lineread (cons (cons stream (cons in ())) (cons --> (cons (cons list (cons unit ())) ())))) + +(declare load (cons string (cons --> (cons symbol ())))) + +(declare map (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) ())))) + +(declare mapcan (cons (cons A (cons --> (cons (cons list (cons B ())) ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) ())))) + +(declare maxinferences (cons number (cons --> (cons number ())))) + +(declare n->string (cons number (cons --> (cons string ())))) + +(declare nl (cons number (cons --> (cons number ())))) + +(declare not (cons boolean (cons --> (cons boolean ())))) + +(declare nth (cons number (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons A ()))) ())))) + +(declare number? (cons A (cons --> (cons boolean ())))) + +(declare occurrences (cons A (cons --> (cons (cons B (cons --> (cons number ()))) ())))) + +(declare occurs-check (cons symbol (cons --> (cons boolean ())))) + +(declare occurs? (cons --> (cons boolean ()))) + +(declare optimise (cons symbol (cons --> (cons boolean ())))) + +(declare optimise? (cons --> (cons boolean ()))) + +(declare or (cons boolean (cons --> (cons (cons boolean (cons --> (cons boolean ()))) ())))) + +(declare os (cons --> (cons string ()))) + +(declare package? (cons symbol (cons --> (cons boolean ())))) + +(declare port (cons --> (cons string ()))) + +(declare porters (cons --> (cons string ()))) + +(declare pos (cons string (cons --> (cons (cons number (cons --> (cons string ()))) ())))) + +(declare pr (cons string (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons string ()))) ())))) + +(declare print (cons A (cons --> (cons A ())))) + +(declare profile (cons symbol (cons --> (cons symbol ())))) + +(declare preclude (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ())))) + +(declare shen.proc-nl (cons string (cons --> (cons string ())))) + +(declare profile-results (cons symbol (cons --> (cons (cons symbol (cons * (cons number ()))) ())))) + +(declare protect (cons A (cons --> (cons A ())))) + +(declare preclude-all-but (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ())))) + +(declare shen.prhush (cons string (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons string ()))) ())))) + +(declare prolog-memory (cons number (cons --> (cons number ())))) + +(declare ps (cons symbol (cons --> (cons (cons list (cons unit ())) ())))) + +(declare read (cons (cons stream (cons in ())) (cons --> (cons unit ())))) + +(declare read-byte (cons (cons stream (cons in ())) (cons --> (cons number ())))) + +(declare read-file-as-bytelist (cons string (cons --> (cons (cons list (cons number ())) ())))) + +(declare read-file-as-string (cons string (cons --> (cons string ())))) + +(declare read-file (cons string (cons --> (cons (cons list (cons unit ())) ())))) + +(declare read-from-string (cons string (cons --> (cons (cons list (cons unit ())) ())))) + +(declare read-from-string-unprocessed (cons string (cons --> (cons (cons list (cons unit ())) ())))) + +(declare release (cons --> (cons string ()))) + +(declare remove (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ())))) + +(declare reverse (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ())))) + +(declare simple-error (cons string (cons --> (cons A ())))) + +(declare snd (cons (cons A (cons * (cons B ()))) (cons --> (cons B ())))) + +(declare specialise (cons symbol (cons --> (cons (cons number (cons --> (cons symbol ()))) ())))) + +(declare spy (cons symbol (cons --> (cons boolean ())))) + +(declare spy? (cons --> (cons boolean ()))) + +(declare step (cons symbol (cons --> (cons boolean ())))) + +(declare step? (cons --> (cons boolean ()))) + +(declare stinput (cons --> (cons (cons stream (cons in ())) ()))) + +(declare stoutput (cons --> (cons (cons stream (cons out ())) ()))) + +(declare string? (cons A (cons --> (cons boolean ())))) + +(declare str (cons A (cons --> (cons string ())))) + +(declare string->n (cons string (cons --> (cons number ())))) + +(declare string->symbol (cons string (cons --> (cons symbol ())))) + +(declare sum (cons (cons list (cons number ())) (cons --> (cons number ())))) + +(declare symbol? (cons A (cons --> (cons boolean ())))) + +(declare systemf (cons symbol (cons --> (cons symbol ())))) + +(declare system-S? (cons --> (cons boolean ()))) + +(declare tail (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ())))) + +(declare tlstr (cons string (cons --> (cons string ())))) + +(declare tlv (cons (cons vector (cons A ())) (cons --> (cons (cons vector (cons A ())) ())))) + +(declare tc (cons symbol (cons --> (cons boolean ())))) + +(declare tc? (cons --> (cons boolean ()))) + +(declare thaw (cons (cons lazy (cons A ())) (cons --> (cons A ())))) + +(declare track (cons symbol (cons --> (cons symbol ())))) + +(declare tracked (cons --> (cons (cons list (cons symbol ())) ()))) + +(declare trap-error (cons A (cons --> (cons (cons (cons exception (cons --> (cons A ()))) (cons --> (cons A ()))) ())))) + +(declare tuple? (cons A (cons --> (cons boolean ())))) + +(declare unabsolute (cons string (cons --> (cons (cons list (cons string ())) ())))) + +(declare undefmacro (cons symbol (cons --> (cons symbol ())))) + +(declare union (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ())))) + +(declare unprofile (cons symbol (cons --> (cons symbol ())))) + +(declare untrack (cons symbol (cons --> (cons symbol ())))) + +(declare userdefs (cons --> (cons (cons list (cons symbol ())) ()))) + +(declare variable? (cons A (cons --> (cons boolean ())))) + +(declare vector? (cons A (cons --> (cons boolean ())))) + +(declare version (cons --> (cons string ()))) + +(declare write-to-file (cons string (cons --> (cons (cons A (cons --> (cons A ()))) ())))) + +(declare write-byte (cons number (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons number ()))) ())))) + +(declare y-or-n? (cons string (cons --> (cons boolean ())))) + +(declare > (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ())))) + +(declare < (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ())))) + +(declare >= (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ())))) + +(declare <= (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ())))) + +(declare = (cons A (cons --> (cons (cons A (cons --> (cons boolean ()))) ())))) + +(declare + (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) + +(declare / (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) + +(declare - (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) + +(declare * (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) + +(declare == (cons A (cons --> (cons (cons B (cons --> (cons boolean ()))) ())))) diff --git a/klambda/writer.kl b/klambda/writer.kl index 2628495..bddb318 100644 --- a/klambda/writer.kl +++ b/klambda/writer.kl @@ -1,56 +1,52 @@ -(defun print (V6803) (let W6804 (shen.insert V6803 "~S") (let W6805 (pr W6804 (stoutput)) V6803))) +(defun print (V5561) (let W5562 (shen.insert V5561 "~S") (let W5563 (pr W5562 (stoutput)) V5561))) -(defun pr (V6806 V6807) (if (value *hush*) V6806 (if (shen.char-stoutput? V6807) (shen.write-string V6806 V6807) (shen.write-chars V6806 V6807 (shen.string->byte V6806 0) 1)))) +(defun pr (V5564 V5565) (if (value *hush*) V5564 (if (shen.char-stoutput? V5565) (shen.write-string V5564 V5565) (shen.write-chars V5564 V5565 (shen.string->byte V5564 0) 1)))) -(defun shen.string->byte (V6808 V6809) (trap-error (string->n (pos V6808 V6809)) (lambda Z6810 shen.eos))) +(defun shen.string->byte (V5566 V5567) (trap-error (string->n (pos V5566 V5567)) (lambda Z5568 shen.eos))) -(defun shen.write-chars (V6811 V6812 V6813 V6814) (cond ((= shen.eos V6813) V6811) (true (shen.write-chars V6811 V6812 (do (write-byte V6813 V6812) (shen.string->byte V6811 V6814)) (+ V6814 1))))) +(defun shen.write-chars (V5569 V5570 V5571 V5572) (cond ((= shen.eos V5571) V5569) (true (shen.write-chars V5569 V5570 (do (write-byte V5571 V5570) (shen.string->byte V5569 V5572)) (+ V5572 1))))) -(defun shen.mkstr (V6815 V6816) (cond ((string? V6815) (shen.mkstr-l (shen.proc-nl V6815) V6816)) (true (shen.mkstr-r (cons shen.proc-nl (cons V6815 ())) V6816)))) +(defun shen.mkstr (V5573 V5574) (cond ((string? V5573) (shen.mkstr-l (shen.proc-nl V5573) V5574)) (true (shen.mkstr-r (cons shen.proc-nl (cons V5573 ())) V5574)))) -(defun shen.mkstr-l (V6821 V6822) (cond ((= () V6822) V6821) ((cons? V6822) (shen.mkstr-l (shen.insert-l (hd V6822) V6821) (tl V6822))) (true (simple-error "implementation error in shen.mkstr-l")))) +(defun shen.mkstr-l (V5579 V5580) (cond ((= () V5580) V5579) ((cons? V5580) (shen.mkstr-l (shen.insert-l (hd V5580) V5579) (tl V5580))) (true (simple-error "implementation error in shen.mkstr-l")))) -(defun shen.insert-l (V6829 V6830) (cond ((= "" V6830) "") ((and (shen.+string? V6830) (and (= "~" (hdstr V6830)) (and (shen.+string? (tlstr V6830)) (= "A" (hdstr (tlstr V6830)))))) (cons shen.app (cons V6829 (cons (tlstr (tlstr V6830)) (cons shen.a ()))))) ((and (shen.+string? V6830) (and (= "~" (hdstr V6830)) (and (shen.+string? (tlstr V6830)) (= "R" (hdstr (tlstr V6830)))))) (cons shen.app (cons V6829 (cons (tlstr (tlstr V6830)) (cons shen.r ()))))) ((and (shen.+string? V6830) (and (= "~" (hdstr V6830)) (and (shen.+string? (tlstr V6830)) (= "S" (hdstr (tlstr V6830)))))) (cons shen.app (cons V6829 (cons (tlstr (tlstr V6830)) (cons shen.s ()))))) ((shen.+string? V6830) (shen.factor-cn (cons cn (cons (hdstr V6830) (cons (shen.insert-l V6829 (tlstr V6830)) ()))))) ((and (cons? V6830) (and (= cn (hd V6830)) (and (cons? (tl V6830)) (and (cons? (tl (tl V6830))) (= () (tl (tl (tl V6830)))))))) (cons cn (cons (hd (tl V6830)) (cons (shen.insert-l V6829 (hd (tl (tl V6830)))) ())))) ((and (cons? V6830) (and (= shen.app (hd V6830)) (and (cons? (tl V6830)) (and (cons? (tl (tl V6830))) (and (cons? (tl (tl (tl V6830)))) (= () (tl (tl (tl (tl V6830)))))))))) (cons shen.app (cons (hd (tl V6830)) (cons (shen.insert-l V6829 (hd (tl (tl V6830)))) (tl (tl (tl V6830))))))) (true (simple-error "implementation error in shen.insert-l")))) +(defun shen.insert-l (V5587 V5588) (cond ((= "" V5588) "") ((and (shen.+string? V5588) (and (= "~" (hdstr V5588)) (and (shen.+string? (tlstr V5588)) (= "A" (hdstr (tlstr V5588)))))) (cons shen.app (cons V5587 (cons (tlstr (tlstr V5588)) (cons shen.a ()))))) ((and (shen.+string? V5588) (and (= "~" (hdstr V5588)) (and (shen.+string? (tlstr V5588)) (= "R" (hdstr (tlstr V5588)))))) (cons shen.app (cons V5587 (cons (tlstr (tlstr V5588)) (cons shen.r ()))))) ((and (shen.+string? V5588) (and (= "~" (hdstr V5588)) (and (shen.+string? (tlstr V5588)) (= "S" (hdstr (tlstr V5588)))))) (cons shen.app (cons V5587 (cons (tlstr (tlstr V5588)) (cons shen.s ()))))) ((shen.+string? V5588) (shen.factor-cn (cons cn (cons (hdstr V5588) (cons (shen.insert-l V5587 (tlstr V5588)) ()))))) ((and (cons? V5588) (and (= cn (hd V5588)) (and (cons? (tl V5588)) (and (cons? (tl (tl V5588))) (= () (tl (tl (tl V5588)))))))) (cons cn (cons (hd (tl V5588)) (cons (shen.insert-l V5587 (hd (tl (tl V5588)))) ())))) ((and (cons? V5588) (and (= shen.app (hd V5588)) (and (cons? (tl V5588)) (and (cons? (tl (tl V5588))) (and (cons? (tl (tl (tl V5588)))) (= () (tl (tl (tl (tl V5588)))))))))) (cons shen.app (cons (hd (tl V5588)) (cons (shen.insert-l V5587 (hd (tl (tl V5588)))) (tl (tl (tl V5588))))))) (true (simple-error "implementation error in shen.insert-l")))) -(defun shen.factor-cn (V6831) (cond ((and (cons? V6831) (and (= cn (hd V6831)) (and (cons? (tl V6831)) (and (cons? (tl (tl V6831))) (and (cons? (hd (tl (tl V6831)))) (and (= cn (hd (hd (tl (tl V6831))))) (and (cons? (tl (hd (tl (tl V6831))))) (and (cons? (tl (tl (hd (tl (tl V6831)))))) (and (= () (tl (tl (tl (hd (tl (tl V6831))))))) (and (= () (tl (tl (tl V6831)))) (and (string? (hd (tl V6831))) (string? (hd (tl (hd (tl (tl V6831))))))))))))))))) (cons cn (cons (cn (hd (tl V6831)) (hd (tl (hd (tl (tl V6831)))))) (tl (tl (hd (tl (tl V6831)))))))) (true V6831))) +(defun shen.factor-cn (V5589) (cond ((and (cons? V5589) (and (= cn (hd V5589)) (and (cons? (tl V5589)) (and (cons? (tl (tl V5589))) (and (cons? (hd (tl (tl V5589)))) (and (= cn (hd (hd (tl (tl V5589))))) (and (cons? (tl (hd (tl (tl V5589))))) (and (cons? (tl (tl (hd (tl (tl V5589)))))) (and (= () (tl (tl (tl (hd (tl (tl V5589))))))) (and (= () (tl (tl (tl V5589)))) (and (string? (hd (tl V5589))) (string? (hd (tl (hd (tl (tl V5589))))))))))))))))) (cons cn (cons (cn (hd (tl V5589)) (hd (tl (hd (tl (tl V5589)))))) (tl (tl (hd (tl (tl V5589)))))))) (true V5589))) -(defun shen.proc-nl (V6834) (cond ((= "" V6834) "") ((and (shen.+string? V6834) (and (= "~" (hdstr V6834)) (and (shen.+string? (tlstr V6834)) (= "%" (hdstr (tlstr V6834)))))) (cn (n->string 10) (shen.proc-nl (tlstr (tlstr V6834))))) ((shen.+string? V6834) (cn (hdstr V6834) (shen.proc-nl (tlstr V6834)))) (true (simple-error "implementation error in shen.proc-nl")))) +(defun shen.proc-nl (V5592) (cond ((= "" V5592) "") ((and (shen.+string? V5592) (and (= "~" (hdstr V5592)) (and (shen.+string? (tlstr V5592)) (= "%" (hdstr (tlstr V5592)))))) (cn (n->string 10) (shen.proc-nl (tlstr (tlstr V5592))))) ((shen.+string? V5592) (cn (hdstr V5592) (shen.proc-nl (tlstr V5592)))) (true (simple-error "implementation error in shen.proc-nl")))) -(defun shen.mkstr-r (V6839 V6840) (cond ((= () V6840) V6839) ((cons? V6840) (shen.mkstr-r (cons shen.insert (cons (hd V6840) (cons V6839 ()))) (tl V6840))) (true (simple-error "implementation error in shen.mkstr-r")))) +(defun shen.mkstr-r (V5597 V5598) (cond ((= () V5598) V5597) ((cons? V5598) (shen.mkstr-r (cons shen.insert (cons (hd V5598) (cons V5597 ()))) (tl V5598))) (true (simple-error "implementation error in shen.mkstr-r")))) -(defun shen.insert (V6841 V6842) (shen.insert-h V6841 V6842 "")) +(defun shen.insert (V5599 V5600) (shen.insert-h V5599 V5600 "")) -(defun shen.insert-h (V6851 V6852 V6853) (cond ((= "" V6852) V6853) ((and (shen.+string? V6852) (and (= "~" (hdstr V6852)) (and (shen.+string? (tlstr V6852)) (= "A" (hdstr (tlstr V6852)))))) (cn V6853 (shen.app V6851 (tlstr (tlstr V6852)) shen.a))) ((and (shen.+string? V6852) (and (= "~" (hdstr V6852)) (and (shen.+string? (tlstr V6852)) (= "R" (hdstr (tlstr V6852)))))) (cn V6853 (shen.app V6851 (tlstr (tlstr V6852)) shen.r))) ((and (shen.+string? V6852) (and (= "~" (hdstr V6852)) (and (shen.+string? (tlstr V6852)) (= "S" (hdstr (tlstr V6852)))))) (cn V6853 (shen.app V6851 (tlstr (tlstr V6852)) shen.s))) ((shen.+string? V6852) (shen.insert-h V6851 (tlstr V6852) (cn V6853 (hdstr V6852)))) (true (simple-error "implementation error in shen.insert-h")))) +(defun shen.insert-h (V5609 V5610 V5611) (cond ((= "" V5610) V5611) ((and (shen.+string? V5610) (and (= "~" (hdstr V5610)) (and (shen.+string? (tlstr V5610)) (= "A" (hdstr (tlstr V5610)))))) (cn V5611 (shen.app V5609 (tlstr (tlstr V5610)) shen.a))) ((and (shen.+string? V5610) (and (= "~" (hdstr V5610)) (and (shen.+string? (tlstr V5610)) (= "R" (hdstr (tlstr V5610)))))) (cn V5611 (shen.app V5609 (tlstr (tlstr V5610)) shen.r))) ((and (shen.+string? V5610) (and (= "~" (hdstr V5610)) (and (shen.+string? (tlstr V5610)) (= "S" (hdstr (tlstr V5610)))))) (cn V5611 (shen.app V5609 (tlstr (tlstr V5610)) shen.s))) ((shen.+string? V5610) (shen.insert-h V5609 (tlstr V5610) (cn V5611 (hdstr V5610)))) (true (simple-error "implementation error in shen.insert-h")))) -(defun shen.app (V6854 V6855 V6856) (cn (shen.arg->str V6854 V6856) V6855)) +(defun shen.app (V5612 V5613 V5614) (cn (shen.arg->str V5612 V5614) V5613)) -(defun shen.arg->str (V6860 V6861) (cond ((= V6860 (fail)) "...") ((shen.list? V6860) (shen.list->str V6860 V6861)) ((string? V6860) (shen.str->str V6860 V6861)) ((absvector? V6860) (shen.vector->str V6860 V6861)) (true (shen.atom->str V6860)))) +(defun shen.arg->str (V5618 V5619) (cond ((= V5618 (fail)) "...") ((shen.list? V5618) (shen.list->str V5618 V5619)) ((string? V5618) (shen.str->str V5618 V5619)) ((absvector? V5618) (shen.vector->str V5618 V5619)) (true (shen.atom->str V5618)))) -(defun shen.list->str (V6862 V6863) (cond ((= shen.r V6863) (@s "(" (@s (shen.iter-list V6862 shen.r (shen.maxseq)) ")"))) (true (@s "[" (@s (shen.iter-list V6862 V6863 (shen.maxseq)) "]"))))) +(defun shen.list->str (V5620 V5621) (cond ((= shen.r V5621) (@s "(" (@s (shen.iter-list V5620 shen.r (shen.maxseq)) ")"))) (true (@s "[" (@s (shen.iter-list V5620 V5621 (shen.maxseq)) "]"))))) (defun shen.maxseq () (value *maximum-print-sequence-size*)) -(defun shen.iter-list (V6874 V6875 V6876) (cond ((= () V6874) "") ((= 0 V6876) "... etc") ((and (cons? V6874) (= () (tl V6874))) (shen.arg->str (hd V6874) V6875)) ((cons? V6874) (@s (shen.arg->str (hd V6874) V6875) (@s " " (shen.iter-list (tl V6874) V6875 (- V6876 1))))) (true (@s "|" (@s " " (shen.arg->str V6874 V6875)))))) +(defun shen.iter-list (V5632 V5633 V5634) (cond ((= () V5632) "") ((= 0 V5634) "... etc") ((and (cons? V5632) (= () (tl V5632))) (shen.arg->str (hd V5632) V5633)) ((cons? V5632) (@s (shen.arg->str (hd V5632) V5633) (@s " " (shen.iter-list (tl V5632) V5633 (- V5634 1))))) (true (@s "|" (@s " " (shen.arg->str V5632 V5633)))))) -(defun shen.str->str (V6879 V6880) (cond ((= shen.a V6880) V6879) (true (@s (n->string 34) (@s V6879 (n->string 34)))))) +(defun shen.str->str (V5637 V5638) (cond ((= shen.a V5638) V5637) (true (@s (n->string 34) (@s V5637 (n->string 34)))))) -(defun shen.vector->str (V6881 V6882) (if (shen.print-vector? V6881) ((fn (<-address V6881 0)) V6881) (if (vector? V6881) (@s "<" (@s (shen.iter-vector V6881 1 V6882 (shen.maxseq)) ">")) (@s "<" (@s "<" (@s (shen.iter-vector V6881 0 V6882 (shen.maxseq)) ">>")))))) +(defun shen.vector->str (V5639 V5640) (if (shen.print-vector? V5639) ((fn (<-address V5639 0)) V5639) (if (vector? V5639) (@s "<" (@s (shen.iter-vector V5639 1 V5640 (shen.maxseq)) ">")) (@s "<" (@s "<" (@s (shen.iter-vector V5639 0 V5640 (shen.maxseq)) ">>")))))) -(defun shen.empty-absvector? (V6883) (= V6883 (value shen.*empty-absvector*))) +(defun shen.print-vector? (V5641) (let W5642 (<-address V5641 0) (if (= W5642 shen.tuple) true (if (= W5642 shen.pvar) true (if (not (number? W5642)) (shen.fbound? W5642) false))))) -(defun shen.print-vector? (V6884) (and (not (shen.empty-absvector? V6884)) (let W6885 (<-address V6884 0) (or (= W6885 shen.tuple) (or (= W6885 shen.pvar) (or (= W6885 shen.dictionary) (and (not (number? W6885)) (shen.fbound? W6885)))))))) +(defun shen.fbound? (V5643) (not (= (arity V5643) -1))) -(defun shen.fbound? (V6886) (not (= (arity V6886) -1))) +(defun shen.tuple (V5644) (cn "(@p " (shen.app (<-address V5644 1) (cn " " (shen.app (<-address V5644 2) ")" shen.s)) shen.s))) -(defun shen.tuple (V6887) (cn "(@p " (shen.app (<-address V6887 1) (cn " " (shen.app (<-address V6887 2) ")" shen.s)) shen.s))) +(defun shen.iter-vector (V5651 V5652 V5653 V5654) (cond ((= 0 V5654) "... etc") (true (let W5655 (trap-error (<-address V5651 V5652) (lambda Z5656 shen.out-of-bounds)) (let W5657 (trap-error (<-address V5651 (+ V5652 1)) (lambda Z5658 shen.out-of-bounds)) (if (= W5655 shen.out-of-bounds) "" (if (= W5657 shen.out-of-bounds) (shen.arg->str W5655 V5653) (@s (shen.arg->str W5655 V5653) (@s " " (shen.iter-vector V5651 (+ V5652 1) V5653 (- V5654 1))))))))))) -(defun shen.dictionary (V6888) "(dict ...)") - -(defun shen.iter-vector (V6895 V6896 V6897 V6898) (cond ((= 0 V6898) "... etc") (true (let W6899 (trap-error (<-address V6895 V6896) (lambda Z6900 shen.out-of-bounds)) (let W6901 (trap-error (<-address V6895 (+ V6896 1)) (lambda Z6902 shen.out-of-bounds)) (if (= W6899 shen.out-of-bounds) "" (if (= W6901 shen.out-of-bounds) (shen.arg->str W6899 V6897) (@s (shen.arg->str W6899 V6897) (@s " " (shen.iter-vector V6895 (+ V6896 1) V6897 (- V6898 1))))))))))) - -(defun shen.atom->str (V6903) (trap-error (str V6903) (lambda Z6904 (shen.funexstring)))) +(defun shen.atom->str (V5659) (trap-error (str V5659) (lambda Z5660 (shen.funexstring)))) (defun shen.funexstring () (@s "" (@s "f" (@s "u" (@s "n" (@s "e" (@s (shen.arg->str (gensym (intern "x")) shen.a) ""))))))) -(defun shen.list? (V6905) (or (empty? V6905) (cons? V6905))) +(defun shen.list? (V5661) (or (empty? V5661) (cons? V5661))) diff --git a/klambda/yacc.kl b/klambda/yacc.kl index a8e638f..fc9c6e3 100644 --- a/klambda/yacc.kl +++ b/klambda/yacc.kl @@ -5,7 +5,7 @@ (defun shen.syntax-error-message (V123 V124 V125) (cond ((= () V125) " ") ((= V123 V124) "...etc -") ((cons? V125) (cn (shen.app (hd V125) " " shen.s) (shen.syntax-error-message V123 (+ V124 1) (tl V125)))) (true (shen.f-error shen.syntax-error-message)))) +") ((cons? V125) (cn (shen.app (hd V125) " " shen.s) (shen.syntax-error-message V123 (+ V124 1) (tl V125)))) (true (simple-error "partial function shen.syntax-error-message")))) (defun shen.parse-failure? (V126) (= V126 (fail))) @@ -80,21 +80,21 @@ (defun shen.conscode (V349 V350 V351 V352 V353) (let W354 (gensym Remainder) (let W355 (gensym Hd) (let W356 (gensym Tl) (cons if (cons (cons shen.ccons? (cons V350 ())) (cons (cons let (cons W355 (cons (cons head (cons V350 ())) (cons W356 (cons (cons tail (cons V350 ())) (cons (shen.yacc-syntax V349 W355 (append (shen.decons V351) (cons ())) (cons shen.processed (cons (shen.yacc-syntax V349 W356 V352 V353) ()))) ())))))) (cons (cons shen.parse-failure ()) ())))))))) -(defun shen.ccons? (V365) (cond ((and (cons? V365) (cons? (hd V365))) true) (true false))) +(defun shen.ccons? (V367) (cond ((and (cons? V367) (cons? (hd V367))) true) ((and (cons? V367) (= () (hd V367))) true) (true false))) -(defun shen.decons (V366) (cond ((and (cons? V366) (and (= cons (hd V366)) (and (cons? (tl V366)) (and (cons? (tl (tl V366))) (= () (tl (tl (tl V366)))))))) (cons (hd (tl V366)) (shen.decons (hd (tl (tl V366)))))) (true V366))) +(defun shen.decons (V368) (cond ((and (cons? V368) (and (= cons (hd V368)) (and (cons? (tl V368)) (and (cons? (tl (tl V368))) (= () (tl (tl (tl V368)))))))) (cons (hd (tl V368)) (shen.decons (hd (tl (tl V368)))))) (true V368))) -(defun shen.comb (V367 V368) (cons V367 (cons V368 ()))) +(defun shen.comb (V369 V370) (cons V369 (cons V370 ()))) -(defun shen.yacc-semantics (V373 V374 V375) (cond ((and (cons? V375) (and (= shen.processed (hd V375)) (and (cons? (tl V375)) (= () (tl (tl V375)))))) (hd (tl V375))) (true (let W376 (shen.process-yacc-semantics V375) (let W377 (shen.use-type-info V373 W376) (cons shen.comb (cons V374 (cons W377 ())))))))) +(defun shen.yacc-semantics (V375 V376 V377) (cond ((and (cons? V377) (and (= shen.processed (hd V377)) (and (cons? (tl V377)) (= () (tl (tl V377)))))) (hd (tl V377))) (true (let W378 (shen.process-yacc-semantics V377) (let W379 (shen.use-type-info V375 W378) (cons shen.comb (cons V376 (cons W379 ())))))))) -(defun shen.use-type-info (V381 V382) (cond ((and (cons? V381) (and (= { (hd V381)) (and (cons? (tl V381)) (and (cons? (hd (tl V381))) (and (= list (hd (hd (tl V381)))) (and (cons? (tl (hd (tl V381)))) (and (= () (tl (tl (hd (tl V381))))) (and (cons? (tl (tl V381))) (and (= --> (hd (tl (tl V381)))) (and (cons? (tl (tl (tl V381)))) (and (cons? (hd (tl (tl (tl V381))))) (and (= str (hd (hd (tl (tl (tl V381)))))) (and (cons? (tl (hd (tl (tl (tl V381)))))) (and (cons? (hd (tl (hd (tl (tl (tl V381))))))) (and (= list (hd (hd (tl (hd (tl (tl (tl V381)))))))) (and (cons? (tl (hd (tl (hd (tl (tl (tl V381)))))))) (and (= () (tl (tl (hd (tl (hd (tl (tl (tl V381))))))))) (and (cons? (tl (tl (hd (tl (tl (tl V381))))))) (and (= () (tl (tl (tl (hd (tl (tl (tl V381)))))))) (and (cons? (tl (tl (tl (tl V381))))) (and (= } (hd (tl (tl (tl (tl V381)))))) (and (= () (tl (tl (tl (tl (tl V381)))))) (and (= (hd (tl (hd (tl V381)))) (hd (tl (hd (tl (hd (tl (tl (tl V381))))))))) (shen.monomorphic? (hd (tl (tl (hd (tl (tl (tl V381))))))))))))))))))))))))))))))) (cons type (cons V382 (tl (tl (hd (tl (tl (tl V381))))))))) (true V382))) +(defun shen.use-type-info (V383 V384) (cond ((and (cons? V383) (and (= { (hd V383)) (and (cons? (tl V383)) (and (cons? (hd (tl V383))) (and (= list (hd (hd (tl V383)))) (and (cons? (tl (hd (tl V383)))) (and (= () (tl (tl (hd (tl V383))))) (and (cons? (tl (tl V383))) (and (= --> (hd (tl (tl V383)))) (and (cons? (tl (tl (tl V383)))) (and (cons? (hd (tl (tl (tl V383))))) (and (= str (hd (hd (tl (tl (tl V383)))))) (and (cons? (tl (hd (tl (tl (tl V383)))))) (and (cons? (hd (tl (hd (tl (tl (tl V383))))))) (and (= list (hd (hd (tl (hd (tl (tl (tl V383)))))))) (and (cons? (tl (hd (tl (hd (tl (tl (tl V383)))))))) (and (= () (tl (tl (hd (tl (hd (tl (tl (tl V383))))))))) (and (cons? (tl (tl (hd (tl (tl (tl V383))))))) (and (= () (tl (tl (tl (hd (tl (tl (tl V383)))))))) (and (cons? (tl (tl (tl (tl V383))))) (and (= } (hd (tl (tl (tl (tl V383)))))) (and (= () (tl (tl (tl (tl (tl V383)))))) (and (= (hd (tl (hd (tl V383)))) (hd (tl (hd (tl (hd (tl (tl (tl V383))))))))) (shen.monomorphic? (hd (tl (tl (hd (tl (tl (tl V383))))))))))))))))))))))))))))))) (cons type (cons V384 (tl (tl (hd (tl (tl (tl V383))))))))) (true V384))) -(defun shen.monomorphic? (V385) (cond ((variable? V385) false) ((cons? V385) (and (shen.monomorphic? (hd V385)) (shen.monomorphic? (tl V385)))) (true true))) +(defun shen.monomorphic? (V387) (cond ((variable? V387) false) ((cons? V387) (and (shen.monomorphic? (hd V387)) (shen.monomorphic? (tl V387)))) (true true))) -(defun shen.process-yacc-semantics (V386) (cond ((and (cons? V386) (and (= protect (hd V386)) (and (cons? (tl V386)) (and (= () (tl (tl V386))) (shen.non-terminal? (hd (tl V386))))))) (hd (tl V386))) ((cons? V386) (map (lambda Z387 (shen.process-yacc-semantics Z387)) V386)) ((shen.non-terminal? V386) (concat Action V386)) (true V386))) +(defun shen.process-yacc-semantics (V388) (cond ((and (cons? V388) (and (= protect (hd V388)) (and (cons? (tl V388)) (and (= () (tl (tl V388))) (shen.non-terminal? (hd (tl V388))))))) (hd (tl V388))) ((cons? V388) (map (lambda Z389 (shen.process-yacc-semantics Z389)) V388)) ((shen.non-terminal? V388) (concat Action V388)) (true V388))) -(defun shen.<-out (V390) (cond ((and (cons? V390) (and (cons? (tl V390)) (= () (tl (tl V390))))) (hd (tl V390))) (true (hd (tl V390))))) +(defun shen.<-out (V390) (hd (tl V390))) (defun shen.in-> (V391) (hd V391)) diff --git a/lua_interop.lua b/lua_interop.lua index bcf6833..a36f88e 100644 --- a/lua_interop.lua +++ b/lua_interop.lua @@ -255,20 +255,20 @@ end -- ---- install: the Shen-side surface ----------------------------------------- -- Shen-LEVEL registration of name/arity: the `arity` property plus the --- shen.lambda-form entry that (fn name) and Shen's evaluator consult. NOT via --- the kernel's update-lambda-table: in 41.2 that does --- (set-lambda-form-entry [F | LambdaEntry]) with LambdaEntry already the --- (name . fn) pair, so the stored lambda-form is a CONS, and any tc+ call --- site — which compiles declare-only functions to ((fn name) A B ...) — --- dies with "attempt to apply a non-function". We do exactly what the --- kernel's own build-lambda-table does: put the arity, then hand --- set-lambda-form-entry the (name . fn) entry from shen.lambda-entry. --- Both writes go through the LIVE F entries, so the fasl wrapper sees them --- ("p" + "lf" records) when called outside a chunk, and is correctly silent --- when called from inside one. +-- shen.*lambdatable* entry that (fn name) and Shen's evaluator consult. +-- +-- The S41.2 (2026-07-11 refresh) kernel dropped shen.set-lambda-form-entry +-- (and the whole lambda-FORM property the pre-refresh kernel keyed on). Its +-- lambda table is now the assoc list shen.*lambdatable*, whose entries are +-- (name . curried-fn) exactly as returned by shen.lambda-entry, and (fn name) +-- resolves by `assoc` into it. The kernel's own update-lambda-table does +-- precisely the pair of writes we need — (put name arity …) then cons +-- (shen.lambda-entry name) onto shen.*lambdatable* — and stores the CURRIED +-- FUNCTION as the value (not a cons), so the old "apply a non-function" hazard +-- at tc+ call sites is gone. Route through it. The internal put goes through +-- the LIVE F entry so the fasl "p" wrapper still sees it when outside a chunk. local function shen_register(nm, arity) - F["put"](nm, R.intern("arity"), arity, P.GLOBALS["*property-vector*"]) - F["shen.set-lambda-form-entry"](F["shen.lambda-entry"](nm)) + F["update-lambda-table"](nm, arity) end function M.install(prims) diff --git a/repl.lua b/repl.lua index c2966dd..9de1d74 100644 --- a/repl.lua +++ b/repl.lua @@ -288,7 +288,11 @@ end function M.run(opts) opts = opts or {} local P = opts.P or require("boot") - if P.F["shen.initialise"] == nil then P.load_kernel(opts.verbose) end + -- "kernel loaded?" probe: `version` is a stable public kernel function + -- present in every Shen version. (Do NOT probe shen.initialise — the S41.2 + -- 2026-07-11 refresh removed it, folding initialisation into declarations.kl + -- load-time forms; probing it would reload the kernel on every call.) + if P.F["version"] == nil then P.load_kernel(opts.verbose) end if P.GLOBALS["*property-vector*"] == nil then P.initialise() end local ed = make_editor() diff --git a/typecheck_native.lua b/typecheck_native.lua index 6599d4b..1dda0f5 100644 --- a/typecheck_native.lua +++ b/typecheck_native.lua @@ -180,6 +180,39 @@ local function harvest_init_sigs(src) return total > 0 and total == got end +-- Refreshed-kernel (S41.2 2026-07-11) signature harvest, from types.kl. +-- The refresh dropped init.kl/shen.initialise-signedfuncs; the 161 kernel +-- signatures now live as top-level (declare NAME TYPEFORM) forms in types.kl, +-- where TYPEFORM is the same rcons tree — e.g. (cons (cons list (cons A ())) +-- (cons --> ...)) — that `declare` evaluates into the type list at load. That +-- is exactly what evalrcons decodes, so we read the declare's type argument +-- directly (no CPS-lambda unwrapping). This yields the same raw, pre-rectify +-- signatures the init.kl harvest produced, which import_fresh + unify_oc +-- consume unchanged. +local function harvest_types_sigs(src) + init_syms() + if not src then return false end + local SYM_declare = R.intern("declare") + local total, got = 0, 0 + for _, form in ipairs(R.read_all(src)) do + if getmt(form) == Cons and form[1] == SYM_declare and getmt(form[2]) == Cons + and getmt(form[2][2]) == Cons then + local name = form[2][1] + local typeform = form[2][2][1] + if getmt(name) == Symbol then + total = total + 1 + local ok, t = pcall(evalrcons, typeform) + if ok and t ~= nil then + NativeSig[name] = t + got = got + 1 + end + end + end + end + M.sig_total, M.sig_got = total, got + return total > 0 and total == got +end + -- --------------------------------------------------------------------------- -- hand-ported drivers -- --------------------------------------------------------------------------- @@ -312,8 +345,14 @@ function M.install(Pmod, Emod) end return nil end - -- kernel signatures from init.kl; incomplete harvest forces legacy fallback - M.sigs_complete = harvest_init_sigs(read_kl("init")) + -- Kernel signatures: refreshed kernels carry them as (declare ...) forms in + -- types.kl; pre-refresh kernels (reachable via SHEN_KL_DIR) carry them as + -- shen.initialise-signedfuncs CPS lambdas in init.kl. Try the refresh source + -- first, fall back to the legacy one. An incomplete harvest (missing source + -- or an unrecognised form) leaves sigs_complete false, which forces the + -- legacy in-kernel typecheck path — slower, but identical verdicts. + M.sigs_complete = harvest_types_sigs(read_kl("types")) + or harvest_init_sigs(read_kl("init")) -- Driver TRANSLATION is DEFERRED to the first typecheck; the t-star.kl READ -- stays eager. Walking the 16 driver defuns through the KL->Lua prolog