From ea867d73c1d76d0210960f1c3ec6db9de58ee7bb Mon Sep 17 00:00:00 2001 From: Claude Date: Sun, 11 Oct 2026 04:28:02 +0000 Subject: [PATCH] Upgrade kernel to ShenOSKernel 42.2 (shen-scheme 0.50 parity) Adopt the community ShenOSKernel 42.2 release wholesale (option a of #79), replacing Tarver's S42.0 lineage: all 23 klambda/*.kl files and the tests/ suite are vendored byte-identical from ShenOSKernel-42.2.tar.gz (SHA-256 1d02273003654d34ec020ae67cb214ecec410dee3350419ff807d82b652678d8, shen-sources tag shen-42.2, commit 73507e069fe147aefb728d632c4ce40bc6a7b314). (version) is now "42.2". Boot/loader: - FILES is the 42.2 module set (pure defuns, no load-time effects) plus the extensions shen-scheme 0.50 boots (features, expand-dynamic, launcher, programmable-pattern-matching) and the precompiled stlib.kl. - initialise() calls (shen.initialise), the features and pattern-matching initialisers, registers lua.* interop, then (stlib.initialise). - The stdlib's 290 declares are cached as dumped prolog abstractions in a sidecar of the kernel bytecode cache (.stlib), reusing record_declares/replay_declares; stdlib phases run with the JIT off (run-once code; avoids a 10 ms vs 700 ms JIT-dependent bimodality). - lib/StLib (S-lineage stdlib sources) and the stdlib boot image are removed. prims.lua: - Native get/put/unput/arity/GET_OR rewritten for the 42.2 shen.dict property vector; fn fast path invalidated by a shen.lambda-form write generation counter (42.0 requirement). shen.lambda-entry native from boot. - <-address raises past the end of an absvector, so (vector 3) prints <... ... ...> like shen-scheme. Other: typecheck_native exposes record_sig for the cached replay; make-bundle drops the stdlib source payload; yggdrasil-build expects 42.2 manifests; scm rockspec drops lib/; specs updated for prolog-memory 10000, the new boot caches and <-address; docs, PROVENANCE, CHANGELOG. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01X718xocsFckMvso6EAKoXR --- .gitignore | 2 + CHANGELOG.md | 39 + README.md | 19 +- bin/yggdrasil-build.lua | 6 +- boot.lua | 490 ++++---- build/make-bundle.lua | 28 +- demo/walkthrough.md | 12 +- klambda/PROVENANCE.md | 197 ++-- klambda/README.md | 51 +- klambda/backend.kl | 20 - klambda/core.kl | 144 ++- klambda/declarations.kl | 98 +- klambda/dict.kl | 33 + klambda/extension-expand-dynamic.kl | 18 +- klambda/extension-features.kl | 6 +- klambda/extension-launcher.kl | 32 +- klambda/extension-namespaces.kl | 31 + ...extension-programmable-pattern-matching.kl | 32 +- klambda/extension-type-annotations.kl | 17 + klambda/init.kl | 8 + klambda/load.kl | 40 +- klambda/macros.kl | 66 +- klambda/prolog.kl | 202 ++-- klambda/reader.kl | 290 ++--- klambda/sequent.kl | 104 +- klambda/stlib.kl | 684 +++++++++++ klambda/sys.kl | 214 ++-- klambda/t-star.kl | 106 +- klambda/toplevel.kl | 36 +- klambda/track.kl | 66 +- klambda/types.kl | 334 +----- klambda/writer.kl | 52 +- klambda/yacc.kl | 12 +- lib/StLib/Calendar/date.shen | 160 --- lib/StLib/Data/data.shen | 26 - lib/StLib/IO/delete-file.shen | 7 - lib/StLib/IO/files.shen | 83 -- lib/StLib/IO/prettyprint.shen | 83 -- lib/StLib/Lists/lists.shen | 267 ----- lib/StLib/Lists/lists.shen.kl | 110 -- lib/StLib/Maths/complex.dtype | 31 - lib/StLib/Maths/complex.shen | 38 - lib/StLib/Maths/macros.shen | 55 - lib/StLib/Maths/maths.shen | 542 --------- lib/StLib/Maths/numerals.dtype | 47 - lib/StLib/Maths/numerals.shen | 91 -- lib/StLib/Maths/r.shen | 6 - lib/StLib/Maths/rationals.dtype | 31 - lib/StLib/Maths/rationals.shen | 126 -- lib/StLib/PROVENANCE.md | 54 - lib/StLib/README.txt | 1 - lib/StLib/Strings/macros.shen | 3 - lib/StLib/Strings/regex.shen | 286 ----- lib/StLib/Strings/smart.shen | 60 - lib/StLib/Strings/smartmem.shen | 63 - lib/StLib/Strings/strings.shen | 300 ----- lib/StLib/Symbols/symbols1.shen | 10 - lib/StLib/Symbols/symbols2.shen | 9 - lib/StLib/Tuples/tuples.shen | 30 - lib/StLib/Vectors/macros.shen | 26 - lib/StLib/install.shen | 51 - lib/StLib/package-stlib.shen | 4 - lua_interop.lua | 20 +- prims.lua | 250 ++-- repl.lua | 6 +- shen-scm-1.rockspec | 11 +- test/boot_cache_spec.lua | 92 +- test/library_spec.lua | 16 +- test/primitives_spec.lua | 12 +- test/prolog_semantics_spec.lua | 19 +- test/stdlib_spec.lua | 17 +- tests/README | 6 +- tests/binary.shen | 48 +- tests/bubble version 1.shen | 56 +- tests/bubble version 2.shen | 44 +- tests/c-minus.shen | 1032 ++++++++--------- tests/calculator.shen | 42 +- tests/call.shen | 29 +- tests/cartprod.shen | 46 +- tests/change.shen | 50 +- tests/classes-defaults.shen | 188 +-- tests/classes-inheritance.shen | 200 ++-- tests/classes-typed.shen | 148 +-- tests/classes-untyped.shen | 92 +- tests/cut.shen | 50 +- tests/depth.shen | 28 +- tests/einsteins-riddle.shen | 74 +- tests/extensions/features/tests.shen | 42 + tests/extensions/namespaces/code.shen | 40 + tests/extensions/namespaces/macros.shen | 23 + tests/extensions/namespaces/tests.shen | 178 +++ .../programmable-pattern-matching/code.shen | 8 +- .../programmable-pattern-matching/setup.shen | 26 + .../programmable-pattern-matching/tests.shen | 72 ++ .../typed-code.shen | 20 + .../typed-invalid.shen | 3 + tests/extensions/runme.shen | 5 + .../source-forms/fixtures/empty.shen | 2 + .../source-forms/fixtures/error.shen | 1 + .../source-forms/fixtures/input.shen | 1 + tests/extensions/source-forms/tests.shen | 119 ++ tests/extensions/type-annotations/code.shen | 12 + tests/extensions/type-annotations/tests.shen | 52 + tests/findall.shen | 12 +- tests/fork.shen | 30 +- tests/harness.shen | 84 +- tests/interpreter.shen | 410 +++---- tests/kerneltests.shen | 555 +++++---- tests/lisp.shen | 134 +-- tests/metaprog.shen | 170 +-- tests/minim.shen | 358 +++--- tests/montague.shen | 192 +-- tests/mutual.shen | 22 +- tests/n queens-axioms.shen | 416 +++---- tests/n queens-r.shen | 98 +- tests/n queens.axioms | 720 ++++++------ tests/n queens.kl | 16 - tests/n queens.shen | 94 +- tests/nreverseprolog.shen | 12 +- tests/parseprolog.shen | 32 +- tests/parser.shen | 102 +- tests/parsetest.shen | 2 - tests/powerset.shen | 20 +- tests/prime.shen | 20 +- tests/prolog.shen | 104 +- tests/prologinterp.shen | 348 +++--- tests/proof assistant.shen | 160 +-- tests/propcalcprolog.shen | 29 +- tests/proplog version 1.shen | 50 +- tests/proplog version 2.shen | 54 +- tests/qmachine.shen | 132 +-- tests/runme.shen | 2 +- tests/search.shen | 110 +- tests/secd1.shen | 97 +- tests/semantic net.shen | 88 +- tests/spreadsheet.shen | 68 +- tests/stack.shen | 54 +- tests/streams.shen | 40 +- tests/strings.shen | 100 +- tests/structures-typed.shen | 142 +-- tests/structures-untyped.shen | 82 +- tests/tableauprolog.shen | 64 +- tests/totalprolog.shen | 56 +- tests/unification.shen | 48 +- tests/yacc.shen | 280 ++--- typecheck_native.lua | 12 +- 146 files changed, 6673 insertions(+), 8215 deletions(-) create mode 100644 CHANGELOG.md delete mode 100644 klambda/backend.kl create mode 100644 klambda/dict.kl create mode 100644 klambda/extension-namespaces.kl create mode 100644 klambda/extension-type-annotations.kl create mode 100644 klambda/init.kl create mode 100644 klambda/stlib.kl delete mode 100644 lib/StLib/Calendar/date.shen delete mode 100644 lib/StLib/Data/data.shen delete mode 100644 lib/StLib/IO/delete-file.shen delete mode 100644 lib/StLib/IO/files.shen delete mode 100644 lib/StLib/IO/prettyprint.shen delete mode 100644 lib/StLib/Lists/lists.shen delete mode 100644 lib/StLib/Lists/lists.shen.kl delete mode 100644 lib/StLib/Maths/complex.dtype delete mode 100644 lib/StLib/Maths/complex.shen delete mode 100644 lib/StLib/Maths/macros.shen delete mode 100644 lib/StLib/Maths/maths.shen delete mode 100644 lib/StLib/Maths/numerals.dtype delete mode 100644 lib/StLib/Maths/numerals.shen delete mode 100644 lib/StLib/Maths/r.shen delete mode 100644 lib/StLib/Maths/rationals.dtype delete mode 100644 lib/StLib/Maths/rationals.shen delete mode 100644 lib/StLib/PROVENANCE.md delete mode 100644 lib/StLib/README.txt delete mode 100644 lib/StLib/Strings/macros.shen delete mode 100644 lib/StLib/Strings/regex.shen delete mode 100644 lib/StLib/Strings/smart.shen delete mode 100644 lib/StLib/Strings/smartmem.shen delete mode 100644 lib/StLib/Strings/strings.shen delete mode 100644 lib/StLib/Symbols/symbols1.shen delete mode 100644 lib/StLib/Symbols/symbols2.shen delete mode 100644 lib/StLib/Tuples/tuples.shen delete mode 100644 lib/StLib/Vectors/macros.shen delete mode 100644 lib/StLib/install.shen delete mode 100644 lib/StLib/package-stlib.shen create mode 100644 tests/extensions/features/tests.shen create mode 100644 tests/extensions/namespaces/code.shen create mode 100644 tests/extensions/namespaces/macros.shen create mode 100644 tests/extensions/namespaces/tests.shen create mode 100644 tests/extensions/programmable-pattern-matching/typed-code.shen create mode 100644 tests/extensions/programmable-pattern-matching/typed-invalid.shen create mode 100644 tests/extensions/source-forms/fixtures/empty.shen create mode 100644 tests/extensions/source-forms/fixtures/error.shen create mode 100644 tests/extensions/source-forms/fixtures/input.shen create mode 100644 tests/extensions/source-forms/tests.shen create mode 100644 tests/extensions/type-annotations/code.shen create mode 100644 tests/extensions/type-annotations/tests.shen delete mode 100644 tests/n queens.kl delete mode 100644 tests/parsetest.shen diff --git a/.gitignore b/.gitignore index 73bcdea..bfb3e7d 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,8 @@ .claude/ .shen-kernel-cache*.bin .shen-kernel-cache*.bin.tmp +.shen-kernel-cache*.bin.stlib +.shen-kernel-cache*.bin.stlib.tmp build/shen-bundle.lua .fasl-test/ luacov.stats.out diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..a47ca96 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,39 @@ +# Changelog + +Notable changes to shen-lua. Release notes for earlier versions are under +[`doc/`](doc/) (`RELEASE-*.md`). + +## [Unreleased] + +### Changed + +- **Kernel: ShenOSKernel 42.2** (community `Shen-Language/shen-sources`, tag + `shen-42.2`, commit `73507e0`, release tarball SHA-256 `1d022730…2678d8`), + vendored byte-identical, replacing Tarver's S42.0 kernel — the same kernel + shen-scheme 0.50 ships. `(version)` is `"42.2"`. Lineage choice and full + delta: [`klambda/PROVENANCE.md`](klambda/PROVENANCE.md) (pyrex41/shen-lua#79). +- Boot: the 42.2 modules are pure defuns; `boot.lua` now calls + `(shen.initialise)`, `(shen.x.features.initialise …)`, + `(shen.x.programmable-pattern-matching.initialise)` and `(stlib.initialise)` + after loading them, matching shen-scheme 0.50's boot set and order. +- Standard library: the precompiled 42.2 `klambda/stlib.kl` replaces the + S-lineage `lib/StLib` Shen sources (removed, together with the stdlib boot + image that cached loading them). Its 290 type signatures are cached in a + sidecar of the kernel bytecode cache (`.stlib`). Warm boot is + ~100 ms CPU (was ~135 ms). +- `prims.lua`: the native `get`/`put`/`unput`/`arity` property store now + operates on the 42.2 `shen.dict` layout; the native `fn` cache is + invalidated on every `shen.lambda-form` write (42.0 port requirement). + `shen.lambda-entry` is native from boot. +- The kernel test suite under `tests/` is the 42.2 suite (143 tests, was 134); + the 42.2 extension suite (`tests/extensions/runme.shen`, 123 checks) passes + when run from a ShenOSKernel 42.2 tree. +- `shen.*prolog-memory*` defaults to 10000 (42.2 `init.kl`; S42 had 1000). +- `bin/yggdrasil-build.lua` expects `kernel-version=42.2` manifests (older + slices still build, with a warning). + +### Fixed + +- `<-address` past the end of an absvector raises instead of returning `nil`, + so the kernel's vector printer stops at the end: `(vector 3)` prints + `<... ... ...>` (it printed stray `funex…` entries). diff --git a/README.md b/README.md index 5de2391..51d2b06 100644 --- a/README.md +++ b/README.md @@ -1,8 +1,8 @@ # shen-lua [Shen](https://shenlanguage.org) on **LuaJIT 2.1**: pattern matching, optional -sequent types, and Prolog, compiled to Lua. Shen 42, **134/134** official -kernel tests. Embeds in any Lua host. Plain Lua 5.1/5.4/5.5 works too (slower, +sequent types, and Prolog, compiled to Lua. ShenOSKernel 42.2, **143/143** +official kernel tests. Embeds in any Lua host. Plain Lua 5.1/5.4/5.5 works too (slower, still correct). ```sh @@ -15,8 +15,9 @@ luajit examples/hello_embed.lua # embed in Lua, ~25 lines LuaJIT 2.1 is the primary host (`brew install luajit` / `apt-get install luajit`); the source checkout also supports plain Lua as -described below. First boot compiles the kernel and loads the Shen-source -standard library; subsequent boots use bytecode and standard-library caches. +described below. First boot compiles the kernel (including the precompiled +standard library, `stlib.kl`); subsequent boots use the bytecode and +standard-library signature caches. Loaded programs are cached fasl-style. Cross-port agreement lives in [Bifrost](https://github.com/pyrex41/bifrost). New to Shen? [shenlanguage.org](https://shenlanguage.org). @@ -124,7 +125,7 @@ More under [`examples/`](examples/README.md). A full tour: ```sh make test # port specs (test/*_spec.lua) -luajit run-kernel-tests.lua # official 42 suite → 134/134 +luajit run-kernel-tests.lua # official 42.2 suite → 143/143 ``` The kernel suite is vendored in `tests/`. Port specs cover primitives, REPL, @@ -137,8 +138,8 @@ luarocks install shen # launcher + modules luarocks make --local shen-scm-1.rockspec # this tree ``` -LuaJIT required (`lua == 5.1`). Release **0.11.1** uses kernel **42**; **0.9.0** -was 41.1. Or grab `shen-bundle.lua` from +LuaJIT required (`lua == 5.1`). This tree uses ShenOSKernel **42.2**; release +**0.11.1** uses Tarver's S42 kernel; **0.9.0** was 41.1. Or grab `shen-bundle.lua` from [Releases](https://github.com/pyrex41/shen-lua/releases/latest) — one file, `require("shen-bundle")`. @@ -168,7 +169,7 @@ LuaJIT trace logs, run `luajit -jv bin/shen ...`. Prolog and the typechecker run on a native engine (`prolog_engine.lua`); the portable kernel predicates that show up on compile and execution paths are -overridden in `prims.lua`. Caches (kernel bytecode, stdlib image, user fasl) +overridden in `prims.lua`. Caches (kernel bytecode, stdlib signatures, user fasl) are content-keyed and safe to delete. Internals: [`doc/PERF-HANDOFF.md`](doc/PERF-HANDOFF.md), [`doc/BENCHMARKS.md`](doc/BENCHMARKS.md). @@ -179,7 +180,7 @@ LuaJIT 2.1. Kernel sources are in `klambda/` (see [`klambda/PROVENANCE.md`](klambda/PROVENANCE.md)). `SHEN_KL_DIR` can point at another tree. -**PUC Lua 5.1/5.4/5.5:** same 134/134. No FFI → legacy Prolog engine; no `bit` +**PUC Lua 5.1/5.4/5.5:** same 143/143 (checked on 5.4.7). No FFI → legacy Prolog engine; no `bit` → caches off. Lua 5.3+ arithmetic is forced to floats so it matches LuaJIT. **Old LuaJIT on aarch64** (2.1.0-beta3): boot-time JIT crash, fixed upstream. diff --git a/bin/yggdrasil-build.lua b/bin/yggdrasil-build.lua index 2882867..0cf79ac 100644 --- a/bin/yggdrasil-build.lua +++ b/bin/yggdrasil-build.lua @@ -3,7 +3,7 @@ -- luajit bin/yggdrasil-build.lua [--linked] -- -- is a Yggdrasil stage-1 output directory: a tree-shaken --- kernel (kernel.kl, ShenOSKernel-42 defuns in load order), the user +-- kernel (kernel.kl, ShenOSKernel defuns in load order), the user -- program as KL (one or more user= files), and yggdrasil.manifest.txt. -- The builder compiles every KL form ahead of time with the port's own -- compiler (compiler.lua C.compile_top) and emits ONE runnable Lua @@ -108,8 +108,8 @@ end assert(man.kernel, MANIFEST .. ": missing kernel=") assert(man.init, MANIFEST .. ": missing init=") assert(#man.user > 0, MANIFEST .. ": no user= entries") -if man["kernel-version"] ~= "42" then - io.stderr:write(("yggdrasil-build: warning: manifest kernel-version=%s, this port is certified against 42\n") +if man["kernel-version"] ~= "42.2" then + io.stderr:write(("yggdrasil-build: warning: manifest kernel-version=%s, this port is certified against 42.2\n") :format(tostring(man["kernel-version"]))) end diff --git a/boot.lua b/boot.lua index 9125657..5bcc913 100644 --- a/boot.lua +++ b/boot.lua @@ -1,7 +1,7 @@ -- boot.lua : load the full Shen KLambda kernel into the Lua runtime and --- initialise it. Returns the prims module P with everything live. (On the --- S42 (2026-08-25) kernel self-initialises at load time; see FILES --- and initialise() below.) +-- initialise it. Returns the prims module P with everything live. The +-- ShenOSKernel 42.2 modules are pure defuns; initialise() below runs +-- (shen.initialise), the extension initialisers and (stlib.initialise). local R = require("runtime") local C = require("compiler") local P = require("prims") @@ -146,41 +146,27 @@ local function find_kldir() end local KLDIR = find_kldir() .. "/" P.KLDIR = KLDIR -- resolved .kl directory (trailing /), for typecheck_native --- Boot order for the S42 (2026-08-25) 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()). +-- Boot order for the ShenOSKernel-42.2 kernel (community shen-sources line). +-- Every 42.2 .kl file is pure defuns: no module has load-time side effects, so +-- the order below (upstream make.shen's module order, then the booted +-- extensions, then the precompiled standard library) is for readability only. +-- All initialisation happens AFTER load, in initialise() below, exactly as +-- upstream ports do it: +-- (shen.initialise) -- init.kl: environment, *property-vector* dict, +-- -- arity table, lambda forms, kernel signatures +-- (stlib.initialise) -- stlib.kl: stdlib arities, macros, datatypes, types -- --- 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 three are the community ShenOSKernel extensions, which Tarver's --- refresh no longer ships as KLambda. shen-lua keeps vendoring them on top so --- the CLI launcher etc. stay available; they are pure defuns/defmacros --- referencing only public kernel functions, so they load unchanged. --- --- NOTE: stlib is NOT here. The standard library is no longer a precompiled --- klambda/stlib.kl; it is loaded from the S-lineage Shen sources under --- lib/StLib/ by load_stdlib() (below), which the refresh's own install.shen --- drives. See lib/StLib/PROVENANCE.md and klambda/PROVENANCE.md. +-- Booted extensions match what shen-scheme 0.50 boots: features and +-- programmable-pattern-matching (both initialised in initialise(), in that +-- order, as shen-scheme does), expand-dynamic and launcher. Vendored but NOT +-- booted (opt-in): extension-namespaces and extension-type-annotations. See +-- klambda/PROVENANCE.md. local FILES = { - "yacc","core","load","prolog","reader","sequent","sys","toplevel", - "track","writer","backend","macros","declarations","t-star","types", - "extension-features","extension-expand-dynamic","extension-launcher" + "yacc","core","declarations","load","prolog","reader","sequent","sys", + "dict","t-star","toplevel","track","types","writer","init","macros", + "extension-features","extension-expand-dynamic","extension-launcher", + "extension-programmable-pattern-matching", + "stlib" } -- ---- standard streams ---------------------------------------------------- @@ -200,7 +186,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 declarations.kl ("42") +P.GLOBALS["*release*"] = "0.1" -- port release; kernel *version* comes from init.kl ("42.2") -- ---- kernel bytecode cache ------------------------------------------------- -- Loading the kernel from .kl sources costs ~0.8s (read + parse + KL->Lua @@ -434,16 +420,20 @@ local function read_cache(path, key) end -- ---- load the kernel ----------------------------------------------------- --- Loads the 19 .kl modules in FILES (see above): the 15 refreshed S42 --- (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. +-- Loads the .kl modules in FILES (see above): the 16 ShenOSKernel 42.2 kernel +-- modules, 4 booted extensions and the precompiled stlib. The opt-in +-- extension-namespaces.kl / extension-type-annotations.kl are 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). -- Native overrides, installed after the compiled KL defuns are all in F. local function install_native_overrides() + -- shen.lambda-entry without a KL->Lua compile per entry: every + -- update-lambda-table (each `define`, and the 326 stdlib arities that + -- (stlib.initialise-arities) registers at boot) builds one. + P.install_native_lambda_entry() -- Hottest Prolog deref primitives (see prims.install_native_prolog). P.install_native_prolog() -- Hottest general-purpose kernel functions with native Lua @@ -482,7 +472,13 @@ local function kernel_key() end -- ---- hoisted kernel type signatures --------------------------------------- --- klambda/types.kl ends with 161 top-level `(declare Name Type)` forms, and +-- (ShenOSKernel 42.2 has no top-level forms at all — its kernel signatures are +-- precompiled closures in init.kl's shen.initialise-signedfuncs — so on the +-- vendored kernel hoist_tail finds nothing to hoist. The machinery stays for +-- S42-shaped trees via SHEN_KL_DIR, and record_declares / replay_declares are +-- reused for the standard library's 290 declares; see stlib_types.) +-- On the S42.0 kernel, klambda/types.kl ended with 161 top-level +-- `(declare Name Type)` forms, and -- they are not cheap annotations: `declare` (types.kl) runs the type theory for -- real on every one of them — -- (a) shen.variancy over the signature under the Prolog machine, @@ -551,8 +547,9 @@ end -- Split a kernel file's forms into (body, init forms, declares). Only a -- TRAILING run of non-defun top-level forms is ever moved, and it is run -- immediately after the body chunk, so hoisting cannot reorder anything. In --- the 42 kernel exactly two files have such a run: types.kl (161 declares) --- and declarations.kl (one form, (shen.build-lambda-table (external shen))). +-- the S42.0 kernel exactly two files had such a run: types.kl (161 declares) +-- and declarations.kl (one form, (shen.build-lambda-table (external shen))); +-- ShenOSKernel 42.2 has none. -- Anything less tidy than [defuns...][inits...][declares...] is left inline. local function hoist_tail(forms) local last = #forms @@ -595,7 +592,7 @@ local function record_declares(decls) if rec.n ~= n0 + 1 or rec[rec.n].k ~= "c" then error("shen-lua: unexpected declare recording", 0) end - out[#out + 1] = { name = d.name.name, dump = rec[rec.n].dump } + out[#out + 1] = { name = d.name.name, typ = d.typ, dump = rec[rec.n].dump } end end) P.FASL_REC = saved_rec @@ -612,12 +609,17 @@ local function record_declares(decls) return out end -local function replay_declares(decl) +-- fns: optional pre-loaded chunk functions (index-aligned with decl). +-- on_sig: optional (name, typ) hook — the native typechecker's signature +-- table, which a live `declare` would have fed through its wrapper. +local function replay_declares(decl, fns, on_sig) local sigf = R.intern("shen.*sigf*") local assoc, set = P.F["shen.assoc->"], P.F["set"] - for _, e in ipairs(decl) do - local fn = P.load_chunk(e.dump, "declare:" .. e.name) - set(sigf, assoc(R.intern(e.name), fn(), P.GLOBALS["shen.*sigf*"])) + for i, e in ipairs(decl) do + local fn = fns and fns[i] or P.load_chunk(e.dump, "declare:" .. e.name) + local name = R.intern(e.name) + if on_sig and e.typ ~= nil then on_sig(name, e.typ) end + set(sigf, assoc(name, fn(), P.GLOBALS["shen.*sigf*"])) end end @@ -1368,134 +1370,52 @@ local function install_fasl() FASL_INSTALLED = true end --- ---- initialise ---------------------------------------------------------- --- ---- standard library (S-lineage lib/StLib sources) ---------------------- --- Tarver's S42 release ships the standard library as Shen SOURCES under --- Lib/StLib (loaded into the SBCL image at install time), not as a precompiled --- stlib.kl. shen-lua vendors those sources under lib/StLib/ and loads them the --- same way: through the kernel's own (load ...) / define pipeline. Unlike raw --- stlib.kl defuns (which the pre-refresh port booted as a kernel module), the --- define path registers each function's arity property + shen.*lambdatable* --- entry, so `(fn filter)` and a bare top-level `(filter ...)` now resolve --- instead of raising "fn: filter is undefined". --- --- We run upstream's own install.shen (its factorise toggles, the package + --- systemf externals block, everything) with two mechanical rewrites: --- 1. its relative (load "Sub/file.shen") paths are made absolute against the --- vendored directory, so no process chdir is needed (a chdir would --- invalidate the KLDIR-relative reads the fasl kernel-key hashing does); --- 2. its (tc +) toggles are neutralised to (tc -), i.e. the stdlib is loaded --- WITHOUT typechecking. This matches the pre-refresh behaviour (the old --- precompiled stlib.kl registered no stdlib type signatures either — its --- stlib.initialise was never called), it is markedly faster, and it keeps --- the native typecheck drivers deferred at boot (a tc+ load would trigger --- the typechecker and translate them eagerly). Functions are still fully --- defined and arity-registered — only their type signatures are skipped. --- SHEN_NO_STDLIB=1 skips the whole thing (a kernel-only embed); SHEN_STDLIB_DIR --- overrides the location. +-- ---- standard library (precompiled klambda/stlib.kl) ---------------------- +-- ShenOSKernel 42.2 ships the standard library precompiled as klambda/stlib.kl +-- (generated by upstream make-stlib.shen from lib/stlib). Its defuns load with +-- the kernel (FILES); port-upgrades.md (41.1) then requires a call to +-- (stlib.initialise) after the kernel is initialised, which installs the +-- library's package/external symbols, arities + lambda forms, macros, +-- datatypes, type signatures and source records, and finishes with +-- (preclude-all-but []) (set shen.*userdefs* []) (cd "") (tc -). This is +-- exactly what shen-scheme 0.50 does. SHEN_NO_STDLIB=1 skips the call (the +-- defuns stay loaded but are not registered as Shen functions). local STDLIB_LOADED = false --- set when the stdlib was materialised to a fresh temp directory (single-file --- bundle): its paths differ on every boot, so a path-keyed boot image would --- miss every time AND leave a new multi-megabyte file behind on each run. -local STDLIB_EPHEMERAL = false -local function find_stdlib_dir() - local env = os.getenv("SHEN_STDLIB_DIR") - if env and env ~= "" then return env end - -- module-relative first (chdir-independent: boot.lua sits at the repo root) - local src = debug.getinfo(1, "S").source - local here = src:match("^@(.*)[/\\][^/\\]*$") - local candidates = {} - if here then - candidates[#candidates+1] = here .. "/lib/StLib" - -- LuaRocks deploys copy_directories' lib/ tree under lib/lua/5.1, - -- separate from these modules under share/lua/5.1. - local tree = here:match("^(.*)/share/lua/[%d.]+$") - if tree then candidates[#candidates+1] = tree .. "/lib/lua/5.1/StLib" end - end - candidates[#candidates+1] = "lib/StLib" - for _, d in ipairs(candidates) do - local f = io.open(d .. "/install.shen", "r") - if f then f:close(); return d end - end - -- Single-file bundle: no lib/StLib on disk, but make-bundle.lua embedded the - -- whole tree as P.STDLIB_SOURCES (relpath -> content). Materialise it once to - -- a temp dir and load from there (reuses the ordinary file-based load path). - if P.STDLIB_SOURCES then - STDLIB_EPHEMERAL = true - local base = os.tmpname(); os.remove(base) - os.execute("mkdir -p '" .. base .. "'") - for rel, content in pairs(P.STDLIB_SOURCES) do - local full = base .. "/" .. rel - local sub = full:match("^(.*)/[^/]*$") - if sub then os.execute("mkdir -p '" .. sub .. "'") end - local fh = io.open(full, "wb") - if fh then fh:write(content); fh:close() end - end - return base - end - return nil -end --- ---- standard-library boot image ------------------------------------------ --- Everything above caches a PIECE of the boot. This caches the whole standard --- library phase as one artifact — the closest a Lua host gets to shen-cl's --- save-lisp-and-die, which is why it starts so much faster: it does not rebuild --- anything. --- --- A warm stdlib load was, before this, ~20 separate fasl hits plus the --- install.shen driver around them, and the driver is not free: reading --- install.shen through the kernel reader alone costs ~12 ms, and the trailing --- (external stlib) / systemf / preclude-all-but block another ~11 ms, none of --- which any per-file cache could ever capture because it does not happen inside --- a file. The image records the ENTIRE span — driver forms and nested loads --- alike, in stream order — as one fasl record stream (the nested loads splice --- their own streams into it; see splice_into_outer), and replays it in one go. --- --- Invalidation is by construction rather than by convention: the file name is --- keyed on the kernel key + the record format + the Prolog engine + the --- rewritten install.shen text, and the image itself carries the path and --- content hash of EVERY file the recorded span loaded. A stale or edited --- standard-library file fails its hash and the image is a miss. The per-file --- fasl caches are still written on a miss, so if the image cannot be --- serialized for any reason the next boot is exactly as fast as it was before --- this existed. SHEN_STDLIB_IMAGE=off disables it. -local IMAGE_FORMAT = "SHENIMG1" - --- Keyed on the install.shen text as it is ON DISK, deliberately NOT on the --- rewritten script: the rewrite bakes in the absolute stdlib directory, and --- boot.lua resolves that differently depending on how it was itself located --- ("./lib/StLib" from a repo-root run, an absolute path from a package.path --- run), which would give the same checkout several images of a megabyte each. --- The directory is not dropped from the key so much as checked more strictly: --- the recorded dependency paths must all still hash to what they did, so an --- image recorded against one tree simply misses against another. -local function image_path(raw_script) - local d = fasl_dir() - if not d or not FASL_INSTALLED then return nil end - local v = os.getenv("SHEN_STDLIB_IMAGE") - if v == "off" or v == "0" or STDLIB_EPHEMERAL then return nil end - local env = IMAGE_FORMAT .. "|" .. FASL_FORMAT - .. "|" .. (os.getenv("SHEN_PROLOG_ENGINE") or "native") - return d .. "/stdlib-" - .. bit.tohex(fnv1a(raw_script, fnv1a(env, fnv1a((kernel_key()))))) .. ".img" +-- (stlib.initialise-types) is 290 (declare Name Type) calls, and `declare` +-- runs the type theory for real on each (variancy under the Prolog machine, +-- then a KL->Lua compile of the signature's prolog abstraction): ~0.2 s, the +-- bulk of a warm boot. Everything it depends on is fixed by the kernel cache +-- key, so cache it exactly the way the S42 kernel's own types.kl signatures +-- were cached (hoist_tail / record_declares / replay_declares): a sidecar file +-- next to the kernel bytecode cache holds, per signature, its raw type and the +-- dumped abstraction chunk, plus the gensym / inference counters. A warm boot +-- replays them into shen.*sigf* (and the native typechecker's signature +-- table) in the original order. SHEN_KERNEL_CACHE=off disables it with the +-- kernel cache. +local SIGS_FORMAT = "SHENSIG1" +local function stlib_sigs_path() + if P.KERNEL_CACHE_DATA then return nil end -- single-file bundle + local p = cache_path() + return p and (p .. ".stlib") or nil end --- header: IMAGE_FORMAT\n ndeps\n { #path\n path #content\n hash\n }* --- followed by a fasl record stream (fasl_serialize). -local function image_write(path, rec, arity0) - local parts = { IMAGE_FORMAT, "\n", tostring(#rec.deps), "\n" } - for _, d in ipairs(rec.deps) do - parts[#parts+1] = #d.path .. "\n" .. d.path - .. #d.content .. "\n" .. bit.tohex(fnv1a(d.content)) .. "\n" +local function write_sigs(path, key, decl, counters) + local parts = { SIGS_FORMAT, "\n", key, "\n", tostring(#decl), "\n" } + for _, e in ipairs(decl) do + parts[#parts+1] = e.name .. "\n" .. #e.dump .. "\n" .. e.dump + kdata_ser(e.typ, parts) end - parts[#parts+1] = fasl_serialize(rec, arity0) - atomic_write(path, table.concat(parts)) + parts[#parts+1] = tostring(counters.gensym) .. "\n" .. tostring(counters.infs) .. "\n" + local tmp = path .. ".tmp" + local fh = io.open(tmp, "wb") + if not fh then return end + fh:write(table.concat(parts)); fh:close() + os.remove(path) + os.rename(tmp, path) end --- Returns the parsed record stream, or nil if the image is absent, malformed, --- or any recorded dependency no longer hashes to what it did. Also returns the --- dependency contents, in load order, for the FASL_ROLL fold. -local function image_read(path) +local function read_sigs(path, key) local data = read_file(path) if not data then return nil end local pos = 1 @@ -1505,128 +1425,140 @@ local function image_read(path) local s = data:sub(pos, e - 1); pos = e + 1 return s end - if line() ~= IMAGE_FORMAT then return nil end - local nd = tonumber(line() or ""); if not nd then return nil end - local contents = {} - for i = 1, nd do - local plen = tonumber(line() or ""); if not plen then return nil end - if pos + plen - 1 > #data then return nil end - local dpath = data:sub(pos, pos + plen - 1); pos = pos + plen - local clen = tonumber(line() or ""); if not clen then return nil end - local hash = line(); if not hash then return nil end - local c = read_file(dpath) - if not c or #c ~= clen or bit.tohex(fnv1a(c)) ~= hash then return nil end - contents[i] = c + if line() ~= SIGS_FORMAT or line() ~= key then return nil end + local n = tonumber(line() or ""); if not n then return nil end + local decl = {} + local ok = pcall(function() + for i = 1, n do + local nm = line() + local len = tonumber(line() or "") + if not nm or not len or pos + len - 1 > #data then error("truncated") end + local dump = data:sub(pos, pos + len - 1) + pos = pos + len + local typ + typ, pos = kdata_de(data, pos) + decl[i] = { name = nm, typ = typ, dump = dump } + end + end) + if not ok then return nil end + local gensym = tonumber(line() or ""); if not gensym then return nil end + local infs = tonumber(line() or ""); if not infs then return nil end + return { decl = decl, gensym = gensym, infs = infs } +end + +local function stlib_types(verbose) + local init_types = P.F["stlib.initialise-types"] + local path = stlib_sigs_path() + if not path then return init_types() end + local key = kernel_key() .. "|" .. SIGS_FORMAT + local tn = package.loaded["typecheck_native"] + local on_sig = tn and tn.record_sig or nil + local cached = read_sigs(path, key) + if cached then + -- load every dump before running any, so a foreign-arch file falls back + -- to the real declares with nothing half-applied + local fns, lok = {}, true + for i, e in ipairs(cached.decl) do + local ok, fn = pcall(P.load_chunk, e.dump, "declare:" .. e.name) + if not ok then lok = false; break end + fns[i] = fn + end + if lok then + replay_declares(cached.decl, fns, on_sig) + if type(P.GLOBALS["shen.*gensym*"]) == "number" + and cached.gensym > P.GLOBALS["shen.*gensym*"] then + P.GLOBALS["shen.*gensym*"] = cached.gensym + end + if type(P.GLOBALS["shen.*infs*"]) == "number" + and cached.infs > P.GLOBALS["shen.*infs*"] then + P.GLOBALS["shen.*infs*"] = cached.infs + end + if verbose then io.stderr:write(" stdlib signatures (cached)\n") end + return + end + os.remove(path) + end + -- Cold: collect the (name, type) pairs the compiled initialiser declares, + -- then run the real declares through record_declares in the same order. + local live = P.F["declare"] + local decls = {} + P.F["declare"] = function(name, typ) + decls[#decls + 1] = { name = name, typ = typ } + return name + end + local ok, err = pcall(init_types) + P.F["declare"] = live + if not ok then error(err, 0) end + local out = record_declares(decls) + if out then + write_sigs(path, key, out, { + gensym = type(P.GLOBALS["shen.*gensym*"]) == "number" and P.GLOBALS["shen.*gensym*"] or 0, + infs = type(P.GLOBALS["shen.*infs*"]) == "number" and P.GLOBALS["shen.*infs*"] or 0, + }) end - local cached = fasl_parse(data, pos) - if not cached then return nil end - return cached, contents end +local STDLIB_PHASES = { "environment", "arities", "macros", "synonyms", + "datatypes", "types", "sources", "final" } + local function load_stdlib(verbose) if STDLIB_LOADED then return end if os.getenv("SHEN_NO_STDLIB") == "1" then return end - local dir = find_stdlib_dir() - if not dir then - if verbose then io.stderr:write(" stdlib: lib/StLib not found; skipping (kernel-only)\n") end + if not P.F["stlib.initialise"] then + if verbose then io.stderr:write(" stdlib: stlib.initialise not defined; skipping\n") end return end - local raw_script = read_file(dir .. "/install.shen") - if not raw_script then return end - local script = raw_script - -- Rewrite the relative (load "X") targets to absolute so no chdir is needed. - -- All install.shen load paths are relative; the replacement text is escaped - -- for gsub's % handling. - local prefix = ("(load \"" .. dir .. "/"):gsub("%%", "%%%%") - script = script:gsub('%(load "', prefix) - script = script:gsub("%(tc %+%)", "(tc -)") -- load without typechecking (see above) local hush0 = P.GLOBALS["*hush*"] - P.GLOBALS["*hush*"] = true -- suppress the ~20 "loaded" echoes - - -- The driver: read install.shen and run its forms. A top-level (load "X") is - -- dispatched straight to `load` rather than through `eval`, which is what it - -- would compile to anyway — it saves a chunk compile per file, and it keeps - -- the recorded image free of chunks that would re-run the load it is meant to - -- have replaced. - local function run_driver() - local forms = P.F["read-from-string"](script) - while R.is_cons(forms) do - local f = forms[1] - if R.is_cons(f) and R.is_symbol(f[1]) and f[1].name == "load" - and R.is_cons(f[2]) and type(f[2][1]) == "string" and f[2][2] == R.NIL then - P.F["load"](f[2][1]) - else - P.F["eval"](f) - end - forms = forms[2] - end - end - - local path = image_path(raw_script) local ok, err = pcall(function() - if path then - local cached, contents = image_read(path) - if cached then - local rok, rerr = pcall(fasl_replay, cached) - if not rok then - os.remove(path) -- stale beyond what the hashes caught - error(rerr, 0) - end - fasl_log("image hit " .. path) - -- Fold the same content into the rolling key the per-file path would - -- have, in the same order, so a user program's fasl key is unchanged - -- whether the stdlib came from the image or from its 20 fasl files. - for _, c in ipairs(contents) do FASL_ROLL = fnv1a(c, FASL_ROLL) end - return - end - fasl_log("image miss " .. path) - local rec = { n = 0, in_chunk = false, deps = {} } - local arity0 = {} - for k, v in pairs(C.ARITY) do arity0[k] = v end - FASL_STACK[#FASL_STACK + 1] = rec - P.FASL_REC = rec - C.NO_KDATA = true -- recorded chunks must be relocatable - local dok, derr = pcall(run_driver) - FASL_STACK[#FASL_STACK] = nil - P.FASL_REC = FASL_STACK[#FASL_STACK] - C.NO_KDATA = P.FASL_REC ~= nil - if not dok then error(derr, 0) end - local wok, werr = pcall(image_write, path, rec, arity0) - if not wok then fasl_log("image uncacheable: " .. tostring(werr)) end - return + -- (stlib.initialise) is exactly these phases in this order; run them + -- individually so the types phase can be served from the cache. + local whole = true + for _, ph in ipairs(STDLIB_PHASES) do + if not P.F["stlib.initialise-" .. ph] then whole = false end end - run_driver() + if not whole then return P.F["stlib.initialise"]() end + -- The phases are straight-line, run-once code: thousands of calls with + -- literal source trees (sources) and datatype rule compiles (datatypes). + -- Under the JIT they are bimodal — 10 ms or 700 ms for the sources phase + -- on the same host, depending on which side traces get recorded — and + -- never faster than the interpreter. Run them interpreted; the JIT is + -- restored (only if it was on) before anything else runs. + local jit_was_on = jit and jit.status and jit.status() + if jit_was_on then jit.off() end + local pok, perr = pcall(function() + for _, ph in ipairs(STDLIB_PHASES) do + if ph == "types" then stlib_types(verbose) + else P.F["stlib.initialise-" .. ph]() end + end + end) + if jit_was_on then jit.on() end + if not pok then error(perr, 0) end end) P.GLOBALS["*hush*"] = hush0 if not ok then - error("stdlib load failed: " .. tostring(P.F["error-to-string"](err)), 0) + error("stdlib initialise failed: " .. tostring(P.F["error-to-string"](err)), 0) end STDLIB_LOADED = true - if verbose then io.stderr:write(" loaded stdlib from " .. dir .. "\n") end + if verbose then io.stderr:write(" initialised stdlib\n") end end P.load_stdlib = load_stdlib local function initialise() - -- Kernel environment setup (env globals, *property-vector*, arity table). - -- - -- On the S42 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. + -- ShenOSKernel 42.2: the kernel files are pure defuns; (shen.initialise) + -- (init.kl) builds the environment, the *property-vector* dict, the arity + -- table, the lambda forms and the kernel signatures. It must run exactly + -- once, after load_kernel(). A kernel without it (e.g. an older Tarver S42 + -- tree via SHEN_KL_DIR, which self-initialises at load) is tolerated. local r local fn = P.F["shen.initialise"] if fn then r = fn() end - -- Initialise the Shen Batteries feature registry from capabilities detected - -- by native extension installers. The Batteries module loader asks the - -- port for `(shen.x.features.current)` before loading a module; leaving the - -- registry unbound makes that query fail even though the extension API is - -- otherwise available. Keep this derived from backend globals so - -- SHEN_X_SHA256=pure (and ports without native backends) advertise no host - -- capability while retaining the portable implementation. - if P.F["shen.x.features.current"] then + -- Feature registry for the features extension (shen.x.features.*). The + -- 42.2 extension's initialise declares its own types and registers the + -- cond-expand macro; seed it with the features detected from native + -- backends (the Shen Batteries module loader queries + -- (shen.x.features.current) before loading a module). SHEN_X_SHA256=pure + -- (and hosts without native backends) advertise no host capability. + if P.F["shen.x.features.initialise"] then local detected = {} local function add_backend(global, feature) local backend = P.GLOBALS[global] @@ -1636,20 +1568,20 @@ local function initialise() end add_backend("shen.x.*sha256-backend*", "shen.x/sha256-host") add_backend("shen.x.*zmq-backend*", "shen.x/zmq-host") - -- The community extension's `features.initialise` additionally hooks the - -- legacy macro registration API (`shen.set-lambda-form-entry`), which is - -- not present in the refreshed 42 kernel. Seed its backing global - -- directly; `features.current` is the stable API consumed by Batteries - -- and `features.add` can still extend this list later. - P.GLOBALS["shen.x.features.*features*"] = R.from_table(detected) + P.F["shen.x.features.initialise"](R.from_table(detected)) + end + -- Programmable pattern matching: installs the custom pattern compiler / + -- reducer hooks with an empty handler registry and declares the + -- register/unregister API, as shen-scheme 0.50 does at boot. + if P.F["shen.x.programmable-pattern-matching.initialise"] then + P.F["shen.x.programmable-pattern-matching.initialise"]() end -- Register the lua.* interop entries in Shen's own arity/lambda-form -- tables (needs the *property-vector* the kernel just created). require("lua_interop").post_initialise() - -- Load the standard library from its S-lineage Shen sources (lib/StLib). - -- Done here, at the single post-kernel-init chokepoint every boot path runs - -- (shen.boot, run-kernel-tests, the port specs), so the stdlib is present - -- for all of them. SHEN_NO_STDLIB=1 opts out. + -- Standard library: the precompiled klambda/stlib.kl was loaded with the + -- kernel; (stlib.initialise) installs its package info, arities, lambda + -- forms, macros, datatypes and types. SHEN_NO_STDLIB=1 skips it. load_stdlib() return r end diff --git a/build/make-bundle.lua b/build/make-bundle.lua index ac6c2d1..f38e83e 100644 --- a/build/make-bundle.lua +++ b/build/make-bundle.lua @@ -70,24 +70,9 @@ do if nm then kl_names[#kl_names + 1] = nm end end p:close() - -- 19 vendored .kl: 15 refreshed S42 kernel modules + 4 extensions - -- (the standard library is no longer a .kl — see the stdlib payload below). - assert(#kl_names >= 19, "klambda/ looks incomplete (" .. #kl_names .. " files)") -end - --- Standard-library Shen sources (lib/StLib). The refresh ships stdlib as --- sources, loaded at boot by boot.lua load_stdlib; embed the whole tree --- (relative paths, incl. install.shen) so the bundle stays self-contained. --- On boot with no lib/StLib on disk, load_stdlib materialises these to a temp --- dir and loads from there. -local stdlib_names = {} -do - local p = io.popen("cd '" .. root .. "/lib/StLib' && find . -type f | sed 's|^\\./||'") - for line in p:lines() do - if line ~= "" then stdlib_names[#stdlib_names + 1] = line end - end - p:close() - assert(#stdlib_names >= 20, "lib/StLib looks incomplete (" .. #stdlib_names .. " files)") + -- ShenOSKernel 42.2: 18 kernel modules incl. stlib.kl + 5 extensions + -- (the standard library is the precompiled stlib.kl). + assert(#kl_names >= 23, "klambda/ looks incomplete (" .. #kl_names .. " files)") end -- ---- 3. emit --------------------------------------------------------------- @@ -105,7 +90,7 @@ local out = {} local function emit(s) out[#out + 1] = s end emit("-- shen-bundle.lua : self-contained shen-lua (generated by build/make-bundle.lua)\n") -emit("-- Shen kernel 42 on LuaJIT. require() it and go:\n") +emit("-- Shen kernel 42.2 on LuaJIT. require() it and go:\n") emit("-- local shen = require(\"shen-bundle\"); shen.boot{quiet=true}\n") emit("-- print(shen.eval(\"(+ 1 2)\"))\n") emit("-- Generated " .. os.date("!%Y-%m-%dT%H:%M:%SZ") .. " with " .. jit.version .. " (" .. jit.os .. " " .. jit.arch .. ").\n") @@ -122,10 +107,6 @@ for _, nm in ipairs(kl_names) do emit(("kl[%q] = %s\n"):format(nm, quote(read_file(root .. "/klambda/" .. nm .. ".kl")))) end -emit("\nlocal stdlib = {}\n") -for _, rel in ipairs(stdlib_names) do - emit(("stdlib[%q] = %s\n"):format(rel, quote(read_file(root .. "/lib/StLib/" .. rel)))) -end emit("\nlocal KERNEL = " .. quote(blob) .. "\n") @@ -143,7 +124,6 @@ end local P = require("boot") P.KERNEL_CACHE_DATA = KERNEL -- boot.load_kernel() takes the embedded path P.KL_SOURCES = kl -- source fallback for a foreign LuaJIT -P.STDLIB_SOURCES = stdlib -- lib/StLib tree; load_stdlib materialises it return require("shen") ]]) diff --git a/demo/walkthrough.md b/demo/walkthrough.md index 4ea92cc..57c1995 100644 --- a/demo/walkthrough.md +++ b/demo/walkthrough.md @@ -5,7 +5,7 @@ This document is executable proof of what shen-lua is and how it works, built with [showboat](https://github.com/simonw/showboat) (`uv tool install showboat`). Every code block below was actually run from the repo root; `showboat verify demo/walkthrough.md` re-runs them all and confirms the outputs still hold. -**What it is:** [Shen](https://shenlanguage.org) — a functional Lisp with pattern matching, an optional sequent-calculus type system, and integrated Prolog — running on LuaJIT. Shen programs compile to KLambda (a ~46-primitive Lisp kernel); this port compiles KLambda to Lua source, which LuaJIT trace-compiles to machine code. It passes the official Shen 42 kernel test suite and runs (slower) on plain Lua 5.1/5.4/5.5. +**What it is:** [Shen](https://shenlanguage.org) — a functional Lisp with pattern matching, an optional sequent-calculus type system, and integrated Prolog — running on LuaJIT. Shen programs compile to KLambda (a ~46-primitive Lisp kernel); this port compiles KLambda to Lua source, which LuaJIT trace-compiles to machine code. It passes the official ShenOSKernel 42.2 test suite and runs (slower) on plain Lua 5.1/5.4/5.5. ## 1. The language, through the launcher @@ -113,7 +113,7 @@ rejected by the typechecker: type error in rule 1 of broken-check-port ## 6. How it boots fast: kernel, standard-library, and load caches -First boot compiles the vendored S42 kernel files and loads the Shen-source standard library; later boots can use **kernel bytecode and standard-library caches**. A **fasl-style cache** records loaded programs so later loads can skip reader, macroexpansion and typechecking. The following check measures an in-process warm boot on this walkthrough's host, rather than a guaranteed startup time on every host (see [benchmark methodology](../doc/BENCHMARKS.md)): +First boot compiles the vendored ShenOSKernel 42.2 files (including the precompiled standard library); later boots can use **kernel bytecode and standard-library signature caches**. A **fasl-style cache** records loaded programs so later loads can skip reader, macroexpansion and typechecking. The following check measures an in-process warm boot on this walkthrough's host, rather than a guaranteed startup time on every host (see [benchmark methodology](../doc/BENCHMARKS.md)): ```bash t0=$(luajit -e "io.write(os.clock())"); luajit -e "local shen=require(\"shen\"); shen.boot{quiet=true}; assert(shen.eval(\"(+ 1 2)\") == 3)" ; luajit -e " @@ -127,16 +127,16 @@ print(string.format(\"boot+initialise under 250ms: %s\", tostring(ms < 250)))" boot+initialise under 250ms: true ``` -## 7. Certification: the official 42 test suite, from this clone +## 7. Certification: the official 42.2 test suite, from this clone -The suite is vendored in `tests/`; this runs all 134 official kernel tests (typechecker, Prolog, the works) and prints the final tally: +The suite is vendored in `tests/`; this runs all 143 official kernel tests (typechecker, Prolog, the works) and prints the final tally: ```bash luajit run-kernel-tests.lua 2>/dev/null | grep -E "^(passed|failed|pass rate)" | tail -3 ``` ```output -passed ... 134 +passed ... 143 failed ... 0 pass rate ... 100% ``` @@ -148,7 +148,7 @@ SHEN_FASL=off SHEN_PROLOG_ENGINE=legacy luajit run-kernel-tests.lua 2>/dev/null ``` ```output -passed ... 134 +passed ... 143 failed ... 0 ``` diff --git a/klambda/PROVENANCE.md b/klambda/PROVENANCE.md index d6cc4da..291efdb 100644 --- a/klambda/PROVENANCE.md +++ b/klambda/PROVENANCE.md @@ -1,96 +1,113 @@ # Provenance of the vendored KLambda kernel -The vendored `klambda/` tree has **two lineages**. Read both sections — they -come from different upstreams and are updated independently. - -## 1. Kernel proper — S42 (2026-08-25 refresh) - -- **Canonical source**: `pyrex41/shen-upstream` — the designated mirror of Mark - Tarver's shenlanguage.org uploads (private repo). - - Tag: `s42-pristine-20260825` - - Commit: `pending mirror import` - ("Pristine import of the 2026-08-25 S42 refresh from shenlanguage.org") -- **Upstream origin** (what the mirror imported): Mark Tarver's `S42.zip`, - the reference SBCL/Windows distribution. - - URL: https://www.shenlanguage.org/Download/S42.zip - - Last-Modified: 2026-08-25 - - Zip SHA-256: `30abdc7e5a1e27b7a20109c1ed141e4712885e31f24d9710d16415fbbd4dfb23` - -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`): - - yacc core load prolog reader sequent sys t-star toplevel - track types writer backend declarations macros - -> **Caveat — S42 is the upstream 2026-08-25 distribution.** Community -> extensions retained below are not part of the pristine archive. -> `(version)` reports `"42"` (it is set in `declarations.kl`). - -### What changed vs the community ShenOSKernel-42 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 **Shen sources** under - `Lib/StLib/`. shen-lua vendors those sources under `lib/StLib/` and loads them - at boot (see section 2 and `lib/StLib/PROVENANCE.md`); `stlib.kl` is gone. -- Other renames observed: `hush` → `shen.hush`, `input+` → `shen.input-h+` / - `shen.process-input+`, plus new `shen.rdecons`, `shen.shen`, pointer helpers. - -## 2. Extensions — community ShenOSKernel-42 (retained); stdlib moved out - -**Extensions.** Tarver's refresh does not ship these; they are **retained -byte-identical from the community `ShenOSKernel-42`** release (zip SHA-256 -`49f1b85d02348d9b3ebc461570c5c56cc066270ab81e35d5257625fb9d17fe82`) so the CLI -launcher etc. stay available: - -- `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. - -They are pure `defun`/`defmacro` referencing only public kernel functions -(`get`/`put`/`arity`/…) — never the removed `dict.*`, `shen.<-dict`, or -`shen.initialise-*` — so they load unchanged against the refreshed kernel. - -**Standard library.** No longer a `.kl` file here. It is loaded at boot from the -S-lineage Shen sources vendored under `lib/StLib/` — see -[`lib/StLib/PROVENANCE.md`](../lib/StLib/PROVENANCE.md) and `boot.lua` -`load_stdlib`. Loading through the kernel's own `define` path (rather than as -raw `stlib.kl` defuns) registers each function's `arity` property + lambda-table -entry, which **fixes** the long-standing quirk where a bare `(fn filter)` / -top-level `(filter …)` raised "fn: filter is undefined" (the pre-refresh -`stlib.kl` never called `stlib.initialise`, so those functions had runtime -`arity` = -1). A regression test lives in `test/stdlib_spec.lua`. - -## 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`. +## Current: ShenOSKernel 42.2 (community `shen-sources` line) + +The whole `klambda/` tree (23 `.kl` files) and the kernel test suite under +`../tests/` are vendored **byte-identical** from the ShenOSKernel 42.2 release — +the kernel that upstream [shen-scheme 0.50](https://github.com/tizoc/shen-scheme/tree/v0.50) +(2026-10-01) ships: + +- **Repository**: [`Shen-Language/shen-sources`](https://github.com/Shen-Language/shen-sources) + - Tag: `shen-42.2` + - Commit: `73507e069fe147aefb728d632c4ce40bc6a7b314` + ("Prepare Shen kernel 42.2 release", 2026-10-01) +- **Release asset**: `ShenOSKernel-42.2.tar.gz` + - SHA-256: `1d02273003654d34ec020ae67cb214ecec410dee3350419ff807d82b652678d8` + (the checksum pinned in shen-scheme 0.50's Makefile) + - `klambda/*.kl` and `tests/` verified against the extracted archive with + `cmp` / `diff -r`. +- `(version)` reports `"42.2"` (set by `shen.initialise-environment` in + `init.kl`). + +Files: + + core declarations dict init load macros prolog reader sequent sys + t-star toplevel track types writer yacc -- kernel + stlib -- precompiled standard library + extension-features extension-expand-dynamic extension-launcher + extension-programmable-pattern-matching -- extensions (booted) + extension-namespaces extension-type-annotations -- extensions (vendored, opt-in) + +### Lineage choice (pyrex41/shen-lua#79, option a) + +This is a **lineage switch**. Releases up to 0.11.x vendored Mark Tarver's +**S42.0** kernel (`S42.zip` from shenlanguage.org, 2026-08-25, mirrored as +`pyrex41/shen-upstream` tag `s42-pristine-20260825`, zip SHA-256 +`30abdc7e5a1e27b7a20109c1ed141e4712885e31f24d9710d16415fbbd4dfb23`) plus the +community 42 extensions and the S-lineage `Lib/StLib` Shen sources. 42.1 and +42.2 are releases of the **community** line only, which differs structurally, +so per the cross-port decision (pyrex41/bifrost#26, pyrex41/yggdrasil#32) the +42.2 kernel is adopted **wholesale** rather than porting its changes onto the +S42.0 base. Every port that Bifrost and Yggdrasil drive therefore runs the +same kernel as shen-scheme 0.50, byte for byte. + +What that means structurally, relative to the S42.0 tree it replaces: + +- **`init.kl` and `shen.initialise` are back.** Every 42.2 file is pure + defuns; nothing initialises at load time. `boot.lua` loads all modules and + then calls `(shen.initialise)` (environment, `*property-vector*`, arity + table, lambda forms, kernel signatures), the extension initialisers, and + `(stlib.initialise)`. The S42 load-order constraints (`… macros declarations + t-star types`) and the hoisted `types.kl` declares are gone. +- **`dict.kl` is back.** `*property-vector*` is a `shen.dict` (an absvector: + `shen.dictionary`, capacity, count, then hash buckets of `(Key . Props)`), + and `get`/`put`/`unput` go through `shen.<-dict` / `shen.dict->` / + `shen.assoc-set` / `shen.assoc-rm`. `prims.lua`'s native property store was + rewritten for this layout. +- **Lambda forms are a property again.** `fn` reads the `shen.lambda-form` + property; there is no `shen.*lambdatable*`. 42.0's requirement that a cached + callable form be invalidated when a function is redefined with zero or + unknown arity is met by the native `fn` fast path keying its cache on a + generation counter that every `shen.lambda-form` write bumps. +- **`stlib.kl` is back** as the standard library: the precompiled output of + 42.2's `lib/stlib` sources (upstream `make-stlib.shen`). The S-lineage + `lib/StLib` sources that 0.11.x loaded at boot were removed; see + "Standard library" below. +- **`backend.kl`** (S42's `cl.*` Common Lisp backend) is not part of 42.2 and + was removed. +- **42.1 source-form handlers**: `shen.macroexpand-h` takes a 4th argument and + `shen.try-parse` returns parsed forms that the read loop expands afterwards. + shen-lua overrides none of `read`, `lineread`, `shen.read-loop`, + `shen.try-parse`, `macroexpand` or `shen.macroexpand-h`, so the kernel's + own order applies; `read`/`lineread` at EOF without a trailing newline + behave like shen-scheme 0.50. +- **42.2 namespaces**: `extension-namespaces.kl` is vendored from the release + as generated (it already carries the 42.2 `externals`/`with-externals` + change). It is not booted; a program loads the extension's Shen source + (`extensions/namespaces.shen` in shen-sources) and calls + `(shen.x.namespaces.initialise)`, as the 42.2 extension tests do. + +### Boot list + +`boot.lua` (`FILES`) boots the 16 kernel modules, `extension-features`, +`extension-expand-dynamic`, `extension-launcher`, +`extension-programmable-pattern-matching` and `stlib` — the same set +shen-scheme 0.50 boots. After `(shen.initialise)` it calls +`(shen.x.features.initialise …)` and +`(shen.x.programmable-pattern-matching.initialise)` in that order (as +shen-scheme does), registers the `lua.*` interop entries, then runs +`(stlib.initialise)`. The resulting `shen.*sigf*` matches shen-scheme 0.50's +458 signatures plus the four `lua.checked-*` signatures. + +### Standard library + +`klambda/stlib.kl` loads with the kernel and `(stlib.initialise)` registers +it (port-upgrades.md, 41.1). Its 290 `declare`s are cached next to the kernel +bytecode cache (`.stlib`, keyed on the kernel cache key); see +`boot.lua` `stlib_types`. `SHEN_NO_STDLIB=1` skips `(stlib.initialise)`. ## 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. +with the same file set (e.g. a development build of shen-sources). `boot.lua` +loads the `FILES` list from it and calls `shen.initialise` / +`stlib.initialise` when the tree defines them. + +## History + +- 0.11.x: Tarver S42.0 (2026-08-25 refresh) + community 42 extensions + + S-lineage `lib/StLib` sources loaded at boot. +- Earlier: Tarver S41.2 (2026-07-11 refresh); before that the community + ShenOSKernel 41.2 / 41.1 releases. + +`git log -- klambda/PROVENANCE.md` has the full earlier text of each entry. diff --git a/klambda/README.md b/klambda/README.md index 05dd66c..4afe73a 100644 --- a/klambda/README.md +++ b/klambda/README.md @@ -1,42 +1,37 @@ -# Vendored KLambda for Shen 42 +# Vendored KLambda for ShenOSKernel 42.2 -These are the KLambda kernel sources for **Shen 42**. 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. - -The tree has **two lineages** — the refreshed kernel proper from -shenlanguage.org, and the community extensions retained on top. The standard -library is no longer here; it lives as Shen sources under `../lib/StLib/` (see -that directory's PROVENANCE.md). See [PROVENANCE.md](PROVENANCE.md) for exact -sources, checksums, and the full list of what the refresh added/removed. +These are the KLambda sources of **ShenOSKernel 42.2** (community +[`shen-sources`](https://github.com/Shen-Language/shen-sources) release +`shen-42.2`), vendored byte-identical so that `shen-lua` is self-contained: +you can `git clone` and run without a separate kernel checkout. See +[PROVENANCE.md](PROVENANCE.md) for the exact source, checksum and the lineage +note (this replaced Tarver's S42.0 kernel). ## Files -There are 19 `.kl` files. +There are 23 `.kl` files. -**Kernel proper — S42 (2026-07-11 refresh), 15 files, byte-identical to -`shenlanguage.org/Download/S42.zip`:** -- yacc, core, load, prolog, reader, sequent, sys, t-star, toplevel, - track, types, writer, backend, declarations, macros +**Kernel (16):** core, declarations, dict, init, load, macros, prolog, reader, +sequent, sys, t-star, toplevel, track, types, writer, yacc -**Extensions — retained from community ShenOSKernel-42:** -- extension-features, extension-expand-dynamic, extension-launcher (booted) -- extension-programmable-pattern-matching (vendored, opt-in; NOT on the boot list) +**Standard library (1):** stlib — precompiled from 42.2's `lib/stlib`, registered +at boot by `(stlib.initialise)`. -The actual boot order is defined in `boot.lua` (`FILES`), not by this list. +**Extensions (6):** +- extension-features, extension-expand-dynamic, extension-launcher, + extension-programmable-pattern-matching (booted; the same set shen-scheme + 0.50 boots) +- extension-namespaces, extension-type-annotations (vendored, opt-in; NOT on + the boot list) -> Removed relative to the pre-refresh vendored set: `compiler.kl` (a shen-cl -> build artifact), `dict.kl`, `init.kl`, and `stlib.kl` — the standard library -> now loads from `../lib/StLib/` Shen sources. See PROVENANCE.md. +The actual boot order is defined in `boot.lua` (`FILES`), not by this list. ## License -See the LICENSE in the root of this repository and the original Shen distribution. +See the LICENSE in the root of this repository and the license headers at the +top of each `.kl` file. ## Overriding -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 build of the same +kernel), set: SHEN_KL_DIR=/path/to/some/other/klambda - -The `boot.lua` loader will use that location instead of the vendored `klambda/` -directory. diff --git a/klambda/backend.kl b/klambda/backend.kl deleted file mode 100644 index db98dc3..0000000 --- a/klambda/backend.kl +++ /dev/null @@ -1,20 +0,0 @@ -(defun cl.kl-to-lisp (V5715) (cl.kl-to-lisp-h () V5715)) - -(defun cl.kl-to-lisp-h (V5723 V5724) (cond ((= T (MEMBER V5724 V5723)) V5724) ((and (cons? V5724) (and (= type (hd V5724)) (and (cons? (tl V5724)) (and (cons? (tl (tl V5724))) (= () (tl (tl (tl V5724)))))))) (cl.kl-to-lisp-h V5723 (hd (tl V5724)))) ((and (cons? V5724) (and (= protect (hd V5724)) (and (cons? (tl V5724)) (= () (tl (tl V5724)))))) (cl.kl-to-lisp-h V5723 (hd (tl V5724)))) ((and (cons? V5724) (and (= lambda (hd V5724)) (and (cons? (tl V5724)) (and (cons? (tl (tl V5724))) (and (= () (tl (tl (tl V5724)))) (= (hd (tl V5724)) T)))))) (cl.kl-to-lisp-h V5723 (cl.rectify-t V5724))) ((and (cons? V5724) (and (= lambda (hd V5724)) (and (cons? (tl V5724)) (and (cons? (tl (tl V5724))) (= () (tl (tl (tl V5724)))))))) (cons FUNCTION (cons (cons LAMBDA (cons (cons (hd (tl V5724)) ()) (cons (cl.kl-to-lisp-h (cons (hd (tl V5724)) V5723) (hd (tl (tl V5724)))) ()))) ()))) ((and (cons? V5724) (and (= let (hd V5724)) (and (cons? (tl V5724)) (and (cons? (tl (tl V5724))) (and (cons? (tl (tl (tl V5724)))) (and (= () (tl (tl (tl (tl V5724))))) (= (hd (tl V5724)) T))))))) (cl.kl-to-lisp-h V5723 (cl.rectify-t V5724))) ((and (cons? V5724) (and (= let (hd V5724)) (and (cons? (tl V5724)) (and (cons? (tl (tl V5724))) (and (cons? (tl (tl (tl V5724)))) (= () (tl (tl (tl (tl V5724)))))))))) (cons LET (cons (cons (cons (hd (tl V5724)) (cons (cl.kl-to-lisp-h V5723 (hd (tl (tl V5724)))) ())) ()) (cons (cl.kl-to-lisp-h (cons (hd (tl V5724)) V5723) (hd (tl (tl (tl V5724))))) ())))) ((and (cons? V5724) (and (= defun (hd V5724)) (and (cons? (tl V5724)) (and (cons? (tl (tl V5724))) (and (cons? (tl (tl (tl V5724)))) (= () (tl (tl (tl (tl V5724)))))))))) (cons DEFUN (cons (hd (tl V5724)) (cons (hd (tl (tl V5724))) (cons (cl.kl-to-lisp-h (hd (tl (tl V5724))) (hd (tl (tl (tl V5724))))) ()))))) ((and (cons? V5724) (= cond (hd V5724))) (cons COND (CL.MAPCAR (lambda Z5725 (cl.cond-code V5723 Z5725)) (tl V5724)))) ((and (cons? V5724) (or (= T (MEMBER (hd V5724) V5723)) (cons? (hd V5724)))) (let W5726 (CL.MAPCAR (lambda Z5727 (cl.kl-to-lisp-h V5723 Z5727)) V5724) (cl.currylisp W5726))) ((and (cons? V5724) (cl.fastsymbol? (hd V5724))) (let W5728 (CL.MAPCAR (lambda Z5729 (cl.kl-to-lisp-h V5723 Z5729)) (tl V5724)) (let W5730 (cl.maplispsym (hd V5724)) (cl.optimise-application (cons W5730 W5728))))) ((or (number? V5724) (or (string? V5724) (empty? V5724))) V5724) (true (cons QUOTE (cons V5724 ()))))) - -(defun cl.rectify-t (V5731) (SUBST (GENSYM "x") T V5731)) - -(defun cl.currylisp (V5732) (cond ((and (cons? V5732) (and (cons? (tl V5732)) (cons? (tl (tl V5732))))) (cl.currylisp (cons (cons FUNCALL (cons (hd V5732) (cons (hd (tl V5732)) ()))) (tl (tl V5732))))) ((and (cons? V5732) (and (cons? (tl V5732)) (= () (tl (tl V5732))))) (cons FUNCALL V5732)) ((and (cons? V5732) (= () (tl V5732))) (cons FUNCALL V5732)) (true V5732))) - -(defun cl.optimise-application (V5733) (cond ((and (cons? V5733) (and (= protect (hd V5733)) (and (cons? (tl V5733)) (= () (tl (tl V5733)))))) (cl.optimise-application (hd (tl V5733)))) ((and (cons? V5733) (and (= hd (hd V5733)) (and (cons? (tl V5733)) (= () (tl (tl V5733)))))) (cons CAR (cons (cl.optimise-application (hd (tl V5733))) ()))) ((and (cons? V5733) (and (= tl (hd V5733)) (and (cons? (tl V5733)) (= () (tl (tl V5733)))))) (cons CDR (cons (cl.optimise-application (hd (tl V5733))) ()))) ((and (cons? V5733) (and (= cons (hd V5733)) (and (cons? (tl V5733)) (and (cons? (tl (tl V5733))) (= () (tl (tl (tl V5733)))))))) (cons CONS (cons (cl.optimise-application (hd (tl V5733))) (cons (cl.optimise-application (hd (tl (tl V5733)))) ())))) ((and (cons? V5733) (and (= append (hd V5733)) (and (cons? (tl V5733)) (and (cons? (tl (tl V5733))) (= () (tl (tl (tl V5733)))))))) (cons APPEND (cons (cl.optimise-application (hd (tl V5733))) (cons (cl.optimise-application (hd (tl (tl V5733)))) ())))) ((and (cons? V5733) (and (= reverse (hd V5733)) (and (cons? (tl V5733)) (= () (tl (tl V5733)))))) (cons REVERSE (cons (cl.optimise-application (hd (tl V5733))) ()))) ((and (cons? V5733) (and (= length (hd V5733)) (and (cons? (tl V5733)) (= () (tl (tl V5733)))))) (cons CL.LIST-LENGTH (cons (cl.optimise-application (hd (tl V5733))) ()))) ((and (cons? V5733) (and (= if (hd V5733)) (and (cons? (tl V5733)) (and (cons? (tl (tl V5733))) (and (cons? (tl (tl (tl V5733)))) (= () (tl (tl (tl (tl V5733)))))))))) (cons IF (cons (cl.wrap (hd (tl V5733))) (cons (cl.optimise-application (hd (tl (tl V5733)))) (cons (cl.optimise-application (hd (tl (tl (tl V5733))))) ()))))) ((and (cons? V5733) (and (= value (hd V5733)) (and (cons? (tl V5733)) (and (cons? (hd (tl V5733))) (and (cons? (tl (hd (tl V5733)))) (and (= () (tl (tl (hd (tl V5733))))) (and (= () (tl (tl V5733))) (= (hd (hd (tl V5733))) QUOTE)))))))) (hd (tl (hd (tl V5733))))) ((and (cons? V5733) (and (= map (hd V5733)) (and (cons? (tl V5733)) (and (cons? (tl (tl V5733))) (= () (tl (tl (tl V5733)))))))) (cons CL.MAPCAR (tl V5733))) ((and (cons? V5733) (and (= + (hd V5733)) (and (cons? (tl V5733)) (and (= 1 (hd (tl V5733))) (and (cons? (tl (tl V5733))) (= () (tl (tl (tl V5733))))))))) (cons (intern "1+") (cons (cl.optimise-application (hd (tl (tl V5733)))) ()))) ((and (cons? V5733) (and (= + (hd V5733)) (and (cons? (tl V5733)) (and (cons? (tl (tl V5733))) (and (= 1 (hd (tl (tl V5733)))) (= () (tl (tl (tl V5733))))))))) (cons (intern "1+") (cons (cl.optimise-application (hd (tl V5733))) ()))) ((and (cons? V5733) (and (= - (hd V5733)) (and (cons? (tl V5733)) (and (cons? (tl (tl V5733))) (and (= 1 (hd (tl (tl V5733)))) (= () (tl (tl (tl V5733))))))))) (cons (intern "1-") (cons (cl.optimise-application (hd (tl V5733))) ()))) ((cons? V5733) (CL.MAPCAR (lambda Z5734 (cl.optimise-application Z5734)) V5733)) (true V5733))) - -(defun cl.cond-code (V5739 V5740) (cond ((and (cons? V5740) (and (cons? (tl V5740)) (= () (tl (tl V5740))))) (let W5741 (cl.wrap (cl.kl-to-lisp-h V5739 (hd V5740))) (let W5742 (cl.kl-to-lisp-h V5739 (hd (tl V5740))) (cons W5741 (cons W5742 ()))))) (true (simple-error "implementation error in shen.cond-code")))) - -(defun cl.wrap (V5743) (cond ((and (cons? V5743) (and (cons? (tl V5743)) (and (= true (hd (tl V5743))) (and (= () (tl (tl V5743))) (= (hd V5743) QUOTE))))) T) ((and (cons? V5743) (and (= cons? (hd V5743)) (and (cons? (tl V5743)) (= () (tl (tl V5743)))))) (cons CONSP (tl V5743))) ((and (cons? V5743) (and (= string? (hd V5743)) (and (cons? (tl V5743)) (= () (tl (tl V5743)))))) (cons STRINGP (tl V5743))) ((and (cons? V5743) (and (= number? (hd V5743)) (and (cons? (tl V5743)) (= () (tl (tl V5743)))))) (cons NUMBERP (tl V5743))) ((and (cons? V5743) (and (= empty? (hd V5743)) (and (cons? (tl V5743)) (= () (tl (tl V5743)))))) (cons NULL (tl V5743))) ((and (cons? V5743) (and (= and (hd V5743)) (and (cons? (tl V5743)) (and (cons? (tl (tl V5743))) (= () (tl (tl (tl V5743)))))))) (cons AND (cons (cl.wrap (hd (tl V5743))) (cons (cl.wrap (hd (tl (tl V5743)))) ())))) ((and (cons? V5743) (and (= or (hd V5743)) (and (cons? (tl V5743)) (and (cons? (tl (tl V5743))) (= () (tl (tl (tl V5743)))))))) (cons OR (cons (cl.wrap (hd (tl V5743))) (cons (cl.wrap (hd (tl (tl V5743)))) ())))) ((and (cons? V5743) (and (= not (hd V5743)) (and (cons? (tl V5743)) (= () (tl (tl V5743)))))) (cons NOT (cons (cl.wrap (hd (tl V5743))) ()))) ((and (cons? V5743) (and (= cl.equal? (hd V5743)) (and (cons? (tl V5743)) (and (cons? (tl (tl V5743))) (and (= () (hd (tl (tl V5743)))) (= () (tl (tl (tl V5743))))))))) (cons NULL (cons (hd (tl V5743)) ()))) ((and (cons? V5743) (and (= cl.equal? (hd V5743)) (and (cons? (tl V5743)) (and (= () (hd (tl V5743))) (and (cons? (tl (tl V5743))) (= () (tl (tl (tl V5743))))))))) (cons NULL (tl (tl V5743)))) ((and (cons? V5743) (and (= cl.equal? (hd V5743)) (and (cons? (tl V5743)) (and (cons? (tl (tl V5743))) (and (cons? (hd (tl (tl V5743)))) (and (cons? (tl (hd (tl (tl V5743))))) (and (= () (tl (tl (hd (tl (tl V5743)))))) (and (= () (tl (tl (tl V5743)))) (and (= (hd (hd (tl (tl V5743)))) QUOTE) (cl.fastsymbol? (hd (tl (hd (tl (tl V5743))))))))))))))) (cons EQ (tl V5743))) ((and (cons? V5743) (and (= cl.equal? (hd V5743)) (and (cons? (tl V5743)) (and (cons? (hd (tl V5743))) (and (cons? (tl (hd (tl V5743)))) (and (= () (tl (tl (hd (tl V5743))))) (and (cons? (tl (tl V5743))) (and (= () (tl (tl (tl V5743)))) (and (= (hd (hd (tl V5743))) QUOTE) (cl.fastsymbol? (hd (tl (hd (tl V5743)))))))))))))) (cons EQ (tl V5743))) ((and (cons? V5743) (and (= cl.equal? (hd V5743)) (and (cons? (tl V5743)) (and (cons? (hd (tl V5743))) (and (= fail (hd (hd (tl V5743)))) (and (= () (tl (hd (tl V5743)))) (and (cons? (tl (tl V5743))) (= () (tl (tl (tl V5743))))))))))) (cons EQ (tl V5743))) ((and (cons? V5743) (and (= cl.equal? (hd V5743)) (and (cons? (tl V5743)) (and (cons? (tl (tl V5743))) (and (cons? (hd (tl (tl V5743)))) (and (= fail (hd (hd (tl (tl V5743))))) (and (= () (tl (hd (tl (tl V5743))))) (= () (tl (tl (tl V5743))))))))))) (cons EQ (tl V5743))) ((and (cons? V5743) (and (= cl.equal? (hd V5743)) (and (cons? (tl V5743)) (and (cons? (tl (tl V5743))) (and (= () (tl (tl (tl V5743)))) (string? (hd (tl V5743)))))))) (cons EQUAL (tl V5743))) ((and (cons? V5743) (and (= cl.equal? (hd V5743)) (and (cons? (tl V5743)) (and (cons? (tl (tl V5743))) (and (= () (tl (tl (tl V5743)))) (string? (hd (tl (tl V5743))))))))) (cons EQUAL (tl V5743))) ((and (cons? V5743) (and (= cl.equal? (hd V5743)) (and (cons? (tl V5743)) (and (cons? (tl (tl V5743))) (and (= () (tl (tl (tl V5743)))) (number? (hd (tl V5743)))))))) (cons EQUALP (tl V5743))) ((and (cons? V5743) (and (= cl.equal? (hd V5743)) (and (cons? (tl V5743)) (and (cons? (tl (tl V5743))) (and (= () (tl (tl (tl V5743)))) (number? (hd (tl (tl V5743))))))))) (cons EQUALP (tl V5743))) ((and (cons? V5743) (and (= cl.equal? (hd V5743)) (and (cons? (tl V5743)) (and (cons? (tl (tl V5743))) (= () (tl (tl (tl V5743)))))))) (cons cl.ABSEQUAL (tl V5743))) ((and (cons? V5743) (and (= cl.greater? (hd V5743)) (and (cons? (tl V5743)) (and (cons? (tl (tl V5743))) (= () (tl (tl (tl V5743)))))))) (cons > (tl V5743))) ((and (cons? V5743) (and (= cl.greater-than-or-equal-to? (hd V5743)) (and (cons? (tl V5743)) (and (cons? (tl (tl V5743))) (= () (tl (tl (tl V5743)))))))) (cons >= (tl V5743))) ((and (cons? V5743) (and (= cl.less? (hd V5743)) (and (cons? (tl V5743)) (and (cons? (tl (tl V5743))) (= () (tl (tl (tl V5743)))))))) (cons < (tl V5743))) ((and (cons? V5743) (and (= cl.less-than-or-equal-to? (hd V5743)) (and (cons? (tl V5743)) (and (cons? (tl (tl V5743))) (= () (tl (tl (tl V5743)))))))) (cons <= (tl V5743))) (true (cons cl.wrapper (cons V5743 ()))))) - -(defun cl.fastsymbol? (V5750) (cond ((cons? V5750) false) ((= () V5750) false) ((string? V5750) false) ((number? V5750) false) (true true))) - -(defun cl.wrapper (V5751) (cond ((= true V5751) T) ((= false V5751) ()) (true (simple-error "boolean expected")))) - -(defun cl.maplispsym (V5752) (cond ((= = V5752) cl.equal?) ((= > V5752) cl.greater?) ((= < V5752) cl.less?) ((= >= V5752) cl.greater-than-or-equal-to?) ((= <= V5752) cl.less-than-or-equal-to?) ((= + V5752) cl.add) ((= - V5752) cl.subtract) ((= / V5752) cl.divide) ((= * V5752) cl.multiply) (true V5752))) - diff --git a/klambda/core.kl b/klambda/core.kl index ac4b06c..8c35f8f 100644 --- a/klambda/core.kl +++ b/klambda/core.kl @@ -1,127 +1,143 @@ -(defun shen.shen->kl (V528) (let W529 (shen.shen->kl-h V528) (shen.record-and-evaluate W529))) +(defun shen.shen->kl (V540) (let W541 (shen.shen->kl-h V540) (shen.record-and-evaluate W541))) -(defun shen.record-and-evaluate (V530) (cond ((and (cons? V530) (and (= defun (hd V530)) (and (cons? (tl V530)) (and (cons? (tl (tl V530))) (and (cons? (tl (tl (tl V530)))) (= () (tl (tl (tl (tl V530)))))))))) (let W531 (if (shen.sysfunc? (hd (tl V530))) (simple-error (shen.app (hd (tl V530)) " is not a legitimate function name -" shen.a)) shen.skip) (let W532 (shen.store-arity (hd (tl V530)) (length (hd (tl (tl V530))))) (let W533 (shen.record-kl (hd (tl V530)) V530) (let W534 (eval-kl V530) (shen.fn-print (hd (tl V530)))))))) (true V530))) +(defun shen.record-and-evaluate (V542) (cond ((and (cons? V542) (and (= defun (hd V542)) (and (cons? (tl V542)) (and (cons? (tl (tl V542))) (and (cons? (tl (tl (tl V542)))) (= () (tl (tl (tl (tl V542)))))))))) (let W543 (if (shen.sysfunc? (hd (tl V542))) (simple-error (shen.app (hd (tl V542)) " is not a legitimate function name +" shen.a)) shen.skip) (let W544 (shen.store-arity (hd (tl V542)) (length (hd (tl (tl V542))))) (let W545 (shen.record-kl (hd (tl V542)) V542) (let W546 (eval-kl V542) (shen.fn-print (hd (tl V542)))))))) (true V542))) -(defun shen.shen->kl-h (V535) (cond ((and (cons? V535) (and (= define (hd V535)) (cons? (tl V535)))) (shen.shendef->kldef (hd (tl V535)) (tl (tl V535)))) ((and (cons? V535) (and (= defun (hd V535)) (and (cons? (tl V535)) (and (cons? (tl (tl V535))) (and (cons? (tl (tl (tl V535)))) (= () (tl (tl (tl (tl V535)))))))))) V535) ((and (cons? V535) (and (= type (hd V535)) (and (cons? (tl V535)) (and (cons? (tl (tl V535))) (= () (tl (tl (tl V535)))))))) (cons type (cons (hd (tl V535)) (cons (shen.rcons_form (hd (tl (tl V535)))) ())))) ((and (cons? V535) (and (= input+ (hd V535)) (and (cons? (tl V535)) (and (cons? (tl (tl V535))) (= () (tl (tl (tl V535)))))))) (cons input+ (cons (shen.rcons_form (hd (tl V535))) (tl (tl V535))))) ((cons? V535) (map (lambda Z536 (shen.shen->kl-h Z536)) V535)) (true V535))) +(defun shen.shen->kl-h (V547) (cond ((and (cons? V547) (and (= define (hd V547)) (cons? (tl V547)))) (shen.shendef->kldef (hd (tl V547)) (tl (tl V547)))) ((and (cons? V547) (and (= defun (hd V547)) (and (cons? (tl V547)) (and (cons? (tl (tl V547))) (and (cons? (tl (tl (tl V547)))) (= () (tl (tl (tl (tl V547)))))))))) V547) ((and (cons? V547) (and (= type (hd V547)) (and (cons? (tl V547)) (and (cons? (tl (tl V547))) (= () (tl (tl (tl V547)))))))) (cons type (cons (hd (tl V547)) (cons (shen.rcons_form (hd (tl (tl V547)))) ())))) ((and (cons? V547) (and (= input+ (hd V547)) (and (cons? (tl V547)) (and (cons? (tl (tl V547))) (= () (tl (tl (tl V547)))))))) (cons input+ (cons (shen.rcons_form (hd (tl V547))) (tl (tl V547))))) ((cons? V547) (map (lambda Z548 (shen.shen->kl-h Z548)) V547)) (true V547))) -(defun shen.shendef->kldef (V537 V538) (compile (lambda Z539 (shen. Z539)) (cons V537 V538))) +(defun shen.shendef->kldef (V549 V550) (compile (lambda Z551 (shen. Z551)) (cons V549 V550))) -(defun shen. (V540) (let W541 (let W542 (shen. V540) (if (shen.parse-failure? W542) (shen.parse-failure) (let W543 (shen.<-out W542) (let W544 (shen.in-> W542) (if (shen.hds=? W544 {) (let W545 (tail W544) (let W546 (shen. W545) (if (shen.parse-failure? W546) (shen.parse-failure) (let W547 (shen.in-> W546) (if (shen.hds=? W547 }) (let W548 (tail W547) (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 W543 W550))))))) (shen.parse-failure)))))) (shen.parse-failure)))))) (if (shen.parse-failure? W541) (let W552 (let W553 (shen. V540) (if (shen.parse-failure? W553) (shen.parse-failure) (let W554 (shen.<-out W553) (let W555 (shen.in-> W553) (let W556 (shen. W555) (if (shen.parse-failure? W556) (shen.parse-failure) (let W557 (shen.<-out W556) (let W558 (shen.in-> W556) (shen.comb W558 (shen.shendef->kldef-h W554 W557)))))))))) (if (shen.parse-failure? W552) (shen.parse-failure) W552)) W541))) +(defun shen. (V552) (let W553 (let W554 (shen. V552) (if (shen.parse-failure? W554) (shen.parse-failure) (let W555 (shen.<-out W554) (let W556 (shen.in-> W554) (if (shen.hds=? W556 {) (let W557 (tail W556) (let W558 (shen. W557) (if (shen.parse-failure? W558) (shen.parse-failure) (let W559 (shen.in-> W558) (if (shen.hds=? W559 }) (let W560 (tail W559) (let W561 (shen. W560) (if (shen.parse-failure? W561) (shen.parse-failure) (let W562 (shen.<-out W561) (let W563 (shen.in-> W561) (shen.comb W563 (shen.shendef->kldef-h W555 W562))))))) (shen.parse-failure)))))) (shen.parse-failure)))))) (if (shen.parse-failure? W553) (let W564 (let W565 (shen. V552) (if (shen.parse-failure? W565) (shen.parse-failure) (let W566 (shen.<-out W565) (let W567 (shen.in-> W565) (let W568 (shen. W567) (if (shen.parse-failure? W568) (shen.parse-failure) (let W569 (shen.<-out W568) (let W570 (shen.in-> W568) (shen.comb W570 (shen.shendef->kldef-h W566 W569)))))))))) (if (shen.parse-failure? W564) (shen.parse-failure) W564)) W553))) -(defun shen.shendef->kldef-h (V559 V560) (let W561 (map (lambda Z562 (fst Z562)) V560) (let W563 (shen.arity-chk V559 W561) (let W564 (map (lambda Z565 (shen.free-var-chk V559 Z565)) V560) (let W566 (shen.unprotect V560) (let W567 (shen.factorise-code (shen.compile-to-kl V559 W566 W563)) W567)))))) +(defun shen.shendef->kldef-h (V571 V572) (let W573 (map (lambda Z574 (fst Z574)) V572) (let W575 (shen.arity-chk V571 W573) (let W576 (map (lambda Z577 (shen.free-var-chk V571 Z577)) V572) (let W578 (shen.unprotect V572) (let W579 (shen.factorise-code (shen.compile-to-kl V571 W578 W575)) W579)))))) -(defun shen.unprotect (V568) (cond ((tuple? V568) (@p (shen.unprotect (fst V568)) (shen.unprotect (snd V568)))) ((and (cons? V568) (and (= protect (hd V568)) (and (cons? (tl V568)) (= () (tl (tl V568)))))) (shen.unprotect (hd (tl V568)))) ((cons? V568) (map (lambda Z569 (shen.unprotect Z569)) V568)) (true V568))) +(defun shen.unprotect (V580) (cond ((tuple? V580) (@p (shen.unprotect (fst V580)) (shen.unprotect (snd V580)))) ((and (cons? V580) (and (= protect (hd V580)) (and (cons? (tl V580)) (= () (tl (tl V580)))))) (shen.unprotect (hd (tl V580)))) ((cons? V580) (map (lambda Z581 (shen.unprotect Z581)) V580)) (true V580))) -(defun shen. (V570) (let W571 (if (cons? V570) (let W572 (head V570) (let W573 (tail V570) (shen.comb W573 (if (and (symbol? W572) (not (variable? W572))) W572 (simple-error (shen.app W572 " is not a legitimate function name. -" shen.a)))))) (shen.parse-failure)) (if (shen.parse-failure? W571) (shen.parse-failure) W571))) +(defun shen. (V582) (let W583 (if (cons? V582) (let W584 (head V582) (let W585 (tail V582) (shen.comb W585 (if (and (symbol? W584) (not (variable? W584))) W584 (simple-error (shen.app W584 " is not a legitimate function name. +" shen.a)))))) (shen.parse-failure)) (if (shen.parse-failure? W583) (shen.parse-failure) W583))) -(defun shen. (V574) (let W575 (if (cons? V574) (let W576 (head V574) (let W577 (tail V574) (let W578 (shen. W577) (if (shen.parse-failure? W578) (shen.parse-failure) (let W579 (shen.<-out W578) (let W580 (shen.in-> W578) (if (not (element? W576 (cons { (cons } ())))) (shen.comb W580 (cons W576 W579)) (shen.parse-failure)))))))) (shen.parse-failure)) (if (shen.parse-failure? W575) (let W581 (let W582 ( V574) (if (shen.parse-failure? W582) (shen.parse-failure) (let W583 (shen.in-> W582) (shen.comb W583 ())))) (if (shen.parse-failure? W581) (shen.parse-failure) W581)) W575))) +(defun shen. (V586) (let W587 (if (cons? V586) (let W588 (head V586) (let W589 (tail V586) (let W590 (shen. W589) (if (shen.parse-failure? W590) (shen.parse-failure) (let W591 (shen.<-out W590) (let W592 (shen.in-> W590) (if (not (element? W588 (cons { (cons } ())))) (shen.comb W592 (cons W588 W591)) (shen.parse-failure)))))))) (shen.parse-failure)) (if (shen.parse-failure? W587) (let W593 (let W594 ( V586) (if (shen.parse-failure? W594) (shen.parse-failure) (let W595 (shen.in-> W594) (shen.comb W595 ())))) (if (shen.parse-failure? W593) (shen.parse-failure) W593)) W587))) -(defun shen. (V584) (let W585 (let W586 (shen. V584) (if (shen.parse-failure? W586) (shen.parse-failure) (let W587 (shen.<-out W586) (let W588 (shen.in-> W586) (let W589 (shen. W588) (if (shen.parse-failure? W589) (shen.parse-failure) (let W590 (shen.<-out W589) (let W591 (shen.in-> W589) (shen.comb W591 (cons (shen.linearise W587) W590)))))))))) (if (shen.parse-failure? W585) (let W592 (let W593 ( V584) (if (shen.parse-failure? W593) (shen.parse-failure) (let W594 (shen.<-out W593) (let W595 (shen.in-> W593) (shen.comb W595 (if (empty? W594) () (simple-error (cn "Shen syntax error here: - " (shen.app W594 " - ..." shen.r))))))))) (if (shen.parse-failure? W592) (shen.parse-failure) W592)) W585))) +(defun shen. (V596) (let W597 (let W598 (shen. V596) (if (shen.parse-failure? W598) (shen.parse-failure) (let W599 (shen.<-out W598) (let W600 (shen.in-> W598) (let W601 (shen. W600) (if (shen.parse-failure? W601) (shen.parse-failure) (let W602 (shen.<-out W601) (let W603 (shen.in-> W601) (shen.comb W603 (cons (shen.linearise W599) W602)))))))))) (if (shen.parse-failure? W597) (let W604 (let W605 ( V596) (if (shen.parse-failure? W605) (shen.parse-failure) (let W606 (shen.<-out W605) (let W607 (shen.in-> W605) (shen.comb W607 (if (empty? W606) () (simple-error (cn "Shen syntax error here: + " (shen.app W606 " + ..." shen.r))))))))) (if (shen.parse-failure? W604) (shen.parse-failure) W604)) W597))) -(defun shen.linearise (V598) (cond ((tuple? V598) (shen.linearise-h (fst V598) (fst V598) () (snd V598))) (true (simple-error "implementation error in shen.linearise")))) +(defun shen.linearise (V610) (cond ((tuple? V610) (shen.linearise-h (fst V610) (fst V610) () (snd V610))) (true (simple-error "implementation error in shen.linearise")))) -(defun shen.linearise-h (V611 V612 V613 V614) (cond ((= () V611) (@p V612 V614)) ((and (cons? V611) (cons? (hd V611))) (shen.linearise-h (append (hd V611) (tl V611)) V612 V613 V614)) ((and (cons? V611) (variable? (hd V611))) (if (element? (hd V611) V613) (let W615 (gensym V) (shen.linearise-h (tl V611) (shen.rep-X (hd V611) W615 V612) V613 (cons where (cons (cons = (cons W615 (cons (hd V611) ()))) (cons V614 ()))))) (shen.linearise-h (tl V611) V612 (cons (hd V611) V613) V614))) ((cons? V611) (shen.linearise-h (tl V611) V612 V613 V614)) (true (simple-error "implementation error in shen.linearise-h")))) +(defun shen.linearise-h (V623 V624 V625 V626) (cond ((= () V623) (@p V624 V626)) ((and (cons? V623) (cons? (hd V623))) (shen.linearise-h (append (hd V623) (tl V623)) V624 V625 V626)) ((and (cons? V623) (variable? (hd V623))) (if (element? (hd V623) V625) (let W627 (gensym V) (shen.linearise-h (tl V623) (shen.rep-X (hd V623) W627 V624) V625 (cons where (cons (cons = (cons W627 (cons (hd V623) ()))) (cons V626 ()))))) (shen.linearise-h (tl V623) V624 (cons (hd V623) V625) V626))) ((cons? V623) (shen.linearise-h (tl V623) V624 V625 V626)) (true (simple-error "implementation error in shen.linearise-h")))) -(defun shen. (V616) (let W617 (let W618 (shen. V616) (if (shen.parse-failure? W618) (shen.parse-failure) (let W619 (shen.<-out W618) (let W620 (shen.in-> W618) (if (shen.hds=? W620 ->) (let W621 (tail W620) (if (cons? W621) (let W622 (head W621) (let W623 (tail W621) (if (shen.hds=? W623 where) (let W624 (tail W623) (if (cons? W624) (let W625 (head W624) (let W626 (tail W624) (shen.comb W626 (@p W619 (cons where (cons W625 (cons W622 ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W617) (let W627 (let W628 (shen. V616) (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) (shen.comb W633 (@p W629 W632)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W627) (let W634 (let W635 (shen. V616) (if (shen.parse-failure? W635) (shen.parse-failure) (let W636 (shen.<-out W635) (let W637 (shen.in-> W635) (if (shen.hds=? W637 <-) (let W638 (tail W637) (if (cons? W638) (let W639 (head W638) (let W640 (tail W638) (if (shen.hds=? W640 where) (let W641 (tail W640) (if (cons? W641) (let W642 (head W641) (let W643 (tail W641) (shen.comb W643 (@p W636 (cons where (cons W642 (cons (cons shen.choicepoint! (cons W639 ())) ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W634) (let W644 (let W645 (shen. V616) (if (shen.parse-failure? W645) (shen.parse-failure) (let W646 (shen.<-out W645) (let W647 (shen.in-> W645) (if (shen.hds=? W647 <-) (let W648 (tail W647) (if (cons? W648) (let W649 (head W648) (let W650 (tail W648) (shen.comb W650 (@p W646 (cons shen.choicepoint! (cons W649 ())))))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W644) (shen.parse-failure) W644)) W634)) W627)) W617))) +(defun shen. (V628) (let W629 (let W630 (shen. V628) (if (shen.parse-failure? W630) (shen.parse-failure) (let W631 (shen.<-out W630) (let W632 (shen.in-> W630) (if (shen.hds=? W632 ->) (let W633 (tail W632) (if (cons? W633) (let W634 (head W633) (let W635 (tail W633) (if (shen.hds=? W635 where) (let W636 (tail W635) (if (cons? W636) (let W637 (head W636) (let W638 (tail W636) (shen.comb W638 (@p W631 (cons where (cons W637 (cons W634 ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W629) (let W639 (let W640 (shen. V628) (if (shen.parse-failure? W640) (shen.parse-failure) (let W641 (shen.<-out W640) (let W642 (shen.in-> W640) (if (shen.hds=? W642 ->) (let W643 (tail W642) (if (cons? W643) (let W644 (head W643) (let W645 (tail W643) (shen.comb W645 (@p W641 W644)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W639) (let W646 (let W647 (shen. V628) (if (shen.parse-failure? W647) (shen.parse-failure) (let W648 (shen.<-out W647) (let W649 (shen.in-> W647) (if (shen.hds=? W649 <-) (let W650 (tail W649) (if (cons? W650) (let W651 (head W650) (let W652 (tail W650) (if (shen.hds=? W652 where) (let W653 (tail W652) (if (cons? W653) (let W654 (head W653) (let W655 (tail W653) (shen.comb W655 (@p W648 (cons where (cons W654 (cons (cons shen.choicepoint! (cons W651 ())) ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W646) (let W656 (let W657 (shen. V628) (if (shen.parse-failure? W657) (shen.parse-failure) (let W658 (shen.<-out W657) (let W659 (shen.in-> W657) (if (shen.hds=? W659 <-) (let W660 (tail W659) (if (cons? W660) (let W661 (head W660) (let W662 (tail W660) (shen.comb W662 (@p W658 (cons shen.choicepoint! (cons W661 ())))))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W656) (shen.parse-failure) W656)) W646)) W639)) W629))) -(defun shen. (V651) (let W652 (let W653 (shen. V651) (if (shen.parse-failure? W653) (shen.parse-failure) (let W654 (shen.<-out W653) (let W655 (shen.in-> W653) (let W656 (shen. W655) (if (shen.parse-failure? W656) (shen.parse-failure) (let W657 (shen.<-out W656) (let W658 (shen.in-> W656) (shen.comb W658 (cons W654 W657)))))))))) (if (shen.parse-failure? W652) (let W659 (let W660 ( V651) (if (shen.parse-failure? W660) (shen.parse-failure) (let W661 (shen.in-> W660) (shen.comb W661 ())))) (if (shen.parse-failure? W659) (shen.parse-failure) W659)) W652))) +(defun shen. (V663) (let W664 (let W665 (shen. V663) (if (shen.parse-failure? W665) (shen.parse-failure) (let W666 (shen.<-out W665) (let W667 (shen.in-> W665) (let W668 (shen. W667) (if (shen.parse-failure? W668) (shen.parse-failure) (let W669 (shen.<-out W668) (let W670 (shen.in-> W668) (shen.comb W670 (cons W666 W669)))))))))) (if (shen.parse-failure? W664) (let W671 (let W672 ( V663) (if (shen.parse-failure? W672) (shen.parse-failure) (let W673 (shen.in-> W672) (shen.comb W673 ())))) (if (shen.parse-failure? W671) (shen.parse-failure) W671)) W664))) -(defun shen. (V662) (let W663 (if (shen.ccons? V662) (let W664 (head V662) (let W665 (tail V662) (let W666 (shen. W664) (if (shen.parse-failure? W666) (shen.parse-failure) (let W667 (shen.<-out W666) (let W668 (shen.in-> W666) (let W669 (shen. W668) (if (shen.parse-failure? W669) (shen.parse-failure) (let W670 (shen.<-out W669) (let W671 (shen.in-> W669) (let W672 (shen. W671) (if (shen.parse-failure? W672) (shen.parse-failure) (let W673 (shen.<-out W672) (let W674 (shen.in-> W672) (let W675 ( W674) (if (shen.parse-failure? W675) (shen.parse-failure) (let W676 (shen.in-> W675) (shen.comb W665 (cons W667 (cons W670 (cons W673 ()))))))))))))))))))))) (shen.parse-failure)) (if (shen.parse-failure? W663) (let W677 (if (shen.ccons? V662) (let W678 (head V662) (let W679 (tail V662) (if (shen.hds=? W678 vector) (let W680 (tail W678) (if (shen.hds=? W680 0) (let W681 (tail W680) (let W682 ( W681) (if (shen.parse-failure? W682) (shen.parse-failure) (let W683 (shen.in-> W682) (shen.comb W679 (cons vector (cons 0 ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W677) (let W684 (if (cons? V662) (let W685 (head V662) (let W686 (tail V662) (if (cons? W685) (shen.comb W686 (shen.constructor-error W685)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W684) (let W687 (let W688 (shen. V662) (if (shen.parse-failure? W688) (shen.parse-failure) (let W689 (shen.<-out W688) (let W690 (shen.in-> W688) (shen.comb W690 W689))))) (if (shen.parse-failure? W687) (shen.parse-failure) W687)) W684)) W677)) W663))) +(defun shen. (V674) (let W675 (if (shen.ccons? V674) (let W676 (head V674) (let W677 (tail V674) (if (shen.hds=? W676 vector) (let W678 (tail W676) (if (shen.hds=? W678 0) (let W679 (tail W678) (let W680 ( W679) (if (shen.parse-failure? W680) (shen.parse-failure) (let W681 (shen.in-> W680) (shen.comb W677 (cons vector (cons 0 ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W675) (let W682 (if (cons? V674) (let W683 (head V674) (let W684 (tail V674) (if (cons? W683) (shen.comb W684 (shen.compound-pattern W683)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W682) (let W685 (let W686 (shen. V674) (if (shen.parse-failure? W686) (shen.parse-failure) (let W687 (shen.<-out W686) (let W688 (shen.in-> W686) (shen.comb W688 W687))))) (if (shen.parse-failure? W685) (shen.parse-failure) W685)) W682)) W675))) -(defun shen. (V691) (let W692 (if (cons? V691) (let W693 (head V691) (let W694 (tail V691) (if (shen.constructor? W693) (shen.comb W694 W693) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W692) (shen.parse-failure) W692))) +(defun shen. (V689) (let W690 (if (cons? V689) (let W691 (head V689) (let W692 (tail V689) (if (shen.constructor? W691) (shen.comb W692 W691) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W690) (shen.parse-failure) W690))) -(defun shen.constructor? (V695) (element? V695 (cons cons (cons @p (cons @s (cons @v ())))))) +(defun shen.constructor? (V693) (element? V693 (cons cons (cons @p (cons @s (cons @v ())))))) -(defun shen.constructor-error (V696) (simple-error (shen.app V696 " is not a legitimate constructor +(defun shen.constructor-error (V694) (simple-error (shen.app V694 " is not a legitimate constructor " shen.r))) -(defun shen. (V697) (let W698 (if (cons? V697) (let W699 (head V697) (let W700 (tail V697) (if (= W699 _) (shen.comb W700 (gensym Y)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W698) (let W701 (if (cons? V697) (let W702 (head V697) (let W703 (tail V697) (if (not (element? W702 (cons -> (cons <- ())))) (shen.comb W703 W702) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W701) (shen.parse-failure) W701)) W698))) +(defun shen.custom-pattern-compiler (V695 V696) (let W697 (value shen.*custom-pattern-compiler*) (if (= W697 false) (thaw V696) ((W697 V695) V696)))) -(defun shen. (V704) (let W705 (let W706 (shen. V704) (if (shen.parse-failure? W706) (shen.parse-failure) (let W707 (shen.<-out W706) (let W708 (shen.in-> W706) (shen.comb W708 W707))))) (if (shen.parse-failure? W705) (shen.parse-failure) W705))) +(defun shen.custom-pattern-reducer (V698) (let W699 (value shen.*custom-pattern-reducer*) (if (= W699 false) (fail) (W699 V698)))) -(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.compound-pattern (V700) (shen.custom-pattern-compiler V700 (freeze (shen.compound-pattern-h V700)))) -(defun shen.fn-print (V714) (let W715 (absvector 2) (let W716 (address-> W715 0 shen.printF) (let W717 (address-> W716 1 (@s "(" (@s "f" (@s "n" (@s " " (@s (str V714) ")")))))) W717)))) +(defun shen.compound-pattern-h (V701) (cond ((and (cons? V701) (and (cons? (tl V701)) (and (cons? (tl (tl V701))) (and (= () (tl (tl (tl V701)))) (shen.constructor? (hd V701)))))) (cons (hd V701) (cons (shen.compile-pattern-fragment (hd (tl V701))) (cons (shen.compile-pattern-fragment (hd (tl (tl V701)))) ())))) (true (shen.constructor-error V701)))) -(defun shen.printF (V718) (<-address V718 1)) +(defun shen.compile-pattern-fragment (V702) (cond ((and (cons? V702) (and (= vector (hd V702)) (and (cons? (tl V702)) (and (= 0 (hd (tl V702))) (= () (tl (tl V702))))))) V702) ((cons? V702) (shen.compound-pattern V702)) ((= V702 _) (gensym Y)) ((not (element? V702 (cons -> (cons <- ())))) V702) (true (shen.constructor-error V702)))) -(defun shen.arity-chk (V723 V724) (cond ((and (cons? V724) (= () (tl V724))) (length (hd V724))) ((and (cons? V724) (and (cons? (tl V724)) (= (length (hd V724)) (length (hd (tl V724)))))) (shen.arity-chk V723 (tl V724))) (true (simple-error (cn "arity error in " (shen.app V723 " +(defun shen.custom-pattern? (V707) (cond ((and (cons? V707) (and (= @p (hd V707)) (and (cons? (tl V707)) (and (= shen.custom-pattern (hd (tl V707))) (and (cons? (tl (tl V707))) (= () (tl (tl (tl V707))))))))) true) (true false))) + +(defun shen.custom-pattern-body (V710) (cond ((and (cons? V710) (and (= @p (hd V710)) (and (cons? (tl V710)) (and (= shen.custom-pattern (hd (tl V710))) (and (cons? (tl (tl V710))) (= () (tl (tl (tl V710))))))))) (hd (tl (tl V710)))) (true (simple-error "implementation error in shen.custom-pattern-body")))) + +(defun shen. (V711) (let W712 (if (cons? V711) (let W713 (head V711) (let W714 (tail V711) (if (= W713 _) (shen.comb W714 (gensym Y)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W712) (let W715 (if (cons? V711) (let W716 (head V711) (let W717 (tail V711) (if (not (element? W716 (cons -> (cons <- ())))) (shen.comb W717 W716) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W715) (shen.parse-failure) W715)) W712))) + +(defun shen. (V718) (let W719 (let W720 (shen. V718) (if (shen.parse-failure? W720) (shen.parse-failure) (let W721 (shen.<-out W720) (let W722 (shen.in-> W720) (shen.comb W722 W721))))) (if (shen.parse-failure? W719) (shen.parse-failure) W719))) + +(defun shen. (V723) (let W724 (let W725 (shen. V723) (if (shen.parse-failure? W725) (shen.parse-failure) (let W726 (shen.<-out W725) (let W727 (shen.in-> W725) (shen.comb W727 W726))))) (if (shen.parse-failure? W724) (shen.parse-failure) W724))) + +(defun shen.fn-print (V728) (let W729 (absvector 2) (let W730 (address-> W729 0 shen.printF) (let W731 (address-> W730 1 (@s "(" (@s "f" (@s "n" (@s " " (@s (str V728) ")")))))) W731)))) + +(defun shen.printF (V732) (<-address V732 1)) + +(defun shen.arity-chk (V737 V738) (cond ((and (cons? V738) (= () (tl V738))) (length (hd V738))) ((and (cons? V738) (and (cons? (tl V738)) (= (length (hd V738)) (length (hd (tl V738)))))) (shen.arity-chk V737 (tl V738))) (true (simple-error (cn "arity error in " (shen.app V737 " " shen.a)))))) -(defun shen.free-var-chk (V725 V726) (cond ((tuple? V726) (shen.free-variable-error-message V725 (shen.find-free-vars (shen.extract-vars (fst V726)) (snd V726)))) (true (simple-error "partial function shen.free-var-chk")))) +(defun shen.free-var-chk (V739 V740) (cond ((tuple? V740) (shen.free-variable-error-message V739 (shen.find-free-vars (shen.extract-vars (fst V740)) (snd V740)))) (true (shen.f-error shen.free-var-chk)))) + +(defun shen.free-variable-error-message (V741 V742) (if (empty? V742) shen.skip (do (pr (cn "free variables in " (shen.app V741 ":" shen.a)) (stoutput)) (do (shen.for-each (lambda Z743 (pr (cn " " (shen.app Z743 "" shen.a)) (stoutput))) V742) (do (nl 1) (abort)))))) -(defun shen.free-variable-error-message (V727 V728) (if (empty? V728) shen.skip (do (pr (cn "free variables in " (shen.app V727 ":" shen.a)) (stoutput)) (do (map (lambda Z729 (pr (cn " " (shen.app Z729 "" shen.a)) (stoutput))) V728) (do (nl 1) (abort)))))) +(defun shen.extract-vars (V746) (cond ((variable? V746) (cons V746 ())) ((cons? V746) (union (shen.extract-vars (hd V746)) (shen.extract-vars (tl V746)))) (true ()))) -(defun shen.extract-vars (V732) (cond ((variable? V732) (cons V732 ())) ((cons? V732) (union (shen.extract-vars (hd V732)) (shen.extract-vars (tl V732)))) (true ()))) +(defun shen.find-free-vars (V751 V752) (cond ((and (cons? V752) (and (= protect (hd V752)) (and (cons? (tl V752)) (= () (tl (tl V752)))))) ()) ((and (cons? V752) (and (= let (hd V752)) (and (cons? (tl V752)) (and (cons? (tl (tl V752))) (and (cons? (tl (tl (tl V752)))) (= () (tl (tl (tl (tl V752)))))))))) (union (shen.find-free-vars V751 (hd (tl (tl V752)))) (shen.find-free-vars (cons (hd (tl V752)) V751) (hd (tl (tl (tl V752))))))) ((and (cons? V752) (and (= lambda (hd V752)) (and (cons? (tl V752)) (and (cons? (tl (tl V752))) (= () (tl (tl (tl V752)))))))) (shen.find-free-vars (cons (hd (tl V752)) V751) (hd (tl (tl V752))))) ((cons? V752) (union (shen.find-free-vars V751 (hd V752)) (shen.find-free-vars V751 (tl V752)))) ((shen.free-variable? V752 V751) (cons V752 ())) (true ()))) -(defun shen.find-free-vars (V737 V738) (cond ((and (cons? V738) (and (= protect (hd V738)) (and (cons? (tl V738)) (= () (tl (tl V738)))))) ()) ((and (cons? V738) (and (= let (hd V738)) (and (cons? (tl V738)) (and (cons? (tl (tl V738))) (and (cons? (tl (tl (tl V738)))) (= () (tl (tl (tl (tl V738)))))))))) (union (shen.find-free-vars V737 (hd (tl (tl V738)))) (shen.find-free-vars (cons (hd (tl V738)) V737) (hd (tl (tl (tl V738))))))) ((and (cons? V738) (and (= lambda (hd V738)) (and (cons? (tl V738)) (and (cons? (tl (tl V738))) (= () (tl (tl (tl V738)))))))) (shen.find-free-vars (cons (hd (tl V738)) V737) (hd (tl (tl V738))))) ((cons? V738) (union (shen.find-free-vars V737 (hd V738)) (shen.find-free-vars V737 (tl V738)))) ((shen.free-variable? V738 V737) (cons V738 ())) (true ()))) +(defun shen.free-variable? (V753 V754) (and (variable? V753) (not (element? V753 V754)))) -(defun shen.free-variable? (V739 V740) (and (variable? V739) (not (element? V739 V740)))) +(defun shen.record-kl (V755 V756) (do (set shen.*userdefs* (adjoin V755 (value shen.*userdefs*))) (put V755 shen.source V756 (value *property-vector*)))) -(defun shen.record-kl (V741 V742) (do (set shen.*userdefs* (adjoin V741 (value shen.*userdefs*))) (put V741 shen.source V742 (value *property-vector*)))) +(defun shen.compile-to-kl (V757 V758 V759) (let W760 (shen.parameters V759) (let W761 (shen.scan-body V757 (shen.kl-body V758 W760)) (let W762 (cons defun (cons V757 (cons W760 (cons (shen.cond-form W761) ())))) W762)))) -(defun shen.compile-to-kl (V743 V744 V745) (let W746 (shen.parameters V745) (let W747 (shen.scan-body V743 (shen.kl-body V744 W746)) (let W748 (cons defun (cons V743 (cons W746 (cons (shen.cond-form W747) ())))) W748)))) +(defun shen.parameters (V763) (cond ((= 0 V763) ()) (true (cons (gensym V) (shen.parameters (- V763 1)))))) -(defun shen.parameters (V749) (cond ((= 0 V749) ()) (true (cons (gensym V) (shen.parameters (- V749 1)))))) +(defun shen.cond-form (V766) (cond ((and (cons? V766) (and (cons? (hd V766)) (and (= true (hd (hd V766))) (and (cons? (tl (hd V766))) (= () (tl (tl (hd V766)))))))) (hd (tl (hd V766)))) (true (cons cond V766)))) -(defun shen.cond-form (V752) (cond ((and (cons? V752) (and (cons? (hd V752)) (and (= true (hd (hd V752))) (and (cons? (tl (hd V752))) (= () (tl (tl (hd V752)))))))) (hd (tl (hd V752)))) (true (cons cond V752)))) +(defun shen.scan-body (V775 V776) (cond ((= () V776) (cons (cons true (cons (cons shen.f-error (cons V775 ())) ())) ())) ((and (cons? V776) (shen.choicepoint? (hd V776))) (shen.choicepoint V775 (gensym Freeze) (gensym Result) (hd V776) (tl V776))) ((and (cons? V776) (and (cons? (hd V776)) (and (= true (hd (hd V776))) (and (cons? (tl (hd V776))) (= () (tl (tl (hd V776)))))))) (cons (hd V776) ())) ((cons? V776) (cons (hd V776) (shen.scan-body V775 (tl V776)))) (true (simple-error "implementation error in shen.scan-body")))) -(defun shen.scan-body (V761 V762) (cond ((= () V762) (cons (cons true (cons (cons shen.f-error (cons V761 ())) ())) ())) ((and (cons? V762) (shen.choicepoint? (hd V762))) (shen.choicepoint V761 (gensym Freeze) (gensym Result) (hd V762) (tl V762))) ((and (cons? V762) (and (cons? (hd V762)) (and (= true (hd (hd V762))) (and (cons? (tl (hd V762))) (= () (tl (tl (hd V762)))))))) (cons (hd V762) ())) ((cons? V762) (cons (hd V762) (shen.scan-body V761 (tl V762)))) (true (simple-error "implementation error in shen.scan-body")))) +(defun shen.choicepoint? (V783) (cond ((and (cons? V783) (and (cons? (tl V783)) (and (cons? (hd (tl V783))) (and (= shen.choicepoint! (hd (hd (tl V783)))) (and (cons? (tl (hd (tl V783)))) (and (= () (tl (tl (hd (tl V783))))) (= () (tl (tl V783))))))))) true) (true false))) -(defun shen.choicepoint? (V769) (cond ((and (cons? V769) (and (cons? (tl V769)) (and (cons? (hd (tl V769))) (and (= shen.choicepoint! (hd (hd (tl V769)))) (and (cons? (tl (hd (tl V769)))) (and (= () (tl (tl (hd (tl V769))))) (= () (tl (tl V769))))))))) true) (true false))) +(defun shen.choicepoint (V799 V800 V801 V802 V803) (cond ((and (cons? V802) (and (cons? (tl V802)) (and (cons? (hd (tl V802))) (and (cons? (tl (hd (tl V802)))) (and (cons? (hd (tl (hd (tl V802))))) (and (= fail-if (hd (hd (tl (hd (tl V802)))))) (and (cons? (tl (hd (tl (hd (tl V802)))))) (and (cons? (tl (tl (hd (tl (hd (tl V802))))))) (and (= () (tl (tl (tl (hd (tl (hd (tl V802)))))))) (and (= () (tl (tl (hd (tl V802))))) (and (= () (tl (tl V802))) (= V799 (hd (tl (hd (tl (hd (tl V802)))))))))))))))))) (cons (cons true (cons (cons let (cons V800 (cons (cons freeze (cons (cons cond (shen.scan-body (hd (tl (hd (tl (hd (tl V802)))))) V803)) ())) (cons (cons if (cons (hd V802) (cons (cons let (cons V801 (cons (hd (tl (tl (hd (tl (hd (tl V802))))))) (cons (cons if (cons (cons (hd (tl (hd (tl (hd (tl V802)))))) (cons V801 ())) (cons (cons thaw (cons V800 ())) (cons V801 ())))) ())))) (cons (cons thaw (cons V800 ())) ())))) ())))) ())) ())) ((and (cons? V802) (and (cons? (tl V802)) (and (cons? (hd (tl V802))) (and (cons? (tl (hd (tl V802)))) (and (= () (tl (tl (hd (tl V802))))) (= () (tl (tl V802)))))))) (cons (cons true (cons (cons let (cons V800 (cons (cons freeze (cons (cons cond (shen.scan-body V799 V803)) ())) (cons (cons if (cons (hd V802) (cons (cons let (cons V801 (cons (hd (tl (hd (tl V802)))) (cons (cons if (cons (cons = (cons V801 (cons (cons fail ()) ()))) (cons (cons thaw (cons V800 ())) (cons V801 ())))) ())))) (cons (cons thaw (cons V800 ())) ())))) ())))) ())) ())) (true (simple-error "implementation error in shen.choicepoint")))) -(defun shen.choicepoint (V785 V786 V787 V788 V789) (cond ((and (cons? V788) (and (cons? (tl V788)) (and (cons? (hd (tl V788))) (and (cons? (tl (hd (tl V788)))) (and (cons? (hd (tl (hd (tl V788))))) (and (= fail-if (hd (hd (tl (hd (tl V788)))))) (and (cons? (tl (hd (tl (hd (tl V788)))))) (and (cons? (tl (tl (hd (tl (hd (tl V788))))))) (and (= () (tl (tl (tl (hd (tl (hd (tl V788)))))))) (and (= () (tl (tl (hd (tl V788))))) (and (= () (tl (tl V788))) (= V785 (hd (tl (hd (tl (hd (tl V788)))))))))))))))))) (cons (cons true (cons (cons let (cons V786 (cons (cons freeze (cons (cons cond (shen.scan-body (hd (tl (hd (tl (hd (tl V788)))))) V789)) ())) (cons (cons if (cons (hd V788) (cons (cons let (cons V787 (cons (hd (tl (tl (hd (tl (hd (tl V788))))))) (cons (cons if (cons (cons (hd (tl (hd (tl (hd (tl V788)))))) (cons V787 ())) (cons (cons thaw (cons V786 ())) (cons V787 ())))) ())))) (cons (cons thaw (cons V786 ())) ())))) ())))) ())) ())) ((and (cons? V788) (and (cons? (tl V788)) (and (cons? (hd (tl V788))) (and (cons? (tl (hd (tl V788)))) (and (= () (tl (tl (hd (tl V788))))) (= () (tl (tl V788)))))))) (cons (cons true (cons (cons let (cons V786 (cons (cons freeze (cons (cons cond (shen.scan-body V785 V789)) ())) (cons (cons if (cons (hd V788) (cons (cons let (cons V787 (cons (hd (tl (hd (tl V788)))) (cons (cons if (cons (cons = (cons V787 (cons (cons fail ()) ()))) (cons (cons thaw (cons V786 ())) (cons V787 ())))) ())))) (cons (cons thaw (cons V786 ())) ())))) ())))) ())) ())) (true (simple-error "implementation error in shen.choicepoint")))) +(defun shen.rep-X (V805 V806 V807) (cond ((= V805 V807) V806) ((cons? V807) (let W808 (shen.rep-X V805 V806 (hd V807)) (if (= W808 (hd V807)) (cons (hd V807) (shen.rep-X V805 V806 (tl V807))) (cons W808 (tl V807))))) (true V807))) -(defun shen.rep-X (V791 V792 V793) (cond ((= V791 V793) V792) ((cons? V793) (let W794 (shen.rep-X V791 V792 (hd V793)) (if (= W794 (hd V793)) (cons (hd V793) (shen.rep-X V791 V792 (tl V793))) (cons W794 (tl V793))))) (true V793))) +(defun shen.alpha-convert (V809) (cond ((and (cons? V809) (and (= lambda (hd V809)) (and (cons? (tl V809)) (and (cons? (tl (tl V809))) (= () (tl (tl (tl V809)))))))) (let W810 (gensym Z) (let W811 (cons lambda (cons W810 (cons (shen.beta (hd (tl V809)) W810 (hd (tl (tl V809)))) ()))) (map (lambda Z812 (shen.alpha-convert Z812)) W811)))) ((and (cons? V809) (and (= let (hd V809)) (and (cons? (tl V809)) (and (cons? (tl (tl V809))) (and (cons? (tl (tl (tl V809)))) (= () (tl (tl (tl (tl V809)))))))))) (let W813 (gensym W) (let W814 (cons let (cons W813 (cons (hd (tl (tl V809))) (cons (shen.beta (hd (tl V809)) W813 (hd (tl (tl (tl V809))))) ())))) (map (lambda Z815 (shen.alpha-convert Z815)) W814)))) ((cons? V809) (map (lambda Z816 (shen.alpha-convert Z816)) V809)) (true V809))) -(defun shen.kl-body (V795 V796) (map (lambda Z797 (shen.triple-stack () (fst Z797) V796 (shen.alpha-convert (snd Z797)))) V795)) +(defun shen.kl-body (V817 V818) (map (lambda Z819 (shen.triple-stack () (fst Z819) V818 (shen.alpha-convert (snd Z819)))) V817)) -(defun shen.alpha-convert (V798) (cond ((and (cons? V798) (and (= lambda (hd V798)) (and (cons? (tl V798)) (and (cons? (tl (tl V798))) (= () (tl (tl (tl V798)))))))) (let W799 (gensym Z) (let W800 (cons lambda (cons W799 (cons (shen.beta (hd (tl V798)) W799 (hd (tl (tl V798)))) ()))) (map (lambda Z801 (shen.alpha-convert Z801)) W800)))) ((and (cons? V798) (and (= let (hd V798)) (and (cons? (tl V798)) (and (cons? (tl (tl V798))) (and (cons? (tl (tl (tl V798)))) (= () (tl (tl (tl (tl V798)))))))))) (let W802 (gensym W) (let W803 (cons let (cons W802 (cons (hd (tl (tl V798))) (cons (shen.beta (hd (tl V798)) W802 (hd (tl (tl (tl V798))))) ())))) (map (lambda Z804 (shen.alpha-convert Z804)) W803)))) ((cons? V798) (map (lambda Z805 (shen.alpha-convert Z805)) V798)) (true V798))) +(defun shen.triple-stack (V828 V829 V830 V831) (cond ((and (= () V829) (and (= () V830) (and (cons? V831) (and (= where (hd V831)) (and (cons? (tl V831)) (and (cons? (tl (tl V831))) (= () (tl (tl (tl V831)))))))))) (shen.triple-stack (cons (hd (tl V831)) V828) () () (hd (tl (tl V831))))) ((and (= () V829) (= () V830)) (cons (shen.rectify-test (reverse V828)) (cons V831 ()))) ((and (cons? V829) (and (cons? V830) (variable? (hd V829)))) (shen.triple-stack V828 (tl V829) (tl V830) (shen.beta (hd V829) (hd V830) V831))) ((and (cons? V829) (and (cons? V830) (shen.custom-pattern? (hd V829)))) (shen.custom-pattern-triple-stack V828 (shen.custom-pattern-body (hd V829)) (tl V829) (hd V830) (tl V830) V831)) ((and (cons? V829) (and (cons? (hd V829)) (and (cons? (tl (hd V829))) (and (cons? (tl (tl (hd V829)))) (and (= () (tl (tl (tl (hd V829))))) (and (cons? V830) (shen.constructor? (hd (hd V829))))))))) (shen.triple-stack (cons (cons (shen.op-test (hd (hd V829))) (cons (hd V830) ())) V828) (cons (hd (tl (hd V829))) (cons (hd (tl (tl (hd V829)))) (tl V829))) (cons (cons (shen.op1 (hd (hd V829))) (cons (hd V830) ())) (cons (cons (shen.op2 (hd (hd V829))) (cons (hd V830) ())) (tl V830))) (shen.beta (hd V829) (hd V830) V831))) ((and (cons? V829) (cons? V830)) (shen.triple-stack (cons (cons = (cons (hd V829) (cons (hd V830) ()))) V828) (tl V829) (tl V830) V831)) (true (simple-error "implementation error in shen.triple-stack")))) -(defun shen.triple-stack (V814 V815 V816 V817) (cond ((and (= () V815) (and (= () V816) (and (cons? V817) (and (= where (hd V817)) (and (cons? (tl V817)) (and (cons? (tl (tl V817))) (= () (tl (tl (tl V817)))))))))) (shen.triple-stack (cons (hd (tl V817)) V814) () () (hd (tl (tl V817))))) ((and (= () V815) (= () V816)) (cons (shen.rectify-test (reverse V814)) (cons V817 ()))) ((and (cons? V815) (and (cons? V816) (variable? (hd V815)))) (shen.triple-stack V814 (tl V815) (tl V816) (shen.beta (hd V815) (hd V816) V817))) ((and (cons? V815) (and (cons? (hd V815)) (and (cons? (tl (hd V815))) (and (cons? (tl (tl (hd V815)))) (and (= () (tl (tl (tl (hd V815))))) (cons? V816)))))) (shen.triple-stack (cons (cons (shen.op-test (hd (hd V815))) (cons (hd V816) ())) V814) (cons (hd (tl (hd V815))) (cons (hd (tl (tl (hd V815)))) (tl V815))) (cons (cons (shen.op1 (hd (hd V815))) (cons (hd V816) ())) (cons (cons (shen.op2 (hd (hd V815))) (cons (hd V816) ())) (tl V816))) (shen.beta (hd V815) (hd V816) V817))) ((and (cons? V815) (cons? V816)) (shen.triple-stack (cons (cons = (cons (hd V815) (cons (hd V816) ()))) V814) (tl V815) (tl V816) V817)) (true (simple-error "implementation error in shen.triple-stack")))) +(defun shen.custom-pattern-triple-stack (V832 V833 V834 V835 V836 V837) (let W838 (shen.custom-pattern-reducer (@p V833 V835)) (if (tuple? W838) (let W839 (fst W838) (let W840 (snd W838) (shen.triple-stack (append (reverse W839) V832) (append (map (lambda Z841 (fst Z841)) W840) V834) (append (map (lambda Z842 (snd Z842)) W840) V836) (shen.beta V833 V835 V837)))) (shen.constructor-error V833)))) -(defun shen.rectify-test (V820) (cond ((= () V820) true) ((and (cons? V820) (= () (tl V820))) (hd V820)) ((and (cons? V820) (cons? (tl V820))) (cons and (cons (hd V820) (cons (shen.rectify-test (tl V820)) ())))) (true (simple-error "implementation error in shen.rectify-test")))) +(defun shen.rectify-test (V845) (cond ((= () V845) true) ((and (cons? V845) (= () (tl V845))) (hd V845)) ((and (cons? V845) (cons? (tl V845))) (cons and (cons (hd V845) (cons (shen.rectify-test (tl V845)) ())))) (true (simple-error "implementation error in shen.rectify-test")))) -(defun shen.beta (V830 V831 V832) (cond ((= V830 V832) V831) ((and (cons? V832) (and (= lambda (hd V832)) (and (cons? (tl V832)) (and (cons? (tl (tl V832))) (and (= () (tl (tl (tl V832)))) (= V830 (hd (tl V832)))))))) V832) ((and (cons? V832) (and (= let (hd V832)) (and (cons? (tl V832)) (and (cons? (tl (tl V832))) (and (cons? (tl (tl (tl V832)))) (and (= () (tl (tl (tl (tl V832))))) (= V830 (hd (tl V832))))))))) (cons let (cons (hd (tl V832)) (cons (shen.beta (hd (tl V832)) V831 (hd (tl (tl V832)))) (tl (tl (tl V832))))))) ((cons? V832) (map (lambda Z833 (shen.beta V830 V831 Z833)) V832)) (true V832))) +(defun shen.beta (V855 V856 V857) (cond ((= V855 V857) V856) ((and (cons? V857) (and (= lambda (hd V857)) (and (cons? (tl V857)) (and (cons? (tl (tl V857))) (and (= () (tl (tl (tl V857)))) (= V855 (hd (tl V857)))))))) V857) ((and (cons? V857) (and (= let (hd V857)) (and (cons? (tl V857)) (and (cons? (tl (tl V857))) (and (cons? (tl (tl (tl V857)))) (and (= () (tl (tl (tl (tl V857))))) (= V855 (hd (tl V857))))))))) (cons let (cons (hd (tl V857)) (cons (shen.beta (hd (tl V857)) V856 (hd (tl (tl V857)))) (tl (tl (tl V857))))))) ((cons? V857) (map (lambda Z858 (shen.beta V855 V856 Z858)) V857)) (true V857))) -(defun shen.op1 (V836) (cond ((= cons V836) hd) ((= @s V836) hdstr) ((= @p V836) fst) ((= @v V836) hdv) (true (simple-error "implementation error in shen.op1")))) +(defun shen.op1 (V861) (cond ((= cons V861) hd) ((= @s V861) hdstr) ((= @p V861) fst) ((= @v V861) hdv) (true (simple-error "implementation error in shen.op1")))) -(defun shen.op2 (V839) (cond ((= cons V839) tl) ((= @s V839) tlstr) ((= @p V839) snd) ((= @v V839) tlv) (true (simple-error "implementation error in shen.op2")))) +(defun shen.op2 (V864) (cond ((= cons V864) tl) ((= @s V864) tlstr) ((= @p V864) snd) ((= @v V864) tlv) (true (simple-error "implementation error in shen.op2")))) -(defun shen.op-test (V842) (cond ((= cons V842) cons?) ((= @s V842) shen.+string?) ((= @p V842) tuple?) ((= @v V842) shen.+vector?) (true (simple-error "implementation error in shen.op-test")))) +(defun shen.op-test (V867) (cond ((= cons V867) cons?) ((= @s V867) shen.+string?) ((= @p V867) tuple?) ((= @v V867) shen.+vector?) (true (simple-error "implementation error in shen.op-test")))) -(defun shen.+string? (V843) (cond ((= "" V843) false) (true (string? V843)))) +(defun shen.+string? (V868) (cond ((= "" V868) false) (true (string? V868)))) -(defun shen.+vector? (V844) (cond ((= V844 (vector 0)) false) (true (vector? V844)))) +(defun shen.+vector? (V869) (cond ((= V869 (vector 0)) false) (true (vector? V869)))) -(defun factorise (V847) (cond ((= + V847) (set shen.*factorise?* true)) ((= - V847) (set shen.*factorise?* false)) (true (simple-error "factorise expects a + or a - +(defun factorise (V872) (cond ((= + V872) (set shen.*factorise?* true)) ((= - V872) (set shen.*factorise?* false)) (true (simple-error "factorise expects a + or a - ")))) -(defun shen.factorise-code (V848) (cond ((value shen.*factorise?*) (shen.factor V848)) (true V848))) +(defun shen.factorise-code (V873) (cond ((value shen.*factorise?*) (shen.factor V873)) (true V873))) -(defun shen.factor (V849) (cond ((and (cons? V849) (and (= defun (hd V849)) (and (cons? (tl V849)) (and (cons? (tl (tl V849))) (and (cons? (tl (tl (tl V849)))) (and (cons? (hd (tl (tl (tl V849))))) (and (= cond (hd (hd (tl (tl (tl V849)))))) (= () (tl (tl (tl (tl V849)))))))))))) (cons defun (cons (hd (tl V849)) (cons (hd (tl (tl V849))) (cons (shen.factor-recognisors (tl (hd (tl (tl (tl V849)))))) ()))))) (true V849))) +(defun shen.factor (V874) (cond ((and (cons? V874) (and (= defun (hd V874)) (and (cons? (tl V874)) (and (cons? (tl (tl V874))) (and (cons? (tl (tl (tl V874)))) (and (cons? (hd (tl (tl (tl V874))))) (and (= cond (hd (hd (tl (tl (tl V874)))))) (= () (tl (tl (tl (tl V874)))))))))))) (cons defun (cons (hd (tl V874)) (cons (hd (tl (tl V874))) (cons (shen.factor-recognisors (tl (hd (tl (tl (tl V874)))))) ()))))) (true V874))) -(defun shen.factor-recognisors (V852) (cond ((and (cons? V852) (and (cons? (hd V852)) (and (= true (hd (hd V852))) (and (cons? (tl (hd V852))) (= () (tl (tl (hd V852)))))))) (hd (tl (hd V852)))) ((and (cons? V852) (and (cons? (hd V852)) (and (cons? (hd (hd V852))) (and (= and (hd (hd (hd V852)))) (and (cons? (tl (hd (hd V852)))) (and (cons? (tl (tl (hd (hd V852))))) (and (= () (tl (tl (tl (hd (hd V852)))))) (and (cons? (tl (hd V852))) (= () (tl (tl (hd V852)))))))))))) (let W853 (shen.pivot-on (hd (tl (hd (hd V852)))) V852 ()) (let W854 (fst W853) (if (shen.bad-pivot? W854) (append (cons if ()) (append (shen.recursively-factor-selectors (hd (hd V852)) (hd (tl (hd V852)))) (cons (shen.factor-recognisors (tl V852)) ()))) (let W855 (snd W853) (let W856 (shen.factor-recognisors W855) (let W857 (gensym GoTo) (let W858 (reverse (cons (cons true (cons (cons thaw (cons W857 ())) ())) W854)) (let W859 (cons let (cons W857 (cons (cons freeze (cons W856 ())) (cons (cons if (cons (hd (tl (hd (hd V852)))) (cons (shen.factor-selectors (hd (tl (hd (hd V852)))) (shen.factor-recognisors W858)) (cons (cons thaw (cons W857 ())) ())))) ())))) (shen.remove-indirection W859)))))))))) ((and (cons? V852) (and (cons? (hd V852)) (and (cons? (tl (hd V852))) (= () (tl (tl (hd V852))))))) (cons if (cons (hd (hd V852)) (cons (hd (tl (hd V852))) (cons (shen.factor-recognisors (tl V852)) ()))))) (true (simple-error "partial function shen.factor-recognisors")))) +(defun shen.factor-recognisors (V877) (cond ((and (cons? V877) (and (cons? (hd V877)) (and (= true (hd (hd V877))) (and (cons? (tl (hd V877))) (= () (tl (tl (hd V877)))))))) (hd (tl (hd V877)))) ((and (cons? V877) (and (cons? (hd V877)) (and (cons? (hd (hd V877))) (and (= and (hd (hd (hd V877)))) (and (cons? (tl (hd (hd V877)))) (and (cons? (tl (tl (hd (hd V877))))) (and (= () (tl (tl (tl (hd (hd V877)))))) (and (cons? (tl (hd V877))) (= () (tl (tl (hd V877)))))))))))) (let W878 (shen.pivot-on (hd (tl (hd (hd V877)))) V877 ()) (let W879 (fst W878) (if (shen.bad-pivot? W879) (append (cons if ()) (append (shen.recursively-factor-selectors (hd (hd V877)) (hd (tl (hd V877)))) (cons (shen.factor-recognisors (tl V877)) ()))) (let W880 (snd W878) (let W881 (shen.factor-recognisors W880) (let W882 (gensym GoTo) (let W883 (reverse (cons (cons true (cons (cons thaw (cons W882 ())) ())) W879)) (let W884 (cons let (cons W882 (cons (cons freeze (cons W881 ())) (cons (cons if (cons (hd (tl (hd (hd V877)))) (cons (shen.factor-selectors (hd (tl (hd (hd V877)))) (shen.factor-recognisors W883)) (cons (cons thaw (cons W882 ())) ())))) ())))) (shen.remove-indirection W884)))))))))) ((and (cons? V877) (and (cons? (hd V877)) (and (cons? (tl (hd V877))) (= () (tl (tl (hd V877))))))) (cons if (cons (hd (hd V877)) (cons (hd (tl (hd V877))) (cons (shen.factor-recognisors (tl V877)) ()))))) (true (shen.f-error shen.factor-recognisors)))) -(defun shen.recursively-factor-selectors (V860 V861) (cond ((and (cons? V860) (and (= let (hd V860)) (and (cons? (tl V860)) (and (cons? (tl (tl V860))) (and (cons? (tl (tl (tl V860)))) (= () (tl (tl (tl (tl V860)))))))))) (shen.restore-local (hd (tl V860)) (hd (tl (tl V860))) (shen.recursively-factor-selectors (hd (tl (tl (tl V860)))) V861))) ((and (cons? V860) (and (= and (hd V860)) (and (cons? (tl V860)) (and (cons? (tl (tl V860))) (= () (tl (tl (tl V860)))))))) (shen.restore-P (hd (tl V860)) (shen.recursively-factor-selectors (shen.factor-selectors (hd (tl V860)) (hd (tl (tl V860)))) (shen.factor-selectors (hd (tl V860)) V861)))) (true (cons V860 (cons V861 ()))))) +(defun shen.recursively-factor-selectors (V885 V886) (cond ((and (cons? V885) (and (= let (hd V885)) (and (cons? (tl V885)) (and (cons? (tl (tl V885))) (and (cons? (tl (tl (tl V885)))) (= () (tl (tl (tl (tl V885)))))))))) (shen.restore-local (hd (tl V885)) (hd (tl (tl V885))) (shen.recursively-factor-selectors (hd (tl (tl (tl V885)))) V886))) ((and (cons? V885) (and (= and (hd V885)) (and (cons? (tl V885)) (and (cons? (tl (tl V885))) (= () (tl (tl (tl V885)))))))) (shen.restore-P (hd (tl V885)) (shen.recursively-factor-selectors (shen.factor-selectors (hd (tl V885)) (hd (tl (tl V885)))) (shen.factor-selectors (hd (tl V885)) V886)))) (true (cons V885 (cons V886 ()))))) -(defun shen.restore-P (V862 V863) (cond ((and (cons? V863) (and (cons? (tl V863)) (= () (tl (tl V863))))) (cons (cons and (cons V862 (cons (hd V863) ()))) (tl V863))) (true (simple-error "partial function shen.restore-P")))) +(defun shen.restore-P (V887 V888) (cond ((and (cons? V888) (and (cons? (tl V888)) (= () (tl (tl V888))))) (cons (cons and (cons V887 (cons (hd V888) ()))) (tl V888))) (true (shen.f-error shen.restore-P)))) -(defun shen.restore-local (V864 V865 V866) (cond ((and (cons? V866) (and (cons? (tl V866)) (= () (tl (tl V866))))) (cons (cons let (cons V864 (cons V865 (cons (hd V866) ())))) (tl V866))) (true (simple-error "partial function shen.restore-local")))) +(defun shen.restore-local (V889 V890 V891) (cond ((and (cons? V891) (and (cons? (tl V891)) (= () (tl (tl V891))))) (cons (cons let (cons V889 (cons V890 (cons (hd V891) ())))) (tl V891))) (true (shen.f-error shen.restore-local)))) -(defun shen.bad-pivot? (V871) (cond ((and (cons? V871) (= () (tl V871))) true) (true false))) +(defun shen.bad-pivot? (V896) (cond ((and (cons? V896) (= () (tl V896))) true) (true false))) -(defun shen.remove-indirection (V872) (cond ((and (cons? V872) (and (= let (hd V872)) (and (cons? (tl V872)) (and (cons? (tl (tl V872))) (and (cons? (hd (tl (tl V872)))) (and (= freeze (hd (hd (tl (tl V872))))) (and (cons? (tl (hd (tl (tl V872))))) (and (cons? (hd (tl (hd (tl (tl V872)))))) (and (= thaw (hd (hd (tl (hd (tl (tl V872))))))) (and (cons? (tl (hd (tl (hd (tl (tl V872))))))) (and (= () (tl (tl (hd (tl (hd (tl (tl V872)))))))) (and (= () (tl (tl (hd (tl (tl V872)))))) (and (cons? (tl (tl (tl V872)))) (and (= () (tl (tl (tl (tl V872))))) (symbol? (hd (tl (hd (tl (hd (tl (tl V872)))))))))))))))))))))) (subst (hd (tl (hd (tl (hd (tl (tl V872))))))) (hd (tl V872)) (hd (tl (tl (tl V872)))))) (true V872))) +(defun shen.remove-indirection (V897) (cond ((and (cons? V897) (and (= let (hd V897)) (and (cons? (tl V897)) (and (cons? (tl (tl V897))) (and (cons? (hd (tl (tl V897)))) (and (= freeze (hd (hd (tl (tl V897))))) (and (cons? (tl (hd (tl (tl V897))))) (and (cons? (hd (tl (hd (tl (tl V897)))))) (and (= thaw (hd (hd (tl (hd (tl (tl V897))))))) (and (cons? (tl (hd (tl (hd (tl (tl V897))))))) (and (= () (tl (tl (hd (tl (hd (tl (tl V897)))))))) (and (= () (tl (tl (hd (tl (tl V897)))))) (and (cons? (tl (tl (tl V897)))) (and (= () (tl (tl (tl (tl V897))))) (symbol? (hd (tl (hd (tl (hd (tl (tl V897)))))))))))))))))))))) (subst (hd (tl (hd (tl (hd (tl (tl V897))))))) (hd (tl V897)) (hd (tl (tl (tl V897)))))) (true V897))) -(defun shen.pivot-on (V875 V876 V877) (cond ((and (cons? V876) (and (cons? (hd V876)) (and (cons? (hd (hd V876))) (and (= and (hd (hd (hd V876)))) (and (cons? (tl (hd (hd V876)))) (and (cons? (tl (tl (hd (hd V876))))) (and (= () (tl (tl (tl (hd (hd V876)))))) (and (cons? (tl (hd V876))) (and (= () (tl (tl (hd V876)))) (= V875 (hd (tl (hd (hd V876)))))))))))))) (shen.pivot-on (hd (tl (hd (hd V876)))) (tl V876) (cons (cons (hd (tl (tl (hd (hd V876))))) (tl (hd V876))) V877))) ((and (cons? V876) (and (cons? (hd V876)) (and (cons? (tl (hd V876))) (and (= () (tl (tl (hd V876)))) (= V875 (hd (hd V876))))))) (shen.pivot-on (hd (hd V876)) (tl V876) (cons (cons true (tl (hd V876))) V877))) (true (@p V877 V876)))) +(defun shen.pivot-on (V900 V901 V902) (cond ((and (cons? V901) (and (cons? (hd V901)) (and (cons? (hd (hd V901))) (and (= and (hd (hd (hd V901)))) (and (cons? (tl (hd (hd V901)))) (and (cons? (tl (tl (hd (hd V901))))) (and (= () (tl (tl (tl (hd (hd V901)))))) (and (cons? (tl (hd V901))) (and (= () (tl (tl (hd V901)))) (= V900 (hd (tl (hd (hd V901)))))))))))))) (shen.pivot-on (hd (tl (hd (hd V901)))) (tl V901) (cons (cons (hd (tl (tl (hd (hd V901))))) (tl (hd V901))) V902))) ((and (cons? V901) (and (cons? (hd V901)) (and (cons? (tl (hd V901))) (and (= () (tl (tl (hd V901)))) (= V900 (hd (hd V901))))))) (shen.pivot-on (hd (hd V901)) (tl V901) (cons (cons true (tl (hd V901))) V902))) (true (@p V902 V901)))) -(defun shen.factor-selectors (V880 V881) (cond ((and (cons? V880) (and (cons? (tl V880)) (= () (tl (tl V880))))) (let W882 (shen.op (hd V880)) (if (= shen.skip W882) V881 (shen.factor-selectors-h (cons (cons (shen.op1 W882) (tl V880)) (cons (cons (shen.op2 W882) (tl V880)) ())) V881)))) (true V881))) +(defun shen.factor-selectors (V905 V906) (cond ((and (cons? V905) (and (cons? (tl V905)) (= () (tl (tl V905))))) (let W907 (shen.op (hd V905)) (if (= shen.skip W907) V906 (shen.factor-selectors-h (cons (cons (shen.op1 W907) (tl V905)) (cons (cons (shen.op2 W907) (tl V905)) ())) V906)))) (true V906))) -(defun shen.op (V885) (cond ((= cons? V885) cons) ((= shen.+string? V885) @s) ((= shen.+vector? V885) @v) ((= tuple? V885) @p) (true shen.skip))) +(defun shen.op (V910) (cond ((= cons? V910) cons) ((= shen.+string? V910) @s) ((= shen.+vector? V910) @v) ((= tuple? V910) @p) (true shen.skip))) -(defun shen.factor-selectors-h (V886 V887) (cond ((= () V886) V887) ((cons? V886) (if (> (occurrences (hd V886) V887) 1) (let W888 (gensym Select) (cons let (cons W888 (cons (hd V886) (cons (shen.factor-selectors-h (tl V886) (subst W888 (hd V886) V887)) ()))))) (shen.factor-selectors-h (tl V886) V887))) (true (simple-error "partial function shen.factor-selectors-h")))) +(defun shen.factor-selectors-h (V911 V912) (cond ((= () V911) V912) ((cons? V911) (if (> (occurrences (hd V911) V912) 1) (let W913 (gensym Select) (cons let (cons W913 (cons (hd V911) (cons (shen.factor-selectors-h (tl V911) (subst W913 (hd V911) V912)) ()))))) (shen.factor-selectors-h (tl V911) V912))) (true (shen.f-error shen.factor-selectors-h)))) diff --git a/klambda/declarations.kl b/klambda/declarations.kl index 6cfab7d..25a2211 100644 --- a/klambda/declarations.kl +++ b/klambda/declarations.kl @@ -1,99 +1,25 @@ -(set shen.*history* ()) +(defun datatypes () (map (lambda Z920 (shen.typename Z920)) (value shen.*alldatatypes*))) -(set shen.*tc* false) +(defun shen.included () (map (lambda Z921 (shen.typename Z921)) (value shen.*datatypes*))) -(set *property-vector* (vector 20000)) +(defun shen.typename (V924) (cond ((cons? V924) (intern (shen.typename-h (str (hd V924))))) (true (shen.f-error shen.typename)))) -(set *macros* (cons (cons shen.macros (lambda X (shen.macros X))) ())) +(defun shen.typename-h (V925) (cond ((= "#type" V925) "") ((shen.+string? V925) (cn (hdstr V925) (shen.typename-h (tlstr V925)))) (true (shen.f-error shen.typename-h)))) -(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* "42") - -(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 Z5759 (shen.typename Z5759)) (value shen.*alldatatypes*))) - -(defun included () (map (lambda Z5760 (shen.typename Z5760)) (value shen.*datatypes*))) - -(defun shen.typename (V5763) (cond ((cons? V5763) (intern (shen.typename-h (str (hd V5763))))) (true (simple-error "partial function shen.typename")))) - -(defun shen.typename-h (V5764) (cond ((= "#type" V5764) "") ((shen.+string? V5764) (cn (hdstr V5764) (shen.typename-h (tlstr V5764)))) (true (simple-error "partial function shen.typename-h")))) - -(defun prolog-memory (V5765) (if (< V5765 0) (value shen.*prolog-memory*) (if (integer? V5765) (set shen.*prolog-memory* V5765) (simple-error "prolog memory expects an integer value +(defun prolog-memory (V926) (if (< V926 0) (value shen.*prolog-memory*) (if (integer? V926) (set shen.*prolog-memory* V926) (simple-error "prolog memory expects an integer value ")))) -(defun shen.initialise-lambda-tables (V5768) (cond ((= () V5768) ()) ((and (cons? V5768) (cons? (tl V5768))) (let W5769 (put (hd V5768) arity (hd (tl V5768)) (value *property-vector*)) (shen.initialise-arity-table (tl (tl V5768))))) (true (simple-error "implementation error in shen.initialise-arity-table")))) - -(defun arity (V5770) (trap-error (get V5770 arity (value *property-vector*)) (lambda Z5771 -1))) - -(defun shen.initialise-arity-table (V5774) (cond ((= () V5774) ()) ((and (cons? V5774) (cons? (tl V5774))) (let W5775 (put (hd V5774) arity (hd (tl V5774)) (value *property-vector*)) (shen.initialise-arity-table (tl (tl V5774))))) (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 arity (V927) (trap-error (get V927 arity (value *property-vector*)) (lambda Z928 -1))) -(defun systemf (V5776) (let W5777 (get shen shen.external-symbols (value *property-vector*)) (let W5778 (put shen shen.external-symbols (adjoin V5776 W5777) (value *property-vector*)) V5776))) +(defun shen.initialise-arity-table (V931) (cond ((= () V931) ()) ((and (cons? V931) (cons? (tl V931))) (let W932 (put (hd V931) arity (hd (tl V931)) (value *property-vector*)) (shen.initialise-arity-table (tl (tl V931))))) (true (simple-error "implementation error in shen.initialise-arity-table")))) -(defun adjoin (V5779 V5780) (if (element? V5779 V5780) V5780 (cons V5779 V5780))) +(defun systemf (V933) (let W934 (get shen shen.external-symbols (value *property-vector*)) (let W935 (put shen shen.external-symbols (adjoin V933 W934) (value *property-vector*)) V933))) -(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 adjoin (V936 V937) (if (element? V936 V937) V937 (cons V936 V937))) -(defun shen.lambda-entry (V5781) (let W5782 (arity V5781) (if (or (= W5782 -1) (= W5782 0)) () (cons V5781 (eval-kl (shen.lambda-function (cons V5781 ()) W5782)))))) +(defun shen.lambda-entry (V938) (let W939 (arity V938) (if (or (= W939 -1) (= W939 0)) () (cons V938 (eval-kl (shen.lambda-function (cons V938 ()) W939)))))) -(defun shen.build-lambda-table (V5783) (let W5784 (map (lambda Z5785 (shen.lambda-entry Z5785)) V5783) (set shen.*lambdatable* (cons (cons shen.tuple (lambda Z5786 (shen.tuple Z5786))) (cons (cons shen.pvar (lambda Z5787 (shen.pvar Z5787))) (cons (cons shen.print-prolog-vector (lambda Z5788 (shen.print-prolog-vector Z5788))) (cons (cons shen.print-freshterm (lambda Z5789 (shen.print-freshterm Z5789))) (cons (cons shen.printF (lambda Z5790 (shen.printF Z5790))) W5784)))))))) +(defun shen.set-lambda-form-entry (V940) (cond ((cons? V940) (put (hd V940) shen.lambda-form (tl V940) (value *property-vector*))) (true (shen.f-error shen.set-lambda-form-entry)))) -(shen.build-lambda-table (external shen)) +(defun shen.build-lambda-table (V941) (let W942 (map (lambda Z943 (shen.lambda-entry Z943)) V941) (shen.for-each (lambda Z944 (shen.set-lambda-form-entry Z944)) (cons (cons shen.register-source-form (lambda Z945 (lambda Z946 (shen.register-source-form Z945 Z946)))) (cons (cons shen.unregister-source-form (lambda Z947 (shen.unregister-source-form Z947))) (cons (cons shen.tuple (lambda Z948 (shen.tuple Z948))) (cons (cons shen.pvar (lambda Z949 (shen.pvar Z949))) (cons (cons shen.dictionary (lambda Z950 (shen.dictionary Z950))) (cons (cons shen.print-prolog-vector (lambda Z951 (shen.print-prolog-vector Z951))) (cons (cons shen.print-freshterm (lambda Z952 (shen.print-freshterm Z952))) (cons (cons shen.printF (lambda Z953 (shen.printF Z953))) W942))))))))))) diff --git a/klambda/dict.kl b/klambda/dict.kl new file mode 100644 index 0000000..40006c0 --- /dev/null +++ b/klambda/dict.kl @@ -0,0 +1,33 @@ +(defun shen.dict (V4225) (cond ((< V4225 1) (simple-error (cn "invalid initial dict size: " (shen.app V4225 "" shen.s)))) (true (let W4226 (absvector (+ 3 V4225)) (let W4227 (address-> W4226 0 shen.dictionary) (let W4228 (address-> W4226 1 V4225) (let W4229 (address-> W4226 2 0) (let W4230 (shen.fillvector W4226 3 (+ 2 V4225) ()) W4226)))))))) + +(defun shen.dict? (V4231) (and (absvector? V4231) (= (trap-error (<-address V4231 0) (lambda Z4232 shen.not-dictionary)) shen.dictionary))) + +(defun shen.dict-capacity (V4233) (<-address V4233 1)) + +(defun shen.dict-count (V4234) (<-address V4234 2)) + +(defun shen.dict-count-> (V4235 V4236) (address-> V4235 2 V4236)) + +(defun shen.<-dict-bucket (V4237 V4238) (<-address V4237 (+ 3 V4238))) + +(defun shen.dict-bucket-> (V4239 V4240 V4241) (address-> V4239 (+ 3 V4240) V4241)) + +(defun shen.dict-update-count (V4242 V4243 V4244) (let W4245 (- (length V4244) (length V4243)) (shen.dict-count-> V4242 (+ W4245 (shen.dict-count V4242))))) + +(defun shen.dict-> (V4246 V4247 V4248) (let W4249 (hash V4247 (shen.dict-capacity V4246)) (let W4250 (shen.<-dict-bucket V4246 W4249) (let W4251 (shen.assoc-set V4247 V4248 W4250) (let W4252 (shen.dict-bucket-> V4246 W4249 W4251) (let W4253 (shen.dict-update-count V4246 W4250 W4251) V4248)))))) + +(defun shen.<-dict (V4254 V4255) (let W4256 (hash V4255 (shen.dict-capacity V4254)) (let W4257 (shen.<-dict-bucket V4254 W4256) (let W4258 (assoc V4255 W4257) (if (empty? W4258) (simple-error (cn "value " (shen.app V4255 " not found in dict +" shen.a))) (tl W4258)))))) + +(defun shen.dict-rm (V4259 V4260) (let W4261 (hash V4260 (shen.dict-capacity V4259)) (let W4262 (shen.<-dict-bucket V4259 W4261) (let W4263 (shen.assoc-rm V4260 W4262) (let W4264 (shen.dict-bucket-> V4259 W4261 W4263) (let W4265 (shen.dict-update-count V4259 W4262 W4263) V4260)))))) + +(defun shen.dict-fold (V4266 V4267 V4268) (let W4269 (shen.dict-capacity V4267) (shen.dict-fold-h V4266 V4267 V4268 0 W4269))) + +(defun shen.dict-fold-h (V4271 V4272 V4273 V4274 V4275) (cond ((= V4274 V4275) V4273) (true (let W4276 (shen.<-dict-bucket V4272 V4274) (let W4277 (shen.bucket-fold V4271 W4276 V4273) (shen.dict-fold-h V4271 V4272 W4277 (+ 1 V4274) V4275)))))) + +(defun shen.bucket-fold (V4278 V4279 V4280) (cond ((= () V4279) V4280) ((and (cons? V4279) (cons? (hd V4279))) (((V4278 (hd (hd V4279))) (tl (hd V4279))) (shen.bucket-fold V4278 (tl V4279) V4280))) (true (shen.f-error shen.bucket-fold)))) + +(defun shen.dict-keys (V4281) (shen.dict-fold (lambda Z4282 (lambda Z4283 (lambda Z4284 (cons Z4282 Z4284)))) V4281 ())) + +(defun shen.dict-values (V4285) (shen.dict-fold (lambda Z4286 (lambda Z4287 (lambda Z4288 (cons Z4287 Z4288)))) V4285 ())) + diff --git a/klambda/extension-expand-dynamic.kl b/klambda/extension-expand-dynamic.kl index a5db6af..759afbc 100644 --- a/klambda/extension-expand-dynamic.kl +++ b/klambda/extension-expand-dynamic.kl @@ -3,21 +3,21 @@ BSD 3-Clause License: http://opensource.org/licenses/BSD-3-Clause" (defun shen.x.expand-dynamic.initialise () (set shen.x.expand-dynamic.*arities* ())) -(defun shen.x.expand-dynamic.expand-dynamic (V7236) (cond ((= () V7236) ()) ((and (cons? V7236) (and (cons? (hd V7236)) (and (= declare (hd (hd V7236))) (and (cons? (tl (hd V7236))) (and (cons? (tl (tl (hd V7236)))) (= () (tl (tl (tl (hd V7236)))))))))) (cons (shen.x.expand-dynamic.expand-declare (hd V7236)) (shen.x.expand-dynamic.expand-dynamic (tl V7236)))) ((and (cons? V7236) (and (cons? (hd V7236)) (and (= shen.initialise-arity-table (hd (hd V7236))) (and (cons? (tl (hd V7236))) (= () (tl (tl (hd V7236)))))))) (do (set shen.x.expand-dynamic.*arities* (eval-kl (hd (tl (hd V7236))))) (cons (hd V7236) (shen.x.expand-dynamic.expand-dynamic (tl V7236))))) ((and (cons? V7236) (and (cons? (hd V7236)) (and (= shen.build-lambda-table (hd (hd V7236))) (and (cons? (tl (hd V7236))) (and (cons? (hd (tl (hd V7236)))) (and (= external (hd (hd (tl (hd V7236))))) (and (cons? (tl (hd (tl (hd V7236))))) (and (= shen (hd (tl (hd (tl (hd V7236)))))) (and (= () (tl (tl (hd (tl (hd V7236)))))) (= () (tl (tl (hd V7236))))))))))))) (let W7237 X (append (shen.x.expand-dynamic.expand-lambda-entries (cons shen.tuple (cons 1 (cons shen.pvar (cons 1 (cons shen.dictionary (cons 1 (cons shen.print-prolog-vector (cons 1 (cons shen.print-freshterm (cons 1 (cons shen.printF (cons 1 (value shen.x.expand-dynamic.*arities*)))))))))))))) (shen.x.expand-dynamic.expand-dynamic (tl V7236))))) ((cons? V7236) (cons (hd V7236) (shen.x.expand-dynamic.expand-dynamic (tl V7236)))) (true (shen.f-error shen.x.expand-dynamic.expand-dynamic)))) +(defun shen.x.expand-dynamic.expand-dynamic (V7391) (cond ((= () V7391) ()) ((and (cons? V7391) (and (cons? (hd V7391)) (and (= declare (hd (hd V7391))) (and (cons? (tl (hd V7391))) (and (cons? (tl (tl (hd V7391)))) (= () (tl (tl (tl (hd V7391)))))))))) (cons (shen.x.expand-dynamic.expand-declare (hd V7391)) (shen.x.expand-dynamic.expand-dynamic (tl V7391)))) ((and (cons? V7391) (and (cons? (hd V7391)) (and (= shen.initialise-arity-table (hd (hd V7391))) (and (cons? (tl (hd V7391))) (= () (tl (tl (hd V7391)))))))) (do (set shen.x.expand-dynamic.*arities* (eval-kl (hd (tl (hd V7391))))) (cons (hd V7391) (shen.x.expand-dynamic.expand-dynamic (tl V7391))))) ((and (cons? V7391) (and (cons? (hd V7391)) (and (= shen.build-lambda-table (hd (hd V7391))) (and (cons? (tl (hd V7391))) (and (cons? (hd (tl (hd V7391)))) (and (= external (hd (hd (tl (hd V7391))))) (and (cons? (tl (hd (tl (hd V7391))))) (and (= shen (hd (tl (hd (tl (hd V7391)))))) (and (= () (tl (tl (hd (tl (hd V7391)))))) (= () (tl (tl (hd V7391))))))))))))) (let W7392 X (append (shen.x.expand-dynamic.expand-lambda-entries (cons shen.tuple (cons 1 (cons shen.pvar (cons 1 (cons shen.dictionary (cons 1 (cons shen.print-prolog-vector (cons 1 (cons shen.print-freshterm (cons 1 (cons shen.printF (cons 1 (value shen.x.expand-dynamic.*arities*)))))))))))))) (shen.x.expand-dynamic.expand-dynamic (tl V7391))))) ((cons? V7391) (cons (hd V7391) (shen.x.expand-dynamic.expand-dynamic (tl V7391)))) (true (shen.f-error shen.x.expand-dynamic.expand-dynamic)))) -(defun shen.x.expand-dynamic.functions-with-lambdas (V7238) (cond ((= () V7238) ()) ((and (cons? V7238) (cons? (tl V7238))) (cons (hd V7238) (shen.x.expand-dynamic.functions-with-lambdas (tl (tl V7238))))) (true (shen.f-error shen.x.expand-dynamic.functions-with-lambdas)))) +(defun shen.x.expand-dynamic.functions-with-lambdas (V7393) (cond ((= () V7393) ()) ((and (cons? V7393) (cons? (tl V7393))) (cons (hd V7393) (shen.x.expand-dynamic.functions-with-lambdas (tl (tl V7393))))) (true (shen.f-error shen.x.expand-dynamic.functions-with-lambdas)))) -(defun shen.x.expand-dynamic.expand-declare (V7239) (cond ((and (cons? V7239) (and (= declare (hd V7239)) (and (cons? (tl V7239)) (and (cons? (tl (tl V7239))) (= () (tl (tl (tl V7239)))))))) (let W7240 (eval-kl (hd (tl (tl V7239)))) (let W7241 (shen.prolog-abstraction W7240) (let W7242 (cons set (cons shen.*sigf* (cons (cons shen.assoc-> (cons (hd (tl V7239)) (cons W7241 (cons (cons value (cons shen.*sigf* ())) ())))) ()))) W7242)))) (true (shen.f-error shen.x.expand-dynamic.expand-declare)))) +(defun shen.x.expand-dynamic.expand-declare (V7394) (cond ((and (cons? V7394) (and (= declare (hd V7394)) (and (cons? (tl V7394)) (and (cons? (tl (tl V7394))) (= () (tl (tl (tl V7394)))))))) (let W7395 (eval-kl (hd (tl (tl V7394)))) (let W7396 (shen.prolog-abstraction W7395) (let W7397 (cons set (cons shen.*sigf* (cons (cons shen.assoc-> (cons (hd (tl V7394)) (cons W7396 (cons (cons value (cons shen.*sigf* ())) ())))) ()))) W7397)))) (true (shen.f-error shen.x.expand-dynamic.expand-declare)))) -(defun shen.x.expand-dynamic.expand-lambda-entries (V7243) (cond ((= () V7243) ()) ((and (cons? V7243) (cons? (tl V7243))) (append (shen.x.expand-dynamic.expand-lambda-form-entry (hd V7243) (hd (tl V7243))) (shen.x.expand-dynamic.expand-lambda-entries (tl (tl V7243))))) (true (simple-error (cn "expand-lambda-entries: got unexpected " (shen.app V7243 "" shen.a)))))) +(defun shen.x.expand-dynamic.expand-lambda-entries (V7398) (cond ((= () V7398) ()) ((and (cons? V7398) (cons? (tl V7398))) (append (shen.x.expand-dynamic.expand-lambda-form-entry (hd V7398) (hd (tl V7398))) (shen.x.expand-dynamic.expand-lambda-entries (tl (tl V7398))))) (true (simple-error (cn "expand-lambda-entries: got unexpected " (shen.app V7398 "" shen.a)))))) -(defun shen.x.expand-dynamic.expand-lambda-form-entry (V7252 V7253) (cond ((= package V7252) ()) ((= receive V7252) ()) ((= list V7252) ()) ((= foreign V7252) ()) (true (if (= V7253 -1) () (if (= V7253 0) () (cons (cons shen.set-lambda-form-entry (cons (cons cons (cons V7252 (cons (shen.lambda-function (cons V7252 ()) V7253) ()))) ())) ())))))) +(defun shen.x.expand-dynamic.expand-lambda-form-entry (V7407 V7408) (cond ((= package V7407) ()) ((= receive V7407) ()) ((= list V7407) ()) ((= foreign V7407) ()) (true (if (= V7408 -1) () (if (= V7408 0) () (cons (cons shen.set-lambda-form-entry (cons (cons cons (cons V7407 (cons (shen.lambda-function (cons V7407 ()) V7408) ()))) ())) ())))))) -(defun shen.x.expand-dynamic.split-defuns-h (V7254 V7255) (cond ((and (cons? V7254) (and (cons? (hd V7254)) (and (= defun (hd (hd V7254))) (tuple? V7255)))) (shen.x.expand-dynamic.split-defuns-h (tl V7254) (@p (cons (hd V7254) (fst V7255)) (snd V7255)))) ((and (cons? V7254) (tuple? V7255)) (shen.x.expand-dynamic.split-defuns-h (tl V7254) (@p (fst V7255) (cons (hd V7254) (snd V7255))))) ((and (= () V7254) (tuple? V7255)) (@p (reverse (fst V7255)) (reverse (snd V7255)))) (true (shen.f-error shen.x.expand-dynamic.split-defuns-h)))) +(defun shen.x.expand-dynamic.split-defuns-h (V7409 V7410) (cond ((and (cons? V7409) (and (cons? (hd V7409)) (and (= defun (hd (hd V7409))) (tuple? V7410)))) (shen.x.expand-dynamic.split-defuns-h (tl V7409) (@p (cons (hd V7409) (fst V7410)) (snd V7410)))) ((and (cons? V7409) (tuple? V7410)) (shen.x.expand-dynamic.split-defuns-h (tl V7409) (@p (fst V7410) (cons (hd V7409) (snd V7410))))) ((and (= () V7409) (tuple? V7410)) (@p (reverse (fst V7410)) (reverse (snd V7410)))) (true (shen.f-error shen.x.expand-dynamic.split-defuns-h)))) -(defun shen.x.expand-dynamic.split-defuns (V7256) (shen.x.expand-dynamic.split-defuns-h V7256 (@p () ()))) +(defun shen.x.expand-dynamic.split-defuns (V7411) (shen.x.expand-dynamic.split-defuns-h V7411 (@p () ()))) -(defun shen.x.expand-dynamic.wrap-in-defun (V7257 V7258 V7259) (cons defun (cons V7257 (cons V7258 (cons (shen.x.expand-dynamic.to-single-expression V7257 V7259) ()))))) +(defun shen.x.expand-dynamic.wrap-in-defun (V7412 V7413 V7414) (cons defun (cons V7412 (cons V7413 (cons (shen.x.expand-dynamic.to-single-expression V7412 V7414) ()))))) -(defun shen.x.expand-dynamic.to-single-expression (V7264 V7265) (cond ((and (cons? V7265) (= () (tl V7265))) (hd V7265)) ((cons? V7265) (cons do (cons (hd V7265) (cons (shen.x.expand-dynamic.to-single-expression V7264 (tl V7265)) ())))) (true (simple-error (cn "to-single-expression: got empty list of expressions: " (shen.app V7264 "" shen.a)))))) +(defun shen.x.expand-dynamic.to-single-expression (V7419 V7420) (cond ((and (cons? V7420) (= () (tl V7420))) (hd V7420)) ((cons? V7420) (cons do (cons (hd V7420) (cons (shen.x.expand-dynamic.to-single-expression V7419 (tl V7420)) ())))) (true (simple-error (cn "to-single-expression: got empty list of expressions: " (shen.app V7419 "" shen.a)))))) diff --git a/klambda/extension-features.kl b/klambda/extension-features.kl index f270a7b..5c542f1 100644 --- a/klambda/extension-features.kl +++ b/klambda/extension-features.kl @@ -1,11 +1,11 @@ "Copyright (c) 2019 Bruno Deferrari. BSD 3-Clause License: http://opensource.org/licenses/BSD-3-Clause" -(defun shen.x.features.cond-expand-macro (V7078) (cond ((and (cons? V7078) (and (= shen.x.features.cond-expand (hd V7078)) (= () (tl V7078)))) (simple-error "Unfulfilled shen.x.features.cond-expand clause.")) ((and (cons? V7078) (and (= shen.x.features.cond-expand (hd V7078)) (and (cons? (tl V7078)) (and (= true (hd (tl V7078))) (and (cons? (tl (tl V7078))) (= () (tl (tl (tl V7078))))))))) (hd (tl (tl V7078)))) ((and (cons? V7078) (and (= shen.x.features.cond-expand (hd V7078)) (and (cons? (tl V7078)) (and (cons? (hd (tl V7078))) (and (= and (hd (hd (tl V7078)))) (and (= () (tl (hd (tl V7078)))) (cons? (tl (tl V7078))))))))) (hd (tl (tl V7078)))) ((and (cons? V7078) (and (= shen.x.features.cond-expand (hd V7078)) (and (cons? (tl V7078)) (and (cons? (hd (tl V7078))) (and (= and (hd (hd (tl V7078)))) (and (cons? (tl (hd (tl V7078)))) (cons? (tl (tl V7078))))))))) (cons shen.x.features.cond-expand (cons (hd (tl (hd (tl V7078)))) (cons (cons shen.x.features.cond-expand (cons (cons and (tl (tl (hd (tl V7078))))) (tl (tl V7078)))) (tl (tl (tl V7078))))))) ((and (cons? V7078) (and (= shen.x.features.cond-expand (hd V7078)) (and (cons? (tl V7078)) (and (cons? (hd (tl V7078))) (and (= or (hd (hd (tl V7078)))) (and (= () (tl (hd (tl V7078)))) (cons? (tl (tl V7078))))))))) (cons shen.x.features.cond-expand (tl (tl (tl V7078))))) ((and (cons? V7078) (and (= shen.x.features.cond-expand (hd V7078)) (and (cons? (tl V7078)) (and (cons? (hd (tl V7078))) (and (= or (hd (hd (tl V7078)))) (and (cons? (tl (hd (tl V7078)))) (cons? (tl (tl V7078))))))))) (cons shen.x.features.cond-expand (cons (hd (tl (hd (tl V7078)))) (cons (hd (tl (tl V7078))) (cons true (cons (cons shen.x.features.cond-expand (cons (cons or (tl (tl (hd (tl V7078))))) (tl (tl V7078)))) ())))))) ((and (cons? V7078) (and (= shen.x.features.cond-expand (hd V7078)) (and (cons? (tl V7078)) (and (cons? (hd (tl V7078))) (and (= not (hd (hd (tl V7078)))) (and (cons? (tl (hd (tl V7078)))) (and (= () (tl (tl (hd (tl V7078))))) (cons? (tl (tl V7078)))))))))) (cons shen.x.features.cond-expand (cons (hd (tl (hd (tl V7078)))) (cons (cons shen.x.features.cond-expand (tl (tl (tl V7078)))) (cons true (cons (hd (tl (tl V7078))) ())))))) ((and (cons? V7078) (and (= shen.x.features.cond-expand (hd V7078)) (and (cons? (tl V7078)) (and (cons? (tl (tl V7078))) (element? (hd (tl V7078)) (value shen.x.features.*features*)))))) (hd (tl (tl V7078)))) ((and (cons? V7078) (and (= shen.x.features.cond-expand (hd V7078)) (and (cons? (tl V7078)) (cons? (tl (tl V7078)))))) (cons shen.x.features.cond-expand (tl (tl (tl V7078))))) (true V7078))) +(defun shen.x.features.cond-expand-macro (V7227) (cond ((and (cons? V7227) (and (= shen.x.features.cond-expand (hd V7227)) (= () (tl V7227)))) (simple-error "Unfulfilled shen.x.features.cond-expand clause.")) ((and (cons? V7227) (and (= shen.x.features.cond-expand (hd V7227)) (and (cons? (tl V7227)) (and (= true (hd (tl V7227))) (and (cons? (tl (tl V7227))) (= () (tl (tl (tl V7227))))))))) (hd (tl (tl V7227)))) ((and (cons? V7227) (and (= shen.x.features.cond-expand (hd V7227)) (and (cons? (tl V7227)) (and (cons? (hd (tl V7227))) (and (= and (hd (hd (tl V7227)))) (and (= () (tl (hd (tl V7227)))) (cons? (tl (tl V7227))))))))) (hd (tl (tl V7227)))) ((and (cons? V7227) (and (= shen.x.features.cond-expand (hd V7227)) (and (cons? (tl V7227)) (and (cons? (hd (tl V7227))) (and (= and (hd (hd (tl V7227)))) (and (cons? (tl (hd (tl V7227)))) (cons? (tl (tl V7227))))))))) (cons shen.x.features.cond-expand (cons (hd (tl (hd (tl V7227)))) (cons (cons shen.x.features.cond-expand (cons (cons and (tl (tl (hd (tl V7227))))) (tl (tl V7227)))) (tl (tl (tl V7227))))))) ((and (cons? V7227) (and (= shen.x.features.cond-expand (hd V7227)) (and (cons? (tl V7227)) (and (cons? (hd (tl V7227))) (and (= or (hd (hd (tl V7227)))) (and (= () (tl (hd (tl V7227)))) (cons? (tl (tl V7227))))))))) (cons shen.x.features.cond-expand (tl (tl (tl V7227))))) ((and (cons? V7227) (and (= shen.x.features.cond-expand (hd V7227)) (and (cons? (tl V7227)) (and (cons? (hd (tl V7227))) (and (= or (hd (hd (tl V7227)))) (and (cons? (tl (hd (tl V7227)))) (cons? (tl (tl V7227))))))))) (cons shen.x.features.cond-expand (cons (hd (tl (hd (tl V7227)))) (cons (hd (tl (tl V7227))) (cons true (cons (cons shen.x.features.cond-expand (cons (cons or (tl (tl (hd (tl V7227))))) (tl (tl V7227)))) ())))))) ((and (cons? V7227) (and (= shen.x.features.cond-expand (hd V7227)) (and (cons? (tl V7227)) (and (cons? (hd (tl V7227))) (and (= not (hd (hd (tl V7227)))) (and (cons? (tl (hd (tl V7227)))) (and (= () (tl (tl (hd (tl V7227))))) (cons? (tl (tl V7227)))))))))) (cons shen.x.features.cond-expand (cons (hd (tl (hd (tl V7227)))) (cons (cons shen.x.features.cond-expand (tl (tl (tl V7227)))) (cons true (cons (hd (tl (tl V7227))) ())))))) ((and (cons? V7227) (and (= shen.x.features.cond-expand (hd V7227)) (and (cons? (tl V7227)) (and (cons? (tl (tl V7227))) (element? (hd (tl V7227)) (value shen.x.features.*features*)))))) (hd (tl (tl V7227)))) ((and (cons? V7227) (and (= shen.x.features.cond-expand (hd V7227)) (and (cons? (tl V7227)) (cons? (tl (tl V7227)))))) (cons shen.x.features.cond-expand (tl (tl (tl V7227))))) (true V7227))) (defun shen.x.features.current () (value shen.x.features.*features*)) -(defun shen.x.features.initialise (V7079) (let W7080 (trap-error (value shen.x.features.*features*) (lambda Z7081 (do (set shen.x.features.*features* ()) (do (shen.set-lambda-form-entry (cons shen.x.features.cond-expand-macro (lambda Z7082 (shen.x.features.cond-expand-macro Z7082)))) (shen.record-macro shen.x.features.cond-expand-macro (lambda Z7083 (shen.x.features.cond-expand-macro Z7083))))))) (let W7084 (shen.x.features.current) (let W7085 (set shen.x.features.*features* V7079) W7084)))) +(defun shen.x.features.initialise (V7228) (do (declare shen.x.features.initialise (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ())))) (do (declare shen.x.features.current (cons --> (cons (cons list (cons symbol ())) ()))) (do (declare shen.x.features.add (cons symbol (cons --> (cons (cons list (cons symbol ())) ())))) (let W7229 (trap-error (value shen.x.features.*features*) (lambda Z7230 (do (set shen.x.features.*features* ()) (do (shen.set-lambda-form-entry (cons shen.x.features.cond-expand-macro (lambda Z7231 (shen.x.features.cond-expand-macro Z7231)))) (shen.record-macro shen.x.features.cond-expand-macro (lambda Z7232 (shen.x.features.cond-expand-macro Z7232))))))) (let W7233 (shen.x.features.current) (let W7234 (set shen.x.features.*features* V7228) W7233))))))) -(defun shen.x.features.add (V7086) (let W7087 (shen.x.features.current) (let W7088 (set shen.x.features.*features* (adjoin V7086 W7087)) W7087))) +(defun shen.x.features.add (V7235) (let W7236 (shen.x.features.current) (let W7237 (set shen.x.features.*features* (adjoin V7235 W7236)) W7236))) diff --git a/klambda/extension-launcher.kl b/klambda/extension-launcher.kl index bee4349..707e251 100644 --- a/klambda/extension-launcher.kl +++ b/klambda/extension-launcher.kl @@ -1,12 +1,12 @@ "Copyright (c) 2019 Bruno Deferrari. BSD 3-Clause License: http://opensource.org/licenses/BSD-3-Clause" -(defun shen.x.launcher.quiet-load (V7102) (let W7103 (read-file V7102) (map (lambda Z7104 (eval Z7104)) W7103))) +(defun shen.x.launcher.quiet-load (V7251) (let W7252 (read-file V7251) (map (lambda Z7253 (eval Z7253)) W7252))) (defun shen.x.launcher.version-string () (shen.app (version) (cn " " (shen.app (cons port (cons (cons (language) (cons (port) ())) (cons implementation (cons (cons (implementation) (cons (release) ())) ())))) " " shen.r)) shen.a)) -(defun shen.x.launcher.help-text (V7105) (cn "Usage: " (shen.app V7105 " [--version] [--help] [] +(defun shen.x.launcher.help-text (V7254) (cn "Usage: " (shen.app V7254 " [--version] [--help] [] commands: repl @@ -31,27 +31,27 @@ commands: Launches the interactive REPL after evaluating all the previous expresions." shen.a))) -(defun shen.x.launcher.execute-all (V7106) (cond ((= () V7106) (cons success ())) ((cons? V7106) (do (thaw (hd V7106)) (shen.x.launcher.execute-all (tl V7106)))) (true (shen.f-error shen.x.launcher.execute-all)))) +(defun shen.x.launcher.execute-all (V7255) (cond ((= () V7255) (cons success ())) ((cons? V7255) (do (thaw (hd V7255)) (shen.x.launcher.execute-all (tl V7255)))) (true (shen.f-error shen.x.launcher.execute-all)))) -(defun shen.x.launcher.eval-string (V7107) (eval (head (read-from-string V7107)))) +(defun shen.x.launcher.eval-string (V7256) (eval (head (read-from-string V7256)))) -(defun shen.x.launcher.eval-flag-map (V7110) (cond ((= "-e" V7110) "--eval") ((= "-l" V7110) "--load") ((= "-q" V7110) "--quiet") ((= "-s" V7110) "--set") ((= "-r" V7110) "--repl") (true false))) +(defun shen.x.launcher.eval-flag-map (V7259) (cond ((= "-e" V7259) "--eval") ((= "-l" V7259) "--load") ((= "-q" V7259) "--quiet") ((= "-s" V7259) "--set") ((= "-r" V7259) "--repl") (true false))) -(defun shen.x.launcher.eval-command-h (V7115 V7116) (cond ((= () V7115) (shen.x.launcher.execute-all (reverse V7116))) ((and (cons? V7115) (and (= "--eval" (hd V7115)) (cons? (tl V7115)))) (shen.x.launcher.eval-command-h (tl (tl V7115)) (cons (freeze (pr (shen.app (shen.x.launcher.eval-string (hd (tl V7115))) " -" shen.a) (stoutput))) V7116))) ((and (cons? V7115) (and (= "--load" (hd V7115)) (cons? (tl V7115)))) (shen.x.launcher.eval-command-h (tl (tl V7115)) (cons (freeze (load (hd (tl V7115)))) V7116))) ((and (cons? V7115) (= "--quiet" (hd V7115))) (shen.x.launcher.eval-command-h (tl V7115) (cons (freeze (set *hush* true)) V7116))) ((and (cons? V7115) (and (= "--set" (hd V7115)) (and (cons? (tl V7115)) (cons? (tl (tl V7115)))))) (shen.x.launcher.eval-command-h (tl (tl (tl V7115))) (cons (freeze (set (shen.x.launcher.eval-string (hd (tl V7115))) (shen.x.launcher.eval-string (hd (tl (tl V7115)))))) V7116))) ((and (cons? V7115) (= "--repl" (hd V7115))) (do (shen.x.launcher.eval-command-h () V7116) (cons launch-repl (tl V7115)))) (true (let Freeze7119 (freeze (cond ((cons? V7115) (cons error (cons (cn "Invalid eval argument: " (shen.app (hd V7115) "" shen.a)) ()))) (true (shen.f-error shen.x.launcher.eval-command-h)))) (if (cons? V7115) (let Result7118 (let W7117 (shen.x.launcher.eval-flag-map (hd V7115)) (if (= false W7117) (fail) (shen.x.launcher.eval-command-h (cons W7117 (tl V7115)) V7116))) (if (= Result7118 (fail)) (thaw Freeze7119) Result7118)) (thaw Freeze7119)))))) +(defun shen.x.launcher.eval-command-h (V7264 V7265) (cond ((= () V7264) (shen.x.launcher.execute-all (reverse V7265))) ((and (cons? V7264) (and (= "--eval" (hd V7264)) (cons? (tl V7264)))) (shen.x.launcher.eval-command-h (tl (tl V7264)) (cons (freeze (pr (shen.app (shen.x.launcher.eval-string (hd (tl V7264))) " +" shen.a) (stoutput))) V7265))) ((and (cons? V7264) (and (= "--load" (hd V7264)) (cons? (tl V7264)))) (shen.x.launcher.eval-command-h (tl (tl V7264)) (cons (freeze (load (hd (tl V7264)))) V7265))) ((and (cons? V7264) (= "--quiet" (hd V7264))) (shen.x.launcher.eval-command-h (tl V7264) (cons (freeze (set *hush* true)) V7265))) ((and (cons? V7264) (and (= "--set" (hd V7264)) (and (cons? (tl V7264)) (cons? (tl (tl V7264)))))) (shen.x.launcher.eval-command-h (tl (tl (tl V7264))) (cons (freeze (set (shen.x.launcher.eval-string (hd (tl V7264))) (shen.x.launcher.eval-string (hd (tl (tl V7264)))))) V7265))) ((and (cons? V7264) (= "--repl" (hd V7264))) (do (shen.x.launcher.eval-command-h () V7265) (cons launch-repl (tl V7264)))) (true (let Freeze7268 (freeze (cond ((cons? V7264) (cons error (cons (cn "Invalid eval argument: " (shen.app (hd V7264) "" shen.a)) ()))) (true (shen.f-error shen.x.launcher.eval-command-h)))) (if (cons? V7264) (let Result7267 (let W7266 (shen.x.launcher.eval-flag-map (hd V7264)) (if (= false W7266) (fail) (shen.x.launcher.eval-command-h (cons W7266 (tl V7264)) V7265))) (if (= Result7267 (fail)) (thaw Freeze7268) Result7267)) (thaw Freeze7268)))))) -(defun shen.x.launcher.eval-command (V7120) (shen.x.launcher.eval-command-h V7120 ())) +(defun shen.x.launcher.eval-command (V7269) (shen.x.launcher.eval-command-h V7269 ())) -(defun shen.x.launcher.script-command (V7121 V7122) (do (set *argv* (cons V7121 V7122)) (do (shen.x.launcher.quiet-load V7121) (cons success ())))) +(defun shen.x.launcher.script-command (V7270 V7271) (do (set *argv* (cons V7270 V7271)) (do (shen.x.launcher.quiet-load V7270) (cons success ())))) -(defun shen.x.launcher.launch-shen (V7123) (cond ((and (cons? V7123) (= () (tl V7123))) (cons launch-repl ())) ((and (cons? V7123) (and (cons? (tl V7123)) (= "--help" (hd (tl V7123))))) (cons show-help (cons (shen.x.launcher.help-text (hd V7123)) ()))) ((and (cons? V7123) (and (cons? (tl V7123)) (= "--version" (hd (tl V7123))))) (cons success (cons (shen.x.launcher.version-string) ()))) ((and (cons? V7123) (and (cons? (tl V7123)) (= "repl" (hd (tl V7123))))) (cons launch-repl (tl (tl V7123)))) ((and (cons? V7123) (and (cons? (tl V7123)) (and (= "script" (hd (tl V7123))) (cons? (tl (tl V7123)))))) (shen.x.launcher.script-command (hd (tl (tl V7123))) (tl (tl (tl V7123))))) ((and (cons? V7123) (and (cons? (tl V7123)) (= "eval" (hd (tl V7123))))) (shen.x.launcher.eval-command (tl (tl V7123)))) ((and (cons? V7123) (cons? (tl V7123))) (cons unknown-arguments V7123)) (true (shen.f-error shen.x.launcher.launch-shen)))) +(defun shen.x.launcher.launch-shen (V7272) (cond ((and (cons? V7272) (= () (tl V7272))) (cons launch-repl ())) ((and (cons? V7272) (and (cons? (tl V7272)) (= "--help" (hd (tl V7272))))) (cons show-help (cons (shen.x.launcher.help-text (hd V7272)) ()))) ((and (cons? V7272) (and (cons? (tl V7272)) (= "--version" (hd (tl V7272))))) (cons success (cons (shen.x.launcher.version-string) ()))) ((and (cons? V7272) (and (cons? (tl V7272)) (= "repl" (hd (tl V7272))))) (cons launch-repl (tl (tl V7272)))) ((and (cons? V7272) (and (cons? (tl V7272)) (and (= "script" (hd (tl V7272))) (cons? (tl (tl V7272)))))) (shen.x.launcher.script-command (hd (tl (tl V7272))) (tl (tl (tl V7272))))) ((and (cons? V7272) (and (cons? (tl V7272)) (= "eval" (hd (tl V7272))))) (shen.x.launcher.eval-command (tl (tl V7272)))) ((and (cons? V7272) (cons? (tl V7272))) (cons unknown-arguments V7272)) (true (shen.f-error shen.x.launcher.launch-shen)))) -(defun shen.x.launcher.default-handle-result (V7126) (cond ((and (cons? V7126) (and (= success (hd V7126)) (= () (tl V7126)))) shen.x.launcher.done) ((and (cons? V7126) (and (= success (hd V7126)) (and (cons? (tl V7126)) (= () (tl (tl V7126)))))) (pr (shen.app (hd (tl V7126)) " -" shen.a) (stoutput))) ((and (cons? V7126) (and (= error (hd V7126)) (and (cons? (tl V7126)) (= () (tl (tl V7126)))))) (pr (cn "ERROR: " (shen.app (hd (tl V7126)) " -" shen.a)) (stoutput))) ((and (cons? V7126) (= launch-repl (hd V7126))) (shen.repl)) ((and (cons? V7126) (and (= show-help (hd V7126)) (and (cons? (tl V7126)) (= () (tl (tl V7126)))))) (pr (shen.app (hd (tl V7126)) " -" shen.a) (stoutput))) ((and (cons? V7126) (and (= unknown-arguments (hd V7126)) (and (cons? (tl V7126)) (cons? (tl (tl V7126)))))) (pr (cn "ERROR: Invalid argument: " (shen.app (hd (tl (tl V7126))) (cn " -Try `" (shen.app (hd (tl V7126)) " --help' for more information. +(defun shen.x.launcher.default-handle-result (V7275) (cond ((and (cons? V7275) (and (= success (hd V7275)) (= () (tl V7275)))) shen.x.launcher.done) ((and (cons? V7275) (and (= success (hd V7275)) (and (cons? (tl V7275)) (= () (tl (tl V7275)))))) (pr (shen.app (hd (tl V7275)) " +" shen.a) (stoutput))) ((and (cons? V7275) (and (= error (hd V7275)) (and (cons? (tl V7275)) (= () (tl (tl V7275)))))) (pr (cn "ERROR: " (shen.app (hd (tl V7275)) " +" shen.a)) (stoutput))) ((and (cons? V7275) (= launch-repl (hd V7275))) (shen.repl)) ((and (cons? V7275) (and (= show-help (hd V7275)) (and (cons? (tl V7275)) (= () (tl (tl V7275)))))) (pr (shen.app (hd (tl V7275)) " +" shen.a) (stoutput))) ((and (cons? V7275) (and (= unknown-arguments (hd V7275)) (and (cons? (tl V7275)) (cons? (tl (tl V7275)))))) (pr (cn "ERROR: Invalid argument: " (shen.app (hd (tl (tl V7275))) (cn " +Try `" (shen.app (hd (tl V7275)) " --help' for more information. " shen.a)) shen.a)) (stoutput))) (true (shen.f-error shen.x.launcher.default-handle-result)))) -(defun shen.x.launcher.main (V7127) (shen.x.launcher.default-handle-result (shen.x.launcher.launch-shen V7127))) +(defun shen.x.launcher.main (V7276) (shen.x.launcher.default-handle-result (shen.x.launcher.launch-shen V7276))) diff --git a/klambda/extension-namespaces.kl b/klambda/extension-namespaces.kl new file mode 100644 index 0000000..4299d03 --- /dev/null +++ b/klambda/extension-namespaces.kl @@ -0,0 +1,31 @@ +"Copyright (c) 2026 Bruno Deferrari. All rights reserved. +BSD 3-Clause License: http://opensource.org/licenses/BSD-3-Clause" + +(defun shen.x.namespaces.initialise () (shen.register-source-form shen.x.namespace (lambda Z7445 (shen.x.namespaces.expand Z7445)))) + +(defun shen.x.namespaces.expand (V7446) (cond ((and (cons? V7446) (and (= shen.x.namespace (hd V7446)) (and (cons? (tl V7446)) (shen.x.namespaces.name? (hd (tl V7446)))))) (shen.x.namespaces.header (hd (tl V7446)) (tl (tl V7446)) () ())) (true (simple-error (cn "invalid namespace: " (shen.app V7446 " +" shen.s)))))) + +(defun shen.x.namespaces.header (V7451 V7452 V7453 V7454) (cond ((and (cons? V7452) (and (cons? (hd V7452)) (and (= use (hd (hd V7452))) (and (cons? (tl (hd V7452))) (= () (tl (tl (hd V7452)))))))) (shen.x.namespaces.header V7451 (tl V7452) (shen.x.namespaces.add-use (hd (tl (hd V7452))) (hd (tl (hd V7452))) V7453) V7454)) ((and (cons? V7452) (and (cons? (hd V7452)) (and (= use (hd (hd V7452))) (and (cons? (tl (hd V7452))) (and (cons? (tl (tl (hd V7452)))) (and (= => (hd (tl (tl (hd V7452))))) (and (cons? (tl (tl (tl (hd V7452))))) (= () (tl (tl (tl (tl (hd V7452))))))))))))) (shen.x.namespaces.header V7451 (tl V7452) (shen.x.namespaces.add-use (hd (tl (hd V7452))) (hd (tl (tl (tl (hd V7452))))) V7453) V7454)) ((and (cons? V7452) (and (cons? (hd V7452)) (and (= externals (hd (hd V7452))) (and (cons? (tl (hd V7452))) (= () (tl (tl (hd V7452)))))))) (shen.x.namespaces.header V7451 (tl V7452) V7453 (union (shen.x.namespaces.external-symbols (eval (hd (tl (hd V7452))))) V7454))) ((and (cons? V7452) (and (cons? (hd V7452)) (element? (hd (hd V7452)) (cons use (cons externals ()))))) (simple-error (cn "invalid namespace directive: " (shen.app (hd V7452) " +" shen.s)))) (true (let W7455 (shen.x.namespaces.qualify-list (shen.x.namespaces.body-forms V7452) (str V7451) V7453 V7454) (do (shen.record-external V7451 V7454) (do (shen.record-internal V7451 () (snd W7455)) (fst W7455))))))) + +(defun shen.x.namespaces.add-use (V7458 V7459 V7460) (cond ((and (shen.x.namespaces.name? V7458) (and (shen.x.namespaces.name? V7459) (empty? (assoc V7459 V7460)))) (cons (cons V7459 V7458) V7460)) (true (simple-error (cn "invalid or duplicate namespace use: " (shen.app V7458 (cn " => " (shen.app V7459 " +" shen.s)) shen.s)))))) + +(defun shen.x.namespaces.body-forms (V7463) (cond ((and (cons? V7463) (and (cons? (hd V7463)) (element? (hd (hd V7463)) (cons use (cons externals ()))))) (simple-error (cn "namespace directive after body: " (shen.app (hd (hd V7463)) " +" shen.s)))) ((cons? V7463) (cons (hd V7463) (shen.x.namespaces.body-forms (tl V7463)))) ((= () V7463) ()) (true (shen.f-error shen.x.namespaces.body-forms)))) + +(defun shen.x.namespaces.name? (V7464) (and (symbol? V7464) (not (variable? V7464)))) + +(defun shen.x.namespaces.external-symbols (V7465) (cond ((= () V7465) ()) ((and (cons? V7465) (shen.x.namespaces.name? (hd V7465))) (cons (hd V7465) (shen.x.namespaces.external-symbols (tl V7465)))) (true (simple-error (cn "externals expects a list of non-variable symbols: " (shen.app V7465 " +" shen.s)))))) + +(defun shen.x.namespaces.qualify (V7478 V7479 V7480 V7481) (cond ((and (cons? V7478) (and (= with-externals (hd V7478)) (and (cons? (tl V7478)) (and (cons? (tl (tl V7478))) (= () (tl (tl (tl V7478)))))))) (shen.x.namespaces.qualify (hd (tl (tl V7478))) V7479 V7480 (union (shen.x.namespaces.external-symbols (eval (hd (tl V7478)))) V7481))) ((and (cons? V7478) (= with-externals (hd V7478))) (simple-error (cn "invalid with-externals: " (shen.app (tl V7478) " +" shen.s)))) ((cons? V7478) (shen.x.namespaces.qualify-list V7478 V7479 V7480 V7481)) ((shen.internal? V7478 V7479 V7481) (let W7482 (shen.x.namespaces.import-name V7478 V7480) (if (cons? W7482) (@p (tl W7482) ()) (@p (shen.intern-in-package V7479 V7478) (cons V7478 ()))))) (true (@p V7478 ())))) + +(defun shen.x.namespaces.qualify-list (V7483 V7484 V7485 V7486) (cond ((cons? V7483) (let W7487 (shen.x.namespaces.qualify (hd V7483) V7484 V7485 V7486) (let W7488 (shen.x.namespaces.qualify-list (tl V7483) V7484 V7485 V7486) (@p (cons (fst W7487) (fst W7488)) (union (snd W7487) (snd W7488)))))) (true (shen.x.namespaces.qualify V7483 V7484 V7485 V7486)))) + +(defun shen.x.namespaces.import-name (V7491 V7492) (cond ((= () V7492) ()) ((and (cons? V7492) (cons? (hd V7492))) (let W7493 (shen.x.namespaces.import-name V7491 (tl V7492)) (let W7494 (shen.x.namespaces.member-after (str (hd (hd V7492))) (str V7491)) (if (and (string? W7494) (or (empty? W7493) (shen.internal-to-P? (str (hd W7493)) (str (hd (hd V7492)))))) (cons (hd (hd V7492)) (shen.intern-in-package (str (tl (hd V7492))) (intern W7494))) W7493)))) (true (shen.f-error shen.x.namespaces.import-name)))) + +(defun shen.x.namespaces.member-after (V7500 V7501) (cond ((and (= "" V7500) (and (shen.+string? V7501) (and (= "." (hdstr V7501)) (not (= (tlstr V7501) ""))))) (tlstr V7501)) ((and (shen.+string? V7500) (and (shen.+string? V7501) (= (hdstr V7500) (hdstr V7501)))) (shen.x.namespaces.member-after (tlstr V7500) (tlstr V7501))) (true false))) + diff --git a/klambda/extension-programmable-pattern-matching.kl b/klambda/extension-programmable-pattern-matching.kl index c6235be..dcc8122 100644 --- a/klambda/extension-programmable-pattern-matching.kl +++ b/klambda/extension-programmable-pattern-matching.kl @@ -1,34 +1,36 @@ "Copyright (c) 2019 Bruno Deferrari. All rights reserved. BSD 3-Clause License: http://opensource.org/licenses/BSD-3-Clause" -(defun shen.x.programmable-pattern-matching.apply-pattern-handlers (V7168 V7169 V7170 V7171 V7172) (cond ((= () V7168) (fail)) (true (let Freeze7174 (freeze (cond ((cons? V7168) (shen.x.programmable-pattern-matching.apply-pattern-handlers (tl V7168) V7169 V7170 V7171 V7172)) (true (shen.f-error shen.x.programmable-pattern-matching.apply-pattern-handlers)))) (if (cons? V7168) (let Result7173 (((((hd V7168) V7169) V7170) V7171) V7172) (if (= Result7173 (fail)) (thaw Freeze7174) Result7173)) (thaw Freeze7174)))))) +(defun shen.x.programmable-pattern-matching.apply-pattern-handlers (V7318 V7319 V7320 V7321 V7322) (cond ((= () V7318) (fail)) (true (let Freeze7324 (freeze (cond ((cons? V7318) (shen.x.programmable-pattern-matching.apply-pattern-handlers (tl V7318) V7319 V7320 V7321 V7322)) (true (shen.f-error shen.x.programmable-pattern-matching.apply-pattern-handlers)))) (if (cons? V7318) (let Result7323 (((((hd V7318) V7319) V7320) V7321) V7322) (if (= Result7323 (fail)) (thaw Freeze7324) Result7323)) (thaw Freeze7324)))))) (defun shen.x.programmable-pattern-matching.make-stack () (address-> (absvector 1) 0 ())) -(defun shen.x.programmable-pattern-matching.push (V7175 V7176) (address-> V7175 0 (cons V7176 (<-address V7175 0)))) +(defun shen.x.programmable-pattern-matching.push (V7325 V7326) (address-> V7325 0 (cons V7326 (<-address V7325 0)))) -(defun shen.x.programmable-pattern-matching.pop-all (V7177) (let W7178 (<-address V7177 0) (let W7179 (address-> V7177 0 ()) W7178))) +(defun shen.x.programmable-pattern-matching.pop-all (V7327) (let W7328 (<-address V7327 0) (let W7329 (address-> V7327 0 ()) W7328))) -(defun shen.x.programmable-pattern-matching.surface-pattern (V7180) (cond ((and (cons? V7180) (and (= cons (hd V7180)) (and (cons? (tl V7180)) (and (cons? (tl (tl V7180))) (= () (tl (tl (tl V7180)))))))) (cons (shen.x.programmable-pattern-matching.surface-pattern (hd (tl V7180))) (shen.x.programmable-pattern-matching.surface-pattern-tail (hd (tl (tl V7180)))))) (true V7180))) +(defun shen.x.programmable-pattern-matching.surface-pattern (V7330) (cond ((and (cons? V7330) (and (= cons (hd V7330)) (and (cons? (tl V7330)) (and (cons? (tl (tl V7330))) (= () (tl (tl (tl V7330)))))))) (cons (shen.x.programmable-pattern-matching.surface-pattern (hd (tl V7330))) (shen.x.programmable-pattern-matching.surface-pattern-tail (hd (tl (tl V7330)))))) (true (let W7331 (shen.x.programmable-pattern-matching.surface-application V7330) (if (= W7331 (fail)) V7330 W7331))))) -(defun shen.x.programmable-pattern-matching.surface-pattern-tail (V7181) (cond ((= () V7181) ()) ((and (cons? V7181) (and (= cons (hd V7181)) (and (cons? (tl V7181)) (and (cons? (tl (tl V7181))) (= () (tl (tl (tl V7181)))))))) (cons (shen.x.programmable-pattern-matching.surface-pattern (hd (tl V7181))) (shen.x.programmable-pattern-matching.surface-pattern-tail (hd (tl (tl V7181)))))) (true V7181))) +(defun shen.x.programmable-pattern-matching.surface-pattern-tail (V7332) (cond ((= () V7332) ()) ((and (cons? V7332) (and (= cons (hd V7332)) (and (cons? (tl V7332)) (and (cons? (tl (tl V7332))) (= () (tl (tl (tl V7332)))))))) (cons (shen.x.programmable-pattern-matching.surface-pattern (hd (tl V7332))) (shen.x.programmable-pattern-matching.surface-pattern-tail (hd (tl (tl V7332)))))) (true V7332))) -(defun shen.x.programmable-pattern-matching.compile-pattern (V7182 V7183 V7184) (let W7185 (shen.x.programmable-pattern-matching.surface-pattern V7182) (let W7186 (shen.x.programmable-pattern-matching.make-stack) (let W7187 Self$$7907$$ (let W7188 (lambda Z7189 shen.x.programmable-pattern-matching.ignored) (let W7190 (lambda Z7191 (lambda Z7192 (shen.x.programmable-pattern-matching.push W7186 Z7191))) (let W7193 (shen.x.programmable-pattern-matching.apply-pattern-handlers V7183 W7187 W7188 W7190 W7185) (if (= W7193 (fail)) (thaw V7184) (cons @p (cons shen.custom-pattern (cons (shen.x.programmable-pattern-matching.compile-pattern-h W7185 (reverse (shen.x.programmable-pattern-matching.pop-all W7186))) ()))))))))))) +(defun shen.x.programmable-pattern-matching.surface-application (V7335) (cond ((and (cons? V7335) (and (cons? (hd V7335)) (and (= fn (hd (hd V7335))) (and (cons? (tl (hd V7335))) (and (= () (tl (tl (hd V7335)))) (and (cons? (tl V7335)) (= () (tl (tl V7335))))))))) (cons (hd (tl (hd V7335))) (cons (shen.x.programmable-pattern-matching.surface-pattern (hd (tl V7335))) ()))) ((and (cons? V7335) (and (cons? (tl V7335)) (= () (tl (tl V7335))))) (let W7336 (shen.x.programmable-pattern-matching.surface-application (hd V7335)) (if (= W7336 (fail)) (fail) (append W7336 (cons (shen.x.programmable-pattern-matching.surface-pattern (hd (tl V7335))) ()))))) (true (fail)))) -(defun shen.x.programmable-pattern-matching.compile-pattern-h (V7194 V7195) (cond ((cons? V7194) (let W7196 (map (lambda Z7197 (if (element? Z7197 V7195) (shen.compile-pattern-fragment Z7197) Z7197)) (tl V7194)) (cons (hd V7194) W7196))) (true (shen.f-error shen.x.programmable-pattern-matching.compile-pattern-h)))) +(defun shen.x.programmable-pattern-matching.compile-pattern (V7337 V7338 V7339) (let W7340 (shen.x.programmable-pattern-matching.surface-pattern V7337) (let W7341 (shen.x.programmable-pattern-matching.make-stack) (let W7342 Self$$7907$$ (let W7343 (lambda Z7344 shen.x.programmable-pattern-matching.ignored) (let W7345 (lambda Z7346 (lambda Z7347 (shen.x.programmable-pattern-matching.push W7341 Z7346))) (let W7348 (shen.x.programmable-pattern-matching.apply-pattern-handlers V7338 W7342 W7343 W7345 W7340) (if (= W7348 (fail)) (thaw V7339) (cons @p (cons shen.custom-pattern (cons (shen.x.programmable-pattern-matching.compile-pattern-h W7340 (reverse (shen.x.programmable-pattern-matching.pop-all W7341))) ()))))))))))) -(defun shen.x.programmable-pattern-matching.reduce (V7198 V7199) (cond ((tuple? V7198) (let W7200 (shen.x.programmable-pattern-matching.surface-pattern (fst V7198)) (let W7201 (shen.x.programmable-pattern-matching.make-stack) (let W7202 (shen.x.programmable-pattern-matching.make-stack) (let W7203 (lambda Z7204 (shen.x.programmable-pattern-matching.push W7201 Z7204)) (let W7205 (lambda Z7206 (lambda Z7207 (shen.x.programmable-pattern-matching.push W7202 (@p Z7206 Z7207)))) (let W7208 (shen.x.programmable-pattern-matching.apply-pattern-handlers V7199 (snd V7198) W7203 W7205 W7200) (if (= W7208 (fail)) (fail) (@p (reverse (shen.x.programmable-pattern-matching.pop-all W7201)) (reverse (shen.x.programmable-pattern-matching.pop-all W7202))))))))))) (true (shen.f-error shen.x.programmable-pattern-matching.reduce)))) +(defun shen.x.programmable-pattern-matching.compile-pattern-h (V7349 V7350) (cond ((cons? V7349) (let W7351 (map (lambda Z7352 (if (element? Z7352 V7350) (shen.compile-pattern-fragment Z7352) Z7352)) (tl V7349)) (cons (hd V7349) W7351))) (true (shen.f-error shen.x.programmable-pattern-matching.compile-pattern-h)))) -(defun shen.x.programmable-pattern-matching.initialise () (do (set shen.*custom-pattern-compiler* (lambda Z7209 (lambda Z7210 (shen.x.programmable-pattern-matching.compile-pattern Z7209 (value shen.x.programmable-pattern-matching.*pattern-handlers*) Z7210)))) (do (set shen.*custom-pattern-reducer* (lambda Z7211 (shen.x.programmable-pattern-matching.reduce Z7211 (value shen.x.programmable-pattern-matching.*pattern-handlers*)))) (do (set shen.x.programmable-pattern-matching.*pattern-handlers* ()) (do (set shen.x.programmable-pattern-matching.*pattern-handlers-reg* ()) shen.x.programmable-pattern-matching.done))))) +(defun shen.x.programmable-pattern-matching.reduce (V7353 V7354) (cond ((tuple? V7353) (let W7355 (shen.x.programmable-pattern-matching.surface-pattern (fst V7353)) (let W7356 (shen.x.programmable-pattern-matching.make-stack) (let W7357 (shen.x.programmable-pattern-matching.make-stack) (let W7358 (lambda Z7359 (shen.x.programmable-pattern-matching.push W7356 Z7359)) (let W7360 (lambda Z7361 (lambda Z7362 (shen.x.programmable-pattern-matching.push W7357 (@p Z7361 Z7362)))) (let W7363 (shen.x.programmable-pattern-matching.apply-pattern-handlers V7354 (snd V7353) W7358 W7360 W7355) (if (= W7363 (fail)) (fail) (@p (reverse (shen.x.programmable-pattern-matching.pop-all W7356)) (reverse (shen.x.programmable-pattern-matching.pop-all W7357))))))))))) (true (shen.f-error shen.x.programmable-pattern-matching.reduce)))) -(defun shen.x.programmable-pattern-matching.register-handler (V7212) (cond ((element? V7212 (value shen.x.programmable-pattern-matching.*pattern-handlers-reg*)) V7212) (true (do (set shen.x.programmable-pattern-matching.*pattern-handlers-reg* (cons V7212 (value shen.x.programmable-pattern-matching.*pattern-handlers-reg*))) (do (set shen.x.programmable-pattern-matching.*pattern-handlers* (cons (fn V7212) (value shen.x.programmable-pattern-matching.*pattern-handlers*))) V7212))))) +(defun shen.x.programmable-pattern-matching.initialise () (do (declare shen.x.programmable-pattern-matching.register-handler (cons symbol (cons --> (cons symbol ())))) (do (declare shen.x.programmable-pattern-matching.unregister-handler (cons symbol (cons --> (cons symbol ())))) (do (set shen.*custom-pattern-compiler* (lambda Z7364 (lambda Z7365 (shen.x.programmable-pattern-matching.compile-pattern Z7364 (value shen.x.programmable-pattern-matching.*pattern-handlers*) Z7365)))) (do (set shen.*custom-pattern-reducer* (lambda Z7366 (shen.x.programmable-pattern-matching.reduce Z7366 (value shen.x.programmable-pattern-matching.*pattern-handlers*)))) (do (set shen.x.programmable-pattern-matching.*pattern-handlers* ()) (do (set shen.x.programmable-pattern-matching.*pattern-handlers-reg* ()) shen.x.programmable-pattern-matching.done))))))) -(defun shen.x.programmable-pattern-matching.findpos (V7213 V7214) (shen.x.programmable-pattern-matching.findpos-h V7213 V7214 1)) +(defun shen.x.programmable-pattern-matching.register-handler (V7367) (cond ((element? V7367 (value shen.x.programmable-pattern-matching.*pattern-handlers-reg*)) V7367) (true (do (set shen.x.programmable-pattern-matching.*pattern-handlers-reg* (cons V7367 (value shen.x.programmable-pattern-matching.*pattern-handlers-reg*))) (do (set shen.x.programmable-pattern-matching.*pattern-handlers* (cons (fn V7367) (value shen.x.programmable-pattern-matching.*pattern-handlers*))) V7367))))) -(defun shen.x.programmable-pattern-matching.findpos-h (V7222 V7223 V7224) (cond ((= () V7223) (simple-error (shen.app V7222 " is not a pattern handler -" shen.a))) ((and (cons? V7223) (= V7222 (hd V7223))) V7224) ((cons? V7223) (shen.x.programmable-pattern-matching.findpos-h V7222 (tl V7223) (+ V7224 1))) (true (shen.f-error shen.x.programmable-pattern-matching.findpos-h)))) +(defun shen.x.programmable-pattern-matching.findpos (V7368 V7369) (shen.x.programmable-pattern-matching.findpos-h V7368 V7369 1)) -(defun shen.x.programmable-pattern-matching.remove-nth (V7229 V7230) (cond ((not (and (integer? V7229) (> V7229 0))) V7230) ((= () V7230) ()) ((and (= 1 V7229) (cons? V7230)) (tl V7230)) ((cons? V7230) (cons (hd V7230) (shen.x.programmable-pattern-matching.remove-nth (- V7229 1) (tl V7230)))) (true (shen.f-error shen.x.programmable-pattern-matching.remove-nth)))) +(defun shen.x.programmable-pattern-matching.findpos-h (V7377 V7378 V7379) (cond ((= () V7378) (simple-error (shen.app V7377 " is not a pattern handler +" shen.a))) ((and (cons? V7378) (= V7377 (hd V7378))) V7379) ((cons? V7378) (shen.x.programmable-pattern-matching.findpos-h V7377 (tl V7378) (+ V7379 1))) (true (shen.f-error shen.x.programmable-pattern-matching.findpos-h)))) -(defun shen.x.programmable-pattern-matching.unregister-handler (V7231) (let W7232 (value shen.x.programmable-pattern-matching.*pattern-handlers-reg*) (let W7233 (shen.x.programmable-pattern-matching.findpos V7231 W7232) (let W7234 (set shen.x.programmable-pattern-matching.*pattern-handlers-reg* (remove V7231 W7232)) (let W7235 (set shen.x.programmable-pattern-matching.*pattern-handlers* (shen.x.programmable-pattern-matching.remove-nth W7233 (value shen.x.programmable-pattern-matching.*pattern-handlers*))) V7231))))) +(defun shen.x.programmable-pattern-matching.remove-nth (V7384 V7385) (cond ((not (and (integer? V7384) (> V7384 0))) V7385) ((= () V7385) ()) ((and (= 1 V7384) (cons? V7385)) (tl V7385)) ((cons? V7385) (cons (hd V7385) (shen.x.programmable-pattern-matching.remove-nth (- V7384 1) (tl V7385)))) (true (shen.f-error shen.x.programmable-pattern-matching.remove-nth)))) + +(defun shen.x.programmable-pattern-matching.unregister-handler (V7386) (let W7387 (value shen.x.programmable-pattern-matching.*pattern-handlers-reg*) (let W7388 (shen.x.programmable-pattern-matching.findpos V7386 W7387) (let W7389 (set shen.x.programmable-pattern-matching.*pattern-handlers-reg* (remove V7386 W7387)) (let W7390 (set shen.x.programmable-pattern-matching.*pattern-handlers* (shen.x.programmable-pattern-matching.remove-nth W7388 (value shen.x.programmable-pattern-matching.*pattern-handlers*))) V7386))))) diff --git a/klambda/extension-type-annotations.kl b/klambda/extension-type-annotations.kl new file mode 100644 index 0000000..ee67719 --- /dev/null +++ b/klambda/extension-type-annotations.kl @@ -0,0 +1,17 @@ +"Copyright (c) 2026 Bruno Deferrari. All rights reserved. +BSD 3-Clause License: http://opensource.org/licenses/BSD-3-Clause" + +(defun shen.x.type-annotations.annotate-kl (V7519) (cond ((and (cons? V7519) (and (= defun (hd V7519)) (and (cons? (tl V7519)) (and (cons? (tl (tl V7519))) (and (cons? (tl (tl (tl V7519)))) (= () (tl (tl (tl (tl V7519)))))))))) (let W7520 (shen.x.type-annotations.function-type (hd (tl V7519))) (let W7521 (shen.x.type-annotations.type-table W7520 (hd (tl (tl V7519)))) (cons defun (cons (hd (tl V7519)) (cons (hd (tl (tl V7519))) (cons (shen.x.type-annotations.annotate (hd (tl (tl V7519))) W7521 (hd (tl (tl (tl V7519))))) ()))))))) (true (shen.x.type-annotations.annotate () () V7519)))) + +(defun shen.x.type-annotations.function-type (V7526) (cond ((cons? V7526) false) ((not (symbol? V7526)) false) (true (let W7527 (((((lambda Z7528 (lambda Z7529 (lambda Z7530 (lambda Z7531 (let W7532 (shen.newpv Z7528) (shen.gc Z7528 (do (shen.incinfs) (shen.lookupsig (receive (shen.deref V7526 Z7528)) W7532 Z7528 Z7529 Z7530 (freeze (return W7532 Z7528 Z7529 Z7530 Z7531)))))))))) (shen.prolog-vector)) (@v true (@v 0 (vector 0)))) 0) (freeze true)) (if (= W7527 false) false (fst (shen.x.type-annotations.reify-type W7527 ()))))))) + +(defun shen.x.type-annotations.reify-type (V7533 V7534) (cond ((cons? V7533) (let W7535 (shen.x.type-annotations.reify-type (hd V7533) V7534) (let W7536 (shen.x.type-annotations.reify-type (tl V7533) (snd W7535)) (@p (cons (fst W7535) (fst W7536)) (snd W7536))))) ((shen.pvar? V7533) (let W7537 (<-address V7533 1) (let W7538 (assoc W7537 V7534) (if (empty? W7538) (let W7539 (gensym A) (@p W7539 (cons (cons W7537 W7539) V7534))) (@p (tl W7538) V7534))))) (true (@p V7533 V7534)))) + +(defun shen.x.type-annotations.type-table (V7544 V7545) (cond ((and (cons? V7544) (and (cons? (tl V7544)) (and (= --> (hd (tl V7544))) (and (cons? (tl (tl V7544))) (and (= () (tl (tl (tl V7544)))) (cons? V7545)))))) (if (variable? (hd V7544)) (shen.x.type-annotations.type-table (hd (tl (tl V7544))) (tl V7545)) (cons (cons (hd V7545) (hd V7544)) (shen.x.type-annotations.type-table (hd (tl (tl V7544))) (tl V7545))))) (true ()))) + +(defun shen.x.type-annotations.annotate (V7546 V7547 V7548) (cond ((and (cons? V7548) (and (= type (hd V7548)) (and (cons? (tl V7548)) (and (cons? (tl (tl V7548))) (= () (tl (tl (tl V7548)))))))) V7548) ((and (cons? V7548) (and (= let (hd V7548)) (and (cons? (tl V7548)) (and (cons? (tl (tl V7548))) (and (cons? (tl (tl (tl V7548)))) (= () (tl (tl (tl (tl V7548)))))))))) (cons let (cons (hd (tl V7548)) (cons (shen.x.type-annotations.annotate V7546 V7547 (hd (tl (tl V7548)))) (cons (shen.x.type-annotations.annotate (cons (hd (tl V7548)) V7546) V7547 (hd (tl (tl (tl V7548))))) ()))))) ((and (cons? V7548) (and (= lambda (hd V7548)) (and (cons? (tl V7548)) (and (cons? (tl (tl V7548))) (= () (tl (tl (tl V7548)))))))) (cons lambda (cons (hd (tl V7548)) (cons (shen.x.type-annotations.annotate (cons (hd (tl V7548)) V7546) V7547 (hd (tl (tl V7548)))) ())))) ((and (cons? V7548) (= cond (hd V7548))) (cons cond (shen.x.type-annotations.annotate-cases V7546 V7547 (tl V7548)))) ((cons? V7548) (let W7549 (shen.x.type-annotations.function-type (hd V7548)) (let W7550 (shen.x.type-annotations.type-table W7549 (tl V7548)) (cons (hd V7548) (map (lambda Z7551 (shen.x.type-annotations.annotate V7546 (append V7547 W7550) Z7551)) (tl V7548)))))) (true (let W7552 (assoc V7548 V7547) (if (cons? W7552) (cons type (cons V7548 (cons (tl W7552) ()))) (if (element? V7548 V7546) V7548 (shen.x.type-annotations.atom-type V7548))))))) + +(defun shen.x.type-annotations.annotate-cases (V7561 V7562 V7563) (cond ((= () V7563) ()) ((and (cons? V7563) (and (cons? (hd V7563)) (and (cons? (tl (hd V7563))) (= () (tl (tl (hd V7563))))))) (cons (cons (shen.x.type-annotations.annotate V7561 V7562 (hd (hd V7563))) (cons (shen.x.type-annotations.annotate V7561 V7562 (hd (tl (hd V7563)))) ())) (shen.x.type-annotations.annotate-cases V7561 V7562 (tl V7563)))) (true V7563))) + +(defun shen.x.type-annotations.atom-type (V7564) (if (string? V7564) (cons type (cons V7564 (cons string ()))) (if (number? V7564) (cons type (cons V7564 (cons number ()))) (if (boolean? V7564) (cons type (cons V7564 (cons boolean ()))) (if (symbol? V7564) (cons type (cons V7564 (cons symbol ()))) V7564))))) + diff --git a/klambda/init.kl b/klambda/init.kl new file mode 100644 index 0000000..d009742 --- /dev/null +++ b/klambda/init.kl @@ -0,0 +1,8 @@ +(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.*source-form-handlers* ()) (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 shen.input-h+ (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* "42.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 shen.register-source-form (cons 2 (cons shen.unregister-source-form (cons 1 (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 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 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-> shen.register-source-form (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 symbol (cons --> (cons (cons (cons A (cons --> (cons (cons list (cons B ())) ()))) (cons --> (cons symbol ()))) ()))) B6062 L6063 Key6064 C6065)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.unregister-source-form (lambda V6071 (lambda B6067 (lambda L6068 (lambda Key6069 (lambda C6070 (is! V6071 (cons symbol (cons --> (cons symbol ()))) B6067 L6068 Key6069 C6070)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> abort (lambda V6076 (lambda B6072 (lambda L6073 (lambda Key6074 (lambda C6075 (let A (shen.newpv B6072) (shen.gc B6072 (is! V6076 (cons --> (cons A ())) B6072 L6073 Key6074 C6075)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> absolute (lambda V6081 (lambda B6077 (lambda L6078 (lambda Key6079 (lambda C6080 (is! V6081 (cons string (cons --> (cons (cons list (cons string ())) ()))) B6077 L6078 Key6079 C6080)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> absvector? (lambda V6086 (lambda B6082 (lambda L6083 (lambda Key6084 (lambda C6085 (let A (shen.newpv B6082) (shen.gc B6082 (is! V6086 (cons A (cons --> (cons boolean ()))) B6082 L6083 Key6084 C6085)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> adjoin (lambda V6091 (lambda B6087 (lambda L6088 (lambda Key6089 (lambda C6090 (let A (shen.newpv B6087) (shen.gc B6087 (is! V6091 (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6087 L6088 Key6089 C6090)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> and (lambda V6096 (lambda B6092 (lambda L6093 (lambda Key6094 (lambda C6095 (is! V6096 (cons boolean (cons --> (cons (cons boolean (cons --> (cons boolean ()))) ()))) B6092 L6093 Key6094 C6095)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.app (lambda V6101 (lambda B6097 (lambda L6098 (lambda Key6099 (lambda C6100 (let A (shen.newpv B6097) (shen.gc B6097 (is! V6101 (cons A (cons --> (cons (cons string (cons --> (cons (cons symbol (cons --> (cons string ()))) ()))) ()))) B6097 L6098 Key6099 C6100)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> append (lambda V6106 (lambda B6102 (lambda L6103 (lambda Key6104 (lambda C6105 (let A (shen.newpv B6102) (shen.gc B6102 (is! V6106 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6102 L6103 Key6104 C6105)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> arity (lambda V6111 (lambda B6107 (lambda L6108 (lambda Key6109 (lambda C6110 (let A (shen.newpv B6107) (shen.gc B6107 (is! V6111 (cons A (cons --> (cons number ()))) B6107 L6108 Key6109 C6110)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> assoc (lambda V6116 (lambda B6112 (lambda L6113 (lambda Key6114 (lambda C6115 (let A (shen.newpv B6112) (shen.gc B6112 (is! V6116 (cons A (cons --> (cons (cons (cons list (cons (cons list (cons A ())) ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6112 L6113 Key6114 C6115)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> atom? (lambda V6121 (lambda B6117 (lambda L6118 (lambda Key6119 (lambda C6120 (let A (shen.newpv B6117) (shen.gc B6117 (is! V6121 (cons A (cons --> (cons boolean ()))) B6117 L6118 Key6119 C6120)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> boolean? (lambda V6126 (lambda B6122 (lambda L6123 (lambda Key6124 (lambda C6125 (let A (shen.newpv B6122) (shen.gc B6122 (is! V6126 (cons A (cons --> (cons boolean ()))) B6122 L6123 Key6124 C6125)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> bootstrap (lambda V6131 (lambda B6127 (lambda L6128 (lambda Key6129 (lambda C6130 (is! V6131 (cons string (cons --> (cons string ()))) B6127 L6128 Key6129 C6130)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> bound? (lambda V6136 (lambda B6132 (lambda L6133 (lambda Key6134 (lambda C6135 (is! V6136 (cons symbol (cons --> (cons boolean ()))) B6132 L6133 Key6134 C6135)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.ccons? (lambda V6141 (lambda B6137 (lambda L6138 (lambda Key6139 (lambda C6140 (let A (shen.newpv B6137) (shen.gc B6137 (is! V6141 (cons (cons list (cons A ())) (cons --> (cons boolean ()))) B6137 L6138 Key6139 C6140)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> cd (lambda V6146 (lambda B6142 (lambda L6143 (lambda Key6144 (lambda C6145 (is! V6146 (cons string (cons --> (cons string ()))) B6142 L6143 Key6144 C6145)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> close (lambda V6151 (lambda B6147 (lambda L6148 (lambda Key6149 (lambda C6150 (let A (shen.newpv B6147) (shen.gc B6147 (let B (shen.newpv B6147) (shen.gc B6147 (is! V6151 (cons (cons stream (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) B6147 L6148 Key6149 C6150)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> cn (lambda V6156 (lambda B6152 (lambda L6153 (lambda Key6154 (lambda C6155 (is! V6156 (cons string (cons --> (cons (cons string (cons --> (cons string ()))) ()))) B6152 L6153 Key6154 C6155)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> compile (lambda V6161 (lambda B6157 (lambda L6158 (lambda Key6159 (lambda C6160 (let A (shen.newpv B6157) (shen.gc B6157 (let B (shen.newpv B6157) (shen.gc B6157 (is! V6161 (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 ()))) ()))) B6157 L6158 Key6159 C6160)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> cons? (lambda V6166 (lambda B6162 (lambda L6163 (lambda Key6164 (lambda C6165 (let A (shen.newpv B6162) (shen.gc B6162 (is! V6166 (cons A (cons --> (cons boolean ()))) B6162 L6163 Key6164 C6165)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> datatypes (lambda V6171 (lambda B6167 (lambda L6168 (lambda Key6169 (lambda C6170 (is! V6171 (cons --> (cons (cons list (cons symbol ())) ())) B6167 L6168 Key6169 C6170)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> destroy (lambda V6176 (lambda B6172 (lambda L6173 (lambda Key6174 (lambda C6175 (is! V6176 (cons symbol (cons --> (cons symbol ()))) B6172 L6173 Key6174 C6175)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> difference (lambda V6181 (lambda B6177 (lambda L6178 (lambda Key6179 (lambda C6180 (let A (shen.newpv B6177) (shen.gc B6177 (is! V6181 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6177 L6178 Key6179 C6180)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> do (lambda V6186 (lambda B6182 (lambda L6183 (lambda Key6184 (lambda C6185 (let A (shen.newpv B6182) (shen.gc B6182 (let B (shen.newpv B6182) (shen.gc B6182 (is! V6186 (cons A (cons --> (cons (cons B (cons --> (cons B ()))) ()))) B6182 L6183 Key6184 C6185)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> (lambda V6191 (lambda B6187 (lambda L6188 (lambda Key6189 (lambda C6190 (let A (shen.newpv B6187) (shen.gc B6187 (let B (shen.newpv B6187) (shen.gc B6187 (is! V6191 (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons (cons list (cons B ())) ()))) ()))) B6187 L6188 Key6189 C6190)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> (lambda V6196 (lambda B6192 (lambda L6193 (lambda Key6194 (lambda C6195 (let B (shen.newpv B6192) (shen.gc B6192 (let A (shen.newpv B6192) (shen.gc B6192 (is! V6196 (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons B ())) (cons (cons list (cons A ())) ()))) ()))) B6192 L6193 Key6194 C6195)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> (lambda V6201 (lambda B6197 (lambda L6198 (lambda Key6199 (lambda C6200 (let A (shen.newpv B6197) (shen.gc B6197 (let B (shen.newpv B6197) (shen.gc B6197 (is! V6201 (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons (cons list (cons B ())) ()))) ()))) B6197 L6198 Key6199 C6200)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.parse-failure? (lambda V6206 (lambda B6202 (lambda L6203 (lambda Key6204 (lambda C6205 (let A (shen.newpv B6202) (shen.gc B6202 (let B (shen.newpv B6202) (shen.gc B6202 (is! V6206 (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons boolean ()))) B6202 L6203 Key6204 C6205)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.parse-failure (lambda V6211 (lambda B6207 (lambda L6208 (lambda Key6209 (lambda C6210 (let A (shen.newpv B6207) (shen.gc B6207 (let B (shen.newpv B6207) (shen.gc B6207 (is! V6211 (cons --> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) ())) B6207 L6208 Key6209 C6210)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.<-out (lambda V6216 (lambda B6212 (lambda L6213 (lambda Key6214 (lambda C6215 (let A (shen.newpv B6212) (shen.gc B6212 (let B (shen.newpv B6212) (shen.gc B6212 (is! V6216 (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons B ()))) B6212 L6213 Key6214 C6215)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.in-> (lambda V6221 (lambda B6217 (lambda L6218 (lambda Key6219 (lambda C6220 (let B (shen.newpv B6217) (shen.gc B6217 (let A (shen.newpv B6217) (shen.gc B6217 (is! V6221 (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons (cons list (cons A ())) ()))) B6217 L6218 Key6219 C6220)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.comb (lambda V6226 (lambda B6222 (lambda L6223 (lambda Key6224 (lambda C6225 (let A (shen.newpv B6222) (shen.gc B6222 (let B (shen.newpv B6222) (shen.gc B6222 (is! V6226 (cons (cons list (cons A ())) (cons --> (cons (cons B (cons --> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) ()))) ()))) B6222 L6223 Key6224 C6225)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> element? (lambda V6231 (lambda B6227 (lambda L6228 (lambda Key6229 (lambda C6230 (let A (shen.newpv B6227) (shen.gc B6227 (is! V6231 (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons boolean ()))) ()))) B6227 L6228 Key6229 C6230)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> empty? (lambda V6236 (lambda B6232 (lambda L6233 (lambda Key6234 (lambda C6235 (let A (shen.newpv B6232) (shen.gc B6232 (is! V6236 (cons A (cons --> (cons boolean ()))) B6232 L6233 Key6234 C6235)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> enable-type-theory (lambda V6241 (lambda B6237 (lambda L6238 (lambda Key6239 (lambda C6240 (is! V6241 (cons symbol (cons --> (cons boolean ()))) B6237 L6238 Key6239 C6240)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> external (lambda V6246 (lambda B6242 (lambda L6243 (lambda Key6244 (lambda C6245 (is! V6246 (cons symbol (cons --> (cons (cons list (cons symbol ())) ()))) B6242 L6243 Key6244 C6245)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> error-to-string (lambda V6251 (lambda B6247 (lambda L6248 (lambda Key6249 (lambda C6250 (is! V6251 (cons exception (cons --> (cons string ()))) B6247 L6248 Key6249 C6250)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> explode (lambda V6256 (lambda B6252 (lambda L6253 (lambda Key6254 (lambda C6255 (let A (shen.newpv B6252) (shen.gc B6252 (is! V6256 (cons A (cons --> (cons (cons list (cons string ())) ()))) B6252 L6253 Key6254 C6255)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> factorise (lambda V6261 (lambda B6257 (lambda L6258 (lambda Key6259 (lambda C6260 (is! V6261 (cons symbol (cons --> (cons symbol ()))) B6257 L6258 Key6259 C6260)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> factorise? (lambda V6266 (lambda B6262 (lambda L6263 (lambda Key6264 (lambda C6265 (is! V6266 (cons --> (cons boolean ())) B6262 L6263 Key6264 C6265)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> fail (lambda V6271 (lambda B6267 (lambda L6268 (lambda Key6269 (lambda C6270 (is! V6271 (cons --> (cons symbol ())) B6267 L6268 Key6269 C6270)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> fix (lambda V6276 (lambda B6272 (lambda L6273 (lambda Key6274 (lambda C6275 (let A (shen.newpv B6272) (shen.gc B6272 (is! V6276 (cons (cons A (cons --> (cons A ()))) (cons --> (cons (cons A (cons --> (cons A ()))) ()))) B6272 L6273 Key6274 C6275)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> freeze (lambda V6281 (lambda B6277 (lambda L6278 (lambda Key6279 (lambda C6280 (let A (shen.newpv B6277) (shen.gc B6277 (is! V6281 (cons A (cons --> (cons (cons lazy (cons A ())) ()))) B6277 L6278 Key6279 C6280)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> fst (lambda V6286 (lambda B6282 (lambda L6283 (lambda Key6284 (lambda C6285 (let B (shen.newpv B6282) (shen.gc B6282 (let A (shen.newpv B6282) (shen.gc B6282 (is! V6286 (cons (cons A (cons * (cons B ()))) (cons --> (cons A ()))) B6282 L6283 Key6284 C6285)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> gensym (lambda V6291 (lambda B6287 (lambda L6288 (lambda Key6289 (lambda C6290 (is! V6291 (cons symbol (cons --> (cons symbol ()))) B6287 L6288 Key6289 C6290)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.hds=? (lambda V6296 (lambda B6292 (lambda L6293 (lambda Key6294 (lambda C6295 (let A (shen.newpv B6292) (shen.gc B6292 (is! V6296 (cons (cons list (cons A ())) (cons --> (cons (cons A (cons --> (cons boolean ()))) ()))) B6292 L6293 Key6294 C6295)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hush (lambda V6301 (lambda B6297 (lambda L6298 (lambda Key6299 (lambda C6300 (is! V6301 (cons symbol (cons --> (cons boolean ()))) B6297 L6298 Key6299 C6300)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hush? (lambda V6306 (lambda B6302 (lambda L6303 (lambda Key6304 (lambda C6305 (is! V6306 (cons --> (cons boolean ())) B6302 L6303 Key6304 C6305)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> <-vector (lambda V6311 (lambda B6307 (lambda L6308 (lambda Key6309 (lambda C6310 (let A (shen.newpv B6307) (shen.gc B6307 (is! V6311 (cons (cons vector (cons A ())) (cons --> (cons (cons number (cons --> (cons A ()))) ()))) B6307 L6308 Key6309 C6310)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> vector-> (lambda V6316 (lambda B6312 (lambda L6313 (lambda Key6314 (lambda C6315 (let A (shen.newpv B6312) (shen.gc B6312 (is! V6316 (cons (cons vector (cons A ())) (cons --> (cons (cons number (cons --> (cons (cons A (cons --> (cons (cons vector (cons A ())) ()))) ()))) ()))) B6312 L6313 Key6314 C6315)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> vector (lambda V6321 (lambda B6317 (lambda L6318 (lambda Key6319 (lambda C6320 (let A (shen.newpv B6317) (shen.gc B6317 (is! V6321 (cons number (cons --> (cons (cons vector (cons A ())) ()))) B6317 L6318 Key6319 C6320)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> get-time (lambda V6326 (lambda B6322 (lambda L6323 (lambda Key6324 (lambda C6325 (is! V6326 (cons symbol (cons --> (cons number ()))) B6322 L6323 Key6324 C6325)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hash (lambda V6331 (lambda B6327 (lambda L6328 (lambda Key6329 (lambda C6330 (let A (shen.newpv B6327) (shen.gc B6327 (is! V6331 (cons A (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6327 L6328 Key6329 C6330)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> head (lambda V6336 (lambda B6332 (lambda L6333 (lambda Key6334 (lambda C6335 (let A (shen.newpv B6332) (shen.gc B6332 (is! V6336 (cons (cons list (cons A ())) (cons --> (cons A ()))) B6332 L6333 Key6334 C6335)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hdv (lambda V6341 (lambda B6337 (lambda L6338 (lambda Key6339 (lambda C6340 (let A (shen.newpv B6337) (shen.gc B6337 (is! V6341 (cons (cons vector (cons A ())) (cons --> (cons A ()))) B6337 L6338 Key6339 C6340)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hdstr (lambda V6346 (lambda B6342 (lambda L6343 (lambda Key6344 (lambda C6345 (is! V6346 (cons string (cons --> (cons string ()))) B6342 L6343 Key6344 C6345)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> if (lambda V6351 (lambda B6347 (lambda L6348 (lambda Key6349 (lambda C6350 (let A (shen.newpv B6347) (shen.gc B6347 (is! V6351 (cons boolean (cons --> (cons (cons A (cons --> (cons (cons A (cons --> (cons A ()))) ()))) ()))) B6347 L6348 Key6349 C6350)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> in-package (lambda V6356 (lambda B6352 (lambda L6353 (lambda Key6354 (lambda C6355 (is! V6356 (cons symbol (cons --> (cons symbol ()))) B6352 L6353 Key6354 C6355)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> it (lambda V6361 (lambda B6357 (lambda L6358 (lambda Key6359 (lambda C6360 (is! V6361 (cons --> (cons string ())) B6357 L6358 Key6359 C6360)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> implementation (lambda V6366 (lambda B6362 (lambda L6363 (lambda Key6364 (lambda C6365 (is! V6366 (cons --> (cons string ())) B6362 L6363 Key6364 C6365)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> include (lambda V6371 (lambda B6367 (lambda L6368 (lambda Key6369 (lambda C6370 (is! V6371 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) B6367 L6368 Key6369 C6370)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> include-all-but (lambda V6376 (lambda B6372 (lambda L6373 (lambda Key6374 (lambda C6375 (is! V6376 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) B6372 L6373 Key6374 C6375)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> included (lambda V6381 (lambda B6377 (lambda L6378 (lambda Key6379 (lambda C6380 (is! V6381 (cons --> (cons (cons list (cons symbol ())) ())) B6377 L6378 Key6379 C6380)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> inferences (lambda V6386 (lambda B6382 (lambda L6383 (lambda Key6384 (lambda C6385 (is! V6386 (cons --> (cons number ())) B6382 L6383 Key6384 C6385)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.insert (lambda V6391 (lambda B6387 (lambda L6388 (lambda Key6389 (lambda C6390 (let A (shen.newpv B6387) (shen.gc B6387 (is! V6391 (cons A (cons --> (cons (cons string (cons --> (cons string ()))) ()))) B6387 L6388 Key6389 C6390)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> integer? (lambda V6396 (lambda B6392 (lambda L6393 (lambda Key6394 (lambda C6395 (let A (shen.newpv B6392) (shen.gc B6392 (is! V6396 (cons A (cons --> (cons boolean ()))) B6392 L6393 Key6394 C6395)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> internal (lambda V6401 (lambda B6397 (lambda L6398 (lambda Key6399 (lambda C6400 (is! V6401 (cons symbol (cons --> (cons (cons list (cons symbol ())) ()))) B6397 L6398 Key6399 C6400)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> intersection (lambda V6406 (lambda B6402 (lambda L6403 (lambda Key6404 (lambda C6405 (let A (shen.newpv B6402) (shen.gc B6402 (is! V6406 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6402 L6403 Key6404 C6405)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> language (lambda V6411 (lambda B6407 (lambda L6408 (lambda Key6409 (lambda C6410 (is! V6411 (cons --> (cons string ())) B6407 L6408 Key6409 C6410)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> length (lambda V6416 (lambda B6412 (lambda L6413 (lambda Key6414 (lambda C6415 (let A (shen.newpv B6412) (shen.gc B6412 (is! V6416 (cons (cons list (cons A ())) (cons --> (cons number ()))) B6412 L6413 Key6414 C6415)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> limit (lambda V6421 (lambda B6417 (lambda L6418 (lambda Key6419 (lambda C6420 (let A (shen.newpv B6417) (shen.gc B6417 (is! V6421 (cons (cons vector (cons A ())) (cons --> (cons number ()))) B6417 L6418 Key6419 C6420)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> lineread (lambda V6426 (lambda B6422 (lambda L6423 (lambda Key6424 (lambda C6425 (is! V6426 (cons (cons stream (cons in ())) (cons --> (cons (cons list (cons unit ())) ()))) B6422 L6423 Key6424 C6425)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> load (lambda V6431 (lambda B6427 (lambda L6428 (lambda Key6429 (lambda C6430 (is! V6431 (cons string (cons --> (cons symbol ()))) B6427 L6428 Key6429 C6430)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> map (lambda V6436 (lambda B6432 (lambda L6433 (lambda Key6434 (lambda C6435 (let A (shen.newpv B6432) (shen.gc B6432 (let B (shen.newpv B6432) (shen.gc B6432 (is! V6436 (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) ()))) B6432 L6433 Key6434 C6435)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> mapcan (lambda V6441 (lambda B6437 (lambda L6438 (lambda Key6439 (lambda C6440 (let A (shen.newpv B6437) (shen.gc B6437 (let B (shen.newpv B6437) (shen.gc B6437 (is! V6441 (cons (cons A (cons --> (cons (cons list (cons B ())) ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) ()))) B6437 L6438 Key6439 C6440)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> maxinferences (lambda V6446 (lambda B6442 (lambda L6443 (lambda Key6444 (lambda C6445 (is! V6446 (cons number (cons --> (cons number ()))) B6442 L6443 Key6444 C6445)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> n->string (lambda V6451 (lambda B6447 (lambda L6448 (lambda Key6449 (lambda C6450 (is! V6451 (cons number (cons --> (cons string ()))) B6447 L6448 Key6449 C6450)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> nl (lambda V6456 (lambda B6452 (lambda L6453 (lambda Key6454 (lambda C6455 (is! V6456 (cons number (cons --> (cons number ()))) B6452 L6453 Key6454 C6455)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> not (lambda V6461 (lambda B6457 (lambda L6458 (lambda Key6459 (lambda C6460 (is! V6461 (cons boolean (cons --> (cons boolean ()))) B6457 L6458 Key6459 C6460)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> nth (lambda V6466 (lambda B6462 (lambda L6463 (lambda Key6464 (lambda C6465 (let A (shen.newpv B6462) (shen.gc B6462 (is! V6466 (cons number (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons A ()))) ()))) B6462 L6463 Key6464 C6465)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> number? (lambda V6471 (lambda B6467 (lambda L6468 (lambda Key6469 (lambda C6470 (let A (shen.newpv B6467) (shen.gc B6467 (is! V6471 (cons A (cons --> (cons boolean ()))) B6467 L6468 Key6469 C6470)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> occurrences (lambda V6476 (lambda B6472 (lambda L6473 (lambda Key6474 (lambda C6475 (let A (shen.newpv B6472) (shen.gc B6472 (let B (shen.newpv B6472) (shen.gc B6472 (is! V6476 (cons A (cons --> (cons (cons B (cons --> (cons number ()))) ()))) B6472 L6473 Key6474 C6475)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> occurs-check (lambda V6481 (lambda B6477 (lambda L6478 (lambda Key6479 (lambda C6480 (is! V6481 (cons symbol (cons --> (cons boolean ()))) B6477 L6478 Key6479 C6480)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> occurs? (lambda V6486 (lambda B6482 (lambda L6483 (lambda Key6484 (lambda C6485 (is! V6486 (cons --> (cons boolean ())) B6482 L6483 Key6484 C6485)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> optimise (lambda V6491 (lambda B6487 (lambda L6488 (lambda Key6489 (lambda C6490 (is! V6491 (cons symbol (cons --> (cons boolean ()))) B6487 L6488 Key6489 C6490)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> optimise? (lambda V6496 (lambda B6492 (lambda L6493 (lambda Key6494 (lambda C6495 (is! V6496 (cons --> (cons boolean ())) B6492 L6493 Key6494 C6495)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> or (lambda V6501 (lambda B6497 (lambda L6498 (lambda Key6499 (lambda C6500 (is! V6501 (cons boolean (cons --> (cons (cons boolean (cons --> (cons boolean ()))) ()))) B6497 L6498 Key6499 C6500)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> os (lambda V6506 (lambda B6502 (lambda L6503 (lambda Key6504 (lambda C6505 (is! V6506 (cons --> (cons string ())) B6502 L6503 Key6504 C6505)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> package? (lambda V6511 (lambda B6507 (lambda L6508 (lambda Key6509 (lambda C6510 (is! V6511 (cons symbol (cons --> (cons boolean ()))) B6507 L6508 Key6509 C6510)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> port (lambda V6516 (lambda B6512 (lambda L6513 (lambda Key6514 (lambda C6515 (is! V6516 (cons --> (cons string ())) B6512 L6513 Key6514 C6515)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> porters (lambda V6521 (lambda B6517 (lambda L6518 (lambda Key6519 (lambda C6520 (is! V6521 (cons --> (cons string ())) B6517 L6518 Key6519 C6520)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> pos (lambda V6526 (lambda B6522 (lambda L6523 (lambda Key6524 (lambda C6525 (is! V6526 (cons string (cons --> (cons (cons number (cons --> (cons string ()))) ()))) B6522 L6523 Key6524 C6525)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> pr (lambda V6531 (lambda B6527 (lambda L6528 (lambda Key6529 (lambda C6530 (is! V6531 (cons string (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons string ()))) ()))) B6527 L6528 Key6529 C6530)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> print (lambda V6536 (lambda B6532 (lambda L6533 (lambda Key6534 (lambda C6535 (let A (shen.newpv B6532) (shen.gc B6532 (is! V6536 (cons A (cons --> (cons A ()))) B6532 L6533 Key6534 C6535)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> profile (lambda V6541 (lambda B6537 (lambda L6538 (lambda Key6539 (lambda C6540 (is! V6541 (cons symbol (cons --> (cons symbol ()))) B6537 L6538 Key6539 C6540)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> preclude (lambda V6546 (lambda B6542 (lambda L6543 (lambda Key6544 (lambda C6545 (is! V6546 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) B6542 L6543 Key6544 C6545)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.proc-nl (lambda V6551 (lambda B6547 (lambda L6548 (lambda Key6549 (lambda C6550 (is! V6551 (cons string (cons --> (cons string ()))) B6547 L6548 Key6549 C6550)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> profile-results (lambda V6556 (lambda B6552 (lambda L6553 (lambda Key6554 (lambda C6555 (is! V6556 (cons symbol (cons --> (cons (cons symbol (cons * (cons number ()))) ()))) B6552 L6553 Key6554 C6555)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> protect (lambda V6561 (lambda B6557 (lambda L6558 (lambda Key6559 (lambda C6560 (let A (shen.newpv B6557) (shen.gc B6557 (is! V6561 (cons A (cons --> (cons A ()))) B6557 L6558 Key6559 C6560)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> preclude-all-but (lambda V6566 (lambda B6562 (lambda L6563 (lambda Key6564 (lambda C6565 (is! V6566 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) B6562 L6563 Key6564 C6565)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.prhush (lambda V6571 (lambda B6567 (lambda L6568 (lambda Key6569 (lambda C6570 (is! V6571 (cons string (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons string ()))) ()))) B6567 L6568 Key6569 C6570)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> prolog-memory (lambda V6576 (lambda B6572 (lambda L6573 (lambda Key6574 (lambda C6575 (is! V6576 (cons number (cons --> (cons number ()))) B6572 L6573 Key6574 C6575)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> ps (lambda V6581 (lambda B6577 (lambda L6578 (lambda Key6579 (lambda C6580 (is! V6581 (cons symbol (cons --> (cons (cons list (cons unit ())) ()))) B6577 L6578 Key6579 C6580)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read (lambda V6586 (lambda B6582 (lambda L6583 (lambda Key6584 (lambda C6585 (is! V6586 (cons (cons stream (cons in ())) (cons --> (cons unit ()))) B6582 L6583 Key6584 C6585)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-byte (lambda V6591 (lambda B6587 (lambda L6588 (lambda Key6589 (lambda C6590 (is! V6591 (cons (cons stream (cons in ())) (cons --> (cons number ()))) B6587 L6588 Key6589 C6590)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-file-as-bytelist (lambda V6596 (lambda B6592 (lambda L6593 (lambda Key6594 (lambda C6595 (is! V6596 (cons string (cons --> (cons (cons list (cons number ())) ()))) B6592 L6593 Key6594 C6595)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-file-as-string (lambda V6601 (lambda B6597 (lambda L6598 (lambda Key6599 (lambda C6600 (is! V6601 (cons string (cons --> (cons string ()))) B6597 L6598 Key6599 C6600)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-file (lambda V6606 (lambda B6602 (lambda L6603 (lambda Key6604 (lambda C6605 (is! V6606 (cons string (cons --> (cons (cons list (cons unit ())) ()))) B6602 L6603 Key6604 C6605)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-from-string (lambda V6611 (lambda B6607 (lambda L6608 (lambda Key6609 (lambda C6610 (is! V6611 (cons string (cons --> (cons (cons list (cons unit ())) ()))) B6607 L6608 Key6609 C6610)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-from-string-unprocessed (lambda V6616 (lambda B6612 (lambda L6613 (lambda Key6614 (lambda C6615 (is! V6616 (cons string (cons --> (cons (cons list (cons unit ())) ()))) B6612 L6613 Key6614 C6615)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> release (lambda V6621 (lambda B6617 (lambda L6618 (lambda Key6619 (lambda C6620 (is! V6621 (cons --> (cons string ())) B6617 L6618 Key6619 C6620)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> remove (lambda V6626 (lambda B6622 (lambda L6623 (lambda Key6624 (lambda C6625 (let A (shen.newpv B6622) (shen.gc B6622 (is! V6626 (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6622 L6623 Key6624 C6625)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> reverse (lambda V6631 (lambda B6627 (lambda L6628 (lambda Key6629 (lambda C6630 (let A (shen.newpv B6627) (shen.gc B6627 (is! V6631 (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) B6627 L6628 Key6629 C6630)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> simple-error (lambda V6636 (lambda B6632 (lambda L6633 (lambda Key6634 (lambda C6635 (let A (shen.newpv B6632) (shen.gc B6632 (is! V6636 (cons string (cons --> (cons A ()))) B6632 L6633 Key6634 C6635)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> snd (lambda V6641 (lambda B6637 (lambda L6638 (lambda Key6639 (lambda C6640 (let A (shen.newpv B6637) (shen.gc B6637 (let B (shen.newpv B6637) (shen.gc B6637 (is! V6641 (cons (cons A (cons * (cons B ()))) (cons --> (cons B ()))) B6637 L6638 Key6639 C6640)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> specialise (lambda V6646 (lambda B6642 (lambda L6643 (lambda Key6644 (lambda C6645 (is! V6646 (cons symbol (cons --> (cons (cons number (cons --> (cons symbol ()))) ()))) B6642 L6643 Key6644 C6645)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> spy (lambda V6651 (lambda B6647 (lambda L6648 (lambda Key6649 (lambda C6650 (is! V6651 (cons symbol (cons --> (cons boolean ()))) B6647 L6648 Key6649 C6650)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.spy? (lambda V6656 (lambda B6652 (lambda L6653 (lambda Key6654 (lambda C6655 (is! V6656 (cons --> (cons boolean ())) B6652 L6653 Key6654 C6655)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> step (lambda V6661 (lambda B6657 (lambda L6658 (lambda Key6659 (lambda C6660 (is! V6661 (cons symbol (cons --> (cons boolean ()))) B6657 L6658 Key6659 C6660)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.step? (lambda V6666 (lambda B6662 (lambda L6663 (lambda Key6664 (lambda C6665 (is! V6666 (cons --> (cons boolean ())) B6662 L6663 Key6664 C6665)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> stinput (lambda V6671 (lambda B6667 (lambda L6668 (lambda Key6669 (lambda C6670 (is! V6671 (cons --> (cons (cons stream (cons in ())) ())) B6667 L6668 Key6669 C6670)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> sterror (lambda V6676 (lambda B6672 (lambda L6673 (lambda Key6674 (lambda C6675 (is! V6676 (cons --> (cons (cons stream (cons out ())) ())) B6672 L6673 Key6674 C6675)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> stoutput (lambda V6681 (lambda B6677 (lambda L6678 (lambda Key6679 (lambda C6680 (is! V6681 (cons --> (cons (cons stream (cons out ())) ())) B6677 L6678 Key6679 C6680)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> string? (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-> str (lambda V6691 (lambda B6687 (lambda L6688 (lambda Key6689 (lambda C6690 (let A (shen.newpv B6687) (shen.gc B6687 (is! V6691 (cons A (cons --> (cons string ()))) B6687 L6688 Key6689 C6690)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> string->n (lambda V6696 (lambda B6692 (lambda L6693 (lambda Key6694 (lambda C6695 (is! V6696 (cons string (cons --> (cons number ()))) B6692 L6693 Key6694 C6695)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> string->symbol (lambda V6701 (lambda B6697 (lambda L6698 (lambda Key6699 (lambda C6700 (is! V6701 (cons string (cons --> (cons symbol ()))) B6697 L6698 Key6699 C6700)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> sum (lambda V6706 (lambda B6702 (lambda L6703 (lambda Key6704 (lambda C6705 (is! V6706 (cons (cons list (cons number ())) (cons --> (cons number ()))) B6702 L6703 Key6704 C6705)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> symbol? (lambda V6711 (lambda B6707 (lambda L6708 (lambda Key6709 (lambda C6710 (let A (shen.newpv B6707) (shen.gc B6707 (is! V6711 (cons A (cons --> (cons boolean ()))) B6707 L6708 Key6709 C6710)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> systemf (lambda V6716 (lambda B6712 (lambda L6713 (lambda Key6714 (lambda C6715 (is! V6716 (cons symbol (cons --> (cons symbol ()))) B6712 L6713 Key6714 C6715)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> system-S? (lambda V6721 (lambda B6717 (lambda L6718 (lambda Key6719 (lambda C6720 (is! V6721 (cons --> (cons boolean ())) B6717 L6718 Key6719 C6720)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tail (lambda V6726 (lambda B6722 (lambda L6723 (lambda Key6724 (lambda C6725 (let A (shen.newpv B6722) (shen.gc B6722 (is! V6726 (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) B6722 L6723 Key6724 C6725)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tlstr (lambda V6731 (lambda B6727 (lambda L6728 (lambda Key6729 (lambda C6730 (is! V6731 (cons string (cons --> (cons string ()))) B6727 L6728 Key6729 C6730)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tlv (lambda V6736 (lambda B6732 (lambda L6733 (lambda Key6734 (lambda C6735 (let A (shen.newpv B6732) (shen.gc B6732 (is! V6736 (cons (cons vector (cons A ())) (cons --> (cons (cons vector (cons A ())) ()))) B6732 L6733 Key6734 C6735)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tc (lambda V6741 (lambda B6737 (lambda L6738 (lambda Key6739 (lambda C6740 (is! V6741 (cons symbol (cons --> (cons boolean ()))) B6737 L6738 Key6739 C6740)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tc? (lambda V6746 (lambda B6742 (lambda L6743 (lambda Key6744 (lambda C6745 (is! V6746 (cons --> (cons boolean ())) B6742 L6743 Key6744 C6745)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> thaw (lambda V6751 (lambda B6747 (lambda L6748 (lambda Key6749 (lambda C6750 (let A (shen.newpv B6747) (shen.gc B6747 (is! V6751 (cons (cons lazy (cons A ())) (cons --> (cons A ()))) B6747 L6748 Key6749 C6750)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> track (lambda V6756 (lambda B6752 (lambda L6753 (lambda Key6754 (lambda C6755 (is! V6756 (cons symbol (cons --> (cons symbol ()))) B6752 L6753 Key6754 C6755)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tracked (lambda V6761 (lambda B6757 (lambda L6758 (lambda Key6759 (lambda C6760 (is! V6761 (cons --> (cons (cons list (cons symbol ())) ())) B6757 L6758 Key6759 C6760)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> trap-error (lambda V6766 (lambda B6762 (lambda L6763 (lambda Key6764 (lambda C6765 (let A (shen.newpv B6762) (shen.gc B6762 (is! V6766 (cons A (cons --> (cons (cons (cons exception (cons --> (cons A ()))) (cons --> (cons A ()))) ()))) B6762 L6763 Key6764 C6765)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tuple? (lambda V6771 (lambda B6767 (lambda L6768 (lambda Key6769 (lambda C6770 (let A (shen.newpv B6767) (shen.gc B6767 (is! V6771 (cons A (cons --> (cons boolean ()))) B6767 L6768 Key6769 C6770)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> unabsolute (lambda V6776 (lambda B6772 (lambda L6773 (lambda Key6774 (lambda C6775 (is! V6776 (cons string (cons --> (cons (cons list (cons string ())) ()))) B6772 L6773 Key6774 C6775)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> undefmacro (lambda V6781 (lambda B6777 (lambda L6778 (lambda Key6779 (lambda C6780 (is! V6781 (cons symbol (cons --> (cons symbol ()))) B6777 L6778 Key6779 C6780)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> union (lambda V6786 (lambda B6782 (lambda L6783 (lambda Key6784 (lambda C6785 (let A (shen.newpv B6782) (shen.gc B6782 (is! V6786 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6782 L6783 Key6784 C6785)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> unprofile (lambda V6791 (lambda B6787 (lambda L6788 (lambda Key6789 (lambda C6790 (is! V6791 (cons symbol (cons --> (cons symbol ()))) B6787 L6788 Key6789 C6790)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> untrack (lambda V6796 (lambda B6792 (lambda L6793 (lambda Key6794 (lambda C6795 (is! V6796 (cons symbol (cons --> (cons symbol ()))) B6792 L6793 Key6794 C6795)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> userdefs (lambda V6801 (lambda B6797 (lambda L6798 (lambda Key6799 (lambda C6800 (is! V6801 (cons --> (cons (cons list (cons symbol ())) ())) B6797 L6798 Key6799 C6800)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> variable? (lambda V6806 (lambda B6802 (lambda L6803 (lambda Key6804 (lambda C6805 (let A (shen.newpv B6802) (shen.gc B6802 (is! V6806 (cons A (cons --> (cons boolean ()))) B6802 L6803 Key6804 C6805)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> vector? (lambda V6811 (lambda B6807 (lambda L6808 (lambda Key6809 (lambda C6810 (let A (shen.newpv B6807) (shen.gc B6807 (is! V6811 (cons A (cons --> (cons boolean ()))) B6807 L6808 Key6809 C6810)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> version (lambda V6816 (lambda B6812 (lambda L6813 (lambda Key6814 (lambda C6815 (is! V6816 (cons --> (cons string ())) B6812 L6813 Key6814 C6815)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> write-to-file (lambda V6821 (lambda B6817 (lambda L6818 (lambda Key6819 (lambda C6820 (let A (shen.newpv B6817) (shen.gc B6817 (is! V6821 (cons string (cons --> (cons (cons A (cons --> (cons A ()))) ()))) B6817 L6818 Key6819 C6820)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> write-byte (lambda V6826 (lambda B6822 (lambda L6823 (lambda Key6824 (lambda C6825 (is! V6826 (cons number (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons number ()))) ()))) B6822 L6823 Key6824 C6825)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> y-or-n? (lambda V6831 (lambda B6827 (lambda L6828 (lambda Key6829 (lambda C6830 (is! V6831 (cons string (cons --> (cons boolean ()))) B6827 L6828 Key6829 C6830)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> > (lambda V6836 (lambda B6832 (lambda L6833 (lambda Key6834 (lambda C6835 (is! V6836 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) B6832 L6833 Key6834 C6835)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> < (lambda V6841 (lambda B6837 (lambda L6838 (lambda Key6839 (lambda C6840 (is! V6841 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) B6837 L6838 Key6839 C6840)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> >= (lambda V6846 (lambda B6842 (lambda L6843 (lambda Key6844 (lambda C6845 (is! V6846 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) B6842 L6843 Key6844 C6845)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> <= (lambda V6851 (lambda B6847 (lambda L6848 (lambda Key6849 (lambda C6850 (is! V6851 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) B6847 L6848 Key6849 C6850)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> = (lambda V6856 (lambda B6852 (lambda L6853 (lambda Key6854 (lambda C6855 (let A (shen.newpv B6852) (shen.gc B6852 (is! V6856 (cons A (cons --> (cons (cons A (cons --> (cons boolean ()))) ()))) B6852 L6853 Key6854 C6855)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> + (lambda V6861 (lambda B6857 (lambda L6858 (lambda Key6859 (lambda C6860 (is! V6861 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6857 L6858 Key6859 C6860)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> / (lambda V6866 (lambda B6862 (lambda L6863 (lambda Key6864 (lambda C6865 (is! V6866 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6862 L6863 Key6864 C6865)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> - (lambda V6871 (lambda B6867 (lambda L6868 (lambda Key6869 (lambda C6870 (is! V6871 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6867 L6868 Key6869 C6870)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> * (lambda V6876 (lambda B6872 (lambda L6873 (lambda Key6874 (lambda C6875 (is! V6876 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6872 L6873 Key6874 C6875)))))) (value shen.*sigf*))) (set shen.*sigf* (shen.assoc-> == (lambda V6881 (lambda B6877 (lambda L6878 (lambda Key6879 (lambda C6880 (let A (shen.newpv B6877) (shen.gc B6877 (let B (shen.newpv B6877) (shen.gc B6877 (is! V6881 (cons A (cons --> (cons (cons B (cons --> (cons boolean ()))) ()))) B6877 L6878 Key6879 C6880)))))))))) (value shen.*sigf*)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) + +(defun shen.initialise-lambda-forms () (do (shen.set-lambda-form-entry (cons shen.tuple (lambda Y1242 (shen.tuple Y1242)))) (do (shen.set-lambda-form-entry (cons shen.pvar (lambda Y1241 (shen.pvar Y1241)))) (do (shen.set-lambda-form-entry (cons shen.dictionary (lambda Y1240 (shen.dictionary Y1240)))) (do (shen.set-lambda-form-entry (cons shen.print-prolog-vector (lambda Y1239 (shen.print-prolog-vector Y1239)))) (do (shen.set-lambda-form-entry (cons shen.print-freshterm (lambda Y1238 (shen.print-freshterm Y1238)))) (do (shen.set-lambda-form-entry (cons shen.printF (lambda Y1237 (shen.printF Y1237)))) (do (shen.set-lambda-form-entry (cons absolute (lambda Y1236 (absolute Y1236)))) (do (shen.set-lambda-form-entry (cons absvector? (lambda Y1235 (absvector? Y1235)))) (do (shen.set-lambda-form-entry (cons absvector (lambda Y1234 (absvector Y1234)))) (do (shen.set-lambda-form-entry (cons address-> (lambda Y1231 (lambda Y1232 (lambda Y1233 (address-> Y1231 Y1232 Y1233)))))) (do (shen.set-lambda-form-entry (cons adjoin (lambda Y1229 (lambda Y1230 (adjoin Y1229 Y1230))))) (do (shen.set-lambda-form-entry (cons and (lambda Y1227 (lambda Y1228 (and Y1227 Y1228))))) (do (shen.set-lambda-form-entry (cons append (lambda Y1225 (lambda Y1226 (append Y1225 Y1226))))) (do (shen.set-lambda-form-entry (cons arity (lambda Y1224 (arity Y1224)))) (do (shen.set-lambda-form-entry (cons assoc (lambda Y1222 (lambda Y1223 (assoc Y1222 Y1223))))) (do (shen.set-lambda-form-entry (cons atom? (lambda Y1221 (atom? Y1221)))) (do (shen.set-lambda-form-entry (cons boolean? (lambda Y1220 (boolean? Y1220)))) (do (shen.set-lambda-form-entry (cons bootstrap (lambda Y1219 (bootstrap Y1219)))) (do (shen.set-lambda-form-entry (cons bound? (lambda Y1218 (bound? Y1218)))) (do (shen.set-lambda-form-entry (cons bind (lambda Y1212 (lambda Y1213 (lambda Y1214 (lambda Y1215 (lambda Y1216 (lambda Y1217 (bind Y1212 Y1213 Y1214 Y1215 Y1216 Y1217))))))))) (do (shen.set-lambda-form-entry (cons call (lambda Y1207 (lambda Y1208 (lambda Y1209 (lambda Y1210 (lambda Y1211 (call Y1207 Y1208 Y1209 Y1210 Y1211)))))))) (do (shen.set-lambda-form-entry (cons cd (lambda Y1206 (cd Y1206)))) (do (shen.set-lambda-form-entry (cons compile (lambda Y1204 (lambda Y1205 (compile Y1204 Y1205))))) (do (shen.set-lambda-form-entry (cons concat (lambda Y1202 (lambda Y1203 (concat Y1202 Y1203))))) (do (shen.set-lambda-form-entry (cons cons (lambda Y1200 (lambda Y1201 (cons Y1200 Y1201))))) (do (shen.set-lambda-form-entry (cons cons? (lambda Y1199 (cons? Y1199)))) (do (shen.set-lambda-form-entry (cons cn (lambda Y1197 (lambda Y1198 (cn Y1197 Y1198))))) (do (shen.set-lambda-form-entry (cons close (lambda Y1196 (close Y1196)))) (do (shen.set-lambda-form-entry (cons declare (lambda Y1194 (lambda Y1195 (declare Y1194 Y1195))))) (do (shen.set-lambda-form-entry (cons destroy (lambda Y1193 (destroy Y1193)))) (do (shen.set-lambda-form-entry (cons difference (lambda Y1191 (lambda Y1192 (difference Y1191 Y1192))))) (do (shen.set-lambda-form-entry (cons do (lambda Y1189 (lambda Y1190 (do Y1189 Y1190))))) (do (shen.set-lambda-form-entry (cons element? (lambda Y1187 (lambda Y1188 (element? Y1187 Y1188))))) (do (shen.set-lambda-form-entry (cons empty? (lambda Y1186 (empty? Y1186)))) (do (shen.set-lambda-form-entry (cons enable-type-theory (lambda Y1185 (enable-type-theory Y1185)))) (do (shen.set-lambda-form-entry (cons external (lambda Y1184 (external Y1184)))) (do (shen.set-lambda-form-entry (cons error-to-string (lambda Y1183 (error-to-string Y1183)))) (do (shen.set-lambda-form-entry (cons eval (lambda Y1182 (eval Y1182)))) (do (shen.set-lambda-form-entry (cons eval-kl (lambda Y1181 (eval-kl Y1181)))) (do (shen.set-lambda-form-entry (cons explode (lambda Y1180 (explode Y1180)))) (do (shen.set-lambda-form-entry (cons external (lambda Y1179 (external Y1179)))) (do (shen.set-lambda-form-entry (cons factorise (lambda Y1178 (factorise Y1178)))) (do (shen.set-lambda-form-entry (cons fail-if (lambda Y1176 (lambda Y1177 (fail-if Y1176 Y1177))))) (do (shen.set-lambda-form-entry (cons fix (lambda Y1174 (lambda Y1175 (fix Y1174 Y1175))))) (do (shen.set-lambda-form-entry (cons findall (lambda Y1167 (lambda Y1168 (lambda Y1169 (lambda Y1170 (lambda Y1171 (lambda Y1172 (lambda Y1173 (findall Y1167 Y1168 Y1169 Y1170 Y1171 Y1172 Y1173)))))))))) (do (shen.set-lambda-form-entry (cons fork (lambda Y1162 (lambda Y1163 (lambda Y1164 (lambda Y1165 (lambda Y1166 (fork Y1162 Y1163 Y1164 Y1165 Y1166)))))))) (do (shen.set-lambda-form-entry (cons freeze (lambda Y1161 (freeze Y1161)))) (do (shen.set-lambda-form-entry (cons fst (lambda Y1160 (fst Y1160)))) (do (shen.set-lambda-form-entry (cons fn (lambda Y1159 (fn Y1159)))) (do (shen.set-lambda-form-entry (cons function (lambda Y1158 (function Y1158)))) (do (shen.set-lambda-form-entry (cons gensym (lambda Y1157 (gensym Y1157)))) (do (shen.set-lambda-form-entry (cons get (lambda Y1154 (lambda Y1155 (lambda Y1156 (get Y1154 Y1155 Y1156)))))) (do (shen.set-lambda-form-entry (cons get-time (lambda Y1153 (get-time Y1153)))) (do (shen.set-lambda-form-entry (cons address-> (lambda Y1150 (lambda Y1151 (lambda Y1152 (address-> Y1150 Y1151 Y1152)))))) (do (shen.set-lambda-form-entry (cons <-address (lambda Y1148 (lambda Y1149 (<-address Y1148 Y1149))))) (do (shen.set-lambda-form-entry (cons <-vector (lambda Y1146 (lambda Y1147 (<-vector Y1146 Y1147))))) (do (shen.set-lambda-form-entry (cons > (lambda Y1144 (lambda Y1145 (> Y1144 Y1145))))) (do (shen.set-lambda-form-entry (cons >= (lambda Y1142 (lambda Y1143 (>= Y1142 Y1143))))) (do (shen.set-lambda-form-entry (cons = (lambda Y1140 (lambda Y1141 (= Y1140 Y1141))))) (do (shen.set-lambda-form-entry (cons hash (lambda Y1138 (lambda Y1139 (hash Y1138 Y1139))))) (do (shen.set-lambda-form-entry (cons hd (lambda Y1137 (hd Y1137)))) (do (shen.set-lambda-form-entry (cons hdv (lambda Y1136 (hdv Y1136)))) (do (shen.set-lambda-form-entry (cons hdstr (lambda Y1135 (hdstr Y1135)))) (do (shen.set-lambda-form-entry (cons head (lambda Y1134 (head Y1134)))) (do (shen.set-lambda-form-entry (cons hush (lambda Y1133 (hush Y1133)))) (do (shen.set-lambda-form-entry (cons if (lambda Y1130 (lambda Y1131 (lambda Y1132 (if Y1130 Y1131 Y1132)))))) (do (shen.set-lambda-form-entry (cons include (lambda Y1129 (include Y1129)))) (do (shen.set-lambda-form-entry (cons in-package (lambda Y1128 (in-package Y1128)))) (do (shen.set-lambda-form-entry (cons integer? (lambda Y1127 (integer? Y1127)))) (do (shen.set-lambda-form-entry (cons internal (lambda Y1126 (internal Y1126)))) (do (shen.set-lambda-form-entry (cons intern (lambda Y1125 (intern Y1125)))) (do (shen.set-lambda-form-entry (cons input (lambda Y1124 (input Y1124)))) (do (shen.set-lambda-form-entry (cons input+ (lambda Y1122 (lambda Y1123 (input+ Y1122 Y1123))))) (do (shen.set-lambda-form-entry (cons include-all-but (lambda Y1121 (include-all-but Y1121)))) (do (shen.set-lambda-form-entry (cons intersection (lambda Y1119 (lambda Y1120 (intersection Y1119 Y1120))))) (do (shen.set-lambda-form-entry (cons internal (lambda Y1118 (internal Y1118)))) (do (shen.set-lambda-form-entry (cons is (lambda Y1112 (lambda Y1113 (lambda Y1114 (lambda Y1115 (lambda Y1116 (lambda Y1117 (is Y1112 Y1113 Y1114 Y1115 Y1116 Y1117))))))))) (do (shen.set-lambda-form-entry (cons is! (lambda Y1106 (lambda Y1107 (lambda Y1108 (lambda Y1109 (lambda Y1110 (lambda Y1111 (is! Y1106 Y1107 Y1108 Y1109 Y1110 Y1111))))))))) (do (shen.set-lambda-form-entry (cons length (lambda Y1105 (length Y1105)))) (do (shen.set-lambda-form-entry (cons limit (lambda Y1104 (limit Y1104)))) (do (shen.set-lambda-form-entry (cons lineread (lambda Y1103 (lineread Y1103)))) (do (shen.set-lambda-form-entry (cons load (lambda Y1102 (load Y1102)))) (do (shen.set-lambda-form-entry (cons < (lambda Y1100 (lambda Y1101 (< Y1100 Y1101))))) (do (shen.set-lambda-form-entry (cons <= (lambda Y1098 (lambda Y1099 (<= Y1098 Y1099))))) (do (shen.set-lambda-form-entry (cons vector (lambda Y1097 (vector Y1097)))) (do (shen.set-lambda-form-entry (cons macroexpand (lambda Y1096 (macroexpand Y1096)))) (do (shen.set-lambda-form-entry (cons map (lambda Y1094 (lambda Y1095 (map Y1094 Y1095))))) (do (shen.set-lambda-form-entry (cons mapcan (lambda Y1092 (lambda Y1093 (mapcan Y1092 Y1093))))) (do (shen.set-lambda-form-entry (cons maxinferences (lambda Y1091 (maxinferences Y1091)))) (do (shen.set-lambda-form-entry (cons nl (lambda Y1090 (nl Y1090)))) (do (shen.set-lambda-form-entry (cons not (lambda Y1089 (not Y1089)))) (do (shen.set-lambda-form-entry (cons nth (lambda Y1087 (lambda Y1088 (nth Y1087 Y1088))))) (do (shen.set-lambda-form-entry (cons n->string (lambda Y1086 (n->string Y1086)))) (do (shen.set-lambda-form-entry (cons number? (lambda Y1085 (number? Y1085)))) (do (shen.set-lambda-form-entry (cons occurs-check (lambda Y1084 (occurs-check Y1084)))) (do (shen.set-lambda-form-entry (cons occurrences (lambda Y1082 (lambda Y1083 (occurrences Y1082 Y1083))))) (do (shen.set-lambda-form-entry (cons occurs-check (lambda Y1081 (occurs-check Y1081)))) (do (shen.set-lambda-form-entry (cons open (lambda Y1079 (lambda Y1080 (open Y1079 Y1080))))) (do (shen.set-lambda-form-entry (cons optimise (lambda Y1078 (optimise Y1078)))) (do (shen.set-lambda-form-entry (cons or (lambda Y1076 (lambda Y1077 (or Y1076 Y1077))))) (do (shen.set-lambda-form-entry (cons package? (lambda Y1075 (package? Y1075)))) (do (shen.set-lambda-form-entry (cons pos (lambda Y1073 (lambda Y1074 (pos Y1073 Y1074))))) (do (shen.set-lambda-form-entry (cons preclude-all-but (lambda Y1072 (preclude-all-but Y1072)))) (do (shen.set-lambda-form-entry (cons print (lambda Y1071 (print Y1071)))) (do (shen.set-lambda-form-entry (cons profile (lambda Y1070 (profile Y1070)))) (do (shen.set-lambda-form-entry (cons shen.print-prolog-vector (lambda Y1069 (shen.print-prolog-vector Y1069)))) (do (shen.set-lambda-form-entry (cons shen.print-freshterm (lambda Y1068 (shen.print-freshterm Y1068)))) (do (shen.set-lambda-form-entry (cons shen.printF (lambda Y1067 (shen.printF Y1067)))) (do (shen.set-lambda-form-entry (cons prolog-memory (lambda Y1066 (prolog-memory Y1066)))) (do (shen.set-lambda-form-entry (cons profile-results (lambda Y1065 (profile-results Y1065)))) (do (shen.set-lambda-form-entry (cons pr (lambda Y1063 (lambda Y1064 (pr Y1063 Y1064))))) (do (shen.set-lambda-form-entry (cons ps (lambda Y1062 (ps Y1062)))) (do (shen.set-lambda-form-entry (cons preclude (lambda Y1061 (preclude Y1061)))) (do (shen.set-lambda-form-entry (cons preclude-all-but (lambda Y1060 (preclude-all-but Y1060)))) (do (shen.set-lambda-form-entry (cons protect (lambda Y1059 (protect Y1059)))) (do (shen.set-lambda-form-entry (cons put (lambda Y1055 (lambda Y1056 (lambda Y1057 (lambda Y1058 (put Y1055 Y1056 Y1057 Y1058))))))) (do (shen.set-lambda-form-entry (cons read-file-as-string (lambda Y1054 (read-file-as-string Y1054)))) (do (shen.set-lambda-form-entry (cons read-file-as-bytelist (lambda Y1053 (read-file-as-bytelist Y1053)))) (do (shen.set-lambda-form-entry (cons read-file (lambda Y1052 (read-file Y1052)))) (do (shen.set-lambda-form-entry (cons read (lambda Y1051 (read Y1051)))) (do (shen.set-lambda-form-entry (cons read-byte (lambda Y1050 (read-byte Y1050)))) (do (shen.set-lambda-form-entry (cons read-from-string (lambda Y1049 (read-from-string Y1049)))) (do (shen.set-lambda-form-entry (cons read-from-string-unprocessed (lambda Y1048 (read-from-string-unprocessed Y1048)))) (do (shen.set-lambda-form-entry (cons shen.read-unit-string (lambda Y1047 (shen.read-unit-string Y1047)))) (do (shen.set-lambda-form-entry (cons shen.register-source-form (lambda Y1045 (lambda Y1046 (shen.register-source-form Y1045 Y1046))))) (do (shen.set-lambda-form-entry (cons shen.unregister-source-form (lambda Y1044 (shen.unregister-source-form Y1044)))) (do (shen.set-lambda-form-entry (cons remove (lambda Y1042 (lambda Y1043 (remove Y1042 Y1043))))) (do (shen.set-lambda-form-entry (cons reverse (lambda Y1041 (reverse Y1041)))) (do (shen.set-lambda-form-entry (cons set (lambda Y1039 (lambda Y1040 (set Y1039 Y1040))))) (do (shen.set-lambda-form-entry (cons simple-error (lambda Y1038 (simple-error Y1038)))) (do (shen.set-lambda-form-entry (cons snd (lambda Y1037 (snd Y1037)))) (do (shen.set-lambda-form-entry (cons specialise (lambda Y1035 (lambda Y1036 (specialise Y1035 Y1036))))) (do (shen.set-lambda-form-entry (cons spy (lambda Y1034 (spy Y1034)))) (do (shen.set-lambda-form-entry (cons step (lambda Y1033 (step Y1033)))) (do (shen.set-lambda-form-entry (cons str (lambda Y1032 (str Y1032)))) (do (shen.set-lambda-form-entry (cons string->n (lambda Y1031 (string->n Y1031)))) (do (shen.set-lambda-form-entry (cons string->symbol (lambda Y1030 (string->symbol Y1030)))) (do (shen.set-lambda-form-entry (cons string? (lambda Y1029 (string? Y1029)))) (do (shen.set-lambda-form-entry (cons subst (lambda Y1026 (lambda Y1027 (lambda Y1028 (subst Y1026 Y1027 Y1028)))))) (do (shen.set-lambda-form-entry (cons sum (lambda Y1025 (sum Y1025)))) (do (shen.set-lambda-form-entry (cons symbol? (lambda Y1024 (symbol? Y1024)))) (do (shen.set-lambda-form-entry (cons systemf (lambda Y1023 (systemf Y1023)))) (do (shen.set-lambda-form-entry (cons tail (lambda Y1022 (tail Y1022)))) (do (shen.set-lambda-form-entry (cons tl (lambda Y1021 (tl Y1021)))) (do (shen.set-lambda-form-entry (cons tc (lambda Y1020 (tc Y1020)))) (do (shen.set-lambda-form-entry (cons thaw (lambda Y1019 (thaw Y1019)))) (do (shen.set-lambda-form-entry (cons tlstr (lambda Y1018 (tlstr Y1018)))) (do (shen.set-lambda-form-entry (cons track (lambda Y1017 (track Y1017)))) (do (shen.set-lambda-form-entry (cons trap-error (lambda Y1015 (lambda Y1016 (trap-error Y1015 Y1016))))) (do (shen.set-lambda-form-entry (cons tuple? (lambda Y1014 (tuple? Y1014)))) (do (shen.set-lambda-form-entry (cons type (lambda Y1012 (lambda Y1013 (type Y1012 Y1013))))) (do (shen.set-lambda-form-entry (cons return (lambda Y1007 (lambda Y1008 (lambda Y1009 (lambda Y1010 (lambda Y1011 (return Y1007 Y1008 Y1009 Y1010 Y1011)))))))) (do (shen.set-lambda-form-entry (cons unabsolute (lambda Y1006 (unabsolute Y1006)))) (do (shen.set-lambda-form-entry (cons undefmacro (lambda Y1005 (undefmacro Y1005)))) (do (shen.set-lambda-form-entry (cons unput (lambda Y1002 (lambda Y1003 (lambda Y1004 (unput Y1002 Y1003 Y1004)))))) (do (shen.set-lambda-form-entry (cons unprofile (lambda Y1001 (unprofile Y1001)))) (do (shen.set-lambda-form-entry (cons union (lambda Y999 (lambda Y1000 (union Y999 Y1000))))) (do (shen.set-lambda-form-entry (cons untrack (lambda Y998 (untrack Y998)))) (do (shen.set-lambda-form-entry (cons undefmacro (lambda Y997 (undefmacro Y997)))) (do (shen.set-lambda-form-entry (cons update-lambda-table (lambda Y995 (lambda Y996 (update-lambda-table Y995 Y996))))) (do (shen.set-lambda-form-entry (cons vector (lambda Y994 (vector Y994)))) (do (shen.set-lambda-form-entry (cons vector? (lambda Y993 (vector? Y993)))) (do (shen.set-lambda-form-entry (cons vector-> (lambda Y990 (lambda Y991 (lambda Y992 (vector-> Y990 Y991 Y992)))))) (do (shen.set-lambda-form-entry (cons value (lambda Y989 (value Y989)))) (do (shen.set-lambda-form-entry (cons variable? (lambda Y988 (variable? Y988)))) (do (shen.set-lambda-form-entry (cons var? (lambda Y983 (lambda Y984 (lambda Y985 (lambda Y986 (lambda Y987 (var? Y983 Y984 Y985 Y986 Y987)))))))) (do (shen.set-lambda-form-entry (cons when (lambda Y978 (lambda Y979 (lambda Y980 (lambda Y981 (lambda Y982 (when Y978 Y979 Y980 Y981 Y982)))))))) (do (shen.set-lambda-form-entry (cons write-byte (lambda Y976 (lambda Y977 (write-byte Y976 Y977))))) (do (shen.set-lambda-form-entry (cons write-to-file (lambda Y974 (lambda Y975 (write-to-file Y974 Y975))))) (do (shen.set-lambda-form-entry (cons y-or-n? (lambda Y973 (y-or-n? Y973)))) (do (shen.set-lambda-form-entry (cons + (lambda Y971 (lambda Y972 (+ Y971 Y972))))) (do (shen.set-lambda-form-entry (cons * (lambda Y969 (lambda Y970 (* Y969 Y970))))) (do (shen.set-lambda-form-entry (cons / (lambda Y967 (lambda Y968 (/ Y967 Y968))))) (do (shen.set-lambda-form-entry (cons - (lambda Y965 (lambda Y966 (- Y965 Y966))))) (do (shen.set-lambda-form-entry (cons == (lambda Y963 (lambda Y964 (== Y963 Y964))))) (do (shen.set-lambda-form-entry (cons (lambda Y962 ( Y962)))) (do (shen.set-lambda-form-entry (cons (lambda Y961 ( Y961)))) (do (shen.set-lambda-form-entry (cons (lambda Y960 ( Y960)))) (do (shen.set-lambda-form-entry (cons @p (lambda Y958 (lambda Y959 (@p Y958 Y959))))) (do (shen.set-lambda-form-entry (cons @v (lambda Y956 (lambda Y957 (@v Y956 Y957))))) (shen.set-lambda-form-entry (cons @s (lambda Y954 (lambda Y955 (@s Y954 Y955)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) + +(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 b90b24c..d9d87dc 100644 --- a/klambda/load.kl +++ b/klambda/load.kl @@ -1,43 +1,43 @@ -(defun load (V907) (let W908 (value shen.*tc*) (let W909 (let W910 (get-time run) (let W911 (shen.load-help W908 (read-file V907)) (let W912 (get-time run) (let W913 (- W912 W910) (let W914 (pr (cn " -run time: " (cn (str W913) " secs -")) (stoutput)) W911))))) (let W915 (if W908 (pr (cn " +(defun load (V1261) (let W1262 (value shen.*tc*) (let W1263 (let W1264 (get-time run) (let W1265 (shen.load-help W1262 (read-file V1261)) (let W1266 (get-time run) (let W1267 (- W1266 W1264) (let W1268 (pr (cn " +run time: " (cn (str W1267) " secs +")) (stoutput)) W1265))))) (let W1269 (if W1262 (pr (cn " typechecked in " (shen.app (inferences) " inferences " shen.a)) (stoutput)) shen.skip) loaded)))) -(defun shen.load-help (V918 V919) (cond ((= false V918) (shen.eval-and-print V919)) (true (shen.check-eval-and-print V919)))) +(defun shen.load-help (V1272 V1273) (cond ((= false V1272) (shen.eval-and-print V1273)) (true (shen.check-eval-and-print V1273)))) -(defun shen.eval-and-print (V920) (map (lambda Z921 (pr (shen.app (eval-kl (shen.shen->kl Z921)) " -" shen.s) (stoutput))) V920)) +(defun shen.eval-and-print (V1274) (shen.for-each (lambda Z1275 (pr (shen.app (eval-kl (shen.shen->kl Z1275)) " +" shen.s) (stoutput))) V1274)) -(defun shen.check-eval-and-print (V922) (let W923 (mapcan (lambda Z924 (shen.typetable Z924)) V922) (let W925 (trap-error (shen.assumetypes W923) (lambda Z926 (shen.unwind-types Z926 W923))) (trap-error (shen.work-through V922) (lambda Z927 (shen.unwind-types Z927 W923)))))) +(defun shen.check-eval-and-print (V1276) (let W1277 (mapcan (lambda Z1278 (shen.typetable Z1278)) V1276) (let W1279 (trap-error (shen.assumetypes W1277) (lambda Z1280 (shen.unwind-types Z1280 W1277))) (trap-error (shen.work-through V1276) (lambda Z1281 (shen.unwind-types Z1281 W1277)))))) -(defun shen.typetable (V932) (cond ((and (cons? V932) (and (= define (hd V932)) (and (cons? (tl V932)) (and (cons? (tl (tl V932))) (= { (hd (tl (tl V932)))))))) (cons (hd (tl V932)) (cons (shen.rectify-type (shen.type-F (hd (tl V932)) (tl (tl (tl V932))))) ()))) ((and (cons? V932) (and (= define (hd V932)) (cons? (tl V932)))) (simple-error (cn "missing { in " (shen.app (hd (tl V932)) " +(defun shen.typetable (V1286) (cond ((and (cons? V1286) (and (= define (hd V1286)) (and (cons? (tl V1286)) (and (cons? (tl (tl V1286))) (= { (hd (tl (tl V1286)))))))) (cons (hd (tl V1286)) (cons (shen.rectify-type (shen.type-F (hd (tl V1286)) (tl (tl (tl V1286))))) ()))) ((and (cons? V1286) (and (= define (hd V1286)) (cons? (tl V1286)))) (simple-error (cn "missing { in " (shen.app (hd (tl V1286)) " " shen.a)))) (true ()))) -(defun shen.type-F (V939 V940) (cond ((and (cons? V940) (= } (hd V940))) ()) ((cons? V940) (cons (hd V940) (shen.type-F V939 (tl V940)))) (true (simple-error (cn "missing } in " (shen.app V939 " +(defun shen.type-F (V1293 V1294) (cond ((and (cons? V1294) (= } (hd V1294))) ()) ((cons? V1294) (cons (hd V1294) (shen.type-F V1293 (tl V1294)))) (true (simple-error (cn "missing } in " (shen.app V1293 " " shen.a)))))) -(defun shen.assumetypes (V943) (cond ((= () V943) ()) ((and (cons? V943) (cons? (tl V943))) (do (declare (hd V943) (hd (tl V943))) (shen.assumetypes (tl (tl V943))))) (true (simple-error "implementation error in shen.assumetype")))) +(defun shen.assumetypes (V1297) (cond ((= () V1297) ()) ((and (cons? V1297) (cons? (tl V1297))) (do (declare (hd V1297) (hd (tl V1297))) (shen.assumetypes (tl (tl V1297))))) (true (simple-error "implementation error in shen.assumetype")))) -(defun shen.unwind-types (V948 V949) (cond ((and (cons? V949) (cons? (tl V949))) (do (destroy (hd V949)) (shen.unwind-types V948 (tl (tl V949))))) (true (simple-error (error-to-string V948))))) +(defun shen.unwind-types (V1302 V1303) (cond ((and (cons? V1303) (cons? (tl V1303))) (do (destroy (hd V1303)) (shen.unwind-types V1302 (tl (tl V1303))))) (true (simple-error (error-to-string V1302))))) -(defun shen.work-through (V952) (cond ((= () V952) ()) ((and (cons? V952) (and (cons? (tl V952)) (and (cons? (tl (tl V952))) (= (hd (tl V952)) (intern ":"))))) (let W953 (shen.typecheck (hd V952) (hd (tl (tl V952)))) (if (= W953 false) (shen.type-error) (let W954 (eval-kl (shen.shen->kl (hd V952))) (let W955 (pr (shen.app W954 (cn " : " (shen.app (shen.pretty-type W953) " -" shen.r)) shen.s) (stoutput)) (shen.work-through (tl (tl (tl V952))))))))) ((cons? V952) (shen.work-through (cons (hd V952) (cons (intern ":") (cons A (tl V952)))))) (true (simple-error "implementation error in shen.work-through")))) +(defun shen.work-through (V1306) (cond ((= () V1306) ()) ((and (cons? V1306) (and (cons? (tl V1306)) (and (cons? (tl (tl V1306))) (= (hd (tl V1306)) (intern ":"))))) (let W1307 (shen.typecheck (hd V1306) (hd (tl (tl V1306)))) (if (= W1307 false) (shen.type-error) (let W1308 (eval-kl (shen.shen->kl (hd V1306))) (let W1309 (pr (shen.app W1308 (cn " : " (shen.app (shen.pretty-type W1307) " +" shen.r)) shen.s) (stoutput)) (shen.work-through (tl (tl (tl V1306))))))))) ((cons? V1306) (shen.work-through (cons (hd V1306) (cons (intern ":") (cons A (tl V1306)))))) (true (simple-error "implementation error in shen.work-through")))) -(defun shen.pretty-type (V957) (cond ((and (cons? V957) (and (cons? (hd V957)) (and (= list (hd (hd V957))) (and (cons? (tl (hd V957))) (and (= () (tl (tl (hd V957)))) (and (cons? (tl V957)) (and (= --> (hd (tl V957))) (and (cons? (tl (tl V957))) (and (cons? (hd (tl (tl V957)))) (and (= str (hd (hd (tl (tl V957))))) (and (cons? (tl (hd (tl (tl V957))))) (and (cons? (hd (tl (hd (tl (tl V957)))))) (and (= list (hd (hd (tl (hd (tl (tl V957))))))) (and (cons? (tl (hd (tl (hd (tl (tl V957))))))) (and (= () (tl (tl (hd (tl (hd (tl (tl V957)))))))) (and (cons? (tl (tl (hd (tl (tl V957)))))) (and (= () (tl (tl (tl (hd (tl (tl V957))))))) (and (= () (tl (tl (tl V957)))) (= (hd (tl (hd V957))) (hd (tl (hd (tl (hd (tl (tl V957)))))))))))))))))))))))))) (cons (hd (tl (hd (tl (tl V957))))) (cons ==> (tl (tl (hd (tl (tl V957)))))))) ((cons? V957) (map (lambda Z958 (shen.pretty-type Z958)) V957)) (true V957))) +(defun shen.pretty-type (V1311) (cond ((and (cons? V1311) (and (cons? (hd V1311)) (and (= list (hd (hd V1311))) (and (cons? (tl (hd V1311))) (and (= () (tl (tl (hd V1311)))) (and (cons? (tl V1311)) (and (= --> (hd (tl V1311))) (and (cons? (tl (tl V1311))) (and (cons? (hd (tl (tl V1311)))) (and (= str (hd (hd (tl (tl V1311))))) (and (cons? (tl (hd (tl (tl V1311))))) (and (cons? (hd (tl (hd (tl (tl V1311)))))) (and (= list (hd (hd (tl (hd (tl (tl V1311))))))) (and (cons? (tl (hd (tl (hd (tl (tl V1311))))))) (and (= () (tl (tl (hd (tl (hd (tl (tl V1311)))))))) (and (cons? (tl (tl (hd (tl (tl V1311)))))) (and (= () (tl (tl (tl (hd (tl (tl V1311))))))) (and (= () (tl (tl (tl V1311)))) (= (hd (tl (hd V1311))) (hd (tl (hd (tl (hd (tl (tl V1311)))))))))))))))))))))))))) (cons (hd (tl (hd (tl (tl V1311))))) (cons ==> (tl (tl (hd (tl (tl V1311)))))))) ((cons? V1311) (map (lambda Z1312 (shen.pretty-type Z1312)) V1311)) (true V1311))) (defun shen.type-error () (simple-error "type error ")) -(defun bootstrap (V959) (let W960 (shen.klfile V959) (let W961 (read-file V959) (let W962 (open W960 out) (let W963 (map (lambda Z964 (shen.partial (shen.shen->kl-h Z964))) W961) (let W965 (shen.write-kl W963 W962) W960)))))) +(defun bootstrap (V1313) (let W1314 (shen.klfile V1313) (let W1315 (read-file V1313) (let W1316 (open W1314 out) (let W1317 (map (lambda Z1318 (shen.partial (shen.shen->kl-h Z1318))) W1315) (let W1319 (shen.write-kl W1317 W1316) W1314)))))) -(defun shen.partial (V966) (cond ((and (cons? V966) (and (= shen.f-error (hd V966)) (and (cons? (tl V966)) (= () (tl (tl V966)))))) (cons simple-error (cons (cn "partial function " (str (hd (tl V966)))) ()))) ((cons? V966) (map (lambda Z967 (shen.partial Z967)) V966)) (true V966))) +(defun shen.partial (V1320) (cond ((and (cons? V1320) (and (= shen.f-error (hd V1320)) (and (cons? (tl V1320)) (= () (tl (tl V1320)))))) (cons simple-error (cons (cn "partial function " (str (hd (tl V1320)))) ()))) ((cons? V1320) (map (lambda Z1321 (shen.partial Z1321)) V1320)) (true V1320))) -(defun shen.write-kl (V970 V971) (cond ((= () V970) (close V971)) ((and (cons? V970) (cons? (hd V970))) (shen.write-kl (tl V970) (do (shen.write-kl-h (hd V970) V971) V971))) ((cons? V970) (shen.write-kl (tl V970) V971)) (true (simple-error "partial function shen.write-kl")))) +(defun shen.write-kl (V1324 V1325) (cond ((= () V1324) (close V1325)) ((and (cons? V1324) (cons? (hd V1324))) (shen.write-kl (tl V1324) (do (shen.write-kl-h (hd V1324) V1325) V1325))) ((cons? V1324) (shen.write-kl (tl V1324) V1325)) (true (shen.f-error shen.write-kl)))) -(defun shen.write-kl-h (V974 V975) (cond ((and (cons? V974) (and (= defun (hd V974)) (and (cons? (tl V974)) (and (= fail (hd (tl V974))) (and (cons? (tl (tl V974))) (and (= () (hd (tl (tl V974)))) (and (cons? (tl (tl (tl V974)))) (= () (tl (tl (tl (tl V974)))))))))))) (pr "(defun fail () shen.fail!)" V975)) (true (pr (shen.app V974 " +(defun shen.write-kl-h (V1328 V1329) (cond ((and (cons? V1328) (and (= defun (hd V1328)) (and (cons? (tl V1328)) (and (= fail (hd (tl V1328))) (and (cons? (tl (tl V1328))) (and (= () (hd (tl (tl V1328)))) (and (cons? (tl (tl (tl V1328)))) (= () (tl (tl (tl (tl V1328)))))))))))) (pr "(defun fail () shen.fail!)" V1329)) (true (pr (shen.app V1328 " -" shen.r) V975)))) +" shen.r) V1329)))) -(defun shen.klfile (V976) (cond ((= "" V976) ".kl") ((= ".shen" V976) ".kl") ((shen.+string? V976) (@s (hdstr V976) (shen.klfile (tlstr V976)))) (true (simple-error "partial function shen.klfile")))) +(defun shen.klfile (V1330) (cond ((= "" V1330) ".kl") ((= ".shen" V1330) ".kl") ((shen.+string? V1330) (@s (hdstr V1330) (shen.klfile (tlstr V1330)))) (true (shen.f-error shen.klfile)))) diff --git a/klambda/macros.kl b/klambda/macros.kl index 79e9a1c..0cff0e9 100644 --- a/klambda/macros.kl +++ b/klambda/macros.kl @@ -1,65 +1,69 @@ -(defun macroexpand (V5824) (let W5825 (map (lambda Z5826 (tl Z5826)) (value *macros*)) (shen.macroexpand-h V5824 W5825 W5825))) +(defun macroexpand (V7069) (let W7070 (map (lambda Z7071 (tl Z7071)) (value *macros*)) (shen.macroexpand-h V7069 W7070 W7070 (value shen.*source-form-handlers*)))) -(defun shen.macroexpand-h (V5835 V5836 V5837) (if (= () V5836) V5835 (if (cons? V5836) (let W5838 (shen.walk (hd V5836) V5835) (if (= V5835 W5838) (shen.macroexpand-h V5835 (tl V5836) V5837) (shen.macroexpand-h W5838 V5837 V5837))) (simple-error "implementation error in shen.macroexpand-h")))) +(defun shen.macroexpand-h (V7084 V7085 V7086 V7087) (if (= () V7085) V7084 (if (cons? V7085) (let W7088 (shen.source-macro-walk (hd V7085) V7084 V7087) (if (= V7084 W7088) (shen.macroexpand-h V7084 (tl V7085) V7086 V7087) (shen.macroexpand-h W7088 V7086 V7086 V7087))) (simple-error "implementation error in shen.macroexpand-h")))) -(defun shen.walk (V5839 V5840) (if (cons? V5840) (V5839 (map (lambda Z5841 (shen.walk V5839 Z5841)) V5840)) (V5839 V5840))) +(defun shen.source-macro-walk (V7092 V7093 V7094) (if (= () V7094) (shen.walk V7092 V7093) (if (cons? (shen.source-form-handler V7093 V7094)) V7093 (if (cons? V7093) (V7092 (map (lambda Z7095 (shen.source-macro-walk V7092 Z7095 V7094)) V7093)) (V7092 V7093))))) -(defun shen.macros (V5842) (let GoTo5843 (freeze V5842) (if (cons? V5842) (let Select5848 (hd V5842) (let Select5849 (tl V5842) (if (and (= defmacro Select5848) (cons? Select5849)) (shen.process-def (hd Select5849) (tl Select5849)) (if (= defcc Select5848) (shen.yacc->shen Select5849) (if (and (= u! Select5848) (and (cons? Select5849) (= () (tl Select5849)))) (cons protect (cons (shen.make-uppercase (hd Select5849)) ())) (if (and (= error Select5848) (cons? Select5849)) (cons simple-error (cons (shen.mkstr (hd Select5849) (tl Select5849)) ())) (if (and (= output Select5848) (cons? Select5849)) (cons pr (cons (shen.mkstr (hd Select5849) (tl Select5849)) (cons (cons stoutput ()) ()))) (if (and (= pr Select5848) (and (cons? Select5849) (= () (tl Select5849)))) (cons pr (cons (hd Select5849) (cons (cons stoutput ()) ()))) (if (and (= make-string Select5848) (cons? Select5849)) (shen.mkstr (hd Select5849) (tl Select5849)) (if (and (= lineread Select5848) (= () Select5849)) (cons lineread (cons (cons stinput ()) ())) (if (and (= input Select5848) (= () Select5849)) (cons input (cons (cons stinput ()) ())) (if (and (= read Select5848) (= () Select5849)) (cons read (cons (cons stinput ()) ())) (if (and (= input+ Select5848) (cons? Select5849)) (shen.process-input+ V5842) (if (and (= read-byte Select5848) (= () Select5849)) (shen.process-read-byte) (if (= prolog? Select5848) (shen.call-prolog Select5849) (if (and (= defprolog Select5848) (cons? Select5849)) (shen.compile-prolog (hd Select5849) (tl Select5849)) (if (and (= datatype Select5848) (cons? Select5849)) (shen.process-datatype (hd Select5849) (tl Select5849)) (if (= @s Select5848) (shen.process-@s V5842) (if (= synonyms Select5848) (shen.process-synonyms Select5849) (if (and (= nl Select5848) (= () Select5849)) (cons nl (cons 1 ())) (if (= let Select5848) (shen.process-let V5842) (if (= /. Select5848) (shen.process-lambda V5842) (if (= cases Select5848) (shen.process-cases V5842) (if (and (= time Select5848) (and (cons? Select5849) (= () (tl Select5849)))) (shen.process-time (hd Select5849)) (if (and (= put Select5848) (and (cons? Select5849) (and (cons? (tl Select5849)) (and (cons? (tl (tl Select5849))) (= () (tl (tl (tl Select5849)))))))) (cons put (cons (hd Select5849) (cons (hd (tl Select5849)) (cons (hd (tl (tl Select5849))) (cons (cons value (cons *property-vector* ())) ()))))) (if (and (= get Select5848) (and (cons? Select5849) (and (cons? (tl Select5849)) (= () (tl (tl Select5849)))))) (cons get (cons (hd Select5849) (cons (hd (tl Select5849)) (cons (cons value (cons *property-vector* ())) ())))) (if (and (= unput Select5848) (and (cons? Select5849) (and (cons? (tl Select5849)) (= () (tl (tl Select5849)))))) (cons unput (cons (hd Select5849) (cons (hd (tl Select5849)) (cons (cons value (cons *property-vector* ())) ())))) (if (and (= shen.@c Select5848) (and (cons? Select5849) (= () (tl Select5849)))) (shen.rcons_form (hd Select5849)) (let GoTo5844 (freeze (if (and (cons? Select5849) (and (cons? (tl Select5849)) (and (cons? (tl (tl Select5849))) (element? Select5848 (cons @p (cons @v (cons append (cons and (cons or (cons + (cons * (cons do ())))))))))))) (cons Select5848 (cons (hd Select5849) (cons (shen.process-assoc (cons Select5848 (tl Select5849))) ()))) (thaw GoTo5843))) (if (= shen.@ch Select5848) (if (cons? Select5849) (let Select5846 (hd Select5849) (let Select5847 (tl Select5849) (if (and (cons? Select5846) (and (cons? (tl Select5846)) (and (cons? (tl (tl Select5846))) (and (= () (tl (tl (tl Select5846)))) (and (= () Select5847) (= (hd (tl Select5846)) (intern ":"))))))) (shen.cons-form-respect-modes (cons - (cons (cons (hd Select5846) (cons (hd (tl Select5846)) (cons (cons + (tl (tl Select5846))) ()))) ()))) (if (= () Select5847) (shen.cons-form-respect-modes Select5846) (thaw GoTo5844))))) (thaw GoTo5844)) (thaw GoTo5844))))))))))))))))))))))))))))))) (thaw GoTo5843)))) +(defun shen.walk (V7096 V7097) (if (cons? V7097) (V7096 (map (lambda Z7098 (shen.walk V7096 Z7098)) V7097)) (V7096 V7097))) -(defun shen.process-input+ (V5850) (let GoTo5851 (freeze (simple-error "partial function shen.process-input+")) (if (cons? V5850) (let Select5856 (tl V5850) (if (= input+ (hd V5850)) (if (cons? Select5856) (let Select5854 (hd Select5856) (let Select5855 (tl Select5856) (if (= () Select5855) (cons shen.input-h+ (cons (shen.rcons_form Select5854) (cons (cons stinput ()) ()))) (if (and (cons? Select5855) (= () (tl Select5855))) (cons shen.input-h+ (cons (shen.rcons_form Select5854) Select5855)) (thaw GoTo5851))))) (thaw GoTo5851)) (thaw GoTo5851))) (thaw GoTo5851)))) +(defun shen.macros (V7099) (let GoTo7100 (freeze V7099) (if (cons? V7099) (let Select7105 (hd V7099) (let Select7106 (tl V7099) (if (and (= defmacro Select7105) (cons? Select7106)) (shen.process-def (hd Select7106) (tl Select7106)) (if (= defcc Select7105) (shen.yacc->shen Select7106) (if (and (= u! Select7105) (and (cons? Select7106) (= () (tl Select7106)))) (cons protect (cons (shen.make-uppercase (hd Select7106)) ())) (if (and (= error Select7105) (cons? Select7106)) (cons simple-error (cons (shen.mkstr (hd Select7106) (tl Select7106)) ())) (if (and (= output Select7105) (cons? Select7106)) (cons pr (cons (shen.mkstr (hd Select7106) (tl Select7106)) (cons (cons stoutput ()) ()))) (if (and (= pr Select7105) (and (cons? Select7106) (= () (tl Select7106)))) (cons pr (cons (hd Select7106) (cons (cons stoutput ()) ()))) (if (and (= make-string Select7105) (cons? Select7106)) (shen.mkstr (hd Select7106) (tl Select7106)) (if (and (= lineread Select7105) (= () Select7106)) (cons lineread (cons (cons stinput ()) ())) (if (and (= input Select7105) (= () Select7106)) (cons input (cons (cons stinput ()) ())) (if (and (= read Select7105) (= () Select7106)) (cons read (cons (cons stinput ()) ())) (if (and (= input+ Select7105) (cons? Select7106)) (shen.process-input+ V7099) (if (and (= read-byte Select7105) (= () Select7106)) (shen.process-read-byte) (if (= prolog? Select7105) (shen.call-prolog Select7106) (if (and (= defprolog Select7105) (cons? Select7106)) (shen.compile-prolog (hd Select7106) (tl Select7106)) (if (and (= datatype Select7105) (cons? Select7106)) (shen.process-datatype (hd Select7106) (tl Select7106)) (if (= @s Select7105) (shen.process-@s V7099) (if (= synonyms Select7105) (shen.process-synonyms Select7106) (if (and (= nl Select7105) (= () Select7106)) (cons nl (cons 1 ())) (if (= let Select7105) (shen.process-let V7099) (if (= /. Select7105) (shen.process-lambda V7099) (if (= cases Select7105) (shen.process-cases V7099) (if (and (= time Select7105) (and (cons? Select7106) (= () (tl Select7106)))) (shen.process-time (hd Select7106)) (if (and (= put Select7105) (and (cons? Select7106) (and (cons? (tl Select7106)) (and (cons? (tl (tl Select7106))) (= () (tl (tl (tl Select7106)))))))) (cons put (cons (hd Select7106) (cons (hd (tl Select7106)) (cons (hd (tl (tl Select7106))) (cons (cons value (cons *property-vector* ())) ()))))) (if (and (= get Select7105) (and (cons? Select7106) (and (cons? (tl Select7106)) (= () (tl (tl Select7106)))))) (cons get (cons (hd Select7106) (cons (hd (tl Select7106)) (cons (cons value (cons *property-vector* ())) ())))) (if (and (= unput Select7105) (and (cons? Select7106) (and (cons? (tl Select7106)) (= () (tl (tl Select7106)))))) (cons unput (cons (hd Select7106) (cons (hd (tl Select7106)) (cons (cons value (cons *property-vector* ())) ())))) (if (and (= shen.@c Select7105) (and (cons? Select7106) (= () (tl Select7106)))) (shen.rcons_form (hd Select7106)) (let GoTo7101 (freeze (if (and (cons? Select7106) (and (cons? (tl Select7106)) (and (cons? (tl (tl Select7106))) (element? Select7105 (cons @p (cons @v (cons append (cons and (cons or (cons + (cons * (cons do ())))))))))))) (cons Select7105 (cons (hd Select7106) (cons (shen.process-assoc (cons Select7105 (tl Select7106))) ()))) (thaw GoTo7100))) (if (= shen.@ch Select7105) (if (cons? Select7106) (let Select7103 (hd Select7106) (let Select7104 (tl Select7106) (if (and (cons? Select7103) (and (cons? (tl Select7103)) (and (cons? (tl (tl Select7103))) (and (= () (tl (tl (tl Select7103)))) (and (= () Select7104) (= (hd (tl Select7103)) (intern ":"))))))) (shen.cons-form-respect-modes (cons - (cons (cons (hd Select7103) (cons (hd (tl Select7103)) (cons (cons + (tl (tl Select7103))) ()))) ()))) (if (= () Select7104) (shen.cons-form-respect-modes Select7103) (thaw GoTo7101))))) (thaw GoTo7101)) (thaw GoTo7101))))))))))))))))))))))))))))))) (thaw GoTo7100)))) -(defun shen.cons-form-respect-modes (V5857) (let GoTo5858 (freeze V5857) (if (cons? V5857) (let Select5859 (hd V5857) (let Select5860 (tl V5857) (if (and (= + Select5859) (and (cons? Select5860) (= () (tl Select5860)))) (cons + (cons (shen.cons-form-respect-modes (hd Select5860)) ())) (if (and (= - Select5859) (and (cons? Select5860) (= () (tl Select5860)))) (cons - (cons (shen.cons-form-respect-modes (hd Select5860)) ())) (cons cons (cons (shen.cons-form-respect-modes Select5859) (cons (shen.cons-form-respect-modes Select5860) ()))))))) (thaw GoTo5858)))) +(defun shen.process-input+ (V7107) (let GoTo7108 (freeze (shen.f-error shen.process-input+)) (if (cons? V7107) (let Select7113 (tl V7107) (if (= input+ (hd V7107)) (if (cons? Select7113) (let Select7111 (hd Select7113) (let Select7112 (tl Select7113) (if (= () Select7112) (cons shen.input-h+ (cons (shen.rcons_form Select7111) (cons (cons stinput ()) ()))) (if (and (cons? Select7112) (= () (tl Select7112))) (cons shen.input-h+ (cons (shen.rcons_form Select7111) Select7112)) (thaw GoTo7108))))) (thaw GoTo7108)) (thaw GoTo7108))) (thaw GoTo7108)))) -(defun shen.process-def (V5861 V5862) (let W5863 (cons X (cons -> (cons X ()))) (let W5864 (eval (cons define (cons V5861 (append V5862 W5863)))) (let W5865 (shen.record-macro V5861 (fn V5861)) V5861)))) +(defun shen.cons-form-respect-modes (V7114) (let GoTo7115 (freeze V7114) (if (cons? V7114) (let Select7116 (hd V7114) (let Select7117 (tl V7114) (if (and (= + Select7116) (and (cons? Select7117) (= () (tl Select7117)))) (cons + (cons (shen.cons-form-respect-modes (hd Select7117)) ())) (if (and (= - Select7116) (and (cons? Select7117) (= () (tl Select7117)))) (cons - (cons (shen.cons-form-respect-modes (hd Select7117)) ())) (cons cons (cons (shen.cons-form-respect-modes Select7116) (cons (shen.cons-form-respect-modes Select7117) ()))))))) (thaw GoTo7115)))) -(defun shen.process-let (V5866) (if (and (cons? V5866) (and (= let (hd V5866)) (and (cons? (tl V5866)) (and (cons? (tl (tl V5866))) (and (cons? (tl (tl (tl V5866)))) (cons? (tl (tl (tl (tl V5866)))))))))) (cons let (cons (hd (tl V5866)) (cons (hd (tl (tl V5866))) (cons (cons let (tl (tl (tl V5866)))) ())))) V5866)) +(defun shen.process-def (V7118 V7119) (let W7120 (cons X (cons -> (cons X ()))) (let W7121 (eval (cons define (cons V7118 (append V7119 W7120)))) (let W7122 (shen.record-macro V7118 (fn V7118)) V7118)))) -(defun shen.process-@s (V5867) (let GoTo5869 (freeze V5867) (if (cons? V5867) (let Select5876 (tl V5867) (if (= @s (hd V5867)) (if (cons? Select5876) (let Select5874 (hd Select5876) (let Select5875 (tl Select5876) (if (cons? Select5875) (let Select5873 (tl Select5875) (if (cons? Select5873) (cons @s (cons Select5874 (cons (shen.process-@s (cons @s Select5875)) ()))) (if (and (= () Select5873) (string? Select5874)) (let W5868 (explode Select5874) (if (> (length W5868) 1) (shen.process-@s (cons @s (append W5868 Select5875))) V5867)) (thaw GoTo5869)))) (thaw GoTo5869)))) (thaw GoTo5869)) (thaw GoTo5869))) (thaw GoTo5869)))) +(defun shen.process-let (V7123) (if (and (cons? V7123) (and (= let (hd V7123)) (and (cons? (tl V7123)) (and (cons? (tl (tl V7123))) (and (cons? (tl (tl (tl V7123)))) (cons? (tl (tl (tl (tl V7123)))))))))) (cons let (cons (hd (tl V7123)) (cons (hd (tl (tl V7123))) (cons (cons let (tl (tl (tl V7123)))) ())))) V7123)) -(defun shen.process-datatype (V5877 V5878) (let W5879 (shen.intern-type V5877) (let W5880 (compile (lambda Z5881 (shen. Z5881)) (cons W5879 V5878)) W5879))) +(defun shen.process-@s (V7124) (let GoTo7126 (freeze V7124) (if (cons? V7124) (let Select7133 (tl V7124) (if (= @s (hd V7124)) (if (cons? Select7133) (let Select7131 (hd Select7133) (let Select7132 (tl Select7133) (if (cons? Select7132) (let Select7130 (tl Select7132) (if (cons? Select7130) (cons @s (cons Select7131 (cons (shen.process-@s (cons @s Select7132)) ()))) (if (and (= () Select7130) (string? Select7131)) (let W7125 (explode Select7131) (if (> (length W7125) 1) (shen.process-@s (cons @s (append W7125 Select7132))) V7124)) (thaw GoTo7126)))) (thaw GoTo7126)))) (thaw GoTo7126)) (thaw GoTo7126))) (thaw GoTo7126)))) -(defun shen.intern-type (V5882) (intern (cn (str V5882) "#type"))) +(defun shen.process-datatype (V7134 V7135) (let W7136 (shen.intern-type V7134) (let W7137 (compile (lambda Z7138 (shen. Z7138)) (cons W7136 V7135)) W7136))) -(defun shen.process-synonyms (V5883) (shen.synonyms-h (set shen.*synonyms* (append V5883 (value shen.*synonyms*))))) +(defun shen.intern-type (V7139) (intern (cn (str V7139) "#type"))) -(defun shen.synonyms-h (V5884) (let W5885 (map (lambda Z5886 (shen.curry-type Z5886)) V5884) (let W5887 (eval (cons define (cons shen.demod (shen.compile-synonyms W5885)))) synonyms))) +(defun shen.process-synonyms (V7140) (shen.synonyms-h (set shen.*synonyms* (append V7140 (value shen.*synonyms*))))) -(defun shen.compile-synonyms (V5890) (if (= () V5890) (let W5891 (gensym X) (cons W5891 (cons -> (cons W5891 ())))) (if (and (cons? V5890) (cons? (tl V5890))) (cons (shen.rcons_form (hd V5890)) (cons -> (cons (shen.rcons_form (hd (tl V5890))) (shen.compile-synonyms (tl (tl V5890)))))) (simple-error "synonyms requires an even number of arguments +(defun shen.lambda-of-defun (V7143) (if (and (cons? V7143) (and (= defun (hd V7143)) (and (cons? (tl V7143)) (and (cons? (tl (tl V7143))) (and (cons? (hd (tl (tl V7143)))) (and (= () (tl (hd (tl (tl V7143))))) (and (cons? (tl (tl (tl V7143)))) (= () (tl (tl (tl (tl V7143)))))))))))) (eval (cons /. (cons (hd (hd (tl (tl V7143)))) (tl (tl (tl V7143)))))) (shen.f-error shen.lambda-of-defun))) + +(defun shen.synonyms-h (V7144) (let W7145 (map (lambda Z7146 (shen.curry-type Z7146)) V7144) (let W7147 (shen.lambda-of-defun (shen.shendef->kldef shen.demod (shen.compile-synonyms W7145))) (let W7148 (set shen.*demodulation-function* W7147) synonyms)))) + +(defun shen.compile-synonyms (V7151) (if (= () V7151) (let W7152 (gensym X) (cons W7152 (cons -> (cons W7152 ())))) (if (and (cons? V7151) (cons? (tl V7151))) (cons (shen.rcons_form (hd V7151)) (cons -> (cons (shen.rcons_form (hd (tl V7151))) (shen.compile-synonyms (tl (tl V7151)))))) (simple-error "synonyms requires an even number of arguments ")))) -(defun shen.process-lambda (V5892) (let GoTo5893 (freeze V5892) (if (cons? V5892) (let Select5900 (tl V5892) (if (= /. (hd V5892)) (if (cons? Select5900) (let Select5898 (hd Select5900) (let Select5899 (tl Select5900) (if (cons? Select5899) (let Select5897 (tl Select5899) (if (cons? Select5897) (cons lambda (cons Select5898 (cons (shen.process-lambda (cons /. Select5899)) ()))) (if (= () Select5897) (if (variable? Select5898) (cons lambda Select5900) (simple-error (shen.app Select5898 " is not a variable -" shen.s))) (thaw GoTo5893)))) (thaw GoTo5893)))) (thaw GoTo5893)) (thaw GoTo5893))) (thaw GoTo5893)))) +(defun shen.process-lambda (V7153) (let GoTo7154 (freeze V7153) (if (cons? V7153) (let Select7161 (tl V7153) (if (= /. (hd V7153)) (if (cons? Select7161) (let Select7159 (hd Select7161) (let Select7160 (tl Select7161) (if (cons? Select7160) (let Select7158 (tl Select7160) (if (cons? Select7158) (cons lambda (cons Select7159 (cons (shen.process-lambda (cons /. Select7160)) ()))) (if (= () Select7158) (if (variable? Select7159) (cons lambda Select7161) (simple-error (shen.app Select7159 " is not a variable +" shen.s))) (thaw GoTo7154)))) (thaw GoTo7154)))) (thaw GoTo7154)) (thaw GoTo7154))) (thaw GoTo7154)))) -(defun shen.process-cases (V5903) (let GoTo5904 (freeze V5903) (if (cons? V5903) (let Select5912 (tl V5903) (if (= cases (hd V5903)) (if (cons? Select5912) (let Select5910 (hd Select5912) (let Select5911 (tl Select5912) (if (and (= true Select5910) (cons? Select5911)) (hd Select5911) (let GoTo5907 (freeze (if (= () Select5911) (simple-error "error: odd number of case elements -") (thaw GoTo5904))) (if (cons? Select5911) (let Select5908 (hd Select5911) (let Select5909 (tl Select5911) (if (= () Select5909) (cons if (cons Select5910 (cons Select5908 (cons (cons simple-error (cons "error: cases exhausted" ())) ())))) (cons if (cons Select5910 (cons Select5908 (cons (shen.process-cases (cons cases Select5909)) ()))))))) (thaw GoTo5907)))))) (thaw GoTo5904)) (thaw GoTo5904))) (thaw GoTo5904)))) +(defun shen.process-cases (V7164) (let GoTo7165 (freeze V7164) (if (cons? V7164) (let Select7173 (tl V7164) (if (= cases (hd V7164)) (if (cons? Select7173) (let Select7171 (hd Select7173) (let Select7172 (tl Select7173) (if (and (= true Select7171) (cons? Select7172)) (hd Select7172) (let GoTo7168 (freeze (if (= () Select7172) (simple-error "error: odd number of case elements +") (thaw GoTo7165))) (if (cons? Select7172) (let Select7169 (hd Select7172) (let Select7170 (tl Select7172) (if (= () Select7170) (cons if (cons Select7171 (cons Select7169 (cons (cons simple-error (cons "error: cases exhausted" ())) ())))) (cons if (cons Select7171 (cons Select7169 (cons (shen.process-cases (cons cases Select7170)) ()))))))) (thaw GoTo7168)))))) (thaw GoTo7165)) (thaw GoTo7165))) (thaw GoTo7165)))) -(defun shen.process-time (V5913) (cons let (cons Start (cons (cons get-time (cons run ())) (cons Result (cons V5913 (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 (V7174) (cons let (cons Start (cons (cons get-time (cons run ())) (cons Result (cons V7174 (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 (V5914) (if (and (cons? V5914) (and (cons? (tl V5914)) (and (cons? (tl (tl V5914))) (cons? (tl (tl (tl V5914))))))) (cons (hd V5914) (cons (hd (tl V5914)) (cons (cons (hd V5914) (tl (tl V5914))) ()))) V5914)) +(defun shen.process-assoc (V7175) (if (and (cons? V7175) (and (cons? (tl V7175)) (and (cons? (tl (tl V7175))) (cons? (tl (tl (tl V7175))))))) (cons (hd V7175) (cons (hd (tl V7175)) (cons (cons (hd V7175) (tl (tl V7175))) ()))) V7175)) -(defun shen.make-uppercase (V5915) (intern (shen.mu-h (str V5915)))) +(defun shen.make-uppercase (V7176) (intern (shen.mu-h (str V7176)))) -(defun shen.mu-h (V5916) (if (= "" V5916) "" (if (shen.+string? V5916) (let W5917 (string->n (hdstr V5916)) (let W5918 (- W5917 32) (let W5919 (if (and (>= W5917 97) (<= W5917 122)) (n->string W5918) (hdstr V5916)) (@s W5919 (shen.mu-h (tlstr V5916)))))) (simple-error "partial function shen.mu-h")))) +(defun shen.mu-h (V7177) (if (= "" V7177) "" (if (shen.+string? V7177) (let W7178 (string->n (hdstr V7177)) (let W7179 (- W7178 32) (let W7180 (if (and (>= W7178 97) (<= W7178 122)) (n->string W7179) (hdstr V7177)) (@s W7180 (shen.mu-h (tlstr V7177)))))) (shen.f-error shen.mu-h)))) -(defun shen.record-macro (V5920 V5921) (set *macros* (shen.update-assoc V5920 V5921 (value *macros*)))) +(defun shen.record-macro (V7181 V7182) (set *macros* (shen.update-assoc V7181 V7182 (value *macros*)))) -(defun shen.update-assoc (V5931 V5932 V5933) (if (= () V5933) (cons (cons V5931 V5932) ()) (let GoTo5934 (freeze (simple-error "implementation error in shen.update-assoc")) (if (cons? V5933) (let Select5935 (hd V5933) (let Select5936 (tl V5933) (if (and (cons? Select5935) (= V5931 (hd Select5935))) (cons (cons (hd Select5935) V5932) Select5936) (cons Select5935 (shen.update-assoc V5931 V5932 Select5936))))) (thaw GoTo5934))))) +(defun shen.update-assoc (V7192 V7193 V7194) (if (= () V7194) (cons (cons V7192 V7193) ()) (let GoTo7195 (freeze (simple-error "implementation error in shen.update-assoc")) (if (cons? V7194) (let Select7196 (hd V7194) (let Select7197 (tl V7194) (if (and (cons? Select7196) (= V7192 (hd Select7196))) (cons (cons (hd Select7196) V7193) Select7197) (cons Select7196 (shen.update-assoc V7192 V7193 Select7197))))) (thaw GoTo7195))))) (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 (V5937) (let W5938 (cons shen.prolog-vector ()) (let W5939 (cons @v (cons true (cons 0 (cons (cons vector (cons 0 ())) ())))) (let W5940 0 (let W5941 (cons freeze (cons true ())) (let W5942 (compile (lambda Z5943 (shen. Z5943)) V5937) (let W5944 (shen.received V5937) (let W5945 (gensym V) (let W5946 (gensym L) (let W5947 (gensym K) (let W5948 (gensym C) (let W5949 (cons lambda (cons W5945 (cons (cons lambda (cons W5946 (cons (cons lambda (cons W5947 (cons (cons lambda (cons W5948 (cons (shen.continue W5944 W5942 W5945 W5946 W5947 W5948) ()))) ()))) ()))) ()))) (cons W5949 (cons W5938 (cons W5939 (cons W5940 (cons W5941 ()))))))))))))))))) +(defun shen.call-prolog (V7198) (let W7199 (cons shen.prolog-vector ()) (let W7200 (cons @v (cons true (cons 0 (cons (cons vector (cons 0 ())) ())))) (let W7201 0 (let W7202 (cons freeze (cons true ())) (let W7203 (compile (lambda Z7204 (shen. Z7204)) V7198) (let W7205 (shen.received V7198) (let W7206 (gensym V) (let W7207 (gensym L) (let W7208 (gensym K) (let W7209 (gensym C) (let W7210 (cons lambda (cons W7206 (cons (cons lambda (cons W7207 (cons (cons lambda (cons W7208 (cons (cons lambda (cons W7209 (cons (shen.continue W7205 W7203 W7206 W7207 W7208 W7209) ()))) ()))) ()))) ()))) (cons W7210 (cons W7199 (cons W7200 (cons W7201 (cons W7202 ()))))))))))))))))) -(defun shen.received (V5952) (let GoTo5953 (freeze ()) (if (cons? V5952) (let Select5954 (hd V5952) (let Select5955 (tl V5952) (if (and (= receive Select5954) (and (cons? Select5955) (= () (tl Select5955)))) Select5955 (union (shen.received Select5954) (shen.received Select5955))))) (thaw GoTo5953)))) +(defun shen.received (V7213) (let GoTo7214 (freeze ()) (if (cons? V7213) (let Select7215 (hd V7213) (let Select7216 (tl V7213) (if (and (= receive Select7215) (and (cons? Select7216) (= () (tl Select7216)))) Select7216 (union (shen.received Select7215) (shen.received Select7216))))) (thaw GoTo7214)))) -(defun shen.prolog-vector () (let W5956 (absvector (value shen.*prolog-memory*)) (let W5957 (address-> W5956 0 shen.print-prolog-vector) (let W5958 (address-> W5956 1 2) W5958)))) +(defun shen.prolog-vector () (let W7217 (absvector (value shen.*prolog-memory*)) (let W7218 (address-> W7217 0 shen.print-prolog-vector) (let W7219 (address-> W7217 1 2) W7219)))) -(defun receive (V5959) V5959) +(defun receive (V7220) V7220) -(defun shen.rcons_form (V5960) (if (cons? V5960) (cons cons (cons (shen.rcons_form (hd V5960)) (cons (shen.rcons_form (tl V5960)) ()))) V5960)) +(defun shen.rcons_form (V7221) (if (cons? V7221) (cons cons (cons (shen.rcons_form (hd V7221)) (cons (shen.rcons_form (tl V7221)) ()))) V7221)) -(defun shen.tuple-up (V5961) (if (cons? V5961) (cons @p (cons (hd V5961) (cons (shen.tuple-up (tl V5961)) ()))) V5961)) +(defun shen.tuple-up (V7222) (if (cons? V7222) (cons @p (cons (hd V7222) (cons (shen.tuple-up (tl V7222)) ()))) V7222)) -(defun undefmacro (V5962) (do (set *macros* (remove (assoc V5962 (value *macros*)) (value *macros*))) V5962)) +(defun undefmacro (V7223) (do (set *macros* (remove (assoc V7223 (value *macros*)) (value *macros*))) V7223)) diff --git a/klambda/prolog.kl b/klambda/prolog.kl index 3658fc2..764508d 100644 --- a/klambda/prolog.kl +++ b/klambda/prolog.kl @@ -1,202 +1,202 @@ -(defun asserta (V1245) (shen.assert* V1245 shen.top)) +(defun asserta (V1599) (shen.assert* V1599 shen.top)) -(defun assertz (V1246) (shen.assert* V1246 shen.bottom)) +(defun assertz (V1600) (shen.assert* V1600 shen.bottom)) -(defun shen.assert* (V1247 V1248) (cond ((and (cons? V1247) (and (cons? (tl V1247)) (= <-- (hd (tl V1247))))) (let W1249 (shen.predicate (hd V1247)) (let W1250 (shen.terms (hd V1247)) (let W1251 (length W1250) (let W1252 (shen.parameters W1251) (let W1253 (arity W1249) (let W1254 (if (= W1253 -1) (do (eval (shen.create-skeleton W1249 W1252)) (put W1249 shen.dynamic () (value *property-vector*))) shen.skip) (let W1255 (shen.insert-info W1249 W1250 (tl (tl V1247)) V1247 V1248) W1249)))))))) (true (simple-error "partial function shen.assert*")))) +(defun shen.assert* (V1601 V1602) (cond ((and (cons? V1601) (and (cons? (tl V1601)) (= <-- (hd (tl V1601))))) (let W1603 (shen.predicate (hd V1601)) (let W1604 (shen.terms (hd V1601)) (let W1605 (length W1604) (let W1606 (shen.parameters W1605) (let W1607 (arity W1603) (let W1608 (if (= W1607 -1) (do (eval (shen.create-skeleton W1603 W1606)) (put W1603 shen.dynamic () (value *property-vector*))) shen.skip) (let W1609 (shen.insert-info W1603 W1604 (tl (tl V1601)) V1601 V1602) W1603)))))))) (true (shen.f-error shen.assert*)))) -(defun shen.predicate (V1258) (cond ((cons? V1258) (hd V1258)) (true V1258))) +(defun shen.predicate (V1612) (cond ((cons? V1612) (hd V1612)) (true V1612))) -(defun shen.terms (V1263) (cond ((cons? V1263) (tl V1263)) (true ()))) +(defun shen.terms (V1617) (cond ((cons? V1617) (tl V1617)) (true ()))) -(defun shen.create-skeleton (V1264 V1265) (cons defprolog (cons V1264 (shen.dynamic-default V1264 V1265)))) +(defun shen.create-skeleton (V1618 V1619) (cons defprolog (cons V1618 (shen.dynamic-default V1618 V1619)))) -(defun shen.dynamic-default (V1266 V1267) (append V1267 (cons <-- (cons (cons shen.call-dynamic (cons (shen.cons-form V1267) (cons (cons get (cons V1266 (cons shen.dynamic ()))) ()))) (cons (intern ";") ()))))) +(defun shen.dynamic-default (V1620 V1621) (append V1621 (cons <-- (cons (cons shen.call-dynamic (cons (shen.cons-form V1621) (cons (cons get (cons V1620 (cons shen.dynamic ()))) ()))) (cons (intern ";") ()))))) -(defun shen.insert-info (V1268 V1269 V1270 V1271 V1272) (let W1273 (gensym shen.g) (let W1274 (eval (append (cons defprolog (cons W1273 ())) (append V1269 (cons <-- V1270)))) (let W1275 (cons (fn W1273) (cons W1273 V1271)) (let W1276 (get V1268 shen.dynamic (value *property-vector*)) (let W1277 (if (= V1272 shen.top) (cons W1275 W1276) (append W1276 (cons W1275 ()))) (put V1268 shen.dynamic W1277 (value *property-vector*)))))))) +(defun shen.insert-info (V1622 V1623 V1624 V1625 V1626) (let W1627 (gensym shen.g) (let W1628 (eval (append (cons defprolog (cons W1627 ())) (append V1623 (cons <-- V1624)))) (let W1629 (cons (fn W1627) (cons W1627 V1625)) (let W1630 (get V1622 shen.dynamic (value *property-vector*)) (let W1631 (if (= V1626 shen.top) (cons W1629 W1630) (append W1630 (cons W1629 ()))) (put V1622 shen.dynamic W1631 (value *property-vector*)))))))) -(defun shen.newname () (let W1278 (value shen.*names*) (let W1279 (if (empty? W1278) (gensym shen.g) (do (set shen.*names* (tl W1278)) (hd W1278))) W1279))) +(defun shen.newname () (let W1632 (value shen.*names*) (let W1633 (if (empty? W1632) (gensym shen.g) (do (set shen.*names* (tl W1632)) (hd W1632))) W1633))) -(defun shen.call-dynamic (V1280 V1281 V1282 V1283 V1284 V1285) (let W1286 (if (shen.unlocked? V1283) (let W1287 (shen.lazyderef V1281 V1282) (if (cons? W1287) (let W1288 (shen.lazyderef (hd W1287) V1282) (if (cons? W1288) (let W1289 (hd W1288) (do (shen.incinfs) (shen.callrec W1289 V1280 V1282 V1283 V1284 V1285))) false)) false)) false) (if (= W1286 false) (if (shen.unlocked? V1283) (let W1290 (shen.lazyderef V1281 V1282) (if (cons? W1290) (let W1291 (tl W1290) (do (shen.incinfs) (shen.call-dynamic V1280 W1291 V1282 V1283 V1284 V1285))) false)) false) W1286))) +(defun shen.call-dynamic (V1634 V1635 V1636 V1637 V1638 V1639) (let W1640 (if (shen.unlocked? V1637) (let W1641 (shen.lazyderef V1635 V1636) (if (cons? W1641) (let W1642 (shen.lazyderef (hd W1641) V1636) (if (cons? W1642) (let W1643 (hd W1642) (do (shen.incinfs) (shen.callrec W1643 V1634 V1636 V1637 V1638 V1639))) false)) false)) false) (if (= W1640 false) (if (shen.unlocked? V1637) (let W1644 (shen.lazyderef V1635 V1636) (if (cons? W1644) (let W1645 (tl W1644) (do (shen.incinfs) (shen.call-dynamic V1634 W1645 V1636 V1637 V1638 V1639))) false)) false) W1640))) -(defun shen.callrec (V1292 V1293 V1294 V1295 V1296 V1297) (cond ((= () V1293) ((((V1292 V1294) V1295) V1296) V1297)) ((cons? V1293) (shen.callrec (V1292 (hd V1293)) (tl V1293) V1294 V1295 V1296 V1297)) (true (simple-error "partial function shen.callrec")))) +(defun shen.callrec (V1646 V1647 V1648 V1649 V1650 V1651) (cond ((= () V1647) ((((V1646 V1648) V1649) V1650) V1651)) ((cons? V1647) (shen.callrec (V1646 (hd V1647)) (tl V1647) V1648 V1649 V1650 V1651)) (true (shen.f-error shen.callrec)))) -(defun retract (V1298) (cond ((and (cons? V1298) (and (cons? (tl V1298)) (= <-- (hd (tl V1298))))) (let W1299 (shen.predicate (hd V1298)) (let W1300 (get W1299 shen.dynamic (value *property-vector*)) (put W1299 shen.dynamic (shen.retract-clause V1298 W1300) (value *property-vector*))))) (true (simple-error "partial function retract")))) +(defun retract (V1652) (cond ((and (cons? V1652) (and (cons? (tl V1652)) (= <-- (hd (tl V1652))))) (let W1653 (shen.predicate (hd V1652)) (let W1654 (get W1653 shen.dynamic (value *property-vector*)) (put W1653 shen.dynamic (shen.retract-clause V1652 W1654) (value *property-vector*))))) (true (shen.f-error retract)))) -(defun shen.retract-clause (V1306 V1307) (cond ((= () V1307) ()) ((and (cons? V1307) (and (cons? (hd V1307)) (and (cons? (tl (hd V1307))) (= V1306 (tl (tl (hd V1307))))))) (do (set shen.*names* (cons (hd (tl (hd V1307))) (value shen.*names*))) (tl V1307))) ((cons? V1307) (cons (hd V1307) (shen.retract-clause V1306 (tl V1307)))) (true (simple-error "partial function shen.retract-clause")))) +(defun shen.retract-clause (V1660 V1661) (cond ((= () V1661) ()) ((and (cons? V1661) (and (cons? (hd V1661)) (and (cons? (tl (hd V1661))) (= V1660 (tl (tl (hd V1661))))))) (do (set shen.*names* (cons (hd (tl (hd V1661))) (value shen.*names*))) (tl V1661))) ((cons? V1661) (cons (hd V1661) (shen.retract-clause V1660 (tl V1661)))) (true (shen.f-error shen.retract-clause)))) -(defun shen.compile-prolog (V1308 V1309) (compile (lambda Z1310 (shen. Z1310)) (cons V1308 V1309))) +(defun shen.compile-prolog (V1662 V1663) (compile (lambda Z1664 (shen. Z1664)) (cons V1662 V1663))) -(defun shen. (V1311) (let W1312 (if (cons? V1311) (let W1313 (head V1311) (let W1314 (tail V1311) (let W1315 (shen. W1314) (if (shen.parse-failure? W1315) (shen.parse-failure) (let W1316 (shen.<-out W1315) (let W1317 (shen.in-> W1315) (shen.comb W1317 (let W1318 (shen.prolog-arity-check W1313 W1316) (let W1319 (map (lambda Z1320 (shen.linearise-clause Z1320)) W1316) (shen.horn-clause-procedure W1313 W1319)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W1312) (shen.parse-failure) W1312))) +(defun shen. (V1665) (let W1666 (if (cons? V1665) (let W1667 (head V1665) (let W1668 (tail V1665) (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 (let W1672 (shen.prolog-arity-check W1667 W1670) (let W1673 (map (lambda Z1674 (shen.linearise-clause Z1674)) W1670) (shen.horn-clause-procedure W1667 W1673)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W1666) (shen.parse-failure) W1666))) -(defun shen.prolog-arity-check (V1323 V1324) (cond ((and (cons? V1324) (and (cons? (hd V1324)) (and (cons? (tl (hd V1324))) (and (= () (tl (tl (hd V1324)))) (= () (tl V1324)))))) (length (hd (hd V1324)))) ((and (cons? V1324) (and (cons? (hd V1324)) (and (cons? (tl (hd V1324))) (= () (tl (tl (hd V1324))))))) (shen.pac-h V1323 (length (hd (hd V1324))) (tl V1324))) (true (simple-error "partial function shen.prolog-arity-check")))) +(defun shen.prolog-arity-check (V1677 V1678) (cond ((and (cons? V1678) (and (cons? (hd V1678)) (and (cons? (tl (hd V1678))) (and (= () (tl (tl (hd V1678)))) (= () (tl V1678)))))) (length (hd (hd V1678)))) ((and (cons? V1678) (and (cons? (hd V1678)) (and (cons? (tl (hd V1678))) (= () (tl (tl (hd V1678))))))) (shen.pac-h V1677 (length (hd (hd V1678))) (tl V1678))) (true (shen.f-error shen.prolog-arity-check)))) -(defun shen.pac-h (V1329 V1330 V1331) (cond ((= () V1331) V1330) ((and (cons? V1331) (cons? (hd V1331))) (if (= V1330 (length (hd (hd V1331)))) (shen.pac-h V1329 V1330 (tl V1331)) (simple-error (cn "arity error in prolog procedure " (shen.app V1329 " -" shen.a))))) (true (simple-error "partial function shen.pac-h")))) +(defun shen.pac-h (V1683 V1684 V1685) (cond ((= () V1685) V1684) ((and (cons? V1685) (cons? (hd V1685))) (if (= V1684 (length (hd (hd V1685)))) (shen.pac-h V1683 V1684 (tl V1685)) (simple-error (cn "arity error in prolog procedure " (shen.app V1683 " +" shen.a))))) (true (shen.f-error shen.pac-h)))) -(defun shen. (V1332) (let W1333 (let W1334 (shen. V1332) (if (shen.parse-failure? W1334) (shen.parse-failure) (let W1335 (shen.<-out W1334) (let W1336 (shen.in-> W1334) (let W1337 (shen. W1336) (if (shen.parse-failure? W1337) (shen.parse-failure) (let W1338 (shen.<-out W1337) (let W1339 (shen.in-> W1337) (shen.comb W1339 (cons W1335 W1338)))))))))) (if (shen.parse-failure? W1333) (let W1340 (let W1341 ( V1332) (if (shen.parse-failure? W1341) (shen.parse-failure) (let W1342 (shen.<-out W1341) (let W1343 (shen.in-> W1341) (shen.comb W1343 (if (empty? W1342) () (simple-error (cn "Prolog syntax error here: - " (shen.app W1342 " - ..." shen.r))))))))) (if (shen.parse-failure? W1340) (shen.parse-failure) W1340)) W1333))) +(defun shen. (V1686) (let W1687 (let W1688 (shen. V1686) (if (shen.parse-failure? W1688) (shen.parse-failure) (let W1689 (shen.<-out W1688) (let W1690 (shen.in-> W1688) (let W1691 (shen. W1690) (if (shen.parse-failure? W1691) (shen.parse-failure) (let W1692 (shen.<-out W1691) (let W1693 (shen.in-> W1691) (shen.comb W1693 (cons W1689 W1692)))))))))) (if (shen.parse-failure? W1687) (let W1694 (let W1695 ( V1686) (if (shen.parse-failure? W1695) (shen.parse-failure) (let W1696 (shen.<-out W1695) (let W1697 (shen.in-> W1695) (shen.comb W1697 (if (empty? W1696) () (simple-error (cn "Prolog syntax error here: + " (shen.app W1696 " + ..." shen.r))))))))) (if (shen.parse-failure? W1694) (shen.parse-failure) W1694)) W1687))) -(defun shen.linearise-clause (V1344) (cond ((and (cons? V1344) (and (cons? (tl V1344)) (= () (tl (tl V1344))))) (shen.lch (shen.linearise (@p (hd V1344) (hd (tl V1344)))))) (true (simple-error "partial function shen.linearise-clause")))) +(defun shen.linearise-clause (V1698) (cond ((and (cons? V1698) (and (cons? (tl V1698)) (= () (tl (tl V1698))))) (shen.lch (shen.linearise (@p (hd V1698) (hd (tl V1698)))))) (true (shen.f-error shen.linearise-clause)))) -(defun shen.lch (V1345) (cond ((tuple? V1345) (cons (fst V1345) (cons (shen.lchh (snd V1345)) ()))) (true (simple-error "partial function shen.lch")))) +(defun shen.lch (V1699) (cond ((tuple? V1699) (cons (fst V1699) (cons (shen.lchh (snd V1699)) ()))) (true (shen.f-error shen.lch)))) -(defun shen.lchh (V1346) (cond ((and (cons? V1346) (and (= where (hd V1346)) (and (cons? (tl V1346)) (and (cons? (hd (tl V1346))) (and (= = (hd (hd (tl V1346)))) (and (cons? (tl (hd (tl V1346)))) (and (cons? (tl (tl (hd (tl V1346))))) (and (= () (tl (tl (tl (hd (tl V1346)))))) (and (cons? (tl (tl V1346))) (= () (tl (tl (tl V1346))))))))))))) (cons (cons (if (value shen.*occurs*) is! is) (tl (hd (tl V1346)))) (shen.lchh (hd (tl (tl V1346)))))) (true V1346))) +(defun shen.lchh (V1700) (cond ((and (cons? V1700) (and (= where (hd V1700)) (and (cons? (tl V1700)) (and (cons? (hd (tl V1700))) (and (= = (hd (hd (tl V1700)))) (and (cons? (tl (hd (tl V1700)))) (and (cons? (tl (tl (hd (tl V1700))))) (and (= () (tl (tl (tl (hd (tl V1700)))))) (and (cons? (tl (tl V1700))) (= () (tl (tl (tl V1700))))))))))))) (cons (cons (if (value shen.*occurs*) is! is) (tl (hd (tl V1700)))) (shen.lchh (hd (tl (tl V1700)))))) (true V1700))) -(defun shen. (V1347) (let W1348 (let W1349 (shen. V1347) (if (shen.parse-failure? W1349) (shen.parse-failure) (let W1350 (shen.<-out W1349) (let W1351 (shen.in-> W1349) (if (shen.hds=? W1351 <--) (let W1352 (tail W1351) (let W1353 (shen. W1352) (if (shen.parse-failure? W1353) (shen.parse-failure) (let W1354 (shen.<-out W1353) (let W1355 (shen.in-> W1353) (let W1356 (shen. W1355) (if (shen.parse-failure? W1356) (shen.parse-failure) (let W1357 (shen.in-> W1356) (shen.comb W1357 (cons W1350 (cons W1354 ()))))))))))) (shen.parse-failure)))))) (if (shen.parse-failure? W1348) (shen.parse-failure) W1348))) +(defun shen. (V1701) (let W1702 (let W1703 (shen. V1701) (if (shen.parse-failure? W1703) (shen.parse-failure) (let W1704 (shen.<-out W1703) (let W1705 (shen.in-> W1703) (if (shen.hds=? W1705 <--) (let W1706 (tail W1705) (let W1707 (shen. W1706) (if (shen.parse-failure? W1707) (shen.parse-failure) (let W1708 (shen.<-out W1707) (let W1709 (shen.in-> W1707) (let W1710 (shen. W1709) (if (shen.parse-failure? W1710) (shen.parse-failure) (let W1711 (shen.in-> W1710) (shen.comb W1711 (cons W1704 (cons W1708 ()))))))))))) (shen.parse-failure)))))) (if (shen.parse-failure? W1702) (shen.parse-failure) W1702))) -(defun shen. (V1358) (let W1359 (let W1360 (shen. V1358) (if (shen.parse-failure? W1360) (shen.parse-failure) (let W1361 (shen.<-out W1360) (let W1362 (shen.in-> W1360) (let W1363 (shen. W1362) (if (shen.parse-failure? W1363) (shen.parse-failure) (let W1364 (shen.<-out W1363) (let W1365 (shen.in-> W1363) (shen.comb W1365 (cons W1361 W1364)))))))))) (if (shen.parse-failure? W1359) (let W1366 (let W1367 ( V1358) (if (shen.parse-failure? W1367) (shen.parse-failure) (let W1368 (shen.in-> W1367) (shen.comb W1368 ())))) (if (shen.parse-failure? W1366) (shen.parse-failure) W1366)) W1359))) +(defun shen. (V1712) (let W1713 (let W1714 (shen. V1712) (if (shen.parse-failure? W1714) (shen.parse-failure) (let W1715 (shen.<-out W1714) (let W1716 (shen.in-> W1714) (let W1717 (shen. W1716) (if (shen.parse-failure? W1717) (shen.parse-failure) (let W1718 (shen.<-out W1717) (let W1719 (shen.in-> W1717) (shen.comb W1719 (cons W1715 W1718)))))))))) (if (shen.parse-failure? W1713) (let W1720 (let W1721 ( V1712) (if (shen.parse-failure? W1721) (shen.parse-failure) (let W1722 (shen.in-> W1721) (shen.comb W1722 ())))) (if (shen.parse-failure? W1720) (shen.parse-failure) W1720)) W1713))) -(defun shen. (V1369) (let W1370 (if (cons? V1369) (let W1371 (head V1369) (let W1372 (tail V1369) (if (and (atom? W1371) (not (shen.prolog-keyword? W1371))) (shen.comb W1372 W1371) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1370) (let W1373 (if (cons? V1369) (let W1374 (head V1369) (let W1375 (tail V1369) (if (= W1374 (intern ":")) (shen.comb W1375 W1374) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1373) (let W1376 (if (shen.ccons? V1369) (let W1377 (head V1369) (let W1378 (tail V1369) (if (shen.hds=? W1377 cons) (let W1379 (tail W1377) (let W1380 (shen. W1379) (if (shen.parse-failure? W1380) (shen.parse-failure) (let W1381 (shen.<-out W1380) (let W1382 (shen.in-> W1380) (let W1383 (shen. W1382) (if (shen.parse-failure? W1383) (shen.parse-failure) (let W1384 (shen.<-out W1383) (let W1385 (shen.in-> W1383) (let W1386 ( W1385) (if (shen.parse-failure? W1386) (shen.parse-failure) (let W1387 (shen.in-> W1386) (shen.comb W1378 (cons cons (cons W1381 (cons W1384 ())))))))))))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1376) (let W1388 (if (shen.ccons? V1369) (let W1389 (head V1369) (let W1390 (tail V1369) (if (shen.hds=? W1389 +) (let W1391 (tail W1389) (let W1392 (shen. W1391) (if (shen.parse-failure? W1392) (shen.parse-failure) (let W1393 (shen.<-out W1392) (let W1394 (shen.in-> W1392) (let W1395 ( W1394) (if (shen.parse-failure? W1395) (shen.parse-failure) (let W1396 (shen.in-> W1395) (shen.comb W1390 (cons shen.+m (cons W1393 ()))))))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1388) (let W1397 (if (shen.ccons? V1369) (let W1398 (head V1369) (let W1399 (tail V1369) (if (shen.hds=? W1398 -) (let W1400 (tail W1398) (let W1401 (shen. W1400) (if (shen.parse-failure? W1401) (shen.parse-failure) (let W1402 (shen.<-out W1401) (let W1403 (shen.in-> W1401) (let W1404 ( W1403) (if (shen.parse-failure? W1404) (shen.parse-failure) (let W1405 (shen.in-> W1404) (shen.comb W1399 (cons shen.-m (cons W1402 ()))))))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1397) (let W1406 (if (shen.ccons? V1369) (let W1407 (head V1369) (let W1408 (tail V1369) (if (shen.hds=? W1407 mode) (let W1409 (tail W1407) (let W1410 (shen. W1409) (if (shen.parse-failure? W1410) (shen.parse-failure) (let W1411 (shen.<-out W1410) (let W1412 (shen.in-> W1410) (if (shen.hds=? W1412 +) (let W1413 (tail W1412) (let W1414 ( W1413) (if (shen.parse-failure? W1414) (shen.parse-failure) (let W1415 (shen.in-> W1414) (shen.comb W1408 (cons shen.+m (cons W1411 ()))))))) (shen.parse-failure))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1406) (let W1416 (if (shen.ccons? V1369) (let W1417 (head V1369) (let W1418 (tail V1369) (if (shen.hds=? W1417 mode) (let W1419 (tail W1417) (let W1420 (shen. W1419) (if (shen.parse-failure? W1420) (shen.parse-failure) (let W1421 (shen.<-out W1420) (let W1422 (shen.in-> W1420) (if (shen.hds=? W1422 -) (let W1423 (tail W1422) (let W1424 ( W1423) (if (shen.parse-failure? W1424) (shen.parse-failure) (let W1425 (shen.in-> W1424) (shen.comb W1418 (cons shen.-m (cons W1421 ()))))))) (shen.parse-failure))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1416) (shen.parse-failure) W1416)) W1406)) W1397)) W1388)) W1376)) W1373)) W1370))) +(defun shen. (V1723) (let W1724 (if (cons? V1723) (let W1725 (head V1723) (let W1726 (tail V1723) (if (and (atom? W1725) (not (shen.prolog-keyword? W1725))) (shen.comb W1726 W1725) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1724) (let W1727 (if (cons? V1723) (let W1728 (head V1723) (let W1729 (tail V1723) (if (= W1728 (intern ":")) (shen.comb W1729 W1728) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1727) (let W1730 (if (shen.ccons? V1723) (let W1731 (head V1723) (let W1732 (tail V1723) (if (shen.hds=? W1731 cons) (let W1733 (tail W1731) (let W1734 (shen. W1733) (if (shen.parse-failure? W1734) (shen.parse-failure) (let W1735 (shen.<-out W1734) (let W1736 (shen.in-> W1734) (let W1737 (shen. W1736) (if (shen.parse-failure? W1737) (shen.parse-failure) (let W1738 (shen.<-out W1737) (let W1739 (shen.in-> W1737) (let W1740 ( W1739) (if (shen.parse-failure? W1740) (shen.parse-failure) (let W1741 (shen.in-> W1740) (shen.comb W1732 (cons cons (cons W1735 (cons W1738 ())))))))))))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1730) (let W1742 (if (shen.ccons? V1723) (let W1743 (head V1723) (let W1744 (tail V1723) (if (shen.hds=? W1743 +) (let W1745 (tail W1743) (let W1746 (shen. W1745) (if (shen.parse-failure? W1746) (shen.parse-failure) (let W1747 (shen.<-out W1746) (let W1748 (shen.in-> W1746) (let W1749 ( W1748) (if (shen.parse-failure? W1749) (shen.parse-failure) (let W1750 (shen.in-> W1749) (shen.comb W1744 (cons shen.+m (cons W1747 ()))))))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1742) (let W1751 (if (shen.ccons? V1723) (let W1752 (head V1723) (let W1753 (tail V1723) (if (shen.hds=? W1752 -) (let W1754 (tail W1752) (let W1755 (shen. W1754) (if (shen.parse-failure? W1755) (shen.parse-failure) (let W1756 (shen.<-out W1755) (let W1757 (shen.in-> W1755) (let W1758 ( W1757) (if (shen.parse-failure? W1758) (shen.parse-failure) (let W1759 (shen.in-> W1758) (shen.comb W1753 (cons shen.-m (cons W1756 ()))))))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1751) (let W1760 (if (shen.ccons? V1723) (let W1761 (head V1723) (let W1762 (tail V1723) (if (shen.hds=? W1761 mode) (let W1763 (tail W1761) (let W1764 (shen. W1763) (if (shen.parse-failure? W1764) (shen.parse-failure) (let W1765 (shen.<-out W1764) (let W1766 (shen.in-> W1764) (if (shen.hds=? W1766 +) (let W1767 (tail W1766) (let W1768 ( W1767) (if (shen.parse-failure? W1768) (shen.parse-failure) (let W1769 (shen.in-> W1768) (shen.comb W1762 (cons shen.+m (cons W1765 ()))))))) (shen.parse-failure))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1760) (let W1770 (if (shen.ccons? V1723) (let W1771 (head V1723) (let W1772 (tail V1723) (if (shen.hds=? W1771 mode) (let W1773 (tail W1771) (let W1774 (shen. W1773) (if (shen.parse-failure? W1774) (shen.parse-failure) (let W1775 (shen.<-out W1774) (let W1776 (shen.in-> W1774) (if (shen.hds=? W1776 -) (let W1777 (tail W1776) (let W1778 ( W1777) (if (shen.parse-failure? W1778) (shen.parse-failure) (let W1779 (shen.in-> W1778) (shen.comb W1772 (cons shen.-m (cons W1775 ()))))))) (shen.parse-failure))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1770) (shen.parse-failure) W1770)) W1760)) W1751)) W1742)) W1730)) W1727)) W1724))) -(defun shen.prolog-keyword? (V1426) (element? V1426 (cons (intern ";") (cons <-- ())))) +(defun shen.prolog-keyword? (V1780) (element? V1780 (cons (intern ";") (cons <-- ())))) -(defun atom? (V1427) (or (symbol? V1427) (or (string? V1427) (or (boolean? V1427) (or (number? V1427) (empty? V1427)))))) +(defun atom? (V1781) (or (symbol? V1781) (or (string? V1781) (or (boolean? V1781) (or (number? V1781) (empty? V1781)))))) -(defun shen. (V1428) (let W1429 (let W1430 (shen. V1428) (if (shen.parse-failure? W1430) (shen.parse-failure) (let W1431 (shen.<-out W1430) (let W1432 (shen.in-> W1430) (shen.comb W1432 W1431))))) (if (shen.parse-failure? W1429) (shen.parse-failure) W1429))) +(defun shen. (V1782) (let W1783 (let W1784 (shen. V1782) (if (shen.parse-failure? W1784) (shen.parse-failure) (let W1785 (shen.<-out W1784) (let W1786 (shen.in-> W1784) (shen.comb W1786 W1785))))) (if (shen.parse-failure? W1783) (shen.parse-failure) W1783))) -(defun shen. (V1433) (let W1434 (let W1435 (shen. V1433) (if (shen.parse-failure? W1435) (shen.parse-failure) (let W1436 (shen.<-out W1435) (let W1437 (shen.in-> W1435) (shen.comb W1437 W1436))))) (if (shen.parse-failure? W1434) (shen.parse-failure) W1434))) +(defun shen. (V1787) (let W1788 (let W1789 (shen. V1787) (if (shen.parse-failure? W1789) (shen.parse-failure) (let W1790 (shen.<-out W1789) (let W1791 (shen.in-> W1789) (shen.comb W1791 W1790))))) (if (shen.parse-failure? W1788) (shen.parse-failure) W1788))) -(defun shen. (V1438) (let W1439 (let W1440 (shen. V1438) (if (shen.parse-failure? W1440) (shen.parse-failure) (let W1441 (shen.<-out W1440) (let W1442 (shen.in-> W1440) (let W1443 (shen. W1442) (if (shen.parse-failure? W1443) (shen.parse-failure) (let W1444 (shen.<-out W1443) (let W1445 (shen.in-> W1443) (shen.comb W1445 (cons W1441 W1444)))))))))) (if (shen.parse-failure? W1439) (let W1446 (let W1447 ( V1438) (if (shen.parse-failure? W1447) (shen.parse-failure) (let W1448 (shen.in-> W1447) (shen.comb W1448 ())))) (if (shen.parse-failure? W1446) (shen.parse-failure) W1446)) W1439))) +(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. (V1449) (let W1450 (if (shen.hds=? V1449 !) (let W1451 (tail V1449) (shen.comb W1451 !)) (shen.parse-failure)) (if (shen.parse-failure? W1450) (let W1452 (if (shen.ccons? V1449) (let W1453 (head V1449) (let W1454 (tail V1449) (let W1455 (shen. W1453) (if (shen.parse-failure? W1455) (shen.parse-failure) (let W1456 (shen.<-out W1455) (let W1457 (shen.in-> W1455) (let W1458 ( W1457) (if (shen.parse-failure? W1458) (shen.parse-failure) (let W1459 (shen.in-> W1458) (shen.comb W1454 W1456)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W1452) (shen.parse-failure) W1452)) W1450))) +(defun shen. (V1803) (let W1804 (if (shen.hds=? V1803 !) (let W1805 (tail V1803) (shen.comb W1805 !)) (shen.parse-failure)) (if (shen.parse-failure? W1804) (let W1806 (if (shen.ccons? V1803) (let W1807 (head V1803) (let W1808 (tail V1803) (let W1809 (shen. W1807) (if (shen.parse-failure? W1809) (shen.parse-failure) (let W1810 (shen.<-out W1809) (let W1811 (shen.in-> W1809) (let W1812 ( W1811) (if (shen.parse-failure? W1812) (shen.parse-failure) (let W1813 (shen.in-> W1812) (shen.comb W1808 W1810)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W1806) (shen.parse-failure) W1806)) W1804))) -(defun shen. (V1460) (let W1461 (let W1462 (shen. V1460) (if (shen.parse-failure? W1462) (shen.parse-failure) (let W1463 (shen.<-out W1462) (let W1464 (shen.in-> W1462) (let W1465 (shen. W1464) (if (shen.parse-failure? W1465) (shen.parse-failure) (let W1466 (shen.<-out W1465) (let W1467 (shen.in-> W1465) (shen.comb W1467 (cons W1463 W1466)))))))))) (if (shen.parse-failure? W1461) (let W1468 (let W1469 ( V1460) (if (shen.parse-failure? W1469) (shen.parse-failure) (let W1470 (shen.in-> W1469) (shen.comb W1470 ())))) (if (shen.parse-failure? W1468) (shen.parse-failure) W1468)) W1461))) +(defun shen. (V1814) (let W1815 (let W1816 (shen. V1814) (if (shen.parse-failure? W1816) (shen.parse-failure) (let W1817 (shen.<-out W1816) (let W1818 (shen.in-> W1816) (let W1819 (shen. W1818) (if (shen.parse-failure? W1819) (shen.parse-failure) (let W1820 (shen.<-out W1819) (let W1821 (shen.in-> W1819) (shen.comb W1821 (cons W1817 W1820)))))))))) (if (shen.parse-failure? W1815) (let W1822 (let W1823 ( V1814) (if (shen.parse-failure? W1823) (shen.parse-failure) (let W1824 (shen.in-> W1823) (shen.comb W1824 ())))) (if (shen.parse-failure? W1822) (shen.parse-failure) W1822)) W1815))) -(defun shen. (V1471) (let W1472 (let W1473 (shen. V1471) (if (shen.parse-failure? W1473) (shen.parse-failure) (let W1474 (shen.<-out W1473) (let W1475 (shen.in-> W1473) (shen.comb W1475 W1474))))) (if (shen.parse-failure? W1472) (let W1476 (if (cons? V1471) (let W1477 (head V1471) (let W1478 (tail V1471) (if (atom? W1477) (shen.comb W1478 W1477) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1476) (let W1479 (if (shen.ccons? V1471) (let W1480 (head V1471) (let W1481 (tail V1471) (let W1482 (shen. W1480) (if (shen.parse-failure? W1482) (shen.parse-failure) (let W1483 (shen.<-out W1482) (let W1484 (shen.in-> W1482) (let W1485 ( W1484) (if (shen.parse-failure? W1485) (shen.parse-failure) (let W1486 (shen.in-> W1485) (shen.comb W1481 W1483)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W1479) (shen.parse-failure) W1479)) W1476)) W1472))) +(defun shen. (V1825) (let W1826 (let W1827 (shen. V1825) (if (shen.parse-failure? W1827) (shen.parse-failure) (let W1828 (shen.<-out W1827) (let W1829 (shen.in-> W1827) (shen.comb W1829 W1828))))) (if (shen.parse-failure? W1826) (let W1830 (if (cons? V1825) (let W1831 (head V1825) (let W1832 (tail V1825) (if (atom? W1831) (shen.comb W1832 W1831) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1830) (let W1833 (if (shen.ccons? V1825) (let W1834 (head V1825) (let W1835 (tail V1825) (let W1836 (shen. W1834) (if (shen.parse-failure? W1836) (shen.parse-failure) (let W1837 (shen.<-out W1836) (let W1838 (shen.in-> W1836) (let W1839 ( W1838) (if (shen.parse-failure? W1839) (shen.parse-failure) (let W1840 (shen.in-> W1839) (shen.comb W1835 W1837)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W1833) (shen.parse-failure) W1833)) W1830)) W1826))) -(defun shen. (V1487) (let W1488 (if (cons? V1487) (let W1489 (head V1487) (let W1490 (tail V1487) (if (= W1489 _) (shen.comb W1490 (gensym Y)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1488) (shen.parse-failure) W1488))) +(defun shen. (V1841) (let W1842 (if (cons? V1841) (let W1843 (head V1841) (let W1844 (tail V1841) (if (= W1843 _) (shen.comb W1844 (gensym Y)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1842) (shen.parse-failure) W1842))) -(defun shen. (V1491) (let W1492 (if (cons? V1491) (let W1493 (head V1491) (let W1494 (tail V1491) (if (shen.semicolon? W1493) (shen.comb W1494 W1493) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1492) (shen.parse-failure) W1492))) +(defun shen. (V1845) (let W1846 (if (cons? V1845) (let W1847 (head V1845) (let W1848 (tail V1845) (if (shen.semicolon? W1847) (shen.comb W1848 W1847) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1846) (shen.parse-failure) W1846))) -(defun shen.horn-clause-procedure (V1495 V1496) (let W1497 (gensym B) (let W1498 (gensym L) (let W1499 (gensym K) (let W1500 (gensym C) (let W1501 (shen.prolog-parameters V1496) (let W1502 (shen.hascut? V1496) (let W1503 (shen.prolog-fbody V1496 W1501 W1497 W1498 W1499 W1500 W1502) (let W1504 (if W1502 (cons let (cons W1499 (cons (cons + (cons W1499 (cons 1 ()))) (cons W1503 ())))) W1503) (let W1505 (cons define (cons V1495 (append W1501 (append (cons W1497 (cons W1498 (cons W1499 (cons W1500 (cons -> ()))))) (cons W1504 ()))))) W1505)))))))))) +(defun shen.horn-clause-procedure (V1849 V1850) (let W1851 (gensym B) (let W1852 (gensym L) (let W1853 (gensym K) (let W1854 (gensym C) (let W1855 (shen.prolog-parameters V1850) (let W1856 (shen.hascut? V1850) (let W1857 (shen.prolog-fbody V1850 W1855 W1851 W1852 W1853 W1854 W1856) (let W1858 (if W1856 (cons let (cons W1853 (cons (cons + (cons W1853 (cons 1 ()))) (cons W1857 ())))) W1857) (let W1859 (cons define (cons V1849 (append W1855 (append (cons W1851 (cons W1852 (cons W1853 (cons W1854 (cons -> ()))))) (cons W1858 ()))))) W1859)))))))))) -(defun shen.hascut? (V1508) (cond ((= ! V1508) true) ((cons? V1508) (or (shen.hascut? (hd V1508)) (shen.hascut? (tl V1508)))) (true false))) +(defun shen.hascut? (V1862) (cond ((= ! V1862) true) ((cons? V1862) (or (shen.hascut? (hd V1862)) (shen.hascut? (tl V1862)))) (true false))) -(defun shen.prolog-parameters (V1513) (cond ((and (cons? V1513) (cons? (hd V1513))) (shen.parameters (length (hd (hd V1513))))) (true (simple-error "partial function shen.prolog-parameters")))) +(defun shen.prolog-parameters (V1867) (cond ((and (cons? V1867) (cons? (hd V1867))) (shen.parameters (length (hd (hd V1867))))) (true (shen.f-error shen.prolog-parameters)))) -(defun shen.prolog-fbody (V1534 V1535 V1536 V1537 V1538 V1539 V1540) (cond ((and (= () V1534) (= true V1540)) (cons shen.unlock (cons V1537 (cons V1538 ())))) ((and (cons? V1534) (and (cons? (hd V1534)) (and (cons? (tl (hd V1534))) (and (= () (tl (tl (hd V1534)))) (and (= () (tl V1534)) (= false V1540)))))) (let W1541 (shen.continue (hd (hd V1534)) (hd (tl (hd V1534))) V1536 V1537 V1538 V1539) (cons if (cons (cons shen.unlocked? (cons V1537 ())) (cons (shen.compile-head shen.+m (hd (hd V1534)) V1535 V1536 W1541) (cons false ())))))) ((and (cons? V1534) (and (cons? (hd V1534)) (and (cons? (tl (hd V1534))) (= () (tl (tl (hd V1534))))))) (let W1542 (gensym C) (let W1543 (shen.continue (hd (hd V1534)) (hd (tl (hd V1534))) V1536 V1537 V1538 V1539) (cons let (cons W1542 (cons (cons if (cons (cons shen.unlocked? (cons V1537 ())) (cons (shen.compile-head shen.+m (hd (hd V1534)) V1535 V1536 W1543) (cons false ())))) (cons (cons if (cons (cons = (cons W1542 (cons false ()))) (cons (shen.prolog-fbody (tl V1534) V1535 V1536 V1537 V1538 V1539 V1540) (cons W1542 ())))) ()))))))) (true (simple-error "implementation error in shen.prolog-fbody")))) +(defun shen.prolog-fbody (V1888 V1889 V1890 V1891 V1892 V1893 V1894) (cond ((and (= () V1888) (= true V1894)) (cons shen.unlock (cons V1891 (cons V1892 ())))) ((and (cons? V1888) (and (cons? (hd V1888)) (and (cons? (tl (hd V1888))) (and (= () (tl (tl (hd V1888)))) (and (= () (tl V1888)) (= false V1894)))))) (let W1895 (shen.continue (hd (hd V1888)) (hd (tl (hd V1888))) V1890 V1891 V1892 V1893) (cons if (cons (cons shen.unlocked? (cons V1891 ())) (cons (shen.compile-head shen.+m (hd (hd V1888)) V1889 V1890 W1895) (cons false ())))))) ((and (cons? V1888) (and (cons? (hd V1888)) (and (cons? (tl (hd V1888))) (= () (tl (tl (hd V1888))))))) (let W1896 (gensym C) (let W1897 (shen.continue (hd (hd V1888)) (hd (tl (hd V1888))) V1890 V1891 V1892 V1893) (cons let (cons W1896 (cons (cons if (cons (cons shen.unlocked? (cons V1891 ())) (cons (shen.compile-head shen.+m (hd (hd V1888)) V1889 V1890 W1897) (cons false ())))) (cons (cons if (cons (cons = (cons W1896 (cons false ()))) (cons (shen.prolog-fbody (tl V1888) V1889 V1890 V1891 V1892 V1893 V1894) (cons W1896 ())))) ()))))))) (true (simple-error "implementation error in shen.prolog-fbody")))) -(defun shen.unlock (V1544 V1545) (if (and (shen.locked? V1544) (shen.fits? V1545 V1544)) (shen.openlock V1544) false)) +(defun shen.unlock (V1898 V1899) (if (and (shen.locked? V1898) (shen.fits? V1899 V1898)) (shen.openlock V1898) false)) -(defun shen.locked? (V1546) (not (shen.unlocked? V1546))) +(defun shen.locked? (V1900) (not (shen.unlocked? V1900))) -(defun shen.unlocked? (V1547) (<-address V1547 1)) +(defun shen.unlocked? (V1901) (<-address V1901 1)) -(defun shen.openlock (V1548) (do (address-> V1548 1 true) false)) +(defun shen.openlock (V1902) (do (address-> V1902 1 true) false)) -(defun shen.fits? (V1549 V1550) (= V1549 (<-address V1550 2))) +(defun shen.fits? (V1903 V1904) (= V1903 (<-address V1904 2))) -(defun shen.cut (V1553 V1554 V1555 V1556) (let W1557 (thaw V1556) (if (and (= W1557 false) (shen.unlocked? V1554)) (shen.lock V1555 V1554) W1557))) +(defun shen.cut (V1907 V1908 V1909 V1910) (let W1911 (thaw V1910) (if (and (= W1911 false) (shen.unlocked? V1908)) (shen.lock V1909 V1908) W1911))) -(defun shen.lock (V1558 V1559) (let W1560 (address-> V1559 1 false) (let W1561 (address-> V1559 2 V1558) false))) +(defun shen.lock (V1912 V1913) (let W1914 (address-> V1913 1 false) (let W1915 (address-> V1913 2 V1912) false))) -(defun shen.continue (V1562 V1563 V1564 V1565 V1566 V1567) (let W1568 (shen.extract-vars V1562) (let W1569 (shen.extract-free-vars V1563) (let W1570 (difference W1569 W1568) (let W1571 (cons do (cons (cons shen.incinfs ()) (cons (shen.compile-body V1563 V1564 V1565 V1566 V1567) ()))) (shen.stpart W1570 W1571 V1564)))))) +(defun shen.continue (V1916 V1917 V1918 V1919 V1920 V1921) (let W1922 (shen.extract-vars V1916) (let W1923 (shen.extract-free-vars V1917) (let W1924 (difference W1923 W1922) (let W1925 (cons do (cons (cons shen.incinfs ()) (cons (shen.compile-body V1917 V1918 V1919 V1920 V1921) ()))) (shen.stpart W1924 W1925 V1918)))))) -(defun shen.extract-free-vars (V1574) (cond ((and (cons? V1574) (and (= lambda (hd V1574)) (and (cons? (tl V1574)) (and (cons? (tl (tl V1574))) (= () (tl (tl (tl V1574)))))))) (remove (hd (tl V1574)) (shen.extract-free-vars (hd (tl (tl V1574)))))) ((cons? V1574) (union (shen.extract-free-vars (hd V1574)) (shen.extract-free-vars (tl V1574)))) ((variable? V1574) (cons V1574 ())) (true ()))) +(defun shen.extract-free-vars (V1928) (cond ((and (cons? V1928) (and (= lambda (hd V1928)) (and (cons? (tl V1928)) (and (cons? (tl (tl V1928))) (= () (tl (tl (tl V1928)))))))) (remove (hd (tl V1928)) (shen.extract-free-vars (hd (tl (tl V1928)))))) ((cons? V1928) (union (shen.extract-free-vars (hd V1928)) (shen.extract-free-vars (tl V1928)))) ((variable? V1928) (cons V1928 ())) (true ()))) -(defun shen.compile-body (V1591 V1592 V1593 V1594 V1595) (cond ((= () V1591) (cons thaw (cons V1595 ()))) ((and (cons? V1591) (= ! (hd V1591))) (shen.compile-body (cons (cons shen.cut ()) (tl V1591)) V1592 V1593 V1594 V1595)) ((and (cons? V1591) (= () (tl V1591))) (append (shen.deref-calls (hd V1591) V1592) (cons V1592 (cons V1593 (cons V1594 (cons V1595 ())))))) ((cons? V1591) (let W1596 (shen.deref-calls (hd V1591) V1592) (append W1596 (cons V1592 (cons V1593 (cons V1594 (cons (shen.freeze-literals (tl V1591) V1592 V1593 V1594 V1595) ()))))))) (true (simple-error "implementation error in shen.compile-fbody")))) +(defun shen.compile-body (V1945 V1946 V1947 V1948 V1949) (cond ((= () V1945) (cons thaw (cons V1949 ()))) ((and (cons? V1945) (= ! (hd V1945))) (shen.compile-body (cons (cons shen.cut ()) (tl V1945)) V1946 V1947 V1948 V1949)) ((and (cons? V1945) (= () (tl V1945))) (append (shen.deref-calls (hd V1945) V1946) (cons V1946 (cons V1947 (cons V1948 (cons V1949 ())))))) ((cons? V1945) (let W1950 (shen.deref-calls (hd V1945) V1946) (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.compile-fbody")))) -(defun shen.freeze-literals (V1613 V1614 V1615 V1616 V1617) (cond ((= () V1613) V1617) ((and (cons? V1613) (= ! (hd V1613))) (shen.freeze-literals (cons (cons shen.cut ()) (tl V1613)) V1614 V1615 V1616 V1617)) ((cons? V1613) (let W1618 (shen.deref-calls (hd V1613) V1614) (cons freeze (cons (append W1618 (cons V1614 (cons V1615 (cons V1616 (cons (shen.freeze-literals (tl V1613) V1614 V1615 V1616 V1617) ()))))) ())))) (true (simple-error "implementation error in shen.freeze-literals")))) +(defun shen.freeze-literals (V1967 V1968 V1969 V1970 V1971) (cond ((= () V1967) V1971) ((and (cons? V1967) (= ! (hd V1967))) (shen.freeze-literals (cons (cons shen.cut ()) (tl V1967)) V1968 V1969 V1970 V1971)) ((cons? V1967) (let W1972 (shen.deref-calls (hd V1967) V1968) (cons freeze (cons (append W1972 (cons V1968 (cons V1969 (cons V1970 (cons (shen.freeze-literals (tl V1967) V1968 V1969 V1970 V1971) ()))))) ())))) (true (simple-error "implementation error in shen.freeze-literals")))) -(defun shen.deref-calls (V1623 V1624) (cond ((and (cons? V1623) (= fork (hd V1623))) (cons fork (cons (shen.deref-forked-literals (tl V1623) V1624) ()))) ((cons? V1623) (cons (hd V1623) (map (lambda Z1625 (shen.function-calls Z1625 V1624)) (tl V1623)))) (true (simple-error "implementation error in shen.deref-calls")))) +(defun shen.deref-calls (V1977 V1978) (cond ((and (cons? V1977) (= fork (hd V1977))) (cons fork (cons (shen.deref-forked-literals (tl V1977) V1978) ()))) ((cons? V1977) (cons (hd V1977) (map (lambda Z1979 (shen.function-calls Z1979 V1978)) (tl V1977)))) (true (simple-error "implementation error in shen.deref-calls")))) -(defun shen.deref-forked-literals (V1632 V1633) (cond ((= () V1632) ()) ((cons? V1632) (cons cons (cons (shen.deref-calls (hd V1632) V1633) (cons (shen.deref-forked-literals (tl V1632) V1633) ())))) (true (simple-error "fork requires a list of literals +(defun shen.deref-forked-literals (V1986 V1987) (cond ((= () V1986) ()) ((cons? V1986) (cons cons (cons (shen.deref-calls (hd V1986) V1987) (cons (shen.deref-forked-literals (tl V1986) V1987) ())))) (true (simple-error "fork requires a list of literals ")))) -(defun shen.function-calls (V1636 V1637) (cond ((and (cons? V1636) (and (= cons (hd V1636)) (and (cons? (tl V1636)) (and (cons? (tl (tl V1636))) (= () (tl (tl (tl V1636)))))))) (cons cons (cons (shen.function-calls (hd (tl V1636)) V1637) (cons (shen.function-calls (hd (tl (tl V1636))) V1637) ())))) ((cons? V1636) (shen.deref-terms V1636 V1637 ())) (true V1636))) +(defun shen.function-calls (V1990 V1991) (cond ((and (cons? V1990) (and (= cons (hd V1990)) (and (cons? (tl V1990)) (and (cons? (tl (tl V1990))) (= () (tl (tl (tl V1990)))))))) (cons cons (cons (shen.function-calls (hd (tl V1990)) V1991) (cons (shen.function-calls (hd (tl (tl V1990))) V1991) ())))) ((cons? V1990) (shen.deref-terms V1990 V1991 ())) (true V1990))) -(defun shen.deref-terms (V1646 V1647 V1648) (cond ((and (cons? V1646) (and (= 0 (hd V1646)) (and (cons? (tl V1646)) (= () (tl (tl V1646)))))) (if (variable? (hd (tl V1646))) (hd (tl V1646)) (simple-error (cn "attempt to optimise a non-variable " (shen.app (hd (tl V1646)) " -" shen.s))))) ((and (cons? V1646) (and (= 1 (hd V1646)) (and (cons? (tl V1646)) (= () (tl (tl V1646)))))) (if (variable? (hd (tl V1646))) (cons shen.lazyderef (cons (hd (tl V1646)) (cons V1647 ()))) (simple-error (cn "attempt to optimise a non-variable " (shen.app (hd (tl V1646)) " -" shen.s))))) ((and (not (element? V1646 V1648)) (variable? V1646)) (cons shen.deref (cons V1646 (cons V1647 ())))) ((and (cons? V1646) (and (= lambda (hd V1646)) (and (cons? (tl V1646)) (and (cons? (tl (tl V1646))) (= () (tl (tl (tl V1646)))))))) (cons lambda (cons (hd (tl V1646)) (cons (shen.deref-terms (hd (tl (tl V1646))) V1647 (cons (hd (tl V1646)) V1648)) ())))) ((cons? V1646) (map (lambda Z1649 (shen.deref-terms Z1649 V1647 V1648)) V1646)) (true V1646))) +(defun shen.deref-terms (V2000 V2001 V2002) (cond ((and (cons? V2000) (and (= 0 (hd V2000)) (and (cons? (tl V2000)) (= () (tl (tl V2000)))))) (if (variable? (hd (tl V2000))) (hd (tl V2000)) (simple-error (cn "attempt to optimise a non-variable " (shen.app (hd (tl V2000)) " +" shen.s))))) ((and (cons? V2000) (and (= 1 (hd V2000)) (and (cons? (tl V2000)) (= () (tl (tl V2000)))))) (if (variable? (hd (tl V2000))) (cons shen.lazyderef (cons (hd (tl V2000)) (cons V2001 ()))) (simple-error (cn "attempt to optimise a non-variable " (shen.app (hd (tl V2000)) " +" shen.s))))) ((and (not (element? V2000 V2002)) (variable? V2000)) (cons shen.deref (cons V2000 (cons V2001 ())))) ((and (cons? V2000) (and (= lambda (hd V2000)) (and (cons? (tl V2000)) (and (cons? (tl (tl V2000))) (= () (tl (tl (tl V2000)))))))) (cons lambda (cons (hd (tl V2000)) (cons (shen.deref-terms (hd (tl (tl V2000))) V2001 (cons (hd (tl V2000)) V2002)) ())))) ((cons? V2000) (map (lambda Z2003 (shen.deref-terms Z2003 V2001 V2002)) V2000)) (true V2000))) -(defun shen.compile-head (V1667 V1668 V1669 V1670 V1671) (cond ((and (= () V1668) (= () V1669)) V1671) ((and (cons? V1668) (and (cons? (hd V1668)) (and (= shen.+m (hd (hd V1668))) (and (cons? (tl (hd V1668))) (= () (tl (tl (hd V1668)))))))) (shen.compile-head V1667 (cons shen.+m (cons (hd (tl (hd V1668))) (cons V1667 (tl V1668)))) V1669 V1670 V1671)) ((and (cons? V1668) (and (cons? (hd V1668)) (and (= shen.-m (hd (hd V1668))) (and (cons? (tl (hd V1668))) (= () (tl (tl (hd V1668)))))))) (shen.compile-head V1667 (cons shen.-m (cons (hd (tl (hd V1668))) (cons V1667 (tl V1668)))) V1669 V1670 V1671)) ((and (cons? V1668) (= shen.-m (hd V1668))) (shen.compile-head shen.-m (tl V1668) V1669 V1670 V1671)) ((and (cons? V1668) (= shen.+m (hd V1668))) (shen.compile-head shen.+m (tl V1668) V1669 V1670 V1671)) ((and (cons? V1668) (and (cons? V1669) (shen.wildcard? (hd V1668)))) (shen.compile-head V1667 (tl V1668) (tl V1669) V1670 V1671)) ((and (cons? V1668) (variable? (hd V1668))) (shen.variable-case V1667 V1668 V1669 V1670 V1671)) ((and (= shen.-m V1667) (and (cons? V1668) (atom? (hd V1668)))) (shen.atom-case-minus V1668 V1669 V1670 V1671)) ((and (= shen.-m V1667) (and (cons? V1668) (and (cons? (hd V1668)) (and (= cons (hd (hd V1668))) (and (cons? (tl (hd V1668))) (and (cons? (tl (tl (hd V1668)))) (= () (tl (tl (tl (hd V1668))))))))))) (shen.cons-case-minus V1668 V1669 V1670 V1671)) ((and (= shen.+m V1667) (and (cons? V1668) (atom? (hd V1668)))) (shen.atom-case-plus V1668 V1669 V1670 V1671)) ((and (= shen.+m V1667) (and (cons? V1668) (and (cons? (hd V1668)) (and (= cons (hd (hd V1668))) (and (cons? (tl (hd V1668))) (and (cons? (tl (tl (hd V1668)))) (= () (tl (tl (tl (hd V1668))))))))))) (shen.cons-case-plus V1668 V1669 V1670 V1671)) (true (simple-error "implementation error in shen.compile-head")))) +(defun shen.compile-head (V2021 V2022 V2023 V2024 V2025) (cond ((and (= () V2022) (= () V2023)) V2025) ((and (cons? V2022) (and (cons? (hd V2022)) (and (= shen.+m (hd (hd V2022))) (and (cons? (tl (hd V2022))) (= () (tl (tl (hd V2022)))))))) (shen.compile-head V2021 (cons shen.+m (cons (hd (tl (hd V2022))) (cons V2021 (tl V2022)))) V2023 V2024 V2025)) ((and (cons? V2022) (and (cons? (hd V2022)) (and (= shen.-m (hd (hd V2022))) (and (cons? (tl (hd V2022))) (= () (tl (tl (hd V2022)))))))) (shen.compile-head V2021 (cons shen.-m (cons (hd (tl (hd V2022))) (cons V2021 (tl V2022)))) V2023 V2024 V2025)) ((and (cons? V2022) (= shen.-m (hd V2022))) (shen.compile-head shen.-m (tl V2022) V2023 V2024 V2025)) ((and (cons? V2022) (= shen.+m (hd V2022))) (shen.compile-head shen.+m (tl V2022) V2023 V2024 V2025)) ((and (cons? V2022) (and (cons? V2023) (shen.wildcard? (hd V2022)))) (shen.compile-head V2021 (tl V2022) (tl V2023) V2024 V2025)) ((and (cons? V2022) (variable? (hd V2022))) (shen.variable-case V2021 V2022 V2023 V2024 V2025)) ((and (= shen.-m V2021) (and (cons? V2022) (atom? (hd V2022)))) (shen.atom-case-minus V2022 V2023 V2024 V2025)) ((and (= shen.-m V2021) (and (cons? V2022) (and (cons? (hd V2022)) (and (= cons (hd (hd V2022))) (and (cons? (tl (hd V2022))) (and (cons? (tl (tl (hd V2022)))) (= () (tl (tl (tl (hd V2022))))))))))) (shen.cons-case-minus V2022 V2023 V2024 V2025)) ((and (= shen.+m V2021) (and (cons? V2022) (atom? (hd V2022)))) (shen.atom-case-plus V2022 V2023 V2024 V2025)) ((and (= shen.+m V2021) (and (cons? V2022) (and (cons? (hd V2022)) (and (= cons (hd (hd V2022))) (and (cons? (tl (hd V2022))) (and (cons? (tl (tl (hd V2022)))) (= () (tl (tl (tl (hd V2022))))))))))) (shen.cons-case-plus V2022 V2023 V2024 V2025)) (true (simple-error "implementation error in shen.compile-head")))) -(defun shen.variable-case (V1682 V1683 V1684 V1685 V1686) (cond ((and (cons? V1683) (cons? V1684)) (if (variable? (hd V1684)) (shen.compile-head V1682 (tl V1683) (tl V1684) V1685 (subst (hd V1684) (hd V1683) V1686)) (cons let (cons (hd V1683) (cons (hd V1684) (cons (shen.compile-head V1682 (tl V1683) (tl V1684) V1685 V1686) ())))))) (true (simple-error "implementation error in shen.variable-case")))) +(defun shen.variable-case (V2036 V2037 V2038 V2039 V2040) (cond ((and (cons? V2037) (cons? V2038)) (if (variable? (hd V2038)) (shen.compile-head V2036 (tl V2037) (tl V2038) V2039 (subst (hd V2038) (hd V2037) V2040)) (cons let (cons (hd V2037) (cons (hd V2038) (cons (shen.compile-head V2036 (tl V2037) (tl V2038) V2039 V2040) ())))))) (true (simple-error "implementation error in shen.variable-case")))) -(defun shen.atom-case-minus (V1695 V1696 V1697 V1698) (cond ((and (cons? V1695) (cons? V1696)) (let W1699 (gensym Tm) (cons let (cons W1699 (cons (cons shen.lazyderef (cons (hd V1696) (cons V1697 ()))) (cons (cons if (cons (cons = (cons W1699 (cons (hd V1695) ()))) (cons (shen.compile-head shen.-m (tl V1695) (tl V1696) V1697 V1698) (cons false ())))) ())))))) (true (simple-error "implementation error in shen.atom-case-minus")))) +(defun shen.atom-case-minus (V2049 V2050 V2051 V2052) (cond ((and (cons? V2049) (cons? V2050)) (let W2053 (gensym Tm) (cons let (cons W2053 (cons (cons shen.lazyderef (cons (hd V2050) (cons V2051 ()))) (cons (cons if (cons (cons = (cons W2053 (cons (hd V2049) ()))) (cons (shen.compile-head shen.-m (tl V2049) (tl V2050) V2051 V2052) (cons false ())))) ())))))) (true (simple-error "implementation error in shen.atom-case-minus")))) -(defun shen.cons-case-minus (V1708 V1709 V1710 V1711) (cond ((and (cons? V1708) (and (cons? (hd V1708)) (and (= cons (hd (hd V1708))) (and (cons? (tl (hd V1708))) (and (cons? (tl (tl (hd V1708)))) (and (= () (tl (tl (tl (hd V1708))))) (cons? V1709))))))) (let W1712 (gensym Tm) (cons let (cons W1712 (cons (cons shen.lazyderef (cons (hd V1709) (cons V1710 ()))) (cons (cons if (cons (cons cons? (cons W1712 ())) (cons (shen.compile-head shen.-m (cons (hd (tl (hd V1708))) (cons (hd (tl (tl (hd V1708)))) (tl V1708))) (cons (cons hd (cons W1712 ())) (cons (cons tl (cons W1712 ())) (tl V1709))) V1710 V1711) (cons false ())))) ())))))) (true (simple-error "implementation error in shen.cons-case-minus")))) +(defun shen.cons-case-minus (V2062 V2063 V2064 V2065) (cond ((and (cons? V2062) (and (cons? (hd V2062)) (and (= cons (hd (hd V2062))) (and (cons? (tl (hd V2062))) (and (cons? (tl (tl (hd V2062)))) (and (= () (tl (tl (tl (hd V2062))))) (cons? V2063))))))) (let W2066 (gensym Tm) (cons let (cons W2066 (cons (cons shen.lazyderef (cons (hd V2063) (cons V2064 ()))) (cons (cons if (cons (cons cons? (cons W2066 ())) (cons (shen.compile-head shen.-m (cons (hd (tl (hd V2062))) (cons (hd (tl (tl (hd V2062)))) (tl V2062))) (cons (cons hd (cons W2066 ())) (cons (cons tl (cons W2066 ())) (tl V2063))) V2064 V2065) (cons false ())))) ())))))) (true (simple-error "implementation error in shen.cons-case-minus")))) -(defun shen.atom-case-plus (V1721 V1722 V1723 V1724) (cond ((and (cons? V1721) (cons? V1722)) (let W1725 (gensym Tm) (let W1726 (gensym GoTo) (cons let (cons W1725 (cons (cons shen.lazyderef (cons (hd V1722) (cons V1723 ()))) (cons W1726 (cons (cons freeze (cons (shen.compile-head shen.+m (tl V1721) (tl V1722) V1723 V1724) ())) (cons (cons if (cons (cons = (cons W1725 (cons (hd V1721) ()))) (cons (cons thaw (cons W1726 ())) (cons (cons if (cons (cons shen.pvar? (cons W1725 ())) (cons (cons shen.bind! (cons W1725 (cons (shen.demode (hd V1721)) (cons V1723 (cons W1726 ()))))) (cons false ())))) ())))) ()))))))))) (true (simple-error "implementation error in shen.atom-case-plus")))) +(defun shen.atom-case-plus (V2075 V2076 V2077 V2078) (cond ((and (cons? V2075) (cons? V2076)) (let W2079 (gensym Tm) (let W2080 (gensym GoTo) (cons let (cons W2079 (cons (cons shen.lazyderef (cons (hd V2076) (cons V2077 ()))) (cons W2080 (cons (cons freeze (cons (shen.compile-head shen.+m (tl V2075) (tl V2076) V2077 V2078) ())) (cons (cons if (cons (cons = (cons W2079 (cons (hd V2075) ()))) (cons (cons thaw (cons W2080 ())) (cons (cons if (cons (cons shen.pvar? (cons W2079 ())) (cons (cons shen.bind! (cons W2079 (cons (shen.demode (hd V2075)) (cons V2077 (cons W2080 ()))))) (cons false ())))) ())))) ()))))))))) (true (simple-error "implementation error in shen.atom-case-plus")))) -(defun shen.cons-case-plus (V1735 V1736 V1737 V1738) (cond ((and (cons? V1735) (and (cons? (hd V1735)) (and (= cons (hd (hd V1735))) (and (cons? (tl (hd V1735))) (and (cons? (tl (tl (hd V1735)))) (and (= () (tl (tl (tl (hd V1735))))) (cons? V1736))))))) (let W1739 (gensym Tm) (let W1740 (gensym GoTo) (let W1741 (shen.extract-vars (cons (hd (tl (hd V1735))) (hd (tl (tl (hd V1735)))))) (let W1742 (shen.tame (hd V1735)) (let W1743 (shen.extract-vars W1742) (cons let (cons W1739 (cons (cons shen.lazyderef (cons (hd V1736) (cons V1737 ()))) (cons W1740 (cons (shen.goto W1741 (shen.compile-head shen.+m (tl V1735) (tl V1736) V1737 V1738)) (cons (cons if (cons (cons cons? (cons W1739 ())) (cons (shen.compile-head shen.+m (tl (hd V1735)) (cons (cons hd (cons W1739 ())) (cons (cons tl (cons W1739 ())) ())) V1737 (shen.invoke W1740 W1741)) (cons (cons if (cons (cons shen.pvar? (cons W1739 ())) (cons (shen.stpart W1743 (cons shen.bind! (cons W1739 (cons (shen.demode W1742) (cons V1737 (cons (cons freeze (cons (shen.invoke W1740 W1741) ())) ()))))) V1737) (cons false ())))) ())))) ())))))))))))) (true (simple-error "implementation error in shen.cons-case-plus")))) +(defun shen.cons-case-plus (V2089 V2090 V2091 V2092) (cond ((and (cons? V2089) (and (cons? (hd V2089)) (and (= cons (hd (hd V2089))) (and (cons? (tl (hd V2089))) (and (cons? (tl (tl (hd V2089)))) (and (= () (tl (tl (tl (hd V2089))))) (cons? V2090))))))) (let W2093 (gensym Tm) (let W2094 (gensym GoTo) (let W2095 (shen.extract-vars (cons (hd (tl (hd V2089))) (hd (tl (tl (hd V2089)))))) (let W2096 (shen.tame (hd V2089)) (let W2097 (shen.extract-vars W2096) (cons let (cons W2093 (cons (cons shen.lazyderef (cons (hd V2090) (cons V2091 ()))) (cons W2094 (cons (shen.goto W2095 (shen.compile-head shen.+m (tl V2089) (tl V2090) V2091 V2092)) (cons (cons if (cons (cons cons? (cons W2093 ())) (cons (shen.compile-head shen.+m (tl (hd V2089)) (cons (cons hd (cons W2093 ())) (cons (cons tl (cons W2093 ())) ())) V2091 (shen.invoke W2094 W2095)) (cons (cons if (cons (cons shen.pvar? (cons W2093 ())) (cons (shen.stpart W2097 (cons shen.bind! (cons W2093 (cons (shen.demode W2096) (cons V2091 (cons (cons freeze (cons (shen.invoke W2094 W2095) ())) ()))))) V2091) (cons false ())))) ())))) ())))))))))))) (true (simple-error "implementation error in shen.cons-case-plus")))) -(defun shen.demode (V1744) (cond ((and (cons? V1744) (and (= shen.+m (hd V1744)) (and (cons? (tl V1744)) (= () (tl (tl V1744)))))) (shen.demode (hd (tl V1744)))) ((and (cons? V1744) (and (= shen.-m (hd V1744)) (and (cons? (tl V1744)) (= () (tl (tl V1744)))))) (shen.demode (hd (tl V1744)))) ((cons? V1744) (map (lambda Z1745 (shen.demode Z1745)) V1744)) (true V1744))) +(defun shen.demode (V2098) (cond ((and (cons? V2098) (and (= shen.+m (hd V2098)) (and (cons? (tl V2098)) (= () (tl (tl V2098)))))) (shen.demode (hd (tl V2098)))) ((and (cons? V2098) (and (= shen.-m (hd V2098)) (and (cons? (tl V2098)) (= () (tl (tl V2098)))))) (shen.demode (hd (tl V2098)))) ((cons? V2098) (map (lambda Z2099 (shen.demode Z2099)) V2098)) (true V2098))) -(defun shen.tame (V1746) (cond ((shen.wildcard? V1746) (gensym Y)) ((cons? V1746) (map (lambda Z1747 (shen.tame Z1747)) V1746)) (true V1746))) +(defun shen.tame (V2100) (cond ((shen.wildcard? V2100) (gensym Y)) ((cons? V2100) (map (lambda Z2101 (shen.tame Z2101)) V2100)) (true V2100))) -(defun shen.goto (V1748 V1749) (cond ((= () V1748) (cons freeze (cons V1749 ()))) (true (shen.goto-h V1748 V1749)))) +(defun shen.goto (V2102 V2103) (cond ((= () V2102) (cons freeze (cons V2103 ()))) (true (shen.goto-h V2102 V2103)))) -(defun shen.goto-h (V1750 V1751) (cond ((= () V1750) V1751) ((cons? V1750) (cons lambda (cons (hd V1750) (cons (shen.goto-h (tl V1750) V1751) ())))) (true (simple-error "partial function shen.goto-h")))) +(defun shen.goto-h (V2104 V2105) (cond ((= () V2104) V2105) ((cons? V2104) (cons lambda (cons (hd V2104) (cons (shen.goto-h (tl V2104) V2105) ())))) (true (shen.f-error shen.goto-h)))) -(defun shen.invoke (V1752 V1753) (cond ((= () V1753) (cons thaw (cons V1752 ()))) (true (cons V1752 V1753)))) +(defun shen.invoke (V2106 V2107) (cond ((= () V2107) (cons thaw (cons V2106 ()))) (true (cons V2106 V2107)))) -(defun shen.wildcard? (V1754) (= V1754 _)) +(defun shen.wildcard? (V2108) (= V2108 _)) -(defun shen.pvar? (V1755) (trap-error (and (absvector? V1755) (= (<-address V1755 0) shen.pvar)) (lambda Z1756 false))) +(defun shen.pvar? (V2109) (and (absvector? V2109) (= (trap-error (<-address V2109 0) (lambda Z2110 shen.not-pvar)) shen.pvar))) -(defun shen.lazyderef (V1757 V1758) (if (shen.pvar? V1757) (let W1759 (<-address V1758 (<-address V1757 1)) (if (= W1759 shen.-null-) V1757 (shen.lazyderef W1759 V1758))) V1757)) +(defun shen.lazyderef (V2111 V2112) (if (shen.pvar? V2111) (let W2113 (<-address V2112 (<-address V2111 1)) (if (= W2113 shen.-null-) V2111 (shen.lazyderef W2113 V2112))) V2111)) -(defun shen.deref (V1760 V1761) (cond ((cons? V1760) (cons (shen.deref (hd V1760) V1761) (shen.deref (tl V1760) V1761))) (true (if (shen.pvar? V1760) (let W1762 (<-address V1761 (<-address V1760 1)) (if (= W1762 shen.-null-) V1760 (shen.deref W1762 V1761))) V1760)))) +(defun shen.deref (V2114 V2115) (cond ((cons? V2114) (cons (shen.deref (hd V2114) V2115) (shen.deref (tl V2114) V2115))) (true (if (shen.pvar? V2114) (let W2116 (<-address V2115 (<-address V2114 1)) (if (= W2116 shen.-null-) V2114 (shen.deref W2116 V2115))) V2114)))) -(defun shen.bind! (V1763 V1764 V1765 V1766) (let W1767 (shen.bindv V1763 V1764 V1765) (let W1768 (thaw V1766) (if (= W1768 false) (shen.unwind V1763 V1765 W1768) W1768)))) +(defun shen.bind! (V2117 V2118 V2119 V2120) (let W2121 (shen.bindv V2117 V2118 V2119) (let W2122 (thaw V2120) (if (= W2122 false) (shen.unwind V2117 V2119 W2122) W2122)))) -(defun shen.bindv (V1769 V1770 V1771) (address-> V1771 (<-address V1769 1) V1770)) +(defun shen.bindv (V2123 V2124 V2125) (address-> V2125 (<-address V2123 1) V2124)) -(defun shen.unwind (V1772 V1773 V1774) (do (address-> V1773 (<-address V1772 1) shen.-null-) V1774)) +(defun shen.unwind (V2126 V2127 V2128) (do (address-> V2127 (<-address V2126 1) shen.-null-) V2128)) -(defun shen.stpart (V1783 V1784 V1785) (cond ((= () V1783) V1784) ((cons? V1783) (cons let (cons (hd V1783) (cons (cons shen.newpv (cons V1785 ())) (cons (cons shen.gc (cons V1785 (cons (shen.stpart (tl V1783) V1784 V1785) ()))) ()))))) (true (simple-error "implementation error in shen.stpart")))) +(defun shen.stpart (V2137 V2138 V2139) (cond ((= () V2137) V2138) ((cons? V2137) (cons let (cons (hd V2137) (cons (cons shen.newpv (cons V2139 ())) (cons (cons shen.gc (cons V2139 (cons (shen.stpart (tl V2137) V2138 V2139) ()))) ()))))) (true (simple-error "implementation error in shen.stpart")))) -(defun shen.gc (V1786 V1787) (if (= V1787 false) (let W1788 (shen.ticket-number V1786) (do (shen.decrement-ticket W1788 V1786) V1787)) V1787)) +(defun shen.gc (V2140 V2141) (if (= V2141 false) (let W2142 (shen.ticket-number V2140) (do (shen.decrement-ticket W2142 V2140) V2141)) V2141)) -(defun shen.decrement-ticket (V1789 V1790) (address-> V1790 1 (- V1789 1))) +(defun shen.decrement-ticket (V2143 V2144) (address-> V2144 1 (- V2143 1))) -(defun shen.newpv (V1791) (let W1792 (shen.ticket-number V1791) (let W1793 (shen.make-prolog-variable W1792) (let W1794 (shen.nextticket V1791 W1792) W1793)))) +(defun shen.newpv (V2145) (let W2146 (shen.ticket-number V2145) (let W2147 (shen.make-prolog-variable W2146) (let W2148 (shen.nextticket V2145 W2146) W2147)))) -(defun shen.ticket-number (V1795) (<-address V1795 1)) +(defun shen.ticket-number (V2149) (<-address V2149 1)) -(defun shen.nextticket (V1796 V1797) (let W1798 (address-> V1796 V1797 shen.-null-) (address-> W1798 1 (+ V1797 1)))) +(defun shen.nextticket (V2150 V2151) (let W2152 (address-> V2150 V2151 shen.-null-) (address-> W2152 1 (+ V2151 1)))) -(defun shen.make-prolog-variable (V1799) (address-> (address-> (absvector 2) 0 shen.pvar) 1 V1799)) +(defun shen.make-prolog-variable (V2153) (address-> (address-> (absvector 2) 0 shen.pvar) 1 V2153)) -(defun shen.pvar (V1800) (cn "Var" (shen.app (<-address V1800 1) "" shen.a))) +(defun shen.pvar (V2154) (cn "Var" (shen.app (<-address V2154 1) "" shen.a))) (defun shen.incinfs () (set shen.*infs* (+ 1 (value shen.*infs*)))) -(defun shen.prolog-vector-size (V1801) (if (and (integer? V1801) (> V1801 0)) (set shen.*size-prolog-vector* V1801) (simple-error (cn "prolog vector size: size should be a positive integer; not " (shen.app V1801 "" shen.a))))) +(defun shen.prolog-vector-size (V2155) (if (and (integer? V2155) (> V2155 0)) (set shen.*size-prolog-vector* V2155) (simple-error (cn "prolog vector size: size should be a positive integer; not " (shen.app V2155 "" shen.a))))) -(defun shen.lzy=! (V1813 V1814 V1815 V1816) (cond ((= V1813 V1814) (thaw V1816)) ((and (shen.pvar? V1813) (not (shen.occurs-check? V1813 (shen.deref V1814 V1815)))) (shen.bind! V1813 V1814 V1815 V1816)) ((and (shen.pvar? V1814) (not (shen.occurs-check? V1814 (shen.deref V1813 V1815)))) (shen.bind! V1814 V1813 V1815 V1816)) ((and (cons? V1813) (cons? V1814)) (shen.lzy=! (shen.lazyderef (hd V1813) V1815) (shen.lazyderef (hd V1814) V1815) V1815 (freeze (shen.lzy=! (shen.lazyderef (tl V1813) V1815) (shen.lazyderef (tl V1814) V1815) V1815 V1816)))) (true false))) +(defun shen.lzy=! (V2167 V2168 V2169 V2170) (cond ((= V2167 V2168) (thaw V2170)) ((and (shen.pvar? V2167) (not (shen.occurs-check? V2167 (shen.deref V2168 V2169)))) (shen.bind! V2167 V2168 V2169 V2170)) ((and (shen.pvar? V2168) (not (shen.occurs-check? V2168 (shen.deref V2167 V2169)))) (shen.bind! V2168 V2167 V2169 V2170)) ((and (cons? V2167) (cons? V2168)) (shen.lzy=! (shen.lazyderef (hd V2167) V2169) (shen.lazyderef (hd V2168) V2169) V2169 (freeze (shen.lzy=! (shen.lazyderef (tl V2167) V2169) (shen.lazyderef (tl V2168) V2169) V2169 V2170)))) (true false))) -(defun shen.lzy= (V1828 V1829 V1830 V1831) (cond ((= V1828 V1829) (thaw V1831)) ((shen.pvar? V1828) (shen.bind! V1828 V1829 V1830 V1831)) ((shen.pvar? V1829) (shen.bind! V1829 V1828 V1830 V1831)) ((and (cons? V1828) (cons? V1829)) (shen.lzy= (shen.lazyderef (hd V1828) V1830) (shen.lazyderef (hd V1829) V1830) V1830 (freeze (shen.lzy= (shen.lazyderef (tl V1828) V1830) (shen.lazyderef (tl V1829) V1830) V1830 V1831)))) (true false))) +(defun shen.lzy= (V2182 V2183 V2184 V2185) (cond ((= V2182 V2183) (thaw V2185)) ((shen.pvar? V2182) (shen.bind! V2182 V2183 V2184 V2185)) ((shen.pvar? V2183) (shen.bind! V2183 V2182 V2184 V2185)) ((and (cons? V2182) (cons? V2183)) (shen.lzy= (shen.lazyderef (hd V2182) V2184) (shen.lazyderef (hd V2183) V2184) V2184 (freeze (shen.lzy= (shen.lazyderef (tl V2182) V2184) (shen.lazyderef (tl V2183) V2184) V2184 V2185)))) (true false))) -(defun shen.occurs-check? (V1837 V1838) (cond ((= V1837 V1838) true) ((cons? V1838) (or (shen.occurs-check? V1837 (hd V1838)) (shen.occurs-check? V1837 (tl V1838)))) (true false))) +(defun shen.occurs-check? (V2191 V2192) (cond ((= V2191 V2192) true) ((cons? V2192) (or (shen.occurs-check? V2191 (hd V2192)) (shen.occurs-check? V2191 (tl V2192)))) (true false))) -(defun call (V1839 V1840 V1841 V1842 V1843) ((((V1839 V1840) V1841) V1842) V1843)) +(defun call (V2193 V2194 V2195 V2196 V2197) ((((V2193 V2194) V2195) V2196) V2197)) -(defun return (V1850 V1851 V1852 V1853 V1854) (shen.deref V1850 V1851)) +(defun return (V2204 V2205 V2206 V2207 V2208) (shen.deref V2204 V2205)) -(defun when (V1861 V1862 V1863 V1864 V1865) (if V1861 (thaw V1865) false)) +(defun when (V2215 V2216 V2217 V2218 V2219) (if V2215 (thaw V2219) false)) -(defun is (V1866 V1867 V1868 V1869 V1870 V1871) (shen.lzy= (shen.lazyderef V1866 V1868) (shen.lazyderef V1867 V1868) V1868 V1871)) +(defun is (V2220 V2221 V2222 V2223 V2224 V2225) (shen.lzy= (shen.lazyderef V2220 V2222) (shen.lazyderef V2221 V2222) V2222 V2225)) -(defun is! (V1872 V1873 V1874 V1875 V1876 V1877) (shen.lzy=! (shen.lazyderef V1872 V1874) (shen.lazyderef V1873 V1874) V1874 V1877)) +(defun is! (V2226 V2227 V2228 V2229 V2230 V2231) (shen.lzy=! (shen.lazyderef V2226 V2228) (shen.lazyderef V2227 V2228) V2228 V2231)) -(defun bind (V1882 V1883 V1884 V1885 V1886 V1887) (shen.bind! V1882 V1883 V1884 V1887)) +(defun bind (V2236 V2237 V2238 V2239 V2240 V2241) (shen.bind! V2236 V2237 V2238 V2241)) -(defun var? (V1888 V1889 V1890 V1891 V1892) (if (shen.pvar? (shen.lazyderef V1888 V1889)) (thaw V1892) false)) +(defun var? (V2242 V2243 V2244 V2245 V2246) (if (shen.pvar? (shen.lazyderef V2242 V2243)) (thaw V2246) false)) -(defun shen.print-prolog-vector (V1895) "|prolog vector|") +(defun shen.print-prolog-vector (V2249) "|prolog vector|") -(defun fork (V1914 V1915 V1916 V1917 V1918) (cond ((= () V1914) false) ((cons? V1914) (let W1919 (((((hd V1914) V1915) V1916) V1917) V1918) (if (= W1919 false) (fork (tl V1914) V1915 V1916 V1917 V1918) W1919))) (true (simple-error "fork expects a list of literals +(defun fork (V2268 V2269 V2270 V2271 V2272) (cond ((= () V2268) false) ((cons? V2268) (let W2273 (((((hd V2268) V2269) V2270) V2271) V2272) (if (= W2273 false) (fork (tl V2268) V2269 V2270 V2271 V2272) W2273))) (true (simple-error "fork expects a list of literals ")))) -(defun findall (V1920 V1921 V1922 V1923 V1924 V1925 V1926) (if (shen.unlocked? V1924) (let W1927 (shen.newpv V1923) (shen.gc V1923 (do (shen.incinfs) (is W1927 () V1923 V1924 V1925 (freeze (shen.findall-h V1920 V1921 V1922 W1927 V1923 V1924 V1925 V1926)))))) false)) +(defun findall (V2274 V2275 V2276 V2277 V2278 V2279 V2280) (if (shen.unlocked? V2278) (let W2281 (shen.newpv V2277) (shen.gc V2277 (do (shen.incinfs) (is W2281 () V2277 V2278 V2279 (freeze (shen.findall-h V2274 V2275 V2276 W2281 V2277 V2278 V2279 V2280)))))) false)) -(defun shen.findall-h (V1928 V1929 V1930 V1931 V1932 V1933 V1934 V1935) (let W1936 (if (shen.unlocked? V1933) (do (shen.incinfs) (call V1929 V1932 V1933 V1934 (freeze (shen.overbind V1928 V1931 V1932 V1933 V1934 V1935)))) false) (if (= W1936 false) (if (shen.unlocked? V1933) (do (shen.incinfs) (is! V1930 V1931 V1932 V1933 V1934 V1935)) false) W1936))) +(defun shen.findall-h (V2282 V2283 V2284 V2285 V2286 V2287 V2288 V2289) (let W2290 (if (shen.unlocked? V2287) (do (shen.incinfs) (call V2283 V2286 V2287 V2288 (freeze (shen.overbind V2282 V2285 V2286 V2287 V2288 V2289)))) false) (if (= W2290 false) (if (shen.unlocked? V2287) (do (shen.incinfs) (is! V2284 V2285 V2286 V2287 V2288 V2289)) false) W2290))) -(defun shen.overbind (V1943 V1944 V1945 V1946 V1947 V1948) (do (shen.bindv V1944 (cons (shen.deref V1943 V1945) (shen.lazyderef V1944 V1945)) V1945) false)) +(defun shen.overbind (V2297 V2298 V2299 V2300 V2301 V2302) (do (shen.bindv V2298 (cons (shen.deref V2297 V2299) (shen.lazyderef V2298 V2299)) V2299) false)) -(defun occurs-check (V1951) (cond ((= + V1951) (set shen.*occurs* true)) ((= - V1951) (set shen.*occurs* false)) (true (simple-error "occurs-check expects a + or a -. +(defun occurs-check (V2305) (cond ((= + V2305) (set shen.*occurs* true)) ((= - V2305) (set shen.*occurs* false)) (true (simple-error "occurs-check expects a + or a -. ")))) diff --git a/klambda/reader.kl b/klambda/reader.kl index 5eda85b..3ff1ade 100644 --- a/klambda/reader.kl +++ b/klambda/reader.kl @@ -1,273 +1,287 @@ -(defun read-file (V2196) (let W2197 (read-file-as-bytelist V2196) (let W2198 (trap-error (compile (lambda Z2199 (shen. Z2199)) W2197) (lambda Z2200 (shen.reader-error (value shen.*residue*)))) (let W2201 (shen.process-sexprs W2198) W2201)))) +(defun read-file (V2560) (let W2561 (read-file-as-bytelist V2560) (let W2562 (trap-error (compile (lambda Z2563 (shen. Z2563)) W2561) (lambda Z2564 (shen.reader-error (value shen.*residue*)))) (let W2565 (shen.process-sexprs W2562) W2565)))) -(defun shen.reader-error (V2202) (simple-error (shen.proc-nl (cn "reader error near here: " (shen.reader-error-message (value *maximum-print-sequence-size*) 0 V2202))))) +(defun shen.reader-error (V2566) (simple-error (shen.proc-nl (cn "reader error near here: " (shen.reader-error-message (value *maximum-print-sequence-size*) 0 V2566))))) -(defun shen.reader-error-message (V2210 V2211 V2212) (cond ((= () V2212) "") ((= V2210 V2211) "") ((cons? V2212) (cn (n->string (hd V2212)) (shen.reader-error-message V2210 (+ V2211 1) (tl V2212)))) (true (simple-error "partial function shen.reader-error-message")))) +(defun shen.reader-error-message (V2574 V2575 V2576) (cond ((= () V2576) "") ((= V2574 V2575) "") ((cons? V2576) (cn (n->string (hd V2576)) (shen.reader-error-message V2574 (+ V2575 1) (tl V2576)))) (true (shen.f-error shen.reader-error-message)))) (defun it () (value shen.*it*)) -(defun read-file-as-bytelist (V2213) (let W2214 (open V2213 in) (let W2215 (read-byte W2214) (let W2216 (shen.read-file-as-bytelist-help W2214 W2215 ()) (let W2217 (close W2214) (reverse W2216)))))) +(defun read-file-as-bytelist (V2577) (let W2578 (open V2577 in) (let W2579 (read-byte W2578) (let W2580 (shen.read-file-as-bytelist-help W2578 W2579 ()) (let W2581 (close W2578) (reverse W2580)))))) -(defun shen.read-file-as-bytelist-help (V2218 V2219 V2220) (cond ((= -1 V2219) V2220) (true (shen.read-file-as-bytelist-help V2218 (read-byte V2218) (cons V2219 V2220))))) +(defun shen.read-file-as-bytelist-help (V2582 V2583 V2584) (cond ((= -1 V2583) V2584) (true (shen.read-file-as-bytelist-help V2582 (read-byte V2582) (cons V2583 V2584))))) -(defun read-file-as-string (V2221) (let W2222 (open V2221 in) (shen.rfas-h W2222 (read-byte W2222) ""))) +(defun read-file-as-string (V2585) (let W2586 (open V2585 in) (shen.rfas-h W2586 (read-byte W2586) ""))) -(defun shen.rfas-h (V2223 V2224 V2225) (cond ((= -1 V2224) (do (close V2223) V2225)) (true (shen.rfas-h V2223 (read-byte V2223) (cn V2225 (n->string V2224)))))) +(defun shen.rfas-h (V2587 V2588 V2589) (cond ((= -1 V2588) (do (close V2587) V2589)) (true (shen.rfas-h V2587 (read-byte V2587) (cn V2589 (n->string V2588)))))) -(defun input (V2226) (eval-kl (read V2226))) +(defun input (V2590) (eval-kl (read V2590))) -(defun shen.input-h+ (V2227 V2228) (let W2229 (shen.monotype V2227) (let W2230 (read V2228) (if (= false (shen.typecheck W2230 V2227)) (simple-error (cn "type error: " (shen.app W2230 (cn " is not of type " (shen.app V2227 " -" shen.r)) shen.r))) (eval-kl W2230))))) +(defun shen.input-h+ (V2591 V2592) (let W2593 (shen.monotype V2591) (let W2594 (read V2592) (if (= false (shen.typecheck W2594 V2591)) (simple-error (cn "type error: " (shen.app W2594 (cn " is not of type " (shen.app V2591 " +" shen.r)) shen.r))) (eval-kl W2594))))) -(defun shen.monotype (V2231) (cond ((cons? V2231) (map (lambda Z2232 (shen.monotype Z2232)) V2231)) (true (if (variable? V2231) (simple-error (cn "input+ expects a monotype: not " (shen.app V2231 " -" shen.a))) V2231)))) +(defun shen.monotype (V2595) (cond ((cons? V2595) (map (lambda Z2596 (shen.monotype Z2596)) V2595)) (true (if (variable? V2595) (simple-error (cn "input+ expects a monotype: not " (shen.app V2595 " +" shen.a))) V2595)))) -(defun lineread (V2233) (shen.read-loop V2233 (shen.my-read-byte V2233) () (lambda Z2234 (shen.return? Z2234)))) +(defun lineread (V2597) (shen.read-loop V2597 (shen.my-read-byte V2597) () (lambda Z2598 (shen.return? Z2598)))) -(defun read-from-string (V2235) (let W2236 (shen.str->bytes V2235) (let W2237 (compile (lambda Z2238 (shen. Z2238)) W2236) (let W2239 (shen.process-sexprs W2237) W2239)))) +(defun read-from-string (V2599) (let W2600 (shen.str->bytes V2599) (let W2601 (compile (lambda Z2602 (shen. Z2602)) W2600) (let W2603 (shen.process-sexprs W2601) W2603)))) -(defun read-from-string-unprocessed (V2240) (let W2241 (shen.str->bytes V2240) (let W2242 (compile (lambda Z2243 (shen. Z2243)) W2241) W2242))) +(defun read-from-string-unprocessed (V2604) (let W2605 (shen.str->bytes V2604) (let W2606 (compile (lambda Z2607 (shen. Z2607)) W2605) W2606))) -(defun shen.str->bytes (V2244) (cond ((= "" V2244) ()) ((shen.+string? V2244) (cons (string->n (hdstr V2244)) (shen.str->bytes (tlstr V2244)))) (true (simple-error "partial function shen.str->bytes")))) +(defun shen.str->bytes (V2608) (cond ((= "" V2608) ()) ((shen.+string? V2608) (cons (string->n (hdstr V2608)) (shen.str->bytes (tlstr V2608)))) (true (shen.f-error shen.str->bytes)))) -(defun read (V2245) (hd (shen.read-loop V2245 (shen.my-read-byte V2245) () (lambda Z2246 (shen.whitespace? Z2246))))) +(defun read (V2609) (hd (shen.read-loop V2609 (shen.my-read-byte V2609) () (lambda Z2610 (shen.whitespace? Z2610))))) -(defun shen.my-read-byte (V2247) (if (shen.char-stinput? V2247) (string->n (shen.read-unit-string V2247)) (read-byte V2247))) +(defun shen.my-read-byte (V2611) (if (shen.char-stinput? V2611) (string->n (shen.read-unit-string V2611)) (read-byte V2611))) -(defun shen.read-loop (V2252 V2253 V2254 V2255) (cond ((= 94 V2253) (simple-error "read aborted")) ((= -1 V2253) (if (empty? V2254) (simple-error "error: empty stream") (compile (lambda Z2256 (shen. Z2256)) V2254))) ((= 0 V2253) (shen.read-loop V2252 (shen.my-read-byte V2252) V2254 V2255)) (true (if (V2255 V2253) (let W2257 (shen.try-parse V2254) (if (shen.nothing-doing? W2257) (shen.read-loop V2252 (shen.my-read-byte V2252) (append V2254 (cons V2253 ())) V2255) (do (shen.record-it V2254) W2257))) (shen.read-loop V2252 (shen.my-read-byte V2252) (append V2254 (cons V2253 ())) V2255))))) +(defun shen.read-loop (V2616 V2617 V2618 V2619) (cond ((= 94 V2617) (simple-error "read aborted")) ((= -1 V2617) (if (empty? V2618) (simple-error "error: empty stream") (shen.process-sexprs (compile (lambda Z2620 (shen. Z2620)) V2618)))) ((= 0 V2617) (shen.read-loop V2616 (shen.my-read-byte V2616) V2618 V2619)) (true (if (V2619 V2617) (let W2621 (shen.try-parse V2618) (if (shen.nothing-doing? W2621) (shen.read-loop V2616 (shen.my-read-byte V2616) (append V2618 (cons V2617 ())) V2619) (do (shen.record-it V2618) (shen.process-sexprs W2621)))) (shen.read-loop V2616 (shen.my-read-byte V2616) (append V2618 (cons V2617 ())) V2619))))) -(defun shen.try-parse (V2258) (let W2259 (trap-error (compile (lambda Z2260 (shen. Z2260)) V2258) (lambda Z2261 shen.i-failed!)) (if (shen.nothing-doing? W2259) shen.i-failed! (shen.process-sexprs W2259)))) +(defun shen.try-parse (V2622) (trap-error (compile (lambda Z2623 (shen. Z2623)) V2622) (lambda Z2624 shen.i-failed!))) -(defun shen.nothing-doing? (V2264) (cond ((= shen.i-failed! V2264) true) ((= () V2264) true) (true false))) +(defun shen.nothing-doing? (V2627) (cond ((= shen.i-failed! V2627) true) ((= () V2627) true) (true false))) -(defun shen.record-it (V2265) (set shen.*it* (shen.bytes->string V2265))) +(defun shen.record-it (V2628) (set shen.*it* (shen.bytes->string V2628))) -(defun shen.bytes->string (V2266) (cond ((= () V2266) "") ((cons? V2266) (cn (n->string (hd V2266)) (shen.bytes->string (tl V2266)))) (true (simple-error "partial function shen.bytes->string")))) +(defun shen.bytes->string (V2629) (cond ((= () V2629) "") ((cons? V2629) (cn (n->string (hd V2629)) (shen.bytes->string (tl V2629)))) (true (shen.f-error shen.bytes->string)))) -(defun shen.process-sexprs (V2267) (let W2268 (shen.unpackage¯oexpand V2267) (let W2269 (shen.find-arities W2268) (let W2270 (shen.find-types W2268) (map (lambda Z2271 (shen.process-applications Z2271 W2270)) W2268))))) +(defun shen.process-sexprs (V2630) (let W2631 (shen.unpackage¯oexpand V2630) (let W2632 (shen.find-arities W2631) (let W2633 (shen.find-types W2631) (map (lambda Z2634 (shen.process-applications Z2634 W2633)) W2631))))) -(defun shen.find-types (V2272) (cond ((and (cons? V2272) (and (cons? (tl V2272)) (= (hd V2272) (intern ":")))) (cons (hd (tl V2272)) (shen.find-types (tl (tl V2272))))) ((cons? V2272) (append (shen.find-types (hd V2272)) (shen.find-types (tl V2272)))) (true ()))) +(defun shen.find-types (V2635) (cond ((and (cons? V2635) (and (cons? (tl V2635)) (= (hd V2635) (intern ":")))) (cons (hd (tl V2635)) (shen.find-types (tl (tl V2635))))) ((cons? V2635) (append (shen.find-types (hd V2635)) (shen.find-types (tl V2635)))) (true ()))) -(defun shen.find-arities (V2275) (cond ((and (cons? V2275) (and (= define (hd V2275)) (and (cons? (tl V2275)) (and (cons? (tl (tl V2275))) (= { (hd (tl (tl V2275)))))))) (shen.store-arity (hd (tl V2275)) (shen.find-arity (hd (tl V2275)) 1 (tl (tl (tl V2275)))))) ((and (cons? V2275) (and (= define (hd V2275)) (cons? (tl V2275)))) (shen.store-arity (hd (tl V2275)) (shen.find-arity (hd (tl V2275)) 0 (tl (tl V2275))))) ((cons? V2275) (map (lambda Z2276 (shen.find-arities Z2276)) V2275)) (true shen.skip))) +(defun shen.find-arities (V2638) (cond ((and (cons? V2638) (and (= define (hd V2638)) (and (cons? (tl V2638)) (and (cons? (tl (tl V2638))) (= { (hd (tl (tl V2638)))))))) (shen.store-arity (hd (tl V2638)) (shen.find-arity (hd (tl V2638)) 1 (tl (tl (tl V2638)))))) ((and (cons? V2638) (and (= define (hd V2638)) (cons? (tl V2638)))) (shen.store-arity (hd (tl V2638)) (shen.find-arity (hd (tl V2638)) 0 (tl (tl V2638))))) ((cons? V2638) (map (lambda Z2639 (shen.find-arities Z2639)) V2638)) (true shen.skip))) -(defun shen.store-arity (V2277 V2278) (let W2279 (arity V2277) (if (= W2279 -1) (shen.execute-store-arity V2277 V2278) (if (= W2279 V2278) shen.skip (if (shen.sysfunc? V2277) (simple-error (shen.app V2277 " is a system function -" shen.a)) (do (pr (cn "changing the arity of " (shen.app V2277 " may cause errors -" shen.a)) (stoutput)) (shen.execute-store-arity V2277 V2278))))))) +(defun shen.store-arity (V2640 V2641) (let W2642 (arity V2640) (if (= W2642 -1) (shen.execute-store-arity V2640 V2641) (if (= W2642 V2641) shen.skip (if (shen.sysfunc? V2640) (simple-error (shen.app V2640 " is a system function +" shen.a)) (do (pr (cn "changing the arity of " (shen.app V2640 " may cause errors +" shen.a)) (stoutput)) (shen.execute-store-arity V2640 V2641))))))) -(defun shen.execute-store-arity (V2280 V2281) (cond ((= 0 V2281) (put V2280 arity 0 (value *property-vector*))) (true (do (put V2280 arity V2281 (value *property-vector*)) (shen.update-lambdatable V2280 V2281))))) +(defun shen.execute-store-arity (V2643 V2644) (cond ((= 0 V2644) (put V2643 arity 0 (value *property-vector*))) (true (do (put V2643 arity V2644 (value *property-vector*)) (shen.update-lambdatable V2643 V2644))))) -(defun shen.update-lambdatable (V2282 V2283) (let W2284 (value shen.*lambdatable*) (let W2285 (eval-kl (shen.lambda-function (cons V2282 ()) V2283)) (let W2286 (shen.assoc-> V2282 W2285 W2284) (let W2287 (set shen.*lambdatable* W2286) W2287))))) +(defun shen.update-lambdatable (V2645 V2646) (let W2647 (eval-kl (shen.lambda-function (cons V2645 ()) V2646)) (let W2648 (shen.set-lambda-form-entry (cons V2645 W2647)) V2646))) -(defun shen.lambda-function (V2290 V2291) (cond ((= 0 V2291) shen.skip) ((= 1 V2291) (let W2292 (gensym Y) (cons lambda (cons W2292 (cons (append V2290 (cons W2292 ())) ()))))) (true (let W2293 (gensym Y) (cons lambda (cons W2293 (cons (shen.lambda-function (append V2290 (cons W2293 ())) (- V2291 1)) ()))))))) +(defun shen.lambda-function (V2651 V2652) (cond ((= 0 V2652) shen.skip) ((= 1 V2652) (let W2653 (gensym Y) (cons lambda (cons W2653 (cons (append V2651 (cons W2653 ())) ()))))) (true (let W2654 (gensym Y) (cons lambda (cons W2654 (cons (shen.lambda-function (append V2651 (cons W2654 ())) (- V2652 1)) ()))))))) -(defun shen.assoc-> (V2303 V2304 V2305) (cond ((= () V2305) (cons (cons V2303 V2304) ())) ((and (cons? V2305) (and (cons? (hd V2305)) (= V2303 (hd (hd V2305))))) (cons (cons (hd (hd V2305)) V2304) (tl V2305))) ((cons? V2305) (cons (hd V2305) (shen.assoc-> V2303 V2304 (tl V2305)))) (true (simple-error "implementation error in shen.assoc->")))) +(defun shen.assoc-> (V2664 V2665 V2666) (cond ((= () V2666) (cons (cons V2664 V2665) ())) ((and (cons? V2666) (and (cons? (hd V2666)) (= V2664 (hd (hd V2666))))) (cons (cons (hd (hd V2666)) V2665) (tl V2666))) ((cons? V2666) (cons (hd V2666) (shen.assoc-> V2664 V2665 (tl V2666)))) (true (simple-error "implementation error in shen.assoc->")))) -(defun shen.find-arity (V2320 V2321 V2322) (cond ((and (= 0 V2321) (and (cons? V2322) (= (hd V2322) ->))) 0) ((and (= 0 V2321) (and (cons? V2322) (= (hd V2322) <-))) 0) ((and (= 0 V2321) (cons? V2322)) (+ 1 (shen.find-arity V2320 0 (tl V2322)))) ((and (= 1 V2321) (and (cons? V2322) (= } (hd V2322)))) (shen.find-arity V2320 0 (tl V2322))) ((and (= 1 V2321) (cons? V2322)) (shen.find-arity V2320 1 (tl V2322))) ((= 1 V2321) (simple-error (cn "syntax error in " (shen.app V2320 " definition: missing } -" shen.a)))) (true (simple-error (cn "syntax error in " (shen.app V2320 " definition: missing -> or <- +(defun shen.find-arity (V2681 V2682 V2683) (cond ((and (= 0 V2682) (and (cons? V2683) (= (hd V2683) ->))) 0) ((and (= 0 V2682) (and (cons? V2683) (= (hd V2683) <-))) 0) ((and (= 0 V2682) (cons? V2683)) (+ 1 (shen.find-arity V2681 0 (tl V2683)))) ((and (= 1 V2682) (and (cons? V2683) (= } (hd V2683)))) (shen.find-arity V2681 0 (tl V2683))) ((and (= 1 V2682) (cons? V2683)) (shen.find-arity V2681 1 (tl V2683))) ((= 1 V2682) (simple-error (cn "syntax error in " (shen.app V2681 " definition: missing } +" shen.a)))) (true (simple-error (cn "syntax error in " (shen.app V2681 " definition: missing -> or <- " shen.a)))))) -(defun shen. (V2323) (let W2324 (let W2325 (shen. V2323) (if (shen.parse-failure? W2325) (shen.parse-failure) (let W2326 (shen.in-> W2325) (let W2327 (shen. W2326) (if (shen.parse-failure? W2327) (shen.parse-failure) (let W2328 (shen.<-out W2327) (let W2329 (shen.in-> W2327) (let W2330 (shen. W2329) (if (shen.parse-failure? W2330) (shen.parse-failure) (let W2331 (shen.in-> W2330) (let W2332 (shen. W2331) (if (shen.parse-failure? W2332) (shen.parse-failure) (let W2333 (shen.<-out W2332) (let W2334 (shen.in-> W2332) (shen.comb W2334 (cons (shen.cons-form W2328) W2333)))))))))))))))) (if (shen.parse-failure? W2324) (let W2335 (let W2336 (shen. V2323) (if (shen.parse-failure? W2336) (shen.parse-failure) (let W2337 (shen.in-> W2336) (let W2338 (shen. W2337) (if (shen.parse-failure? W2338) (shen.parse-failure) (let W2339 (shen.<-out W2338) (let W2340 (shen.in-> W2338) (let W2341 (shen. W2340) (if (shen.parse-failure? W2341) (shen.parse-failure) (let W2342 (shen.in-> W2341) (let W2343 (shen. W2342) (if (shen.parse-failure? W2343) (shen.parse-failure) (let W2344 (shen.<-out W2343) (let W2345 (shen.in-> W2343) (shen.comb W2345 (shen.add-sexpr W2339 W2344)))))))))))))))) (if (shen.parse-failure? W2335) (let W2346 (let W2347 (shen. V2323) (if (shen.parse-failure? W2347) (shen.parse-failure) (let W2348 (shen.in-> W2347) (let W2349 (shen. W2348) (if (shen.parse-failure? W2349) (shen.parse-failure) (let W2350 (shen.<-out W2349) (let W2351 (shen.in-> W2349) (shen.comb W2351 (cons { W2350))))))))) (if (shen.parse-failure? W2346) (let W2352 (let W2353 (shen. V2323) (if (shen.parse-failure? W2353) (shen.parse-failure) (let W2354 (shen.in-> W2353) (let W2355 (shen. W2354) (if (shen.parse-failure? W2355) (shen.parse-failure) (let W2356 (shen.<-out W2355) (let W2357 (shen.in-> W2355) (shen.comb W2357 (cons } W2356))))))))) (if (shen.parse-failure? W2352) (let W2358 (let W2359 (shen. V2323) (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 bar! W2362))))))))) (if (shen.parse-failure? W2358) (let W2364 (let W2365 (shen. V2323) (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. V2323) (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.in-> W2373) (let W2375 (shen. W2374) (if (shen.parse-failure? W2375) (shen.parse-failure) (let W2376 (shen.<-out W2375) (let W2377 (shen.in-> W2375) (shen.comb W2377 (cons (intern ":=") W2376)))))))))))) (if (shen.parse-failure? W2370) (let W2378 (let W2379 (shen. V2323) (if (shen.parse-failure? W2379) (shen.parse-failure) (let W2380 (shen.in-> W2379) (let W2381 (shen. W2380) (if (shen.parse-failure? W2381) (shen.parse-failure) (let W2382 (shen.<-out W2381) (let W2383 (shen.in-> W2381) (shen.comb W2383 (cons (intern ":") W2382))))))))) (if (shen.parse-failure? W2378) (let W2384 (let W2385 (shen. V2323) (if (shen.parse-failure? W2385) (shen.parse-failure) (let W2386 (shen.in-> W2385) (let W2387 (shen. W2386) (if (shen.parse-failure? W2387) (shen.parse-failure) (let W2388 (shen.<-out W2387) (let W2389 (shen.in-> W2387) (shen.comb W2389 (cons (intern ",") W2388))))))))) (if (shen.parse-failure? W2384) (let W2390 (let W2391 (shen. V2323) (if (shen.parse-failure? W2391) (shen.parse-failure) (let W2392 (shen.in-> W2391) (let W2393 (shen. W2392) (if (shen.parse-failure? W2393) (shen.parse-failure) (let W2394 (shen.<-out W2393) (let W2395 (shen.in-> W2393) (shen.comb W2395 W2394)))))))) (if (shen.parse-failure? W2390) (let W2396 (let W2397 (shen. V2323) (if (shen.parse-failure? W2397) (shen.parse-failure) (let W2398 (shen.<-out W2397) (let W2399 (shen.in-> W2397) (let W2400 (shen. W2399) (if (shen.parse-failure? W2400) (shen.parse-failure) (let W2401 (shen.<-out W2400) (let W2402 (shen.in-> W2400) (shen.comb W2402 (cons W2398 W2401)))))))))) (if (shen.parse-failure? W2396) (let W2403 (let W2404 (shen. V2323) (if (shen.parse-failure? W2404) (shen.parse-failure) (let W2405 (shen.in-> W2404) (let W2406 (shen. W2405) (if (shen.parse-failure? W2406) (shen.parse-failure) (let W2407 (shen.<-out W2406) (let W2408 (shen.in-> W2406) (shen.comb W2408 W2407)))))))) (if (shen.parse-failure? W2403) (let W2409 (let W2410 ( V2323) (if (shen.parse-failure? W2410) (shen.parse-failure) (let W2411 (shen.in-> W2410) (shen.comb W2411 ())))) (if (shen.parse-failure? W2409) (shen.parse-failure) W2409)) W2403)) W2396)) W2390)) W2384)) W2378)) W2370)) W2364)) W2358)) W2352)) W2346)) W2335)) W2324))) +(defun shen. (V2684) (let W2685 (let W2686 (shen. V2684) (if (shen.parse-failure? W2686) (shen.parse-failure) (let W2687 (shen.in-> W2686) (let W2688 (shen. W2687) (if (shen.parse-failure? W2688) (shen.parse-failure) (let W2689 (shen.<-out W2688) (let W2690 (shen.in-> W2688) (let W2691 (shen. W2690) (if (shen.parse-failure? W2691) (shen.parse-failure) (let W2692 (shen.in-> W2691) (let W2693 (shen. W2692) (if (shen.parse-failure? W2693) (shen.parse-failure) (let W2694 (shen.<-out W2693) (let W2695 (shen.in-> W2693) (shen.comb W2695 (cons (shen.cons-form W2689) W2694)))))))))))))))) (if (shen.parse-failure? W2685) (let W2696 (let W2697 (shen. V2684) (if (shen.parse-failure? W2697) (shen.parse-failure) (let W2698 (shen.in-> W2697) (let W2699 (shen. W2698) (if (shen.parse-failure? W2699) (shen.parse-failure) (let W2700 (shen.<-out W2699) (let W2701 (shen.in-> W2699) (let W2702 (shen. W2701) (if (shen.parse-failure? W2702) (shen.parse-failure) (let W2703 (shen.in-> W2702) (let W2704 (shen. W2703) (if (shen.parse-failure? W2704) (shen.parse-failure) (let W2705 (shen.<-out W2704) (let W2706 (shen.in-> W2704) (shen.comb W2706 (shen.add-sexpr W2700 W2705)))))))))))))))) (if (shen.parse-failure? W2696) (let W2707 (let W2708 (shen. V2684) (if (shen.parse-failure? W2708) (shen.parse-failure) (let W2709 (shen.in-> W2708) (let W2710 (shen. W2709) (if (shen.parse-failure? W2710) (shen.parse-failure) (let W2711 (shen.<-out W2710) (let W2712 (shen.in-> W2710) (shen.comb W2712 (cons { W2711))))))))) (if (shen.parse-failure? W2707) (let W2713 (let W2714 (shen. V2684) (if (shen.parse-failure? W2714) (shen.parse-failure) (let W2715 (shen.in-> W2714) (let W2716 (shen. W2715) (if (shen.parse-failure? W2716) (shen.parse-failure) (let W2717 (shen.<-out W2716) (let W2718 (shen.in-> W2716) (shen.comb W2718 (cons } W2717))))))))) (if (shen.parse-failure? W2713) (let W2719 (let W2720 (shen. V2684) (if (shen.parse-failure? W2720) (shen.parse-failure) (let W2721 (shen.in-> W2720) (let W2722 (shen. W2721) (if (shen.parse-failure? W2722) (shen.parse-failure) (let W2723 (shen.<-out W2722) (let W2724 (shen.in-> W2722) (shen.comb W2724 (cons bar! W2723))))))))) (if (shen.parse-failure? W2719) (let W2725 (let W2726 (shen. V2684) (if (shen.parse-failure? W2726) (shen.parse-failure) (let W2727 (shen.in-> W2726) (let W2728 (shen. W2727) (if (shen.parse-failure? W2728) (shen.parse-failure) (let W2729 (shen.<-out W2728) (let W2730 (shen.in-> W2728) (shen.comb W2730 (cons (intern ";") W2729))))))))) (if (shen.parse-failure? W2725) (let W2731 (let W2732 (shen. V2684) (if (shen.parse-failure? W2732) (shen.parse-failure) (let W2733 (shen.in-> W2732) (let W2734 (shen. W2733) (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 (cons (intern ":=") W2737)))))))))))) (if (shen.parse-failure? W2731) (let W2739 (let W2740 (shen. V2684) (if (shen.parse-failure? W2740) (shen.parse-failure) (let W2741 (shen.in-> W2740) (let W2742 (shen. W2741) (if (shen.parse-failure? W2742) (shen.parse-failure) (let W2743 (shen.<-out W2742) (let W2744 (shen.in-> W2742) (shen.comb W2744 (cons (intern ":") W2743))))))))) (if (shen.parse-failure? W2739) (let W2745 (let W2746 (shen. V2684) (if (shen.parse-failure? W2746) (shen.parse-failure) (let W2747 (shen.in-> W2746) (let W2748 (shen. W2747) (if (shen.parse-failure? W2748) (shen.parse-failure) (let W2749 (shen.<-out W2748) (let W2750 (shen.in-> W2748) (shen.comb W2750 (cons (intern ",") W2749))))))))) (if (shen.parse-failure? W2745) (let W2751 (let W2752 (shen. V2684) (if (shen.parse-failure? W2752) (shen.parse-failure) (let W2753 (shen.in-> W2752) (let W2754 (shen. W2753) (if (shen.parse-failure? W2754) (shen.parse-failure) (let W2755 (shen.<-out W2754) (let W2756 (shen.in-> W2754) (shen.comb W2756 W2755)))))))) (if (shen.parse-failure? W2751) (let W2757 (let W2758 (shen. V2684) (if (shen.parse-failure? W2758) (shen.parse-failure) (let W2759 (shen.<-out W2758) (let W2760 (shen.in-> W2758) (let W2761 (shen. W2760) (if (shen.parse-failure? W2761) (shen.parse-failure) (let W2762 (shen.<-out W2761) (let W2763 (shen.in-> W2761) (shen.comb W2763 (cons W2759 W2762)))))))))) (if (shen.parse-failure? W2757) (let W2764 (let W2765 (shen. V2684) (if (shen.parse-failure? W2765) (shen.parse-failure) (let W2766 (shen.in-> W2765) (let W2767 (shen. W2766) (if (shen.parse-failure? W2767) (shen.parse-failure) (let W2768 (shen.<-out W2767) (let W2769 (shen.in-> W2767) (shen.comb W2769 W2768)))))))) (if (shen.parse-failure? W2764) (let W2770 (let W2771 ( V2684) (if (shen.parse-failure? W2771) (shen.parse-failure) (let W2772 (shen.in-> W2771) (shen.comb W2772 ())))) (if (shen.parse-failure? W2770) (shen.parse-failure) W2770)) W2764)) W2757)) W2751)) W2745)) W2739)) W2731)) W2725)) W2719)) W2713)) W2707)) W2696)) W2685))) -(defun shen.add-sexpr (V2412 V2413) (cond ((and (cons? V2412) (and (= $ (hd V2412)) (and (cons? (tl V2412)) (= () (tl (tl V2412)))))) (append (explode (hd (tl V2412))) V2413)) (true (cons V2412 V2413)))) +(defun shen.add-sexpr (V2773 V2774) (cond ((and (cons? V2773) (and (= $ (hd V2773)) (and (cons? (tl V2773)) (= () (tl (tl V2773)))))) (append (explode (hd (tl V2773))) V2774)) (true (cons V2773 V2774)))) -(defun shen. (V2414) (let W2415 (if (shen.hds=? V2414 91) (let W2416 (tail V2414) (shen.comb W2416 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2415) (shen.parse-failure) W2415))) +(defun shen. (V2775) (let W2776 (if (shen.hds=? V2775 91) (let W2777 (tail V2775) (shen.comb W2777 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2776) (shen.parse-failure) W2776))) -(defun shen. (V2417) (let W2418 (if (shen.hds=? V2417 93) (let W2419 (tail V2417) (shen.comb W2419 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2418) (shen.parse-failure) W2418))) +(defun shen. (V2778) (let W2779 (if (shen.hds=? V2778 93) (let W2780 (tail V2778) (shen.comb W2780 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2779) (shen.parse-failure) W2779))) -(defun shen. (V2420) (let W2421 (let W2422 (shen. V2420) (if (shen.parse-failure? W2422) (shen.parse-failure) (let W2423 (shen.<-out W2422) (let W2424 (shen.in-> W2422) (shen.comb W2424 W2423))))) (if (shen.parse-failure? W2421) (shen.parse-failure) W2421))) +(defun shen. (V2781) (let W2782 (let W2783 (shen. V2781) (if (shen.parse-failure? W2783) (shen.parse-failure) (let W2784 (shen.<-out W2783) (let W2785 (shen.in-> W2783) (shen.comb W2785 W2784))))) (if (shen.parse-failure? W2782) (shen.parse-failure) W2782))) -(defun shen. (V2425) (let W2426 (let W2427 (shen. V2425) (if (shen.parse-failure? W2427) (shen.parse-failure) (let W2428 (shen.<-out W2427) (let W2429 (shen.in-> W2427) (shen.comb W2429 W2428))))) (if (shen.parse-failure? W2426) (shen.parse-failure) W2426))) +(defun shen. (V2786) (let W2787 (let W2788 (shen. V2786) (if (shen.parse-failure? W2788) (shen.parse-failure) (let W2789 (shen.<-out W2788) (let W2790 (shen.in-> W2788) (shen.comb W2790 W2789))))) (if (shen.parse-failure? W2787) (shen.parse-failure) W2787))) -(defun shen.cons-form (V2431) (cond ((= () V2431) ()) ((and (cons? V2431) (and (cons? (tl V2431)) (and (cons? (tl (tl V2431))) (and (= () (tl (tl (tl V2431)))) (= (hd (tl V2431)) bar!))))) (cons cons (cons (hd V2431) (tl (tl V2431))))) ((and (cons? V2431) (and (cons? (tl V2431)) (and (cons? (tl (tl V2431))) (and (cons? (tl (tl (tl V2431)))) (= (hd (tl V2431)) bar!))))) (simple-error "misapplication of | -")) ((cons? V2431) (cons cons (cons (hd V2431) (cons (shen.cons-form (tl V2431)) ())))) (true (simple-error "partial function shen.cons-form")))) +(defun shen.cons-form (V2792) (cond ((= () V2792) ()) ((and (cons? V2792) (and (cons? (tl V2792)) (and (cons? (tl (tl V2792))) (and (= () (tl (tl (tl V2792)))) (= (hd (tl V2792)) bar!))))) (cons cons (cons (hd V2792) (tl (tl V2792))))) ((and (cons? V2792) (and (cons? (tl V2792)) (and (cons? (tl (tl V2792))) (and (cons? (tl (tl (tl V2792)))) (= (hd (tl V2792)) bar!))))) (simple-error "misapplication of | +")) ((cons? V2792) (cons cons (cons (hd V2792) (cons (shen.cons-form (tl V2792)) ())))) (true (shen.f-error shen.cons-form)))) -(defun shen. (V2432) (let W2433 (if (shen.hds=? V2432 40) (let W2434 (tail V2432) (shen.comb W2434 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2433) (shen.parse-failure) W2433))) +(defun shen. (V2793) (let W2794 (if (shen.hds=? V2793 40) (let W2795 (tail V2793) (shen.comb W2795 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2794) (shen.parse-failure) W2794))) -(defun shen. (V2435) (let W2436 (if (shen.hds=? V2435 41) (let W2437 (tail V2435) (shen.comb W2437 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2436) (shen.parse-failure) W2436))) +(defun shen. (V2796) (let W2797 (if (shen.hds=? V2796 41) (let W2798 (tail V2796) (shen.comb W2798 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2797) (shen.parse-failure) W2797))) -(defun shen. (V2438) (let W2439 (if (shen.hds=? V2438 123) (let W2440 (tail V2438) (shen.comb W2440 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2439) (shen.parse-failure) W2439))) +(defun shen. (V2799) (let W2800 (if (shen.hds=? V2799 123) (let W2801 (tail V2799) (shen.comb W2801 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2800) (shen.parse-failure) W2800))) -(defun shen. (V2441) (let W2442 (if (shen.hds=? V2441 125) (let W2443 (tail V2441) (shen.comb W2443 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2442) (shen.parse-failure) W2442))) +(defun shen. (V2802) (let W2803 (if (shen.hds=? V2802 125) (let W2804 (tail V2802) (shen.comb W2804 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2803) (shen.parse-failure) W2803))) -(defun shen. (V2444) (let W2445 (if (shen.hds=? V2444 124) (let W2446 (tail V2444) (shen.comb W2446 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2445) (shen.parse-failure) W2445))) +(defun shen. (V2805) (let W2806 (if (shen.hds=? V2805 124) (let W2807 (tail V2805) (shen.comb W2807 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2806) (shen.parse-failure) W2806))) -(defun shen. (V2447) (let W2448 (if (shen.hds=? V2447 59) (let W2449 (tail V2447) (shen.comb W2449 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2448) (shen.parse-failure) W2448))) +(defun shen. (V2808) (let W2809 (if (shen.hds=? V2808 59) (let W2810 (tail V2808) (shen.comb W2810 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2809) (shen.parse-failure) W2809))) -(defun shen. (V2450) (let W2451 (if (shen.hds=? V2450 58) (let W2452 (tail V2450) (shen.comb W2452 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2451) (shen.parse-failure) W2451))) +(defun shen. (V2811) (let W2812 (if (shen.hds=? V2811 58) (let W2813 (tail V2811) (shen.comb W2813 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2812) (shen.parse-failure) W2812))) -(defun shen. (V2453) (let W2454 (if (shen.hds=? V2453 44) (let W2455 (tail V2453) (shen.comb W2455 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2454) (shen.parse-failure) W2454))) +(defun shen. (V2814) (let W2815 (if (shen.hds=? V2814 44) (let W2816 (tail V2814) (shen.comb W2816 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2815) (shen.parse-failure) W2815))) -(defun shen. (V2456) (let W2457 (if (shen.hds=? V2456 61) (let W2458 (tail V2456) (shen.comb W2458 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2457) (shen.parse-failure) W2457))) +(defun shen. (V2817) (let W2818 (if (shen.hds=? V2817 61) (let W2819 (tail V2817) (shen.comb W2819 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2818) (shen.parse-failure) W2818))) -(defun shen. (V2459) (let W2460 (let W2461 (shen. V2459) (if (shen.parse-failure? W2461) (shen.parse-failure) (let W2462 (shen.in-> W2461) (shen.comb W2462 shen.skip)))) (if (shen.parse-failure? W2460) (let W2463 (let W2464 (shen. V2459) (if (shen.parse-failure? W2464) (shen.parse-failure) (let W2465 (shen.in-> W2464) (shen.comb W2465 shen.skip)))) (if (shen.parse-failure? W2463) (shen.parse-failure) W2463)) W2460))) +(defun shen. (V2820) (let W2821 (let W2822 (shen. V2820) (if (shen.parse-failure? W2822) (shen.parse-failure) (let W2823 (shen.in-> W2822) (shen.comb W2823 shen.skip)))) (if (shen.parse-failure? W2821) (let W2824 (let W2825 (shen. V2820) (if (shen.parse-failure? W2825) (shen.parse-failure) (let W2826 (shen.in-> W2825) (shen.comb W2826 shen.skip)))) (if (shen.parse-failure? W2824) (shen.parse-failure) W2824)) W2821))) -(defun shen. (V2466) (let W2467 (let W2468 (shen. V2466) (if (shen.parse-failure? W2468) (shen.parse-failure) (let W2469 (shen.in-> W2468) (let W2470 (shen. W2469) (if (shen.parse-failure? W2470) (shen.parse-failure) (let W2471 (shen.in-> W2470) (let W2472 (shen. W2471) (if (shen.parse-failure? W2472) (shen.parse-failure) (let W2473 (shen.in-> W2472) (let W2474 (shen. W2473) (if (shen.parse-failure? W2474) (shen.parse-failure) (let W2475 (shen.in-> W2474) (shen.comb W2475 shen.skip))))))))))))) (if (shen.parse-failure? W2467) (shen.parse-failure) W2467))) +(defun shen. (V2827) (let W2828 (let W2829 (shen. V2827) (if (shen.parse-failure? W2829) (shen.parse-failure) (let W2830 (shen.in-> W2829) (let W2831 (shen. W2830) (if (shen.parse-failure? W2831) (shen.parse-failure) (let W2832 (shen.in-> W2831) (let W2833 (shen. W2832) (if (shen.parse-failure? W2833) (shen.parse-failure) (let W2834 (shen.in-> W2833) (let W2835 (shen. W2834) (if (shen.parse-failure? W2835) (shen.parse-failure) (let W2836 (shen.in-> W2835) (shen.comb W2836 shen.skip))))))))))))) (if (shen.parse-failure? W2828) (shen.parse-failure) W2828))) -(defun shen. (V2476) (let W2477 (if (shen.hds=? V2476 92) (let W2478 (tail V2476) (shen.comb W2478 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2477) (shen.parse-failure) W2477))) +(defun shen. (V2837) (let W2838 (if (shen.hds=? V2837 92) (let W2839 (tail V2837) (shen.comb W2839 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2838) (shen.parse-failure) W2838))) -(defun shen. (V2479) (let W2480 (let W2481 (shen. V2479) (if (shen.parse-failure? W2481) (shen.parse-failure) (let W2482 (shen.in-> W2481) (let W2483 (shen. W2482) (if (shen.parse-failure? W2483) (shen.parse-failure) (let W2484 (shen.in-> W2483) (shen.comb W2484 shen.skip))))))) (if (shen.parse-failure? W2480) (let W2485 (let W2486 ( V2479) (if (shen.parse-failure? W2486) (shen.parse-failure) (let W2487 (shen.in-> W2486) (shen.comb W2487 shen.skip)))) (if (shen.parse-failure? W2485) (shen.parse-failure) W2485)) W2480))) +(defun shen. (V2840) (let W2841 (let W2842 (shen. V2840) (if (shen.parse-failure? W2842) (shen.parse-failure) (let W2843 (shen.in-> W2842) (let W2844 (shen. W2843) (if (shen.parse-failure? W2844) (shen.parse-failure) (let W2845 (shen.in-> W2844) (shen.comb W2845 shen.skip))))))) (if (shen.parse-failure? W2841) (let W2846 (let W2847 ( V2840) (if (shen.parse-failure? W2847) (shen.parse-failure) (let W2848 (shen.in-> W2847) (shen.comb W2848 shen.skip)))) (if (shen.parse-failure? W2846) (shen.parse-failure) W2846)) W2841))) -(defun shen. (V2488) (let W2489 (if (cons? V2488) (let W2490 (head V2488) (let W2491 (tail V2488) (if (not (shen.return? W2490)) (shen.comb W2491 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2489) (shen.parse-failure) W2489))) +(defun shen. (V2849) (let W2850 (if (cons? V2849) (let W2851 (head V2849) (let W2852 (tail V2849) (if (not (shen.return? W2851)) (shen.comb W2852 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2850) (shen.parse-failure) W2850))) -(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) (shen.comb W2497 shen.skip))))))) (if (shen.parse-failure? W2493) (let W2498 (let W2499 (shen. V2492) (if (shen.parse-failure? W2499) (shen.parse-failure) (let W2500 (shen.in-> W2499) (shen.comb W2500 shen.skip)))) (if (shen.parse-failure? W2498) (shen.parse-failure) W2498)) W2493))) +(defun shen. (V2853) (let W2854 (let W2855 (shen. V2853) (if (shen.parse-failure? W2855) (shen.parse-failure) (let W2856 (shen.in-> W2855) (let W2857 (shen. W2856) (if (shen.parse-failure? W2857) (shen.parse-failure) (let W2858 (shen.in-> W2857) (shen.comb W2858 shen.skip))))))) (if (shen.parse-failure? W2854) (let W2859 (let W2860 (shen. V2853) (if (shen.parse-failure? W2860) (shen.parse-failure) (let W2861 (shen.in-> W2860) (shen.comb W2861 shen.skip)))) (if (shen.parse-failure? W2859) (shen.parse-failure) W2859)) W2854))) -(defun shen. (V2501) (let W2502 (if (cons? V2501) (let W2503 (head V2501) (let W2504 (tail V2501) (if (shen.return? W2503) (shen.comb W2504 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2502) (shen.parse-failure) W2502))) +(defun shen. (V2862) (let W2863 (if (cons? V2862) (let W2864 (head V2862) (let W2865 (tail V2862) (if (shen.return? W2864) (shen.comb W2865 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2863) (shen.parse-failure) W2863))) -(defun shen.return? (V2505) (element? V2505 (cons 9 (cons 10 (cons 13 ()))))) +(defun shen.return? (V2866) (element? V2866 (cons 9 (cons 10 (cons 13 ()))))) -(defun shen. (V2506) (let W2507 (let W2508 (shen. V2506) (if (shen.parse-failure? W2508) (shen.parse-failure) (let W2509 (shen.in-> W2508) (let W2510 (shen. W2509) (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? W2507) (shen.parse-failure) W2507))) +(defun shen. (V2867) (let W2868 (let W2869 (shen. V2867) (if (shen.parse-failure? W2869) (shen.parse-failure) (let W2870 (shen.in-> W2869) (let W2871 (shen. W2870) (if (shen.parse-failure? W2871) (shen.parse-failure) (let W2872 (shen.in-> W2871) (let W2873 (shen. W2872) (if (shen.parse-failure? W2873) (shen.parse-failure) (let W2874 (shen.in-> W2873) (shen.comb W2874 shen.skip)))))))))) (if (shen.parse-failure? W2868) (shen.parse-failure) W2868))) -(defun shen. (V2514) (let W2515 (if (shen.hds=? V2514 42) (let W2516 (tail V2514) (shen.comb W2516 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2515) (shen.parse-failure) W2515))) +(defun shen. (V2875) (let W2876 (if (shen.hds=? V2875 42) (let W2877 (tail V2875) (shen.comb W2877 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2876) (shen.parse-failure) W2876))) -(defun shen. (V2517) (let W2518 (let W2519 (shen. V2517) (if (shen.parse-failure? W2519) (shen.parse-failure) (let W2520 (shen.in-> W2519) (let W2521 (shen. W2520) (if (shen.parse-failure? W2521) (shen.parse-failure) (let W2522 (shen.in-> W2521) (shen.comb W2522 shen.skip))))))) (if (shen.parse-failure? W2518) (let W2523 (let W2524 (shen. V2517) (if (shen.parse-failure? W2524) (shen.parse-failure) (let W2525 (shen.in-> W2524) (let W2526 (shen. W2525) (if (shen.parse-failure? W2526) (shen.parse-failure) (let W2527 (shen.in-> W2526) (shen.comb W2527 shen.skip))))))) (if (shen.parse-failure? W2523) (let W2528 (if (cons? V2517) (let W2529 (tail V2517) (let W2530 (shen. W2529) (if (shen.parse-failure? W2530) (shen.parse-failure) (let W2531 (shen.in-> W2530) (shen.comb W2531 shen.skip))))) (shen.parse-failure)) (if (shen.parse-failure? W2528) (shen.parse-failure) W2528)) W2523)) W2518))) +(defun shen. (V2878) (let W2879 (let W2880 (shen. V2878) (if (shen.parse-failure? W2880) (shen.parse-failure) (let W2881 (shen.in-> W2880) (let W2882 (shen. W2881) (if (shen.parse-failure? W2882) (shen.parse-failure) (let W2883 (shen.in-> W2882) (shen.comb W2883 shen.skip))))))) (if (shen.parse-failure? W2879) (let W2884 (let W2885 (shen. V2878) (if (shen.parse-failure? W2885) (shen.parse-failure) (let W2886 (shen.in-> W2885) (let W2887 (shen. W2886) (if (shen.parse-failure? W2887) (shen.parse-failure) (let W2888 (shen.in-> W2887) (shen.comb W2888 shen.skip))))))) (if (shen.parse-failure? W2884) (let W2889 (if (cons? V2878) (let W2890 (tail V2878) (let W2891 (shen. W2890) (if (shen.parse-failure? W2891) (shen.parse-failure) (let W2892 (shen.in-> W2891) (shen.comb W2892 shen.skip))))) (shen.parse-failure)) (if (shen.parse-failure? W2889) (shen.parse-failure) W2889)) W2884)) W2879))) -(defun shen. (V2532) (let W2533 (let W2534 (shen. V2532) (if (shen.parse-failure? W2534) (shen.parse-failure) (let W2535 (shen.<-out W2534) (let W2536 (shen.in-> W2534) (shen.comb W2536 W2535))))) (if (shen.parse-failure? W2533) (let W2537 (let W2538 (shen. V2532) (if (shen.parse-failure? W2538) (shen.parse-failure) (let W2539 (shen.<-out W2538) (let W2540 (shen.in-> W2538) (shen.comb W2540 W2539))))) (if (shen.parse-failure? W2537) (let W2541 (let W2542 (shen. V2532) (if (shen.parse-failure? W2542) (shen.parse-failure) (let W2543 (shen.<-out W2542) (let W2544 (shen.in-> W2542) (shen.comb W2544 (if (= W2543 "<>") (cons vector (cons 0 ())) (intern W2543))))))) (if (shen.parse-failure? W2541) (shen.parse-failure) W2541)) W2537)) W2533))) +(defun shen. (V2893) (let W2894 (let W2895 (shen. V2893) (if (shen.parse-failure? W2895) (shen.parse-failure) (let W2896 (shen.<-out W2895) (let W2897 (shen.in-> W2895) (shen.comb W2897 W2896))))) (if (shen.parse-failure? W2894) (let W2898 (let W2899 (shen. V2893) (if (shen.parse-failure? W2899) (shen.parse-failure) (let W2900 (shen.<-out W2899) (let W2901 (shen.in-> W2899) (shen.comb W2901 W2900))))) (if (shen.parse-failure? W2898) (let W2902 (let W2903 (shen. V2893) (if (shen.parse-failure? W2903) (shen.parse-failure) (let W2904 (shen.<-out W2903) (let W2905 (shen.in-> W2903) (shen.comb W2905 (if (= W2904 "<>") (cons vector (cons 0 ())) (intern W2904))))))) (if (shen.parse-failure? W2902) (shen.parse-failure) W2902)) W2898)) W2894))) -(defun shen. (V2545) (let W2546 (let W2547 (shen. V2545) (if (shen.parse-failure? W2547) (shen.parse-failure) (let W2548 (shen.<-out W2547) (let W2549 (shen.in-> W2547) (let W2550 (shen. W2549) (if (shen.parse-failure? W2550) (shen.parse-failure) (let W2551 (shen.<-out W2550) (let W2552 (shen.in-> W2550) (shen.comb W2552 (cn W2548 W2551)))))))))) (if (shen.parse-failure? W2546) (shen.parse-failure) W2546))) +(defun shen. (V2906) (let W2907 (let W2908 (shen. V2906) (if (shen.parse-failure? W2908) (shen.parse-failure) (let W2909 (shen.<-out W2908) (let W2910 (shen.in-> W2908) (let W2911 (shen. W2910) (if (shen.parse-failure? W2911) (shen.parse-failure) (let W2912 (shen.<-out W2911) (let W2913 (shen.in-> W2911) (shen.comb W2913 (cn W2909 W2912)))))))))) (if (shen.parse-failure? W2907) (shen.parse-failure) W2907))) -(defun shen. (V2553) (let W2554 (if (cons? V2553) (let W2555 (head V2553) (let W2556 (tail V2553) (if (shen.alpha? W2555) (shen.comb W2556 (n->string W2555)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2554) (shen.parse-failure) W2554))) +(defun shen. (V2914) (let W2915 (if (cons? V2914) (let W2916 (head V2914) (let W2917 (tail V2914) (if (shen.alpha? W2916) (shen.comb W2917 (n->string W2916)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2915) (shen.parse-failure) W2915))) -(defun shen.alpha? (V2557) (or (shen.lowercase? V2557) (or (shen.uppercase? V2557) (shen.misc? V2557)))) +(defun shen.alpha? (V2918) (or (shen.lowercase? V2918) (or (shen.uppercase? V2918) (shen.misc? V2918)))) -(defun shen.lowercase? (V2558) (and (>= V2558 97) (<= V2558 122))) +(defun shen.lowercase? (V2919) (and (>= V2919 97) (<= V2919 122))) -(defun shen.uppercase? (V2559) (and (>= V2559 65) (<= V2559 90))) +(defun shen.uppercase? (V2920) (and (>= V2920 65) (<= V2920 90))) -(defun shen.misc? (V2560) (element? V2560 (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? (V2921) (element? V2921 (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. (V2561) (let W2562 (let W2563 (shen. V2561) (if (shen.parse-failure? W2563) (shen.parse-failure) (let W2564 (shen.<-out W2563) (let W2565 (shen.in-> W2563) (let W2566 (shen. W2565) (if (shen.parse-failure? W2566) (shen.parse-failure) (let W2567 (shen.<-out W2566) (let W2568 (shen.in-> W2566) (shen.comb W2568 (cn W2564 W2567)))))))))) (if (shen.parse-failure? W2562) (let W2569 (let W2570 ( V2561) (if (shen.parse-failure? W2570) (shen.parse-failure) (let W2571 (shen.in-> W2570) (shen.comb W2571 "")))) (if (shen.parse-failure? W2569) (shen.parse-failure) W2569)) W2562))) +(defun shen. (V2922) (let W2923 (let W2924 (shen. V2922) (if (shen.parse-failure? W2924) (shen.parse-failure) (let W2925 (shen.<-out W2924) (let W2926 (shen.in-> W2924) (let W2927 (shen. W2926) (if (shen.parse-failure? W2927) (shen.parse-failure) (let W2928 (shen.<-out W2927) (let W2929 (shen.in-> W2927) (shen.comb W2929 (cn W2925 W2928)))))))))) (if (shen.parse-failure? W2923) (let W2930 (let W2931 ( V2922) (if (shen.parse-failure? W2931) (shen.parse-failure) (let W2932 (shen.in-> W2931) (shen.comb W2932 "")))) (if (shen.parse-failure? W2930) (shen.parse-failure) W2930)) W2923))) -(defun shen. (V2572) (let W2573 (let W2574 (shen. V2572) (if (shen.parse-failure? W2574) (shen.parse-failure) (let W2575 (shen.<-out W2574) (let W2576 (shen.in-> W2574) (shen.comb W2576 W2575))))) (if (shen.parse-failure? W2573) (let W2577 (let W2578 (shen. V2572) (if (shen.parse-failure? W2578) (shen.parse-failure) (let W2579 (shen.<-out W2578) (let W2580 (shen.in-> W2578) (shen.comb W2580 W2579))))) (if (shen.parse-failure? W2577) (shen.parse-failure) W2577)) W2573))) +(defun shen. (V2933) (let W2934 (let W2935 (shen. V2933) (if (shen.parse-failure? W2935) (shen.parse-failure) (let W2936 (shen.<-out W2935) (let W2937 (shen.in-> W2935) (shen.comb W2937 W2936))))) (if (shen.parse-failure? W2934) (let W2938 (let W2939 (shen. V2933) (if (shen.parse-failure? W2939) (shen.parse-failure) (let W2940 (shen.<-out W2939) (let W2941 (shen.in-> W2939) (shen.comb W2941 W2940))))) (if (shen.parse-failure? W2938) (shen.parse-failure) W2938)) W2934))) -(defun shen. (V2581) (let W2582 (if (cons? V2581) (let W2583 (head V2581) (let W2584 (tail V2581) (if (shen.digit? W2583) (shen.comb W2584 (n->string W2583)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2582) (shen.parse-failure) W2582))) +(defun shen. (V2942) (let W2943 (if (cons? V2942) (let W2944 (head V2942) (let W2945 (tail V2942) (if (shen.digit? W2944) (shen.comb W2945 (n->string W2944)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2943) (shen.parse-failure) W2943))) -(defun shen.digit? (V2585) (and (>= V2585 48) (<= V2585 57))) +(defun shen.digit? (V2946) (and (>= V2946 48) (<= V2946 57))) -(defun shen. (V2586) (let W2587 (let W2588 (shen. V2586) (if (shen.parse-failure? W2588) (shen.parse-failure) (let W2589 (shen.in-> W2588) (let W2590 (shen. W2589) (if (shen.parse-failure? W2590) (shen.parse-failure) (let W2591 (shen.<-out W2590) (let W2592 (shen.in-> W2590) (let W2593 (shen. W2592) (if (shen.parse-failure? W2593) (shen.parse-failure) (let W2594 (shen.in-> W2593) (shen.comb W2594 W2591))))))))))) (if (shen.parse-failure? W2587) (shen.parse-failure) W2587))) +(defun shen. (V2947) (let W2948 (let W2949 (shen. V2947) (if (shen.parse-failure? W2949) (shen.parse-failure) (let W2950 (shen.in-> W2949) (let W2951 (shen. W2950) (if (shen.parse-failure? W2951) (shen.parse-failure) (let W2952 (shen.<-out W2951) (let W2953 (shen.in-> W2951) (let W2954 (shen. W2953) (if (shen.parse-failure? W2954) (shen.parse-failure) (let W2955 (shen.in-> W2954) (shen.comb W2955 W2952))))))))))) (if (shen.parse-failure? W2948) (shen.parse-failure) W2948))) -(defun shen. (V2595) (let W2596 (if (shen.hds=? V2595 34) (let W2597 (tail V2595) (shen.comb W2597 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2596) (shen.parse-failure) W2596))) +(defun shen. (V2956) (let W2957 (if (shen.hds=? V2956 34) (let W2958 (tail V2956) (shen.comb W2958 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2957) (shen.parse-failure) W2957))) -(defun shen. (V2598) (let W2599 (let W2600 (shen. V2598) (if (shen.parse-failure? W2600) (shen.parse-failure) (let W2601 (shen.<-out W2600) (let W2602 (shen.in-> W2600) (let W2603 (shen. W2602) (if (shen.parse-failure? W2603) (shen.parse-failure) (let W2604 (shen.<-out W2603) (let W2605 (shen.in-> W2603) (shen.comb W2605 (cn W2601 W2604)))))))))) (if (shen.parse-failure? W2599) (let W2606 (let W2607 ( V2598) (if (shen.parse-failure? W2607) (shen.parse-failure) (let W2608 (shen.in-> W2607) (shen.comb W2608 "")))) (if (shen.parse-failure? W2606) (shen.parse-failure) W2606)) W2599))) +(defun shen. (V2959) (let W2960 (let W2961 (shen. V2959) (if (shen.parse-failure? W2961) (shen.parse-failure) (let W2962 (shen.<-out W2961) (let W2963 (shen.in-> W2961) (let W2964 (shen. W2963) (if (shen.parse-failure? W2964) (shen.parse-failure) (let W2965 (shen.<-out W2964) (let W2966 (shen.in-> W2964) (shen.comb W2966 (cn W2962 W2965)))))))))) (if (shen.parse-failure? W2960) (let W2967 (let W2968 ( V2959) (if (shen.parse-failure? W2968) (shen.parse-failure) (let W2969 (shen.in-> W2968) (shen.comb W2969 "")))) (if (shen.parse-failure? W2967) (shen.parse-failure) W2967)) W2960))) -(defun shen. (V2609) (let W2610 (let W2611 (shen. V2609) (if (shen.parse-failure? W2611) (shen.parse-failure) (let W2612 (shen.<-out W2611) (let W2613 (shen.in-> W2611) (shen.comb W2613 W2612))))) (if (shen.parse-failure? W2610) (let W2614 (let W2615 (shen. V2609) (if (shen.parse-failure? W2615) (shen.parse-failure) (let W2616 (shen.<-out W2615) (let W2617 (shen.in-> W2615) (shen.comb W2617 W2616))))) (if (shen.parse-failure? W2614) (shen.parse-failure) W2614)) W2610))) +(defun shen. (V2970) (let W2971 (let W2972 (shen. V2970) (if (shen.parse-failure? W2972) (shen.parse-failure) (let W2973 (shen.<-out W2972) (let W2974 (shen.in-> W2972) (shen.comb W2974 W2973))))) (if (shen.parse-failure? W2971) (let W2975 (let W2976 (shen. V2970) (if (shen.parse-failure? W2976) (shen.parse-failure) (let W2977 (shen.<-out W2976) (let W2978 (shen.in-> W2976) (shen.comb W2978 W2977))))) (if (shen.parse-failure? W2975) (shen.parse-failure) W2975)) W2971))) -(defun shen. (V2618) (let W2619 (let W2620 (shen. V2618) (if (shen.parse-failure? W2620) (shen.parse-failure) (let W2621 (shen.in-> W2620) (let W2622 (shen. W2621) (if (shen.parse-failure? W2622) (shen.parse-failure) (let W2623 (shen.in-> W2622) (let W2624 (shen. W2623) (if (shen.parse-failure? W2624) (shen.parse-failure) (let W2625 (shen.<-out W2624) (let W2626 (shen.in-> W2624) (let W2627 (shen. W2626) (if (shen.parse-failure? W2627) (shen.parse-failure) (let W2628 (shen.in-> W2627) (shen.comb W2628 (n->string W2625))))))))))))))) (if (shen.parse-failure? W2619) (shen.parse-failure) W2619))) +(defun shen. (V2979) (let W2980 (let W2981 (shen. V2979) (if (shen.parse-failure? W2981) (shen.parse-failure) (let W2982 (shen.in-> W2981) (let W2983 (shen. W2982) (if (shen.parse-failure? W2983) (shen.parse-failure) (let W2984 (shen.in-> W2983) (let W2985 (shen. W2984) (if (shen.parse-failure? W2985) (shen.parse-failure) (let W2986 (shen.<-out W2985) (let W2987 (shen.in-> W2985) (let W2988 (shen. W2987) (if (shen.parse-failure? W2988) (shen.parse-failure) (let W2989 (shen.in-> W2988) (shen.comb W2989 (n->string W2986))))))))))))))) (if (shen.parse-failure? W2980) (shen.parse-failure) W2980))) -(defun shen. (V2629) (let W2630 (if (cons? V2629) (let W2631 (head V2629) (let W2632 (tail V2629) (if (not (= W2631 34)) (shen.comb W2632 (n->string W2631)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2630) (shen.parse-failure) W2630))) +(defun shen. (V2990) (let W2991 (if (cons? V2990) (let W2992 (head V2990) (let W2993 (tail V2990) (if (not (= W2992 34)) (shen.comb W2993 (n->string W2992)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2991) (shen.parse-failure) W2991))) -(defun shen. (V2633) (let W2634 (if (shen.hds=? V2633 99) (let W2635 (tail V2633) (shen.comb W2635 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2634) (shen.parse-failure) W2634))) +(defun shen. (V2994) (let W2995 (if (shen.hds=? V2994 99) (let W2996 (tail V2994) (shen.comb W2996 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2995) (shen.parse-failure) W2995))) -(defun shen. (V2636) (let W2637 (if (shen.hds=? V2636 35) (let W2638 (tail V2636) (shen.comb W2638 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2637) (shen.parse-failure) W2637))) +(defun shen. (V2997) (let W2998 (if (shen.hds=? V2997 35) (let W2999 (tail V2997) (shen.comb W2999 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2998) (shen.parse-failure) W2998))) -(defun shen. (V2639) (let W2640 (let W2641 (shen. V2639) (if (shen.parse-failure? W2641) (shen.parse-failure) (let W2642 (shen.in-> W2641) (let W2643 (shen. W2642) (if (shen.parse-failure? W2643) (shen.parse-failure) (let W2644 (shen.<-out W2643) (let W2645 (shen.in-> W2643) (shen.comb W2645 (- 0 W2644))))))))) (if (shen.parse-failure? W2640) (let W2646 (let W2647 (shen. V2639) (if (shen.parse-failure? W2647) (shen.parse-failure) (let W2648 (shen.in-> W2647) (let W2649 (shen. W2648) (if (shen.parse-failure? W2649) (shen.parse-failure) (let W2650 (shen.<-out W2649) (let W2651 (shen.in-> W2649) (shen.comb W2651 W2650)))))))) (if (shen.parse-failure? W2646) (let W2652 (let W2653 (shen. V2639) (if (shen.parse-failure? W2653) (shen.parse-failure) (let W2654 (shen.<-out W2653) (let W2655 (shen.in-> W2653) (shen.comb W2655 W2654))))) (if (shen.parse-failure? W2652) (let W2656 (let W2657 (shen. V2639) (if (shen.parse-failure? W2657) (shen.parse-failure) (let W2658 (shen.<-out W2657) (let W2659 (shen.in-> W2657) (shen.comb W2659 W2658))))) (if (shen.parse-failure? W2656) (let W2660 (let W2661 (shen. V2639) (if (shen.parse-failure? W2661) (shen.parse-failure) (let W2662 (shen.<-out W2661) (let W2663 (shen.in-> W2661) (shen.comb W2663 W2662))))) (if (shen.parse-failure? W2660) (shen.parse-failure) W2660)) W2656)) W2652)) W2646)) W2640))) +(defun shen. (V3000) (let W3001 (let W3002 (shen. V3000) (if (shen.parse-failure? W3002) (shen.parse-failure) (let W3003 (shen.in-> W3002) (let W3004 (shen. W3003) (if (shen.parse-failure? W3004) (shen.parse-failure) (let W3005 (shen.<-out W3004) (let W3006 (shen.in-> W3004) (shen.comb W3006 (- 0 W3005))))))))) (if (shen.parse-failure? W3001) (let W3007 (let W3008 (shen. V3000) (if (shen.parse-failure? W3008) (shen.parse-failure) (let W3009 (shen.in-> W3008) (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 W3011)))))))) (if (shen.parse-failure? W3007) (let W3013 (let W3014 (shen. V3000) (if (shen.parse-failure? W3014) (shen.parse-failure) (let W3015 (shen.<-out W3014) (let W3016 (shen.in-> W3014) (shen.comb W3016 W3015))))) (if (shen.parse-failure? W3013) (let W3017 (let W3018 (shen. V3000) (if (shen.parse-failure? W3018) (shen.parse-failure) (let W3019 (shen.<-out W3018) (let W3020 (shen.in-> W3018) (shen.comb W3020 W3019))))) (if (shen.parse-failure? W3017) (let W3021 (let W3022 (shen. V3000) (if (shen.parse-failure? W3022) (shen.parse-failure) (let W3023 (shen.<-out W3022) (let W3024 (shen.in-> W3022) (shen.comb W3024 W3023))))) (if (shen.parse-failure? W3021) (shen.parse-failure) W3021)) W3017)) W3013)) W3007)) W3001))) -(defun shen. (V2664) (let W2665 (if (shen.hds=? V2664 45) (let W2666 (tail V2664) (shen.comb W2666 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2665) (shen.parse-failure) W2665))) +(defun shen. (V3025) (let W3026 (if (shen.hds=? V3025 45) (let W3027 (tail V3025) (shen.comb W3027 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W3026) (shen.parse-failure) W3026))) -(defun shen. (V2667) (let W2668 (if (shen.hds=? V2667 43) (let W2669 (tail V2667) (shen.comb W2669 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2668) (shen.parse-failure) W2668))) +(defun shen. (V3028) (let W3029 (if (shen.hds=? V3028 43) (let W3030 (tail V3028) (shen.comb W3030 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W3029) (shen.parse-failure) W3029))) -(defun shen. (V2670) (let W2671 (let W2672 (shen. V2670) (if (shen.parse-failure? W2672) (shen.parse-failure) (let W2673 (shen.<-out W2672) (let W2674 (shen.in-> W2672) (shen.comb W2674 (shen.compute-integer W2673)))))) (if (shen.parse-failure? W2671) (shen.parse-failure) W2671))) +(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) (shen.comb W3035 (shen.compute-integer W3034)))))) (if (shen.parse-failure? W3032) (shen.parse-failure) W3032))) -(defun shen. (V2675) (let W2676 (let W2677 (shen. V2675) (if (shen.parse-failure? W2677) (shen.parse-failure) (let W2678 (shen.<-out W2677) (let W2679 (shen.in-> W2677) (let W2680 (shen. W2679) (if (shen.parse-failure? W2680) (shen.parse-failure) (let W2681 (shen.<-out W2680) (let W2682 (shen.in-> W2680) (shen.comb W2682 (cons W2678 W2681)))))))))) (if (shen.parse-failure? W2676) (let W2683 (let W2684 (shen. V2675) (if (shen.parse-failure? W2684) (shen.parse-failure) (let W2685 (shen.<-out W2684) (let W2686 (shen.in-> W2684) (shen.comb W2686 (cons W2685 ())))))) (if (shen.parse-failure? W2683) (shen.parse-failure) W2683)) W2676))) +(defun shen. (V3036) (let W3037 (let W3038 (shen. V3036) (if (shen.parse-failure? W3038) (shen.parse-failure) (let W3039 (shen.<-out W3038) (let W3040 (shen.in-> W3038) (let W3041 (shen. W3040) (if (shen.parse-failure? W3041) (shen.parse-failure) (let W3042 (shen.<-out W3041) (let W3043 (shen.in-> W3041) (shen.comb W3043 (cons W3039 W3042)))))))))) (if (shen.parse-failure? W3037) (let W3044 (let W3045 (shen. V3036) (if (shen.parse-failure? W3045) (shen.parse-failure) (let W3046 (shen.<-out W3045) (let W3047 (shen.in-> W3045) (shen.comb W3047 (cons W3046 ())))))) (if (shen.parse-failure? W3044) (shen.parse-failure) W3044)) W3037))) -(defun shen. (V2687) (let W2688 (if (cons? V2687) (let W2689 (head V2687) (let W2690 (tail V2687) (if (shen.digit? W2689) (shen.comb W2690 (shen.byte->digit W2689)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2688) (shen.parse-failure) W2688))) +(defun shen. (V3048) (let W3049 (if (cons? V3048) (let W3050 (head V3048) (let W3051 (tail V3048) (if (shen.digit? W3050) (shen.comb W3051 (shen.byte->digit W3050)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3049) (shen.parse-failure) W3049))) -(defun shen.byte->digit (V2691) (- V2691 48)) +(defun shen.byte->digit (V3052) (- V3052 48)) -(defun shen.compute-integer (V2692) (shen.compute-integer-h (reverse V2692) 0)) +(defun shen.compute-integer (V3053) (shen.compute-integer-h (reverse V3053) 0)) -(defun shen.compute-integer-h (V2695 V2696) (cond ((= () V2695) 0) ((cons? V2695) (+ (* (shen.expt 10 V2696) (hd V2695)) (shen.compute-integer-h (tl V2695) (+ V2696 1)))) (true (simple-error "partial function shen.compute-integer-h")))) +(defun shen.compute-integer-h (V3056 V3057) (cond ((= () V3056) 0) ((cons? V3056) (+ (* (shen.expt 10 V3057) (hd V3056)) (shen.compute-integer-h (tl V3056) (+ V3057 1)))) (true (shen.f-error shen.compute-integer-h)))) -(defun shen.expt (V2699 V2700) (cond ((= 0 V2700) 1) ((> V2700 0) (* V2699 (shen.expt V2699 (- V2700 1)))) (true (/ (shen.expt V2699 (+ V2700 1)) V2699)))) +(defun shen.expt (V3060 V3061) (cond ((= 0 V3061) 1) ((> V3061 0) (* V3060 (shen.expt V3060 (- V3061 1)))) (true (/ (shen.expt V3060 (+ V3061 1)) V3060)))) -(defun shen. (V2701) (let W2702 (let W2703 (shen. V2701) (if (shen.parse-failure? W2703) (shen.parse-failure) (let W2704 (shen.<-out W2703) (let W2705 (shen.in-> W2703) (let W2706 (shen. W2705) (if (shen.parse-failure? W2706) (shen.parse-failure) (let W2707 (shen.in-> W2706) (let W2708 (shen. W2707) (if (shen.parse-failure? W2708) (shen.parse-failure) (let W2709 (shen.<-out W2708) (let W2710 (shen.in-> W2708) (shen.comb W2710 (+ W2704 W2709))))))))))))) (if (shen.parse-failure? W2702) (let W2711 (let W2712 (shen. V2701) (if (shen.parse-failure? W2712) (shen.parse-failure) (let W2713 (shen.in-> W2712) (let W2714 (shen. W2713) (if (shen.parse-failure? W2714) (shen.parse-failure) (let W2715 (shen.<-out W2714) (let W2716 (shen.in-> W2714) (shen.comb W2716 W2715)))))))) (if (shen.parse-failure? W2711) (shen.parse-failure) W2711)) W2702))) +(defun shen. (V3062) (let W3063 (let W3064 (shen. V3062) (if (shen.parse-failure? W3064) (shen.parse-failure) (let W3065 (shen.<-out W3064) (let W3066 (shen.in-> W3064) (let W3067 (shen. W3066) (if (shen.parse-failure? W3067) (shen.parse-failure) (let W3068 (shen.in-> W3067) (let W3069 (shen. W3068) (if (shen.parse-failure? W3069) (shen.parse-failure) (let W3070 (shen.<-out W3069) (let W3071 (shen.in-> W3069) (shen.comb W3071 (+ W3065 W3070))))))))))))) (if (shen.parse-failure? W3063) (let W3072 (let W3073 (shen. V3062) (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) (shen.comb W3077 W3076)))))))) (if (shen.parse-failure? W3072) (shen.parse-failure) W3072)) W3063))) -(defun shen. (V2717) (let W2718 (if (shen.hds=? V2717 46) (let W2719 (tail V2717) (shen.comb W2719 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2718) (shen.parse-failure) W2718))) +(defun shen. (V3078) (let W3079 (if (shen.hds=? V3078 46) (let W3080 (tail V3078) (shen.comb W3080 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W3079) (shen.parse-failure) W3079))) -(defun shen. (V2720) (let W2721 (let W2722 (shen. V2720) (if (shen.parse-failure? W2722) (shen.parse-failure) (let W2723 (shen.<-out W2722) (let W2724 (shen.in-> W2722) (shen.comb W2724 (shen.compute-fraction W2723)))))) (if (shen.parse-failure? W2721) (shen.parse-failure) W2721))) +(defun shen. (V3081) (let W3082 (let W3083 (shen. V3081) (if (shen.parse-failure? W3083) (shen.parse-failure) (let W3084 (shen.<-out W3083) (let W3085 (shen.in-> W3083) (shen.comb W3085 (shen.compute-fraction W3084)))))) (if (shen.parse-failure? W3082) (shen.parse-failure) W3082))) -(defun shen.compute-fraction (V2725) (shen.compute-fraction-h V2725 -1)) +(defun shen.compute-fraction (V3086) (shen.compute-fraction-h V3086 -1)) -(defun shen.compute-fraction-h (V2728 V2729) (cond ((= () V2728) 0) ((cons? V2728) (+ (* (shen.expt 10 V2729) (hd V2728)) (shen.compute-fraction-h (tl V2728) (- V2729 1)))) (true (simple-error "partial function shen.compute-fraction-h")))) +(defun shen.compute-fraction-h (V3089 V3090) (cond ((= () V3089) 0) ((cons? V3089) (+ (* (shen.expt 10 V3090) (hd V3089)) (shen.compute-fraction-h (tl V3089) (- V3090 1)))) (true (shen.f-error shen.compute-fraction-h)))) -(defun shen. (V2730) (let W2731 (let W2732 (shen. V2730) (if (shen.parse-failure? W2732) (shen.parse-failure) (let W2733 (shen.<-out W2732) (let W2734 (shen.in-> W2732) (let W2735 (shen. W2734) (if (shen.parse-failure? W2735) (shen.parse-failure) (let W2736 (shen.in-> W2735) (let W2737 (shen. W2736) (if (shen.parse-failure? W2737) (shen.parse-failure) (let W2738 (shen.<-out W2737) (let W2739 (shen.in-> W2737) (shen.comb W2739 (shen.compute-E W2733 W2738))))))))))))) (if (shen.parse-failure? W2731) (let W2740 (let W2741 (shen. V2730) (if (shen.parse-failure? W2741) (shen.parse-failure) (let W2742 (shen.<-out W2741) (let W2743 (shen.in-> W2741) (let W2744 (shen. W2743) (if (shen.parse-failure? W2744) (shen.parse-failure) (let W2745 (shen.in-> W2744) (let W2746 (shen. W2745) (if (shen.parse-failure? W2746) (shen.parse-failure) (let W2747 (shen.<-out W2746) (let W2748 (shen.in-> W2746) (shen.comb W2748 (shen.compute-E W2742 W2747))))))))))))) (if (shen.parse-failure? W2740) (shen.parse-failure) W2740)) W2731))) +(defun shen. (V3091) (let W3092 (let W3093 (shen. V3091) (if (shen.parse-failure? W3093) (shen.parse-failure) (let W3094 (shen.<-out W3093) (let W3095 (shen.in-> W3093) (let W3096 (shen. W3095) (if (shen.parse-failure? W3096) (shen.parse-failure) (let W3097 (shen.in-> W3096) (let W3098 (shen. W3097) (if (shen.parse-failure? W3098) (shen.parse-failure) (let W3099 (shen.<-out W3098) (let W3100 (shen.in-> W3098) (shen.comb W3100 (shen.compute-E W3094 W3099))))))))))))) (if (shen.parse-failure? W3092) (let W3101 (let W3102 (shen. V3091) (if (shen.parse-failure? W3102) (shen.parse-failure) (let W3103 (shen.<-out W3102) (let W3104 (shen.in-> W3102) (let W3105 (shen. W3104) (if (shen.parse-failure? W3105) (shen.parse-failure) (let W3106 (shen.in-> W3105) (let W3107 (shen. W3106) (if (shen.parse-failure? W3107) (shen.parse-failure) (let W3108 (shen.<-out W3107) (let W3109 (shen.in-> W3107) (shen.comb W3109 (shen.compute-E W3103 W3108))))))))))))) (if (shen.parse-failure? W3101) (shen.parse-failure) W3101)) W3092))) -(defun shen. (V2749) (let W2750 (let W2751 (shen. V2749) (if (shen.parse-failure? W2751) (shen.parse-failure) (let W2752 (shen.in-> W2751) (let W2753 (shen. W2752) (if (shen.parse-failure? W2753) (shen.parse-failure) (let W2754 (shen.<-out W2753) (let W2755 (shen.in-> W2753) (shen.comb W2755 W2754)))))))) (if (shen.parse-failure? W2750) (let W2756 (let W2757 (shen. V2749) (if (shen.parse-failure? W2757) (shen.parse-failure) (let W2758 (shen.in-> W2757) (let W2759 (shen. W2758) (if (shen.parse-failure? W2759) (shen.parse-failure) (let W2760 (shen.<-out W2759) (let W2761 (shen.in-> W2759) (shen.comb W2761 (- 0 W2760))))))))) (if (shen.parse-failure? W2756) (let W2762 (let W2763 (shen. V2749) (if (shen.parse-failure? W2763) (shen.parse-failure) (let W2764 (shen.<-out W2763) (let W2765 (shen.in-> W2763) (shen.comb W2765 W2764))))) (if (shen.parse-failure? W2762) (shen.parse-failure) W2762)) W2756)) W2750))) +(defun shen. (V3110) (let W3111 (let W3112 (shen. V3110) (if (shen.parse-failure? W3112) (shen.parse-failure) (let W3113 (shen.in-> W3112) (let W3114 (shen. W3113) (if (shen.parse-failure? W3114) (shen.parse-failure) (let W3115 (shen.<-out W3114) (let W3116 (shen.in-> W3114) (shen.comb W3116 W3115)))))))) (if (shen.parse-failure? W3111) (let W3117 (let W3118 (shen. V3110) (if (shen.parse-failure? W3118) (shen.parse-failure) (let W3119 (shen.in-> W3118) (let W3120 (shen. W3119) (if (shen.parse-failure? W3120) (shen.parse-failure) (let W3121 (shen.<-out W3120) (let W3122 (shen.in-> W3120) (shen.comb W3122 (- 0 W3121))))))))) (if (shen.parse-failure? W3117) (let W3123 (let W3124 (shen. V3110) (if (shen.parse-failure? W3124) (shen.parse-failure) (let W3125 (shen.<-out W3124) (let W3126 (shen.in-> W3124) (shen.comb W3126 W3125))))) (if (shen.parse-failure? W3123) (shen.parse-failure) W3123)) W3117)) W3111))) -(defun shen. (V2766) (let W2767 (if (shen.hds=? V2766 101) (let W2768 (tail V2766) (shen.comb W2768 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2767) (shen.parse-failure) W2767))) +(defun shen. (V3127) (let W3128 (if (shen.hds=? V3127 101) (let W3129 (tail V3127) (shen.comb W3129 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W3128) (shen.parse-failure) W3128))) -(defun shen.compute-E (V2769 V2770) (* V2769 (shen.expt 10 V2770))) +(defun shen.compute-E (V3130 V3131) (* V3130 (shen.expt 10 V3131))) -(defun shen. (V2771) (let W2772 (let W2773 (shen. V2771) (if (shen.parse-failure? W2773) (shen.parse-failure) (let W2774 (shen.in-> W2773) (let W2775 (shen. W2774) (if (shen.parse-failure? W2775) (shen.parse-failure) (let W2776 (shen.in-> W2775) (shen.comb W2776 shen.skip))))))) (if (shen.parse-failure? W2772) (let W2777 (let W2778 (shen. V2771) (if (shen.parse-failure? W2778) (shen.parse-failure) (let W2779 (shen.in-> W2778) (shen.comb W2779 shen.skip)))) (if (shen.parse-failure? W2777) (shen.parse-failure) W2777)) W2772))) +(defun shen. (V3132) (let W3133 (let W3134 (shen. V3132) (if (shen.parse-failure? W3134) (shen.parse-failure) (let W3135 (shen.in-> W3134) (let W3136 (shen. W3135) (if (shen.parse-failure? W3136) (shen.parse-failure) (let W3137 (shen.in-> W3136) (shen.comb W3137 shen.skip))))))) (if (shen.parse-failure? W3133) (let W3138 (let W3139 (shen. V3132) (if (shen.parse-failure? W3139) (shen.parse-failure) (let W3140 (shen.in-> W3139) (shen.comb W3140 shen.skip)))) (if (shen.parse-failure? W3138) (shen.parse-failure) W3138)) W3133))) -(defun shen. (V2780) (let W2781 (if (cons? V2780) (let W2782 (head V2780) (let W2783 (tail V2780) (if (shen.whitespace? W2782) (shen.comb W2783 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2781) (shen.parse-failure) W2781))) +(defun shen. (V3141) (let W3142 (if (cons? V3141) (let W3143 (head V3141) (let W3144 (tail V3141) (if (shen.whitespace? W3143) (shen.comb W3144 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3142) (shen.parse-failure) W3142))) -(defun shen.whitespace? (V2786) (cond ((= 32 V2786) true) ((= 13 V2786) true) ((= 10 V2786) true) ((= 9 V2786) true) (true false))) +(defun shen.whitespace? (V3147) (cond ((= 32 V3147) true) ((= 13 V3147) true) ((= 10 V3147) true) ((= 9 V3147) true) (true false))) -(defun shen.unpackage¯oexpand (V2787) (cond ((= () V2787) ()) ((and (cons? V2787) (shen.packaged? (hd V2787))) (shen.unpackage¯oexpand (append (shen.unpackage (hd V2787)) (tl V2787)))) ((cons? V2787) (let W2788 (macroexpand (hd V2787)) (if (shen.packaged? W2788) (shen.unpackage¯oexpand (cons W2788 (tl V2787))) (cons W2788 (shen.unpackage¯oexpand (tl V2787)))))) (true (simple-error "partial function shen.unpackage¯oexpand")))) +(defun shen.register-source-form (V3150 V3151) (cond ((and (symbol? V3150) (and (not (variable? V3150)) (not (= V3150 package)))) (do (set shen.*source-form-handlers* (shen.update-assoc V3150 V3151 (value shen.*source-form-handlers*))) V3150)) (true (simple-error (cn "invalid source-form head: " (shen.app V3150 " +" shen.s)))))) -(defun shen.packaged? (V2791) (cond ((and (cons? V2791) (and (= package (hd V2791)) (and (cons? (tl V2791)) (cons? (tl (tl V2791)))))) true) (true false))) +(defun shen.unregister-source-form (V3152) (do (set shen.*source-form-handlers* (remove (assoc V3152 (value shen.*source-form-handlers*)) (value shen.*source-form-handlers*))) V3152)) -(defun shen.unpackage (V2794) (cond ((and (cons? V2794) (and (= package (hd V2794)) (and (cons? (tl V2794)) (and (= null (hd (tl V2794))) (cons? (tl (tl V2794))))))) (tl (tl (tl V2794)))) ((and (cons? V2794) (and (= package (hd V2794)) (and (cons? (tl V2794)) (cons? (tl (tl V2794)))))) (let W2795 (eval (hd (tl (tl V2794)))) (let W2796 (shen.package-symbols (str (hd (tl V2794))) W2795 (tl (tl (tl V2794)))) (let W2797 (shen.record-external (hd (tl V2794)) W2795) (let W2798 (shen.record-internal (hd (tl V2794)) W2795 (tl (tl (tl V2794)))) W2796))))) (true (simple-error "partial function shen.unpackage")))) +(defun shen.source-form-handler (V3159 V3160) (cond ((cons? V3159) (assoc (hd V3159) V3160)) (true ()))) -(defun shen.record-internal (V2799 V2800 V2801) (let W2802 (trap-error (get V2799 shen.internal-symbols (value *property-vector*)) (lambda Z2803 ())) (let W2804 (shen.internal-symbols (str V2799) V2800 V2801) (put V2799 shen.internal-symbols (union W2804 W2802) (value *property-vector*))))) +(defun shen.source-form-expansion (V3163 V3164) (cond ((cons? V3164) (let W3165 ((tl V3164) V3163) (if (shen.source-form-list? W3165) W3165 (simple-error (cn "source-form handler must return a list of forms: " (shen.app V3163 " +" shen.s)))))) (true (shen.f-error shen.source-form-expansion)))) -(defun shen.internal-symbols (V2811 V2812 V2813) (cond ((cons? V2813) (union (shen.internal-symbols V2811 V2812 (hd V2813)) (shen.internal-symbols V2811 V2812 (tl V2813)))) ((shen.internal? V2813 V2811 V2812) (cons (shen.intern-in-package V2811 V2813) ())) (true ()))) +(defun shen.source-form-list? (V3170) (cond ((= () V3170) true) ((cons? V3170) (shen.source-form-list? (tl V3170))) (true false))) -(defun shen.record-external (V2814 V2815) (let W2816 (trap-error (get V2814 shen.external-symbols (value *property-vector*)) (lambda Z2817 ())) (put V2814 shen.external-symbols (union V2815 W2816) (value *property-vector*)))) +(defun shen.unpackage¯oexpand (V3171) (cond ((= () V3171) ()) ((and (cons? V3171) (shen.packaged? (hd V3171))) (shen.unpackage¯oexpand (append (shen.unpackage (hd V3171)) (tl V3171)))) ((cons? V3171) (let W3172 (shen.source-form-handler (hd V3171) (value shen.*source-form-handlers*)) (if (cons? W3172) (shen.unpackage¯oexpand (append (shen.source-form-expansion (hd V3171) W3172) (tl V3171))) (let W3173 (macroexpand (hd V3171)) (if (or (shen.packaged? W3173) (cons? (shen.source-form-handler W3173 (value shen.*source-form-handlers*)))) (shen.unpackage¯oexpand (cons W3173 (tl V3171))) (cons W3173 (shen.unpackage¯oexpand (tl V3171)))))))) (true (shen.f-error shen.unpackage¯oexpand)))) -(defun shen.package-symbols (V2822 V2823 V2824) (cond ((cons? V2824) (map (lambda Z2825 (shen.package-symbols V2822 V2823 Z2825)) V2824)) ((shen.internal? V2824 V2822 V2823) (shen.intern-in-package V2822 V2824)) (true V2824))) +(defun shen.packaged? (V3176) (cond ((and (cons? V3176) (and (= package (hd V3176)) (and (cons? (tl V3176)) (cons? (tl (tl V3176)))))) true) (true false))) -(defun shen.intern-in-package (V2826 V2827) (intern (@s V2826 (@s "." (str V2827))))) +(defun shen.unpackage (V3179) (cond ((and (cons? V3179) (and (= package (hd V3179)) (and (cons? (tl V3179)) (and (= null (hd (tl V3179))) (cons? (tl (tl V3179))))))) (tl (tl (tl V3179)))) ((and (cons? V3179) (and (= package (hd V3179)) (and (cons? (tl V3179)) (cons? (tl (tl V3179)))))) (let W3180 (eval (hd (tl (tl V3179)))) (let W3181 (shen.package-symbols (str (hd (tl V3179))) W3180 (tl (tl (tl V3179)))) (let W3182 (shen.record-external (hd (tl V3179)) W3180) (let W3183 (shen.record-internal (hd (tl V3179)) W3180 (tl (tl (tl V3179)))) W3181))))) (true (shen.f-error shen.unpackage)))) -(defun shen.internal? (V2828 V2829 V2830) (and (not (element? V2828 V2830)) (and (not (shen.sng? V2828)) (and (not (shen.dbl? V2828)) (and (symbol? V2828) (and (not (shen.sysfunc? V2828)) (and (not (variable? V2828)) (and (not (shen.internal-to-shen? (str V2828))) (not (shen.internal-to-P? V2829 (str V2828))))))))))) +(defun shen.record-internal (V3184 V3185 V3186) (let W3187 (trap-error (get V3184 shen.internal-symbols (value *property-vector*)) (lambda Z3188 ())) (let W3189 (shen.internal-symbols (str V3184) V3185 V3186) (put V3184 shen.internal-symbols (union W3189 W3187) (value *property-vector*))))) -(defun shen.internal-to-shen? (V2835) (cond ((and (shen.+string? V2835) (and (= "s" (hdstr V2835)) (and (shen.+string? (tlstr V2835)) (and (= "h" (hdstr (tlstr V2835))) (and (shen.+string? (tlstr (tlstr V2835))) (and (= "e" (hdstr (tlstr (tlstr V2835)))) (and (shen.+string? (tlstr (tlstr (tlstr V2835)))) (and (= "n" (hdstr (tlstr (tlstr (tlstr V2835))))) (and (shen.+string? (tlstr (tlstr (tlstr (tlstr V2835))))) (= "." (hdstr (tlstr (tlstr (tlstr (tlstr V2835))))))))))))))) true) (true false))) +(defun shen.internal-symbols (V3196 V3197 V3198) (cond ((cons? V3198) (union (shen.internal-symbols V3196 V3197 (hd V3198)) (shen.internal-symbols V3196 V3197 (tl V3198)))) ((shen.internal? V3198 V3196 V3197) (cons (shen.intern-in-package V3196 V3198) ())) (true ()))) -(defun shen.sysfunc? (V2836) (element? V2836 (get shen shen.external-symbols (value *property-vector*)))) +(defun shen.record-external (V3199 V3200) (let W3201 (trap-error (get V3199 shen.external-symbols (value *property-vector*)) (lambda Z3202 ())) (put V3199 shen.external-symbols (union V3200 W3201) (value *property-vector*)))) -(defun shen.internal-to-P? (V2844 V2845) (cond ((and (= "" V2844) (and (shen.+string? V2845) (= "." (hdstr V2845)))) true) ((and (shen.+string? V2844) (and (shen.+string? V2845) (= (hdstr V2844) (hdstr V2845)))) (shen.internal-to-P? (tlstr V2844) (tlstr V2845))) (true false))) +(defun shen.package-symbols (V3207 V3208 V3209) (cond ((cons? V3209) (map (lambda Z3210 (shen.package-symbols V3207 V3208 Z3210)) V3209)) ((shen.internal? V3209 V3207 V3208) (shen.intern-in-package V3207 V3209)) (true V3209))) -(defun shen.process-applications (V2848 V2849) (cond ((element? V2848 V2849) V2848) ((and (cons? V2848) (shen.non-application? (hd V2848))) (shen.special-case (hd V2848) V2848 V2849)) ((cons? V2848) (shen.process-application (map (lambda Z2850 (shen.process-applications Z2850 V2849)) V2848) V2849)) (true V2848))) +(defun shen.intern-in-package (V3211 V3212) (intern (@s V3211 (@s "." (str V3212))))) -(defun shen.non-application? (V2853) (cond ((= define V2853) true) ((= defun V2853) true) ((= synonyms V2853) true) ((shen.special? V2853) true) ((shen.extraspecial? V2853) true) (true false))) +(defun shen.internal? (V3213 V3214 V3215) (and (not (element? V3213 V3215)) (and (not (shen.sng? V3213)) (and (not (shen.dbl? V3213)) (and (symbol? V3213) (and (not (shen.sysfunc? V3213)) (and (not (variable? V3213)) (and (not (shen.internal-to-shen? (str V3213))) (not (shen.internal-to-P? V3214 (str V3213))))))))))) -(defun shen.special-case (V2858 V2859 V2860) (cond ((and (= lambda V2858) (and (cons? V2859) (and (= lambda (hd V2859)) (and (cons? (tl V2859)) (and (cons? (tl (tl V2859))) (= () (tl (tl (tl V2859))))))))) (cons lambda (cons (hd (tl V2859)) (cons (shen.process-applications (hd (tl (tl V2859))) V2860) ())))) ((and (= let V2858) (and (cons? V2859) (and (= let (hd V2859)) (and (cons? (tl V2859)) (and (cons? (tl (tl V2859))) (and (cons? (tl (tl (tl V2859)))) (= () (tl (tl (tl (tl V2859))))))))))) (cons let (cons (hd (tl V2859)) (cons (shen.process-applications (hd (tl (tl V2859))) V2860) (cons (shen.process-applications (hd (tl (tl (tl V2859)))) V2860) ()))))) ((and (= defun V2858) (and (cons? V2859) (and (= defun (hd V2859)) (and (cons? (tl V2859)) (and (cons? (tl (tl V2859))) (and (cons? (tl (tl (tl V2859)))) (= () (tl (tl (tl (tl V2859))))))))))) V2859) ((and (= define V2858) (and (cons? V2859) (and (= define (hd V2859)) (and (cons? (tl V2859)) (and (cons? (tl (tl V2859))) (= { (hd (tl (tl V2859))))))))) (cons define (cons (hd (tl V2859)) (cons { (shen.process-after-type (hd (tl V2859)) (tl (tl (tl V2859))) V2860))))) ((and (= define V2858) (and (cons? V2859) (and (= define (hd V2859)) (cons? (tl V2859))))) (cons define (cons (hd (tl V2859)) (map (lambda Z2861 (shen.process-applications Z2861 V2860)) (tl (tl V2859)))))) ((= synonyms V2858) (cons synonyms V2859)) ((and (= type V2858) (and (cons? V2859) (and (= type (hd V2859)) (and (cons? (tl V2859)) (and (cons? (tl (tl V2859))) (= () (tl (tl (tl V2859))))))))) (cons type (cons (shen.process-applications (hd (tl V2859)) V2860) (tl (tl V2859))))) ((and (= input+ V2858) (and (cons? V2859) (and (= input+ (hd V2859)) (and (cons? (tl V2859)) (and (cons? (tl (tl V2859))) (= () (tl (tl (tl V2859))))))))) (cons input+ (cons (hd (tl V2859)) (cons (shen.process-applications (hd (tl (tl V2859))) V2860) ())))) ((and (cons? V2859) (shen.special? (hd V2859))) (cons (hd V2859) (map (lambda Z2862 (shen.process-applications Z2862 V2860)) (tl V2859)))) ((and (cons? V2859) (shen.extraspecial? (hd V2859))) V2859) (true (simple-error "partial function shen.special-case")))) +(defun shen.internal-to-shen? (V3220) (cond ((and (shen.+string? V3220) (and (= "s" (hdstr V3220)) (and (shen.+string? (tlstr V3220)) (and (= "h" (hdstr (tlstr V3220))) (and (shen.+string? (tlstr (tlstr V3220))) (and (= "e" (hdstr (tlstr (tlstr V3220)))) (and (shen.+string? (tlstr (tlstr (tlstr V3220)))) (and (= "n" (hdstr (tlstr (tlstr (tlstr V3220))))) (and (shen.+string? (tlstr (tlstr (tlstr (tlstr V3220))))) (= "." (hdstr (tlstr (tlstr (tlstr (tlstr V3220))))))))))))))) true) (true false))) -(defun shen.process-after-type (V2865 V2866 V2867) (cond ((and (cons? V2866) (= } (hd V2866))) (cons } (map (lambda Z2868 (shen.process-applications Z2868 V2867)) (tl V2866)))) ((cons? V2866) (cons (hd V2866) (shen.process-after-type V2865 (tl V2866) V2867))) (true (simple-error (cn "missing } in " (shen.app V2865 " +(defun shen.sysfunc? (V3221) (element? V3221 (get shen shen.external-symbols (value *property-vector*)))) + +(defun shen.internal-to-P? (V3229 V3230) (cond ((and (= "" V3229) (and (shen.+string? V3230) (= "." (hdstr V3230)))) true) ((and (shen.+string? V3229) (and (shen.+string? V3230) (= (hdstr V3229) (hdstr V3230)))) (shen.internal-to-P? (tlstr V3229) (tlstr V3230))) (true false))) + +(defun shen.process-applications (V3233 V3234) (cond ((element? V3233 V3234) V3233) ((and (cons? V3233) (= cond (hd V3233))) (cons cond (shen.process-cond-clauses (tl V3233) V3234))) ((and (cons? V3233) (shen.non-application? (hd V3233))) (shen.special-case (hd V3233) V3233 V3234)) ((cons? V3233) (shen.process-application (map (lambda Z3235 (shen.process-applications Z3235 V3234)) V3233) V3234)) (true V3233))) + +(defun shen.non-application? (V3238) (cond ((= define V3238) true) ((= defun V3238) true) ((= synonyms V3238) true) ((shen.special? V3238) true) ((shen.extraspecial? V3238) true) (true false))) + +(defun shen.special-case (V3243 V3244 V3245) (cond ((and (= lambda V3243) (and (cons? V3244) (and (= lambda (hd V3244)) (and (cons? (tl V3244)) (and (cons? (tl (tl V3244))) (= () (tl (tl (tl V3244))))))))) (cons lambda (cons (hd (tl V3244)) (cons (shen.process-applications (hd (tl (tl V3244))) V3245) ())))) ((and (= let V3243) (and (cons? V3244) (and (= let (hd V3244)) (and (cons? (tl V3244)) (and (cons? (tl (tl V3244))) (and (cons? (tl (tl (tl V3244)))) (= () (tl (tl (tl (tl V3244))))))))))) (cons let (cons (hd (tl V3244)) (cons (shen.process-applications (hd (tl (tl V3244))) V3245) (cons (shen.process-applications (hd (tl (tl (tl V3244)))) V3245) ()))))) ((and (= defun V3243) (and (cons? V3244) (and (= defun (hd V3244)) (and (cons? (tl V3244)) (and (cons? (tl (tl V3244))) (and (cons? (tl (tl (tl V3244)))) (= () (tl (tl (tl (tl V3244))))))))))) V3244) ((and (= define V3243) (and (cons? V3244) (and (= define (hd V3244)) (and (cons? (tl V3244)) (and (cons? (tl (tl V3244))) (= { (hd (tl (tl V3244))))))))) (cons define (cons (hd (tl V3244)) (cons { (shen.process-after-type (hd (tl V3244)) (tl (tl (tl V3244))) V3245))))) ((and (= define V3243) (and (cons? V3244) (and (= define (hd V3244)) (cons? (tl V3244))))) (cons define (cons (hd (tl V3244)) (map (lambda Z3246 (shen.process-applications Z3246 V3245)) (tl (tl V3244)))))) ((= synonyms V3243) (cons synonyms V3244)) ((and (= type V3243) (and (cons? V3244) (and (= type (hd V3244)) (and (cons? (tl V3244)) (and (cons? (tl (tl V3244))) (= () (tl (tl (tl V3244))))))))) (cons type (cons (shen.process-applications (hd (tl V3244)) V3245) (tl (tl V3244))))) ((and (= input+ V3243) (and (cons? V3244) (and (= input+ (hd V3244)) (and (cons? (tl V3244)) (and (cons? (tl (tl V3244))) (= () (tl (tl (tl V3244))))))))) (cons input+ (cons (hd (tl V3244)) (cons (shen.process-applications (hd (tl (tl V3244))) V3245) ())))) ((and (cons? V3244) (shen.special? (hd V3244))) (cons (hd V3244) (map (lambda Z3247 (shen.process-applications Z3247 V3245)) (tl V3244)))) ((and (cons? V3244) (shen.extraspecial? (hd V3244))) V3244) (true (shen.f-error shen.special-case)))) + +(defun shen.process-cond-clauses (V3250 V3251) (cond ((= () V3250) ()) ((and (cons? V3250) (and (cons? (hd V3250)) (and (cons? (tl (hd V3250))) (= () (tl (tl (hd V3250))))))) (cons (cons (shen.process-applications (hd (hd V3250)) V3251) (cons (shen.process-applications (hd (tl (hd V3250))) V3251) ())) (shen.process-cond-clauses (tl V3250) V3251))) (true (shen.f-error shen.process-cond-clauses)))) + +(defun shen.process-after-type (V3254 V3255 V3256) (cond ((and (cons? V3255) (= } (hd V3255))) (cons } (map (lambda Z3257 (shen.process-applications Z3257 V3256)) (tl V3255)))) ((cons? V3255) (cons (hd V3255) (shen.process-after-type V3254 (tl V3255) V3256))) (true (simple-error (cn "missing } in " (shen.app V3254 " " shen.a)))))) -(defun shen.process-application (V2869 V2870) (cond ((cons? V2869) (let W2871 (arity (hd V2869)) (let W2872 (length (tl V2869)) (if (element? V2869 V2870) V2869 (if (shen.shen-call? (hd V2869)) V2869 (if (shen.foreign? V2869) (shen.unpack-foreign V2869) (if (shen.fn-call? V2869) (shen.fn-call V2869) (if (shen.zero-place? V2869) V2869 (if (shen.undefined-f? (hd V2869) W2871) (shen.simple-curry (cons (cons fn (cons (hd V2869) ())) (tl V2869))) (if (variable? (hd V2869)) (shen.simple-curry V2869) (if (shen.application? (hd V2869)) (shen.simple-curry V2869) (if (shen.partial-application*? (hd V2869) W2871 W2872) (shen.lambda-function V2869 (- W2871 W2872)) (if (shen.overapplication? (hd V2869) W2871 W2872) (shen.simple-curry (cons (cons fn (cons (hd V2869) ())) (tl V2869))) V2869))))))))))))) (true (simple-error "partial function shen.process-application")))) +(defun shen.process-application (V3258 V3259) (cond ((cons? V3258) (let W3260 (arity (hd V3258)) (let W3261 (length (tl V3258)) (if (element? V3258 V3259) V3258 (if (shen.shen-call? (hd V3258)) V3258 (if (shen.foreign? V3258) (shen.unpack-foreign V3258) (if (shen.fn-call? V3258) (shen.fn-call V3258) (if (shen.zero-place? V3258) V3258 (if (shen.undefined-f? (hd V3258) W3260) (shen.simple-curry (cons (cons fn (cons (hd V3258) ())) (tl V3258))) (if (variable? (hd V3258)) (shen.simple-curry V3258) (if (shen.application? (hd V3258)) (shen.simple-curry V3258) (if (shen.partial-application*? (hd V3258) W3260 W3261) (shen.lambda-function V3258 (- W3260 W3261)) (if (shen.overapplication? (hd V3258) W3260 W3261) (shen.simple-curry (cons (cons fn (cons (hd V3258) ())) (tl V3258))) V3258))))))))))))) (true (shen.f-error shen.process-application)))) -(defun shen.unpack-foreign (V2873) (cond ((and (cons? V2873) (and (cons? (hd V2873)) (and (= foreign (hd (hd V2873))) (and (cons? (tl (hd V2873))) (= () (tl (tl (hd V2873)))))))) (cons (hd (tl (hd V2873))) (tl V2873))) (true (simple-error "partial function shen.unpack-foreign")))) +(defun shen.unpack-foreign (V3262) (cond ((and (cons? V3262) (and (cons? (hd V3262)) (and (= foreign (hd (hd V3262))) (and (cons? (tl (hd V3262))) (= () (tl (tl (hd V3262)))))))) (cons (hd (tl (hd V3262))) (tl V3262))) (true (shen.f-error shen.unpack-foreign)))) -(defun shen.foreign? (V2876) (cond ((and (cons? V2876) (and (cons? (hd V2876)) (and (= foreign (hd (hd V2876))) (and (cons? (tl (hd V2876))) (= () (tl (tl (hd V2876)))))))) true) (true false))) +(defun shen.foreign? (V3265) (cond ((and (cons? V3265) (and (cons? (hd V3265)) (and (= foreign (hd (hd V3265))) (and (cons? (tl (hd V3265))) (= () (tl (tl (hd V3265)))))))) true) (true false))) -(defun shen.zero-place? (V2879) (cond ((and (cons? V2879) (= () (tl V2879))) true) (true false))) +(defun shen.zero-place? (V3268) (cond ((and (cons? V3268) (= () (tl V3268))) true) (true false))) -(defun shen.shen-call? (V2880) (and (symbol? V2880) (shen.internal-to-shen? (str V2880)))) +(defun shen.shen-call? (V3269) (and (symbol? V3269) (shen.internal-to-shen? (str V3269)))) -(defun shen.application? (V2885) (cond ((and (cons? V2885) (and (= protect (hd V2885)) (and (cons? (tl V2885)) (= () (tl (tl V2885)))))) false) ((and (cons? V2885) (and (= foreign (hd V2885)) (and (cons? (tl V2885)) (= () (tl (tl V2885)))))) false) (true (cons? V2885)))) +(defun shen.application? (V3274) (cond ((and (cons? V3274) (and (= protect (hd V3274)) (and (cons? (tl V3274)) (= () (tl (tl V3274)))))) false) ((and (cons? V3274) (and (= foreign (hd V3274)) (and (cons? (tl V3274)) (= () (tl (tl V3274)))))) false) (true (cons? V3274)))) -(defun shen.undefined-f? (V2890 V2891) (cond ((= -1 V2891) (and (shen.lowercase-symbol? V2890) (not (element? V2890 (external shen))))) (true false))) +(defun shen.undefined-f? (V3279 V3280) (cond ((= -1 V3280) (and (shen.lowercase-symbol? V3279) (not (element? V3279 (external shen))))) (true false))) -(defun shen.lowercase-symbol? (V2892) (and (symbol? V2892) (not (variable? V2892)))) +(defun shen.lowercase-symbol? (V3281) (and (symbol? V3281) (not (variable? V3281)))) -(defun shen.simple-curry (V2893) (cond ((and (cons? V2893) (and (cons? (tl V2893)) (= () (tl (tl V2893))))) V2893) ((and (cons? V2893) (and (cons? (tl V2893)) (cons? (tl (tl V2893))))) (shen.simple-curry (cons (cons (hd V2893) (cons (hd (tl V2893)) ())) (tl (tl V2893))))) (true V2893))) +(defun shen.simple-curry (V3282) (cond ((and (cons? V3282) (and (cons? (tl V3282)) (= () (tl (tl V3282))))) V3282) ((and (cons? V3282) (and (cons? (tl V3282)) (cons? (tl (tl V3282))))) (shen.simple-curry (cons (cons (hd V3282) (cons (hd (tl V3282)) ())) (tl (tl V3282))))) (true V3282))) -(defun function (V2894) (fn V2894)) +(defun function (V3283) (fn V3283)) -(defun fn (V2895) (cond ((= (arity V2895) 0) (V2895)) (true (let W2896 (assoc V2895 (value shen.*lambdatable*)) (if (empty? W2896) (simple-error (cn "fn: " (shen.app V2895 " is undefined -" shen.a))) (tl W2896)))))) +(defun fn (V3284) (cond ((= (arity V3284) 0) (V3284)) (true (trap-error (get V3284 shen.lambda-form (value *property-vector*)) (lambda Z3285 (simple-error (cn "fn: " (shen.app V3284 " is undefined +" shen.a)))))))) -(defun shen.fn-call? (V2899) (cond ((and (cons? V2899) (and (= fn (hd V2899)) (and (cons? (tl V2899)) (= () (tl (tl V2899)))))) true) ((and (cons? V2899) (and (= function (hd V2899)) (and (cons? (tl V2899)) (= () (tl (tl V2899)))))) true) (true false))) +(defun shen.fn-call? (V3288) (cond ((and (cons? V3288) (and (= fn (hd V3288)) (and (cons? (tl V3288)) (= () (tl (tl V3288)))))) true) ((and (cons? V3288) (and (= function (hd V3288)) (and (cons? (tl V3288)) (= () (tl (tl V3288)))))) true) (true false))) -(defun shen.fn-call (V2900) (cond ((and (cons? V2900) (and (= function (hd V2900)) (and (cons? (tl V2900)) (= () (tl (tl V2900)))))) (shen.fn-call (cons fn (tl V2900)))) ((and (cons? V2900) (and (= fn (hd V2900)) (and (cons? (tl V2900)) (= () (tl (tl V2900)))))) (let W2901 (arity (hd (tl V2900))) (if (= W2901 -1) V2900 (if (= W2901 0) (tl V2900) (shen.lambda-function (tl V2900) W2901))))) (true (simple-error "partial function shen.fn-call")))) +(defun shen.fn-call (V3289) (cond ((and (cons? V3289) (and (= function (hd V3289)) (and (cons? (tl V3289)) (= () (tl (tl V3289)))))) (shen.fn-call (cons fn (tl V3289)))) ((and (cons? V3289) (and (= fn (hd V3289)) (and (cons? (tl V3289)) (= () (tl (tl V3289)))))) (let W3290 (arity (hd (tl V3289))) (if (= W3290 -1) V3289 (if (= W3290 0) (tl V3289) (shen.lambda-function (tl V3289) W3290))))) (true (shen.f-error shen.fn-call)))) -(defun shen.partial-application*? (V2902 V2903 V2904) (let W2905 (> V2903 V2904) (let W2906 (if (and W2905 (and (shen.loading?) (not (element? V2902 (cons + (cons - ())))))) (pr (cn "partial application of " (shen.app V2902 " -" shen.a)) (stoutput)) shen.skip) W2905))) +(defun shen.partial-application*? (V3291 V3292 V3293) (let W3294 (> V3292 V3293) (let W3295 (if (and W3294 (and (shen.loading?) (not (element? V3291 (cons + (cons - ())))))) (pr (cn "partial application of " (shen.app V3291 " +" shen.a)) (stoutput)) shen.skip) W3294))) (defun shen.loading? () (value shen.*loading?*)) -(defun shen.overapplication? (V2911 V2912 V2913) (cond ((= -1 V2912) false) (true (let W2914 (< V2912 V2913) (let W2915 (if (and W2914 (shen.loading?)) (pr (shen.app V2911 (cn " might not like " (shen.app V2913 (cn " argument" (shen.app (if (= V2913 1) "" "s") " -" shen.a)) shen.a)) shen.a) (stoutput)) shen.skip) W2914))))) +(defun shen.overapplication? (V3300 V3301 V3302) (cond ((= -1 V3301) false) (true (let W3303 (< V3301 V3302) (let W3304 (if (and W3303 (shen.loading?)) (pr (shen.app V3300 (cn " might not like " (shen.app V3302 (cn " argument" (shen.app (if (= V3302 1) "" "s") " +" shen.a)) shen.a)) shen.a) (stoutput)) shen.skip) W3303))))) diff --git a/klambda/sequent.kl b/klambda/sequent.kl index d5a16c8..d9eff9f 100644 --- a/klambda/sequent.kl +++ b/klambda/sequent.kl @@ -1,102 +1,102 @@ -(defun shen. (V3033) (let W3034 (if (cons? V3033) (let W3035 (head V3033) (let W3036 (tail V3033) (let W3037 (shen. W3036) (if (shen.parse-failure? W3037) (shen.parse-failure) (let W3038 (shen.<-out W3037) (let W3039 (shen.in-> W3037) (shen.comb W3039 (let W3040 (shen.rules->prolog W3035 W3038) (shen.remember-datatype W3035 (fn W3035)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W3034) (shen.parse-failure) W3034))) +(defun shen. (V3422) (let W3423 (if (cons? V3422) (let W3424 (head V3422) (let W3425 (tail V3422) (let W3426 (shen. W3425) (if (shen.parse-failure? W3426) (shen.parse-failure) (let W3427 (shen.<-out W3426) (let W3428 (shen.in-> W3426) (shen.comb W3428 (let W3429 (shen.rules->prolog W3424 W3427) (shen.remember-datatype W3424 (fn W3424)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W3423) (shen.parse-failure) W3423))) -(defun shen.remember-datatype (V3041 V3042) (do (set shen.*datatypes* (shen.assoc-> V3041 V3042 (value shen.*datatypes*))) (do (set shen.*alldatatypes* (shen.assoc-> V3041 V3042 (value shen.*alldatatypes*))) V3041))) +(defun shen.remember-datatype (V3430 V3431) (do (set shen.*datatypes* (shen.assoc-> V3430 V3431 (value shen.*datatypes*))) (do (set shen.*alldatatypes* (shen.assoc-> V3430 V3431 (value shen.*alldatatypes*))) V3430))) -(defun shen. (V3043) (let W3044 (let W3045 (shen. V3043) (if (shen.parse-failure? W3045) (shen.parse-failure) (let W3046 (shen.<-out W3045) (let W3047 (shen.in-> W3045) (let W3048 (shen. W3047) (if (shen.parse-failure? W3048) (shen.parse-failure) (let W3049 (shen.<-out W3048) (let W3050 (shen.in-> W3048) (shen.comb W3050 (append W3046 W3049)))))))))) (if (shen.parse-failure? W3044) (let W3051 (let W3052 ( V3043) (if (shen.parse-failure? W3052) (shen.parse-failure) (let W3053 (shen.<-out W3052) (let W3054 (shen.in-> W3052) (shen.comb W3054 (if (empty? W3053) () (simple-error (cn "datatype syntax error here: - " (shen.app W3053 " - ..." shen.r))))))))) (if (shen.parse-failure? W3051) (shen.parse-failure) W3051)) W3044))) +(defun shen. (V3432) (let W3433 (let W3434 (shen. V3432) (if (shen.parse-failure? W3434) (shen.parse-failure) (let W3435 (shen.<-out W3434) (let W3436 (shen.in-> W3434) (let W3437 (shen. W3436) (if (shen.parse-failure? W3437) (shen.parse-failure) (let W3438 (shen.<-out W3437) (let W3439 (shen.in-> W3437) (shen.comb W3439 (append W3435 W3438)))))))))) (if (shen.parse-failure? W3433) (let W3440 (let W3441 ( V3432) (if (shen.parse-failure? W3441) (shen.parse-failure) (let W3442 (shen.<-out W3441) (let W3443 (shen.in-> W3441) (shen.comb W3443 (if (empty? W3442) () (simple-error (cn "datatype syntax error here: + " (shen.app W3442 " + ..." shen.r))))))))) (if (shen.parse-failure? W3440) (shen.parse-failure) W3440)) W3433))) -(defun shen. (V3055) (let W3056 (let W3057 (shen. V3055) (if (shen.parse-failure? W3057) (shen.parse-failure) (let W3058 (shen.<-out W3057) (let W3059 (shen.in-> W3057) (shen.comb W3059 W3058))))) (if (shen.parse-failure? W3056) (let W3060 (let W3061 (shen. V3055) (if (shen.parse-failure? W3061) (shen.parse-failure) (let W3062 (shen.<-out W3061) (let W3063 (shen.in-> W3061) (shen.comb W3063 W3062))))) (if (shen.parse-failure? W3060) (shen.parse-failure) W3060)) W3056))) +(defun shen. (V3444) (let W3445 (let W3446 (shen. V3444) (if (shen.parse-failure? W3446) (shen.parse-failure) (let W3447 (shen.<-out W3446) (let W3448 (shen.in-> W3446) (shen.comb W3448 W3447))))) (if (shen.parse-failure? W3445) (let W3449 (let W3450 (shen. V3444) (if (shen.parse-failure? W3450) (shen.parse-failure) (let W3451 (shen.<-out W3450) (let W3452 (shen.in-> W3450) (shen.comb W3452 W3451))))) (if (shen.parse-failure? W3449) (shen.parse-failure) W3449)) W3445))) -(defun shen. (V3064) (let W3065 (let W3066 (shen. V3064) (if (shen.parse-failure? W3066) (shen.parse-failure) (let W3067 (shen.<-out W3066) (let W3068 (shen.in-> W3066) (let W3069 (shen. W3068) (if (shen.parse-failure? W3069) (shen.parse-failure) (let W3070 (shen.<-out W3069) (let W3071 (shen.in-> W3069) (let W3072 (shen. W3071) (if (shen.parse-failure? W3072) (shen.parse-failure) (let W3073 (shen.in-> W3072) (let W3074 (shen. W3073) (if (shen.parse-failure? W3074) (shen.parse-failure) (let W3075 (shen.<-out W3074) (let W3076 (shen.in-> W3074) (let W3077 (shen. W3076) (if (shen.parse-failure? W3077) (shen.parse-failure) (let W3078 (shen.in-> W3077) (shen.comb W3078 (cons (cons W3067 (cons W3070 (cons W3075 ()))) ())))))))))))))))))))) (if (shen.parse-failure? W3065) (shen.parse-failure) W3065))) +(defun shen. (V3453) (let W3454 (let W3455 (shen. V3453) (if (shen.parse-failure? W3455) (shen.parse-failure) (let W3456 (shen.<-out W3455) (let W3457 (shen.in-> W3455) (let W3458 (shen. W3457) (if (shen.parse-failure? W3458) (shen.parse-failure) (let W3459 (shen.<-out W3458) (let W3460 (shen.in-> W3458) (let W3461 (shen. W3460) (if (shen.parse-failure? W3461) (shen.parse-failure) (let W3462 (shen.in-> W3461) (let W3463 (shen. W3462) (if (shen.parse-failure? W3463) (shen.parse-failure) (let W3464 (shen.<-out W3463) (let W3465 (shen.in-> W3463) (let W3466 (shen. W3465) (if (shen.parse-failure? W3466) (shen.parse-failure) (let W3467 (shen.in-> W3466) (shen.comb W3467 (cons (cons W3456 (cons W3459 (cons W3464 ()))) ())))))))))))))))))))) (if (shen.parse-failure? W3454) (shen.parse-failure) W3454))) -(defun shen. (V3079) (let W3080 (let W3081 (shen. V3079) (if (shen.parse-failure? W3081) (shen.parse-failure) (let W3082 (shen.<-out W3081) (let W3083 (shen.in-> W3081) (let W3084 (shen. W3083) (if (shen.parse-failure? W3084) (shen.parse-failure) (let W3085 (shen.<-out W3084) (let W3086 (shen.in-> W3084) (let W3087 (shen. W3086) (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) (let W3092 (shen. W3091) (if (shen.parse-failure? W3092) (shen.parse-failure) (let W3093 (shen.in-> W3092) (shen.comb W3093 (shen.lr-rule W3082 W3085 (cons () (cons W3090 ())))))))))))))))))))))) (if (shen.parse-failure? W3080) (shen.parse-failure) W3080))) +(defun shen. (V3468) (let W3469 (let W3470 (shen. V3468) (if (shen.parse-failure? W3470) (shen.parse-failure) (let W3471 (shen.<-out W3470) (let W3472 (shen.in-> W3470) (let W3473 (shen. W3472) (if (shen.parse-failure? W3473) (shen.parse-failure) (let W3474 (shen.<-out W3473) (let W3475 (shen.in-> W3473) (let W3476 (shen. W3475) (if (shen.parse-failure? W3476) (shen.parse-failure) (let W3477 (shen.in-> W3476) (let W3478 (shen. W3477) (if (shen.parse-failure? W3478) (shen.parse-failure) (let W3479 (shen.<-out W3478) (let W3480 (shen.in-> W3478) (let W3481 (shen. W3480) (if (shen.parse-failure? W3481) (shen.parse-failure) (let W3482 (shen.in-> W3481) (shen.comb W3482 (shen.lr-rule W3471 W3474 (cons () (cons W3479 ())))))))))))))))))))))) (if (shen.parse-failure? W3469) (shen.parse-failure) W3469))) -(defun shen. (V3094) (let W3095 (let W3096 (shen. V3094) (if (shen.parse-failure? W3096) (shen.parse-failure) (let W3097 (shen.<-out W3096) (let W3098 (shen.in-> W3096) (let W3099 (shen. W3098) (if (shen.parse-failure? W3099) (shen.parse-failure) (let W3100 (shen.in-> W3099) (let W3101 (shen. W3100) (if (shen.parse-failure? W3101) (shen.parse-failure) (let W3102 (shen.<-out W3101) (let W3103 (shen.in-> W3101) (shen.comb W3103 (cons (cons () (cons W3097 ())) W3102))))))))))))) (if (shen.parse-failure? W3095) (let W3104 (let W3105 (shen. V3094) (if (shen.parse-failure? W3105) (shen.parse-failure) (let W3106 (shen.<-out W3105) (let W3107 (shen.in-> W3105) (let W3108 (shen. W3107) (if (shen.parse-failure? W3108) (shen.parse-failure) (let W3109 (shen.in-> W3108) (shen.comb W3109 (cons (cons () (cons W3106 ())) ()))))))))) (if (shen.parse-failure? W3104) (shen.parse-failure) W3104)) W3095))) +(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 (cons () (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) (let W3497 (shen. W3496) (if (shen.parse-failure? W3497) (shen.parse-failure) (let W3498 (shen.in-> W3497) (shen.comb W3498 (cons (cons () (cons W3495 ())) ()))))))))) (if (shen.parse-failure? W3493) (shen.parse-failure) W3493)) W3484))) -(defun shen. (V3110) (let W3111 (let W3112 (shen. V3110) (if (shen.parse-failure? W3112) (shen.parse-failure) (let W3113 (shen.<-out W3112) (let W3114 (shen.in-> W3112) (if (shen.hds=? W3114 >>) (let W3115 (tail 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 W3113 (cons W3117 ())))))))) (shen.parse-failure)))))) (if (shen.parse-failure? W3111) (let W3119 (let W3120 (shen. V3110) (if (shen.parse-failure? W3120) (shen.parse-failure) (let W3121 (shen.<-out W3120) (let W3122 (shen.in-> W3120) (shen.comb W3122 (cons () (cons W3121 ()))))))) (if (shen.parse-failure? W3119) (shen.parse-failure) W3119)) W3111))) +(defun shen. (V3499) (let W3500 (let W3501 (shen. V3499) (if (shen.parse-failure? W3501) (shen.parse-failure) (let W3502 (shen.<-out W3501) (let W3503 (shen.in-> W3501) (if (shen.hds=? W3503 >>) (let W3504 (tail W3503) (let W3505 (shen. W3504) (if (shen.parse-failure? W3505) (shen.parse-failure) (let W3506 (shen.<-out W3505) (let W3507 (shen.in-> W3505) (shen.comb W3507 (cons W3502 (cons W3506 ())))))))) (shen.parse-failure)))))) (if (shen.parse-failure? W3500) (let W3508 (let W3509 (shen. V3499) (if (shen.parse-failure? W3509) (shen.parse-failure) (let W3510 (shen.<-out W3509) (let W3511 (shen.in-> W3509) (shen.comb W3511 (cons () (cons W3510 ()))))))) (if (shen.parse-failure? W3508) (shen.parse-failure) W3508)) W3500))) -(defun shen. (V3123) (let W3124 (let W3125 (shen. V3123) (if (shen.parse-failure? W3125) (shen.parse-failure) (let W3126 (shen.<-out W3125) (let W3127 (shen.in-> W3125) (let W3128 (shen. W3127) (if (shen.parse-failure? W3128) (shen.parse-failure) (let W3129 (shen.in-> 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 W3126 W3131))))))))))))) (if (shen.parse-failure? W3124) (let W3133 (let W3134 ( V3123) (if (shen.parse-failure? W3134) (shen.parse-failure) (let W3135 (shen.in-> W3134) (shen.comb W3135 ())))) (if (shen.parse-failure? W3133) (shen.parse-failure) W3133)) W3124))) +(defun shen. (V3512) (let W3513 (let W3514 (shen. V3512) (if (shen.parse-failure? W3514) (shen.parse-failure) (let W3515 (shen.<-out W3514) (let W3516 (shen.in-> W3514) (let W3517 (shen. W3516) (if (shen.parse-failure? W3517) (shen.parse-failure) (let W3518 (shen.in-> W3517) (let W3519 (shen. W3518) (if (shen.parse-failure? W3519) (shen.parse-failure) (let W3520 (shen.<-out W3519) (let W3521 (shen.in-> W3519) (shen.comb W3521 (cons W3515 W3520))))))))))))) (if (shen.parse-failure? W3513) (let W3522 (let W3523 ( V3512) (if (shen.parse-failure? W3523) (shen.parse-failure) (let W3524 (shen.in-> W3523) (shen.comb W3524 ())))) (if (shen.parse-failure? W3522) (shen.parse-failure) W3522)) W3513))) -(defun shen. (V3136) (let W3137 (if (shen.hds=? V3136 !) (let W3138 (tail V3136) (shen.comb W3138 !)) (shen.parse-failure)) (if (shen.parse-failure? W3137) (let W3139 (let W3140 (shen. V3136) (if (shen.parse-failure? W3140) (shen.parse-failure) (let W3141 (shen.<-out W3140) (let W3142 (shen.in-> W3140) (if (shen.hds=? W3142 >>) (let W3143 (tail 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 W3141 (cons W3145 ())))))))) (shen.parse-failure)))))) (if (shen.parse-failure? W3139) (let W3147 (let W3148 (shen. V3136) (if (shen.parse-failure? W3148) (shen.parse-failure) (let W3149 (shen.<-out W3148) (let W3150 (shen.in-> W3148) (shen.comb W3150 (cons () (cons W3149 ()))))))) (if (shen.parse-failure? W3147) (shen.parse-failure) W3147)) W3139)) W3137))) +(defun shen. (V3525) (let W3526 (if (shen.hds=? V3525 !) (let W3527 (tail V3525) (shen.comb W3527 !)) (shen.parse-failure)) (if (shen.parse-failure? W3526) (let W3528 (let W3529 (shen. V3525) (if (shen.parse-failure? W3529) (shen.parse-failure) (let W3530 (shen.<-out W3529) (let W3531 (shen.in-> W3529) (if (shen.hds=? W3531 >>) (let W3532 (tail W3531) (let W3533 (shen. W3532) (if (shen.parse-failure? W3533) (shen.parse-failure) (let W3534 (shen.<-out W3533) (let W3535 (shen.in-> W3533) (shen.comb W3535 (cons W3530 (cons W3534 ())))))))) (shen.parse-failure)))))) (if (shen.parse-failure? W3528) (let W3536 (let W3537 (shen. V3525) (if (shen.parse-failure? W3537) (shen.parse-failure) (let W3538 (shen.<-out W3537) (let W3539 (shen.in-> W3537) (shen.comb W3539 (cons () (cons W3538 ()))))))) (if (shen.parse-failure? W3536) (shen.parse-failure) W3536)) W3528)) W3526))) -(defun shen. (V3151) (let W3152 (let W3153 (shen. V3151) (if (shen.parse-failure? W3153) (shen.parse-failure) (let W3154 (shen.<-out W3153) (let W3155 (shen.in-> W3153) (let W3156 (shen. W3155) (if (shen.parse-failure? W3156) (shen.parse-failure) (let W3157 (shen.in-> W3156) (let W3158 (shen. W3157) (if (shen.parse-failure? W3158) (shen.parse-failure) (let W3159 (shen.<-out W3158) (let W3160 (shen.in-> W3158) (shen.comb W3160 (cons W3154 W3159))))))))))))) (if (shen.parse-failure? W3152) (let W3161 (let W3162 (shen. V3151) (if (shen.parse-failure? W3162) (shen.parse-failure) (let W3163 (shen.<-out W3162) (let W3164 (shen.in-> W3162) (shen.comb W3164 (cons W3163 ())))))) (if (shen.parse-failure? W3161) (let W3165 (let W3166 ( V3151) (if (shen.parse-failure? W3166) (shen.parse-failure) (let W3167 (shen.in-> W3166) (shen.comb W3167 ())))) (if (shen.parse-failure? W3165) (shen.parse-failure) W3165)) W3161)) W3152))) +(defun shen. (V3540) (let W3541 (let W3542 (shen. V3540) (if (shen.parse-failure? W3542) (shen.parse-failure) (let W3543 (shen.<-out W3542) (let W3544 (shen.in-> W3542) (let W3545 (shen. W3544) (if (shen.parse-failure? W3545) (shen.parse-failure) (let W3546 (shen.in-> W3545) (let W3547 (shen. W3546) (if (shen.parse-failure? W3547) (shen.parse-failure) (let W3548 (shen.<-out W3547) (let W3549 (shen.in-> W3547) (shen.comb W3549 (cons W3543 W3548))))))))))))) (if (shen.parse-failure? W3541) (let W3550 (let W3551 (shen. V3540) (if (shen.parse-failure? W3551) (shen.parse-failure) (let W3552 (shen.<-out W3551) (let W3553 (shen.in-> W3551) (shen.comb W3553 (cons W3552 ())))))) (if (shen.parse-failure? W3550) (let W3554 (let W3555 ( V3540) (if (shen.parse-failure? W3555) (shen.parse-failure) (let W3556 (shen.in-> W3555) (shen.comb W3556 ())))) (if (shen.parse-failure? W3554) (shen.parse-failure) W3554)) W3550)) W3541))) -(defun shen. (V3168) (let W3169 (if (cons? V3168) (let W3170 (head V3168) (let W3171 (tail V3168) (if (= W3170 (intern ",")) (shen.comb W3171 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3169) (shen.parse-failure) W3169))) +(defun shen. (V3557) (let W3558 (if (cons? V3557) (let W3559 (head V3557) (let W3560 (tail V3557) (if (= W3559 (intern ",")) (shen.comb W3560 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3558) (shen.parse-failure) W3558))) -(defun shen. (V3172) (let W3173 (let W3174 (shen. V3172) (if (shen.parse-failure? W3174) (shen.parse-failure) (let W3175 (shen.<-out W3174) (let W3176 (shen.in-> W3174) (let W3177 (shen. W3176) (if (shen.parse-failure? W3177) (shen.parse-failure) (let W3178 (shen.in-> W3177) (let W3179 (shen. W3178) (if (shen.parse-failure? W3179) (shen.parse-failure) (let W3180 (shen.<-out W3179) (let W3181 (shen.in-> W3179) (shen.comb W3181 (cons (shen.curry W3175) (cons (intern ":") (cons (shen.rectify-type W3180) ()))))))))))))))) (if (shen.parse-failure? W3173) (let W3182 (let W3183 (shen. V3172) (if (shen.parse-failure? W3183) (shen.parse-failure) (let W3184 (shen.<-out W3183) (let W3185 (shen.in-> W3183) (shen.comb W3185 W3184))))) (if (shen.parse-failure? W3182) (shen.parse-failure) W3182)) W3173))) +(defun shen. (V3561) (let W3562 (let W3563 (shen. V3561) (if (shen.parse-failure? W3563) (shen.parse-failure) (let W3564 (shen.<-out W3563) (let W3565 (shen.in-> W3563) (let W3566 (shen. W3565) (if (shen.parse-failure? W3566) (shen.parse-failure) (let W3567 (shen.in-> W3566) (let W3568 (shen. W3567) (if (shen.parse-failure? W3568) (shen.parse-failure) (let W3569 (shen.<-out W3568) (let W3570 (shen.in-> W3568) (shen.comb W3570 (cons (shen.curry W3564) (cons (intern ":") (cons (shen.rectify-type W3569) ()))))))))))))))) (if (shen.parse-failure? W3562) (let W3571 (let W3572 (shen. V3561) (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)) W3562))) -(defun shen. (V3186) (let W3187 (if (cons? V3186) (let W3188 (head V3186) (let W3189 (tail V3186) (if (= W3188 (intern ":")) (shen.comb W3189 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3187) (shen.parse-failure) W3187))) +(defun shen. (V3575) (let W3576 (if (cons? V3575) (let W3577 (head V3575) (let W3578 (tail V3575) (if (= W3577 (intern ":")) (shen.comb W3578 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3576) (shen.parse-failure) W3576))) -(defun shen. (V3190) (let W3191 (let W3192 (shen. V3190) (if (shen.parse-failure? W3192) (shen.parse-failure) (let W3193 (shen.<-out W3192) (let W3194 (shen.in-> W3192) (let W3195 (shen. W3194) (if (shen.parse-failure? W3195) (shen.parse-failure) (let W3196 (shen.<-out W3195) (let W3197 (shen.in-> W3195) (shen.comb W3197 (cons W3193 W3196)))))))))) (if (shen.parse-failure? W3191) (let W3198 (let W3199 ( V3190) (if (shen.parse-failure? W3199) (shen.parse-failure) (let W3200 (shen.in-> W3199) (shen.comb W3200 ())))) (if (shen.parse-failure? W3198) (shen.parse-failure) W3198)) W3191))) +(defun shen. (V3579) (let W3580 (let W3581 (shen. V3579) (if (shen.parse-failure? W3581) (shen.parse-failure) (let W3582 (shen.<-out W3581) (let W3583 (shen.in-> W3581) (let W3584 (shen. W3583) (if (shen.parse-failure? W3584) (shen.parse-failure) (let W3585 (shen.<-out W3584) (let W3586 (shen.in-> W3584) (shen.comb W3586 (cons W3582 W3585)))))))))) (if (shen.parse-failure? W3580) (let W3587 (let W3588 ( V3579) (if (shen.parse-failure? W3588) (shen.parse-failure) (let W3589 (shen.in-> W3588) (shen.comb W3589 ())))) (if (shen.parse-failure? W3587) (shen.parse-failure) W3587)) W3580))) -(defun shen. (V3201) (let W3202 (if (shen.hds=? V3201 if) (let W3203 (tail V3201) (if (cons? W3203) (let W3204 (head W3203) (let W3205 (tail W3203) (shen.comb W3205 (cons if (cons W3204 ()))))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W3202) (let W3206 (if (shen.hds=? V3201 let) (let W3207 (tail V3201) (if (cons? W3207) (let W3208 (head W3207) (let W3209 (tail W3207) (if (cons? W3209) (let W3210 (head W3209) (let W3211 (tail W3209) (shen.comb W3211 (cons let (cons W3208 (cons W3210 ())))))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W3206) (let W3212 (if (shen.hds=? V3201 ctxt) (let W3213 (tail V3201) (if (cons? W3213) (let W3214 (head W3213) (let W3215 (tail W3213) (if (variable? W3214) (shen.comb W3215 (cons ctxt (cons W3214 ()))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W3212) (let W3216 (if (shen.hds=? V3201 sqts) (let W3217 (tail V3201) (if (cons? W3217) (let W3218 (head W3217) (let W3219 (tail W3217) (if (variable? W3218) (shen.comb W3219 (cons sqts (cons W3218 ()))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W3216) (shen.parse-failure) W3216)) W3212)) W3206)) W3202))) +(defun shen. (V3590) (let W3591 (if (shen.hds=? V3590 if) (let W3592 (tail V3590) (if (cons? W3592) (let W3593 (head W3592) (let W3594 (tail W3592) (shen.comb W3594 (cons if (cons W3593 ()))))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W3591) (let W3595 (if (shen.hds=? V3590 let) (let W3596 (tail V3590) (if (cons? W3596) (let W3597 (head W3596) (let W3598 (tail W3596) (if (cons? W3598) (let W3599 (head W3598) (let W3600 (tail W3598) (shen.comb W3600 (cons let (cons W3597 (cons W3599 ())))))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W3595) (let W3601 (if (shen.hds=? V3590 ctxt) (let W3602 (tail V3590) (if (cons? W3602) (let W3603 (head W3602) (let W3604 (tail W3602) (if (variable? W3603) (shen.comb W3604 (cons ctxt (cons W3603 ()))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W3601) (let W3605 (if (shen.hds=? V3590 sqts) (let W3606 (tail V3590) (if (cons? W3606) (let W3607 (head W3606) (let W3608 (tail W3606) (if (variable? W3607) (shen.comb W3608 (cons sqts (cons W3607 ()))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W3605) (shen.parse-failure) W3605)) W3601)) W3595)) W3591))) -(defun shen.lr-rule (V3226 V3227 V3228) (cond ((and (cons? V3228) (and (= () (hd V3228)) (and (cons? (tl V3228)) (= () (tl (tl V3228)))))) (let W3229 (gensym P) (let W3230 (cons (tl V3228) (cons W3229 ())) (let W3231 (cons (shen.coll-formulae V3227) (cons W3229 ())) (let W3232 (cons V3226 (cons (cons W3231 ()) (cons W3230 ()))) (let W3233 (cons V3226 (cons V3227 (cons V3228 ()))) (cons W3233 (cons W3232 ())))))))) (true (simple-error "implementation error in shen.lr-rule")))) +(defun shen.lr-rule (V3615 V3616 V3617) (cond ((and (cons? V3617) (and (= () (hd V3617)) (and (cons? (tl V3617)) (= () (tl (tl V3617)))))) (let W3618 (gensym P) (let W3619 (cons (tl V3617) (cons W3618 ())) (let W3620 (cons (shen.coll-formulae V3616) (cons W3618 ())) (let W3621 (cons V3615 (cons (cons W3620 ()) (cons W3619 ()))) (let W3622 (cons V3615 (cons V3616 (cons V3617 ()))) (cons W3622 (cons W3621 ())))))))) (true (simple-error "implementation error in shen.lr-rule")))) -(defun shen.coll-formulae (V3236) (cond ((= () V3236) ()) ((and (cons? V3236) (and (cons? (hd V3236)) (and (= () (hd (hd V3236))) (and (cons? (tl (hd V3236))) (= () (tl (tl (hd V3236)))))))) (cons (hd (tl (hd V3236))) (shen.coll-formulae (tl V3236)))) (true (simple-error "implementation error in shen.coll-formulae")))) +(defun shen.coll-formulae (V3625) (cond ((= () V3625) ()) ((and (cons? V3625) (and (cons? (hd V3625)) (and (= () (hd (hd V3625))) (and (cons? (tl (hd V3625))) (= () (tl (tl (hd V3625)))))))) (cons (hd (tl (hd V3625))) (shen.coll-formulae (tl V3625)))) (true (simple-error "implementation error in shen.coll-formulae")))) -(defun shen. (V3237) (let W3238 (if (cons? V3237) (let W3239 (head V3237) (let W3240 (tail V3237) (if (not (shen.key-in-sequent-calculus? W3239)) (shen.comb W3240 (macroexpand W3239)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3238) (shen.parse-failure) W3238))) +(defun shen. (V3626) (let W3627 (if (cons? V3626) (let W3628 (head V3626) (let W3629 (tail V3626) (if (not (shen.key-in-sequent-calculus? W3628)) (shen.comb W3629 (macroexpand W3628)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3627) (shen.parse-failure) W3627))) -(defun shen.key-in-sequent-calculus? (V3241) (or (element? V3241 (cons >> (cons (intern ";") (cons (intern ",") (cons (intern ":") (cons <-- ())))))) (or (shen.sng? V3241) (shen.dbl? V3241)))) +(defun shen.key-in-sequent-calculus? (V3630) (or (element? V3630 (cons >> (cons (intern ";") (cons (intern ",") (cons (intern ":") (cons <-- ())))))) (or (shen.sng? V3630) (shen.dbl? V3630)))) -(defun shen. (V3242) (let W3243 (let W3244 (shen. V3242) (if (shen.parse-failure? W3244) (shen.parse-failure) (let W3245 (shen.<-out W3244) (let W3246 (shen.in-> W3244) (shen.comb W3246 W3245))))) (if (shen.parse-failure? W3243) (shen.parse-failure) W3243))) +(defun shen. (V3631) (let W3632 (let W3633 (shen. V3631) (if (shen.parse-failure? W3633) (shen.parse-failure) (let W3634 (shen.<-out W3633) (let W3635 (shen.in-> W3633) (shen.comb W3635 W3634))))) (if (shen.parse-failure? W3632) (shen.parse-failure) W3632))) -(defun shen. (V3247) (let W3248 (if (cons? V3247) (let W3249 (head V3247) (let W3250 (tail V3247) (if (shen.dbl? W3249) (shen.comb W3250 W3249) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3248) (shen.parse-failure) W3248))) +(defun shen. (V3636) (let W3637 (if (cons? V3636) (let W3638 (head V3636) (let W3639 (tail V3636) (if (shen.dbl? W3638) (shen.comb W3639 W3638) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3637) (shen.parse-failure) W3637))) -(defun shen. (V3251) (let W3252 (if (cons? V3251) (let W3253 (head V3251) (let W3254 (tail V3251) (if (shen.sng? W3253) (shen.comb W3254 W3253) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3252) (shen.parse-failure) W3252))) +(defun shen. (V3640) (let W3641 (if (cons? V3640) (let W3642 (head V3640) (let W3643 (tail V3640) (if (shen.sng? W3642) (shen.comb W3643 W3642) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3641) (shen.parse-failure) W3641))) -(defun shen.sng? (V3255) (and (symbol? V3255) (shen.sng-h? (str V3255)))) +(defun shen.sng? (V3644) (and (symbol? V3644) (shen.sng-h? (str V3644)))) -(defun shen.sng-h? (V3258) (cond ((= "___" V3258) true) ((and (shen.+string? V3258) (= "_" (hdstr V3258))) (shen.sng-h? (tlstr V3258))) (true false))) +(defun shen.sng-h? (V3647) (cond ((= "___" V3647) true) ((and (shen.+string? V3647) (= "_" (hdstr V3647))) (shen.sng-h? (tlstr V3647))) (true false))) -(defun shen.dbl? (V3259) (and (symbol? V3259) (shen.dbl-h? (str V3259)))) +(defun shen.dbl? (V3648) (and (symbol? V3648) (shen.dbl-h? (str V3648)))) -(defun shen.dbl-h? (V3262) (cond ((= "===" V3262) true) ((and (shen.+string? V3262) (= "=" (hdstr V3262))) (shen.dbl-h? (tlstr V3262))) (true false))) +(defun shen.dbl-h? (V3651) (cond ((= "===" V3651) true) ((and (shen.+string? V3651) (= "=" (hdstr V3651))) (shen.dbl-h? (tlstr V3651))) (true false))) -(defun shen.rules->prolog (V3263 V3264) (let W3265 (mapcan (lambda Z3266 (shen.rule->clause Z3266)) V3264) (let W3267 (cons defprolog (cons V3263 W3265)) (eval W3267)))) +(defun shen.rules->prolog (V3652 V3653) (let W3654 (mapcan (lambda Z3655 (shen.rule->clause Z3655)) V3653) (let W3656 (cons defprolog (cons V3652 W3654)) (eval W3656)))) -(defun shen.rule->clause (V3268) (cond ((and (cons? V3268) (and (cons? (tl V3268)) (and (cons? (tl (tl V3268))) (and (cons? (hd (tl (tl V3268)))) (and (cons? (tl (hd (tl (tl V3268))))) (and (= () (tl (tl (hd (tl (tl V3268)))))) (= () (tl (tl (tl V3268)))))))))) (let W3269 (shen.extract-vars (hd (tl (hd (tl (tl V3268)))))) (append (shen.rule->head (hd (tl (hd (tl (tl V3268)))))) (append (cons <-- ()) (shen.rule->body W3269 Assumptions (hd V3268) (hd (tl V3268)) (hd (hd (tl (tl V3268))))))))) (true (simple-error "partial function shen.rule->clause")))) +(defun shen.rule->clause (V3657) (cond ((and (cons? V3657) (and (cons? (tl V3657)) (and (cons? (tl (tl V3657))) (and (cons? (hd (tl (tl V3657)))) (and (cons? (tl (hd (tl (tl V3657))))) (and (= () (tl (tl (hd (tl (tl V3657)))))) (= () (tl (tl (tl V3657)))))))))) (let W3658 (shen.extract-vars (hd (tl (hd (tl (tl V3657)))))) (append (shen.rule->head (hd (tl (hd (tl (tl V3657)))))) (append (cons <-- ()) (shen.rule->body W3658 Assumptions (hd V3657) (hd (tl V3657)) (hd (hd (tl (tl V3657))))))))) (true (shen.f-error shen.rule->clause)))) -(defun shen.rule->head (V3270) (cons (shen.macro-@ch V3270) (cons Assumptions ()))) +(defun shen.rule->head (V3659) (cons (shen.macro-@ch V3659) (cons Assumptions ()))) -(defun shen.macro-@ch (V3271) (cons shen.@ch (cons V3271 ()))) +(defun shen.macro-@ch (V3660) (cons shen.@ch (cons V3660 ()))) -(defun shen.macro-@c (V3272) (cons shen.@c (cons V3272 ()))) +(defun shen.macro-@c (V3661) (cons shen.@c (cons V3661 ()))) -(defun shen.rule->body (V3273 V3274 V3275 V3276 V3277) (cond ((= () V3277) (shen.side-conditions->goals () V3273 V3274 V3275 V3276)) ((and (= () V3276) (and (cons? V3277) (= () (tl V3277)))) (let W3278 (shen.passive-variables (hd V3277) V3273) (let W3279 (shen.remove-bystanders V3273 (hd V3277)) (cons (shen.specialise-member (hd V3277) V3274 W3279 W3278) (shen.side-conditions->goals () V3273 V3274 V3275 ()))))) ((cons? V3277) (let W3280 (gensym NewAssumptions) (let W3281 (shen.passive-variables (hd V3277) V3273) (let W3282 (shen.remove-bystanders V3273 (hd V3277)) (cons (shen.specialise-consume (hd V3277) V3274 W3282 W3281 W3280) (shen.rule->body (append V3273 W3281) W3280 V3275 V3276 (tl V3277))))))) (true (simple-error "partial function shen.rule->body")))) +(defun shen.rule->body (V3662 V3663 V3664 V3665 V3666) (cond ((= () V3666) (shen.side-conditions->goals () V3662 V3663 V3664 V3665)) ((and (= () V3665) (and (cons? V3666) (= () (tl V3666)))) (let W3667 (shen.passive-variables (hd V3666) V3662) (let W3668 (shen.remove-bystanders V3662 (hd V3666)) (cons (shen.specialise-member (hd V3666) V3663 W3668 W3667) (shen.side-conditions->goals () V3662 V3663 V3664 ()))))) ((cons? V3666) (let W3669 (gensym NewAssumptions) (let W3670 (shen.passive-variables (hd V3666) V3662) (let W3671 (shen.remove-bystanders V3662 (hd V3666)) (cons (shen.specialise-consume (hd V3666) V3663 W3671 W3670 W3669) (shen.rule->body (append V3662 W3670) W3669 V3664 V3665 (tl V3666))))))) (true (shen.f-error shen.rule->body)))) -(defun shen.specialise-member (V3283 V3284 V3285 V3286) (let W3287 (gensym shen.member) (let W3288 (shen.member-clause W3287 V3283 V3285 V3286) (cons W3287 (cons V3284 (append V3285 V3286)))))) +(defun shen.specialise-member (V3672 V3673 V3674 V3675) (let W3676 (gensym shen.member) (let W3677 (shen.member-clause W3676 V3672 V3674 V3675) (cons W3676 (cons V3673 (append V3674 V3675)))))) -(defun shen.remove-bystanders (V3291 V3292) (cond ((= () V3291) ()) ((and (cons? V3291) (shen.occurs-check? (hd V3291) V3292)) (cons (hd V3291) (shen.remove-bystanders (tl V3291) V3292))) ((cons? V3291) (shen.remove-bystanders (tl V3291) V3292)) (true (simple-error "partial function shen.remove-bystanders")))) +(defun shen.remove-bystanders (V3680 V3681) (cond ((= () V3680) ()) ((and (cons? V3680) (shen.occurs-check? (hd V3680) V3681)) (cons (hd V3680) (shen.remove-bystanders (tl V3680) V3681))) ((cons? V3680) (shen.remove-bystanders (tl V3680) V3681)) (true (shen.f-error shen.remove-bystanders)))) -(defun shen.member-clause (V3293 V3294 V3295 V3296) (let W3297 (shen.nvars (length V3296)) (let W3298 (append (cons (cons - (cons (cons cons (cons (shen.macro-@ch V3294) (cons _ ()))) ())) ()) (append V3295 (append W3297 (append (cons <-- ()) (append (shen.passive-bind V3296 W3297) (cons (intern ";") ())))))) (let W3299 (let W3300 (gensym Hypotheses) (let W3301 (append V3295 V3296) (let W3302 (append (cons (cons - (cons (cons cons (cons _ (cons W3300 ()))) ())) ()) W3301) (let W3303 (cons (cons V3293 (cons W3300 W3301)) ()) (append W3302 (append (cons <-- ()) (append W3303 (cons (intern ";") ())))))))) (let W3304 (cons defprolog (cons V3293 (append W3298 W3299))) (eval W3304)))))) +(defun shen.member-clause (V3682 V3683 V3684 V3685) (let W3686 (shen.nvars (length V3685)) (let W3687 (append (cons (cons - (cons (cons cons (cons (shen.macro-@ch V3683) (cons _ ()))) ())) ()) (append V3684 (append W3686 (append (cons <-- ()) (append (shen.passive-bind V3685 W3686) (cons (intern ";") ())))))) (let W3688 (let W3689 (gensym Hypotheses) (let W3690 (append V3684 V3685) (let W3691 (append (cons (cons - (cons (cons cons (cons _ (cons W3689 ()))) ())) ()) W3690) (let W3692 (cons (cons V3682 (cons W3689 W3690)) ()) (append W3691 (append (cons <-- ()) (append W3692 (cons (intern ";") ())))))))) (let W3693 (cons defprolog (cons V3682 (append W3687 W3688))) (eval W3693)))))) -(defun shen.nvars (V3305) (cond ((= 0 V3305) ()) (true (cons (gensym NewV) (shen.nvars (- V3305 1)))))) +(defun shen.nvars (V3694) (cond ((= 0 V3694) ()) (true (cons (gensym NewV) (shen.nvars (- V3694 1)))))) -(defun shen.passive-bind (V3306 V3307) (cond ((and (= () V3306) (= () V3307)) ()) ((and (cons? V3306) (cons? V3307)) (cons (cons bind (cons (hd V3307) (cons (hd V3306) ()))) (shen.passive-bind (tl V3306) (tl V3307)))) (true (simple-error "partial function shen.passive-bind")))) +(defun shen.passive-bind (V3695 V3696) (cond ((and (= () V3695) (= () V3696)) ()) ((and (cons? V3695) (cons? V3696)) (cons (cons bind (cons (hd V3696) (cons (hd V3695) ()))) (shen.passive-bind (tl V3695) (tl V3696)))) (true (shen.f-error shen.passive-bind)))) -(defun shen.specialise-consume (V3308 V3309 V3310 V3311 V3312) (let W3313 (gensym shen.consume) (let W3314 (shen.consume-clause W3313 V3308 V3310 V3311 V3312) (cons W3313 (cons V3309 (cons V3312 (append V3310 V3311))))))) +(defun shen.specialise-consume (V3697 V3698 V3699 V3700 V3701) (let W3702 (gensym shen.consume) (let W3703 (shen.consume-clause W3702 V3697 V3699 V3700 V3701) (cons W3702 (cons V3698 (cons V3701 (append V3699 V3700))))))) -(defun shen.consume-clause (V3315 V3316 V3317 V3318 V3319) (let W3320 (shen.nvars (length V3318)) (let W3321 (gensym Assumption) (let W3322 (cons (cons - (cons (cons cons (cons (shen.macro-@ch V3316) (cons W3321 ()))) ())) (cons V3319 (append V3317 (append W3320 (append (cons <-- ()) (append (shen.passive-bind V3318 W3320) (cons (cons bind (cons V3319 (cons W3321 ()))) (cons (intern ";") ())))))))) (let W3323 (let W3324 (gensym Hypotheses) (let W3325 (append V3317 V3318) (let W3326 (gensym Assumptions) (let W3327 (cons (cons - (cons (cons cons (cons W3321 (cons W3324 ()))) ())) (cons (cons cons (cons W3326 (cons V3319 ()))) W3325)) (let W3328 (cons (cons bind (cons W3326 (cons W3321 ()))) (cons (cons V3315 (cons W3324 (cons V3319 W3325))) ())) (append W3327 (append (cons <-- ()) (append W3328 (cons (intern ";") ()))))))))) (let W3329 (cons defprolog (cons V3315 (append W3322 W3323))) (eval W3329))))))) +(defun shen.consume-clause (V3704 V3705 V3706 V3707 V3708) (let W3709 (shen.nvars (length V3707)) (let W3710 (gensym Assumption) (let W3711 (cons (cons - (cons (cons cons (cons (shen.macro-@ch V3705) (cons W3710 ()))) ())) (cons V3708 (append V3706 (append W3709 (append (cons <-- ()) (append (shen.passive-bind V3707 W3709) (cons (cons bind (cons V3708 (cons W3710 ()))) (cons (intern ";") ())))))))) (let W3712 (let W3713 (gensym Hypotheses) (let W3714 (append V3706 V3707) (let W3715 (gensym Assumptions) (let W3716 (cons (cons - (cons (cons cons (cons W3710 (cons W3713 ()))) ())) (cons (cons cons (cons W3715 (cons V3708 ()))) W3714)) (let W3717 (cons (cons bind (cons W3715 (cons W3710 ()))) (cons (cons V3704 (cons W3713 (cons V3708 W3714))) ())) (append W3716 (append (cons <-- ()) (append W3717 (cons (intern ";") ()))))))))) (let W3718 (cons defprolog (cons V3704 (append W3711 W3712))) (eval W3718))))))) -(defun shen.passive-variables (V3330 V3331) (difference (shen.extract-vars V3330) V3331)) +(defun shen.passive-variables (V3719 V3720) (difference (shen.extract-vars V3719) V3720)) -(defun shen.side-conditions->goals (V3336 V3337 V3338 V3339 V3340) (cond ((= () V3339) (shen.premises->goals V3336 V3338 V3340)) ((and (cons? V3339) (and (cons? (hd V3339)) (and (= if (hd (hd V3339))) (and (cons? (tl (hd V3339))) (= () (tl (tl (hd V3339)))))))) (cons (cons when (tl (hd V3339))) (shen.side-conditions->goals V3336 V3337 V3338 (tl V3339) V3340))) ((and (cons? V3339) (and (cons? (hd V3339)) (and (= let (hd (hd V3339))) (and (cons? (tl (hd V3339))) (and (cons? (tl (tl (hd V3339)))) (= () (tl (tl (tl (hd V3339)))))))))) (if (element? (hd (tl (hd V3339))) V3337) (cons (cons is! (tl (hd V3339))) (shen.side-conditions->goals V3336 V3337 V3338 (tl V3339) V3340)) (cons (cons bind (tl (hd V3339))) (shen.side-conditions->goals V3336 (cons (hd (tl (hd V3339))) V3337) V3338 (tl V3339) V3340)))) ((and (cons? V3339) (and (cons? (hd V3339)) (and (= ctxt (hd (hd V3339))) (and (cons? (tl (hd V3339))) (= () (tl (tl (hd V3339)))))))) (if (element? (hd (tl (hd V3339))) V3337) (shen.side-conditions->goals (cons (hd (tl (hd V3339))) V3336) V3337 V3338 (tl V3339) V3340) (cons (cons bind (cons (hd (tl (hd V3339))) (cons V3338 ()))) (shen.side-conditions->goals (cons (hd (tl (hd V3339))) V3336) (cons (hd (tl (hd V3339))) V3337) (hd (tl (hd V3339))) (tl V3339) V3340)))) ((and (cons? V3339) (and (cons? (hd V3339)) (and (= sqts (hd (hd V3339))) (and (cons? (tl (hd V3339))) (= () (tl (tl (hd V3339)))))))) (shen.side-conditions->goals V3336 V3337 V3338 (tl V3339) V3340)) (true (simple-error "partial function shen.side-conditions->goals")))) +(defun shen.side-conditions->goals (V3725 V3726 V3727 V3728 V3729) (cond ((= () V3728) (shen.premises->goals V3725 V3727 V3729)) ((and (cons? V3728) (and (cons? (hd V3728)) (and (= if (hd (hd V3728))) (and (cons? (tl (hd V3728))) (= () (tl (tl (hd V3728)))))))) (cons (cons when (tl (hd V3728))) (shen.side-conditions->goals V3725 V3726 V3727 (tl V3728) V3729))) ((and (cons? V3728) (and (cons? (hd V3728)) (and (= let (hd (hd V3728))) (and (cons? (tl (hd V3728))) (and (cons? (tl (tl (hd V3728)))) (= () (tl (tl (tl (hd V3728)))))))))) (if (element? (hd (tl (hd V3728))) V3726) (cons (cons is! (tl (hd V3728))) (shen.side-conditions->goals V3725 V3726 V3727 (tl V3728) V3729)) (cons (cons bind (tl (hd V3728))) (shen.side-conditions->goals V3725 (cons (hd (tl (hd V3728))) V3726) V3727 (tl V3728) V3729)))) ((and (cons? V3728) (and (cons? (hd V3728)) (and (= ctxt (hd (hd V3728))) (and (cons? (tl (hd V3728))) (= () (tl (tl (hd V3728)))))))) (if (element? (hd (tl (hd V3728))) V3726) (shen.side-conditions->goals (cons (hd (tl (hd V3728))) V3725) V3726 V3727 (tl V3728) V3729) (cons (cons bind (cons (hd (tl (hd V3728))) (cons V3727 ()))) (shen.side-conditions->goals (cons (hd (tl (hd V3728))) V3725) (cons (hd (tl (hd V3728))) V3726) (hd (tl (hd V3728))) (tl V3728) V3729)))) ((and (cons? V3728) (and (cons? (hd V3728)) (and (= sqts (hd (hd V3728))) (and (cons? (tl (hd V3728))) (= () (tl (tl (hd V3728)))))))) (shen.side-conditions->goals V3725 V3726 V3727 (tl V3728) V3729)) (true (shen.f-error shen.side-conditions->goals)))) -(defun shen.premises->goals (V3345 V3346 V3347) (cond ((= () V3347) (cons (intern ";") ())) ((and (cons? V3347) (= ! (hd V3347))) (cons ! (shen.premises->goals V3345 V3346 (tl V3347)))) ((and (cons? V3347) (= fail (hd V3347))) (cons (cons when (cons false ())) (shen.premises->goals V3345 V3346 (tl V3347)))) ((and (cons? V3347) (and (cons? (hd V3347)) (and (cons? (tl (hd V3347))) (= () (tl (tl (hd V3347))))))) (cons (cons shen.system-S (cons (shen.macro-@c (hd (tl (hd V3347)))) (cons (shen.construct-context V3345 (hd (hd V3347)) V3346) ()))) (shen.premises->goals V3345 V3346 (tl V3347)))) (true (simple-error "partial function shen.premises->goals")))) +(defun shen.premises->goals (V3734 V3735 V3736) (cond ((= () V3736) (cons (intern ";") ())) ((and (cons? V3736) (= ! (hd V3736))) (cons ! (shen.premises->goals V3734 V3735 (tl V3736)))) ((and (cons? V3736) (= fail (hd V3736))) (cons (cons when (cons false ())) (shen.premises->goals V3734 V3735 (tl V3736)))) ((and (cons? V3736) (and (cons? (hd V3736)) (and (cons? (tl (hd V3736))) (= () (tl (tl (hd V3736))))))) (cons (cons shen.system-S (cons (shen.macro-@c (hd (tl (hd V3736)))) (cons (shen.construct-context V3734 (hd (hd V3736)) V3735) ()))) (shen.premises->goals V3734 V3735 (tl V3736)))) (true (shen.f-error shen.premises->goals)))) -(defun shen.construct-context (V3351 V3352 V3353) (cond ((= () V3352) V3353) ((and (cons? V3352) (and (= () (tl V3352)) (element? (hd V3352) V3351))) (hd V3352)) ((cons? V3352) (cons cons (cons (shen.macro-@c (hd V3352)) (cons (shen.construct-context V3351 (tl V3352) V3353) ())))) (true (simple-error "partial function shen.construct-context")))) +(defun shen.construct-context (V3740 V3741 V3742) (cond ((= () V3741) V3742) ((and (cons? V3741) (and (= () (tl V3741)) (element? (hd V3741) V3740))) (hd V3741)) ((cons? V3741) (cons cons (cons (shen.macro-@c (hd V3741)) (cons (shen.construct-context V3740 (tl V3741) V3742) ())))) (true (shen.f-error shen.construct-context)))) -(defun preclude (V3354) (let W3355 (map (lambda Z3356 (shen.intern-type Z3356)) V3354) (let W3357 (value shen.*datatypes*) (let W3358 (shen.remove-datatypes W3355 W3357) (let W3359 (set shen.*datatypes* W3358) (shen.show-datatypes W3359)))))) +(defun preclude (V3743) (let W3744 (map (lambda Z3745 (shen.intern-type Z3745)) V3743) (let W3746 (value shen.*datatypes*) (let W3747 (shen.remove-datatypes W3744 W3746) (let W3748 (set shen.*datatypes* W3747) (shen.show-datatypes W3748)))))) -(defun shen.remove-datatypes (V3364 V3365) (cond ((= () V3364) V3365) ((cons? V3364) (shen.remove-datatypes (tl V3364) (shen.unassoc (hd V3364) V3365))) (true (simple-error "implementation error in shen.remove-datatypes")))) +(defun shen.remove-datatypes (V3753 V3754) (cond ((= () V3753) V3754) ((cons? V3753) (shen.remove-datatypes (tl V3753) (shen.unassoc (hd V3753) V3754))) (true (simple-error "implementation error in shen.remove-datatypes")))) -(defun shen.show-datatypes (V3366) (map (lambda Z3367 (hd Z3367)) V3366)) +(defun shen.show-datatypes (V3755) (map (lambda Z3756 (hd Z3756)) V3755)) -(defun include (V3368) (let W3369 (map (lambda Z3370 (shen.intern-type Z3370)) V3368) (let W3371 (map (lambda Z3372 (shen.remember-datatype Z3372 (fn Z3372))) W3369) (let W3373 (value shen.*datatypes*) (shen.show-datatypes W3373))))) +(defun include (V3757) (let W3758 (map (lambda Z3759 (shen.intern-type Z3759)) V3757) (let W3760 (map (lambda Z3761 (shen.remember-datatype Z3761 (fn Z3761))) W3758) (let W3762 (value shen.*datatypes*) (shen.show-datatypes W3762))))) -(defun preclude-all-but (V3374) (let W3375 (set shen.*datatypes* ()) (let W3376 (map (lambda Z3377 (shen.intern-type Z3377)) V3374) (let W3378 (map (lambda Z3379 (shen.remember-datatype Z3379 (fn Z3379))) W3376) (shen.show-datatypes (value shen.*datatypes*)))))) +(defun preclude-all-but (V3763) (let W3764 (set shen.*datatypes* ()) (let W3765 (map (lambda Z3766 (shen.intern-type Z3766)) V3763) (let W3767 (map (lambda Z3768 (shen.remember-datatype Z3768 (fn Z3768))) W3765) (shen.show-datatypes (value shen.*datatypes*)))))) -(defun include-all-but (V3380) (let W3381 (map (lambda Z3382 (shen.intern-type Z3382)) V3380) (let W3383 (value shen.*alldatatypes*) (let W3384 (set shen.*datatypes* (shen.remove-datatypes W3381 W3383)) (shen.show-datatypes W3384))))) +(defun include-all-but (V3769) (let W3770 (map (lambda Z3771 (shen.intern-type Z3771)) V3769) (let W3772 (value shen.*alldatatypes*) (let W3773 (set shen.*datatypes* (shen.remove-datatypes W3770 W3772)) (shen.show-datatypes W3773))))) diff --git a/klambda/stlib.kl b/klambda/stlib.kl new file mode 100644 index 0000000..9e3c6e7 --- /dev/null +++ b/klambda/stlib.kl @@ -0,0 +1,684 @@ +(defun concat* (V3 V4) (let W5 (concat V3 V4) (if (symbol? W5) W5 (simple-error (cn "'" (shen.app W5 "' is not a symbol +" shen.a)))))) + +(defun newv () (gensym X)) + +(defun maths.maths-macro (V15) (let GoTo16 (freeze V15) (if (cons? V15) (let Select30 (hd V15) (let Select31 (tl V15) (if (and (= log10 Select30) (and (cons? Select31) (= () (tl Select31)))) (cons log10 (cons (hd Select31) (cons (cons tolerance ()) ()))) (if (and (= log2 Select30) (and (cons? Select31) (= () (tl Select31)))) (cons log2 (cons (hd Select31) (cons (cons tolerance ()) ()))) (if (and (= loge Select30) (and (cons? Select31) (= () (tl Select31)))) (cons loge (cons (hd Select31) (cons (cons tolerance ()) ()))) (if (and (= log Select30) (and (cons? Select31) (and (cons? (tl Select31)) (= () (tl (tl Select31)))))) (cons log (cons (hd Select31) (cons (hd (tl Select31)) (cons (cons tolerance ()) ())))) (if (and (= sin Select30) (and (cons? Select31) (= () (tl Select31)))) (cons sin (cons (hd Select31) (cons (cons tolerance ()) ()))) (if (and (= tan Select30) (and (cons? Select31) (= () (tl Select31)))) (cons tan (cons (hd Select31) (cons (cons tolerance ()) ()))) (if (and (= cos Select30) (and (cons? Select31) (= () (tl Select31)))) (cons cos (cons (hd Select31) (cons (cons tolerance ()) ()))) (if (and (= tanh Select30) (and (cons? Select31) (= () (tl Select31)))) (cons tanh (cons (hd Select31) (cons (cons tolerance ()) ()))) (if (and (= cosh Select30) (and (cons? Select31) (= () (tl Select31)))) (cons cosh (cons (hd Select31) (cons (cons tolerance ()) ()))) (if (and (= sinh Select30) (and (cons? Select31) (= () (tl Select31)))) (cons sinh (cons (hd Select31) (cons (cons tolerance ()) ()))) (if (and (= sech Select30) (and (cons? Select31) (= () (tl Select31)))) (cons sech (cons (hd Select31) (cons (cons tolerance ()) ()))) (if (and (= csch Select30) (and (cons? Select31) (= () (tl Select31)))) (cons csch (cons (hd Select31) (cons (cons tolerance ()) ()))) (if (and (= coth Select30) (and (cons? Select31) (= () (tl Select31)))) (cons coth (cons (hd Select31) (cons (cons tolerance ()) ()))) (if (and (= nthrt Select30) (and (cons? Select31) (and (cons? (tl Select31)) (= () (tl (tl Select31)))))) (cons nthrt (cons (hd Select31) (cons (hd (tl Select31)) (cons (cons tolerance ()) ())))) (if (and (= sqrt Select30) (and (cons? Select31) (= () (tl Select31)))) (cons sqrt (cons (hd Select31) (cons (cons tolerance ()) ()))) (if (and (= expt Select30) (and (cons? Select31) (and (cons? (tl Select31)) (= () (tl (tl Select31)))))) (cons expt (cons (hd Select31) (cons (hd (tl Select31)) (cons (cons tolerance ()) ())))) (if (and (= max Select30) (and (cons? Select31) (and (cons? (tl Select31)) (cons? (tl (tl Select31)))))) (cons max (cons (hd Select31) (cons (cons max (tl Select31)) ()))) (if (and (= min Select30) (and (cons? Select31) (and (cons? (tl Select31)) (cons? (tl (tl Select31)))))) (cons min (cons (hd Select31) (cons (cons min (tl Select31)) ()))) (if (and (= tolerance Select30) (and (cons? Select31) (= () (tl Select31)))) (cons maths.tolerance=n Select31) (if (= for Select30) (if (cons? Select31) (let Select28 (hd Select31) (let Select29 (tl Select31) (if (cons? Select29) (let Select27 (tl Select29) (if (= = (hd Select29)) (if (cons? Select27) (let Select25 (hd Select27) (let Select26 (tl Select27) (if (cons? Select26) (let Select23 (hd Select26) (let Select24 (tl Select26) (if (and (= stop Select23) (cons? Select24)) (cons maths.upto (cons Select25 (cons (hd Select24) (maths.process-options Select28 (tl Select24))))) (if (and (= to Select23) (cons? Select24)) (cons maths.upto (cons Select25 (cons (cons < (cons (hd Select24) ())) (maths.process-options Select28 (tl Select24))))) (thaw GoTo16))))) (thaw GoTo16)))) (thaw GoTo16)) (thaw GoTo16))) (thaw GoTo16)))) (thaw GoTo16)) (thaw GoTo16))))))))))))))))))))))) (thaw GoTo16)))) + +(defun maths.process-options (V33 V34) (append (maths.step-option V34) (append (maths.constructor-option V34) (append (maths.end-option V34) (maths.process V33 V34))))) + +(defun maths.step-option (V41) (if (= () V41) (cons (cons + (cons 1 ())) ()) (let GoTo42 (freeze (shen.f-error maths.step-option)) (if (cons? V41) (let Select43 (tl V41) (if (and (= step (hd V41)) (cons? Select43)) (cons (hd Select43) ()) (maths.step-option Select43))) (thaw GoTo42))))) + +(defun maths.constructor-option (V49) (if (= () V49) (cons (cons fn (cons do ())) ()) (let GoTo50 (freeze (shen.f-error maths.constructor-option)) (if (cons? V49) (let Select51 (tl V49) (if (and (= constructor (hd V49)) (cons? Select51)) (cons (hd Select51) ()) (maths.constructor-option Select51))) (thaw GoTo50))))) + +(defun maths.end-option (V57) (if (= () V57) (cons done ()) (let GoTo58 (freeze (shen.f-error maths.end-option)) (if (cons? V57) (let Select59 (tl V57) (if (and (= end (hd V57)) (cons? Select59)) (cons (hd Select59) ()) (maths.end-option Select59))) (thaw GoTo58))))) + +(defun maths.process (V63 V64) (let GoTo65 (freeze (shen.f-error maths.process)) (if (cons? V64) (let Select66 (tl V64) (if (= () Select66) (cons (cons /. (cons V63 V64)) ()) (maths.process V63 Select66))) (thaw GoTo65)))) + +(defun set-tolerance (V299) (set maths.*tolerance* V299)) + +(defun tolerance () (value maths.*tolerance*)) + +(defun sq (V301) (* V301 V301)) + +(defun cube (V303) (* V303 (* V303 V303))) + +(defun for (V305 V306 V307 V308 V309) (maths.for-h (V308 V305) V306 V307 V308 V309 (V307 V305))) + +(defun maths.for-h (V318 V319 V320 V321 V322 V323) (cond ((not (V319 V318)) V323) (true (maths.for-h (V321 V318) V319 V320 V321 V322 ((V322 V323) (V320 V318)))))) + +(defun maths.lazyfor-and (V340 V341 V342 V343) (cond ((not (V341 V340)) true) ((V342 V340) (maths.lazyfor-and (V343 V340) V341 V342 V343)) (true false))) + +(defun maths.lazyfor-or (V350 V351 V352 V353) (cond ((not (V351 V350)) false) ((V352 V350) true) (true (maths.lazyfor-or (V353 V350) V351 V352 V353)))) + +(defun max (V360 V361) (cond ((> V361 V360) V361) (true V360))) + +(defun min (V366 V367) (cond ((< V367 V366) V367) (true V366))) + +(defun expt (V370 V371 V372) (if (= V371 0) 1 (if (positive? V371) (maths.expt-h V370 (maths.n->r V371 1) V372) (/ 1 (maths.expt-h V370 (maths.n->r (~ V371) 1) V372))))) + +(defun maths.n->r (V376 V377) (cond ((integer? V376) (@p V376 V377)) (true (maths.n->r (* V376 10) (* V377 10))))) + +(defun maths.expt-h (V380 V381 V382) (cond ((tuple? V381) (power (nthrt V380 (snd V381) V382) (fst V381))) (true (shen.f-error maths.expt-h)))) + +(defun gcd (V386 V387) (if (and (integer? V386) (integer? V387)) (let W388 (abs V386) (let W389 (abs V387) (if (> W388 W389) (maths.gcd-help (- W388 W389) W389) (maths.gcd-help W388 (- W389 W388))))) (simple-error "gcd expects integer inputs"))) + +(defun maths.gcd-help (V392 V393) (if (> V392 V393) (maths.gcd-loop V392 V393 V393) (maths.gcd-loop V392 V393 V392))) + +(defun maths.gcd-loop (V400 V401 V402) (cond ((= 1 V402) 1) ((and (integer? (/ V400 V402)) (integer? (/ V401 V402))) V402) (true (maths.gcd-loop V400 V401 (- V402 1))))) + +(defun lcd (V406 V407) (cond ((and (even? V406) (even? V407)) 2) (true (maths.lcd-loop V406 V407 (if (> V406 V407) V407 V406) 3)))) + +(defun maths.lcd-loop (V413 V414 V415 V416) (cond ((> V416 V415) 1) ((and (integer? (/ V413 V416)) (integer? (/ V414 V416))) V416) (true (maths.lcd-loop V413 V414 V415 (+ 2 V416))))) + +(defun isqrt (V421) (maths.isqrt-loop V421 0)) + +(defun maths.isqrt-loop (V423 V424) (cond ((= (* V424 V424) V423) V424) ((> (* V424 V424) V423) (- V424 1)) (true (maths.isqrt-loop V423 (+ V424 1))))) + +(defun div (V427 V428) (floor (/ V427 V428))) + +(defun modf (V431) (let W432 (floor V431) (@p W432 (- V431 W432)))) + +(defun floor (V434) (cond ((negative? V434) (~ (ceiling (~ V434)))) (true (maths.rounding-loop floor V434 15 0)))) + +(defun maths.rounding-loop (V439 V440 V441 V442) (cond ((and (= 0 V441) (= V440 V442)) V442) ((and (= 0 V441) (> V442 V440)) (if (= V439 floor) (- V442 1) (if (= V439 ceiling) V442 (if (= V439 round) (let W443 (- V442 V440) (let W444 (- V440 (- V442 1)) (if (> W443 W444) (- V442 1) V442))) (simple-error "error: cases exhausted"))))) ((> V440 V442) (maths.rounding-loop V439 V440 V441 (+ V442 (power 10 V441)))) (true (maths.rounding-loop V439 V440 (- V441 1) (- V442 (power 10 V441)))))) + +(defun maths.float->pair (V449) (let W450 (floor V449) (@p W450 (- V449 W450)))) + +(defun ceiling (V452) (cond ((negative? V452) (~ (floor (~ V452)))) (true (maths.rounding-loop ceiling V452 15 0)))) + +(defun round (V454) (cond ((negative? V454) (~ (round (~ V454)))) (true (maths.rounding-loop round V454 15 0)))) + +(defun mod (V456 V457) (let W458 (/ V456 V457) (let W459 (floor W458) (if (and (integer? V456) (integer? V457)) (round (* V457 (- W458 W459))) (* V457 (- W458 W459)))))) + +(defun lcm (V462) (let W463 (maths.greatest V462) (maths.lcm-h W463 W463 V462))) + +(defun maths.greatest (V467) (cond ((and (cons? V467) (= () (tl V467))) (hd V467)) ((and (cons? V467) (and (cons? (tl V467)) (> (hd V467) (hd (tl V467))))) (maths.greatest (cons (hd V467) (tl (tl V467))))) ((and (cons? V467) (cons? (tl V467))) (maths.greatest (tl V467))) (true (shen.f-error maths.greatest)))) + +(defun maths.lcm-h (V469 V470 V471) (cond ((maths.lcm? V469 V471) V469) (true (maths.lcm-h (+ V469 V470) V470 V471)))) + +(defun maths.lcm? (V477 V478) (cond ((= () V478) true) ((cons? V478) (and (integer? (/ V477 (hd V478))) (maths.lcm? V477 (tl V478)))) (true (shen.f-error maths.lcm?)))) + +(defun random (V481 V482) (let W483 (maths.bbs (value maths.*seed*)) (let W484 (set maths.*seed* W483) (let W485 (min V481 V482) (+ W485 (mod W484 (abs (+ 1 (- V482 V481))))))))) + +(defun min (V490 V491) (cond ((> V490 V491) V491) (true V490))) + +(defun reseed () (set maths.*seed* (get-time unix))) + +(defun maths.bbs (V494) (let W495 (* 1201 1213) (mod (* V494 V494) W495))) + +(defun ~ (V497) (- 0 V497)) + +(defun positive? (V499) (> V499 0)) + +(defun negative? (V501) (< V501 0)) + +(defun natural? (V503) (cond ((= 0 V503) true) (true (and (integer? V503) (positive? V503))))) + +(defun converge (V505 V506 V507) (maths.converge-help V506 (V506 V505) V505 V507)) + +(defun maths.converge-help (V514 V515 V516 V517) (cond (((V517 V516) V515) V515) (true (maths.converge-help V514 (V514 V515) V515 V517)))) + +(defun nthrt (V526 V527 V528) (cond ((positive? V526) (converge V526 (lambda Z529 (maths.compute-nthrt V526 Z529 V527 V528)) (approx V528))) (true (simple-error (cn "nthrt: negA must be a positive numberneg%" ""))))) + +(defun sqrt (V533 V534) (nthrt V533 2 V534)) + +(defun maths.compute-nthrt (V537 V538 V539 V540) (let W541 (/ 1 V539) (let W542 (* (- V539 1) V538) (let W543 (expt V538 (- V539 1) V540) (let W544 (/ V537 W543) (let W545 (+ W542 W544) (* W541 W545))))))) + +(defun approx (V550) (lambda Z551 (lambda Z552 (let W553 (- Z551 Z552) (>= V550 (abs W553)))))) + +(defun abs (V555) (if (>= V555 0) V555 (- 0 V555))) + +(defun series (V557 V558 V559 V560) (maths.series-h (+ V557 1) V559 V558 (V558 V557) V560)) + +(defun maths.series-h (V565 V566 V567 V568 V569) (let W570 ((V569 (V567 V565)) V568) (if (<= (abs (- V568 W570)) V566) W570 (maths.series-h (+ V565 1) V566 V567 W570 V569)))) + +(defun product (V578 V579 V580) (series V578 V579 V580 (lambda Z581 (lambda Z582 (* Z581 Z582))))) + +(defun summation (V588 V589 V590) (series V588 V589 V590 (lambda Z591 (lambda Z592 (+ Z591 Z592))))) + +(defun odd? (V596) (and (integer? V596) (not (integer? (/ V596 2))))) + +(defun even? (V598) (and (integer? V598) (integer? (/ V598 2)))) + +(defun maths.compute-sine (V600 V601) (let W602 (+ (* 2 V601) 1) (let W603 (* (power -1 V601) (power V600 W602)) (let W604 (factorial W602) (/ W603 W604))))) + +(defun maths.compute-cos (V607 V608) (let W609 (* 2 V608) (let W610 (* (power -1 V608) (power V607 W609)) (let W611 (factorial W609) (/ W610 W611))))) + +(defun cos (V615 V616) (let W617 (radians V615) (summation 0 (lambda Z618 (maths.compute-cos W617 Z618)) V616))) + +(defun sin (V622 V623) (let W624 (radians V622) (summation 0 (lambda Z625 (maths.compute-sine W624 Z625)) V623))) + +(defun tan (V628 V629) (/ (sin V628 V629) (cos V628 V629))) + +(defun radians (V632) (* (/ V632 180) (pi))) + +(defun g () 1.6180339887498) + +(defun pi () 3.1415926535897) + +(defun e () 2.7182818284590002) + +(defun tan30 () 0.5773502691896) + +(defun cos30 () 0.8660254037844001) + +(defun cos45 () 0.70710678118651) + +(defun sin45 () 0.7071067811865) + +(defun sqrt2 () 1.4142135623731) + +(defun tan60 () 1.7320508075692) + +(defun maths.sin60 () 0.8660254037844001) + +(defun sin120 () 0.8660254037844001) + +(defun tan120 () -1.7320508075692) + +(defun sin135 () 0.7071067811865) + +(defun cos135 () -0.7071067811865) + +(defun cos150 () -0.8660254037844001) + +(defun tan150 () -0.5773502691905) + +(defun cos210 () -0.8660254037844001) + +(defun tan210 () 0.5773502691905) + +(defun sin225 () -0.7071067811865) + +(defun cos225 () -0.7071067811865) + +(defun sin240 () -0.8660254037844001) + +(defun tan240 () 1.7320508075692) + +(defun sin300 () -0.8660254037844001) + +(defun tan300 () -1.7320508075692) + +(defun sin315 () -0.7071067811865) + +(defun cos315 () 0.7071067811865) + +(defun cos330 () 0.8660254037844001) + +(defun tan330 () -0.5773502691905) + +(defun coth (V634 V635) (let W636 (e) (let W637 (expt W636 (~ (* 2 V634)) V635) (/ (+ 1 W637) (- 1 W637))))) + +(defun sinh (V640 V641) (let W642 (e) (let W643 (expt W642 V640 V641) (let W644 (expt W642 (~ V640) V641) (let W645 (- W643 W644) (/ W645 2)))))) + +(defun cosh (V648 V649) (let W650 (e) (let W651 (expt W650 V648 V649) (let W652 (expt W650 (~ V648) V649) (let W653 (+ W651 W652) (/ W653 2)))))) + +(defun tanh (V656 V657) (/ (sinh V656 V657) (cosh V656 V657))) + +(defun sech (V660 V661) (/ 1 (cosh V660 V661))) + +(defun csch (V664 V665) (/ 1 (sinh V664 V665))) + +(defun power (V670 V671) (cond ((= 0 V671) 1) (true (* V670 (power V670 (- V671 1)))))) + +(defun factorial (V674) (cond ((= 0 V674) 1) (true (* V674 (factorial (- V674 1)))))) + +(defun prime? (V676) (cond ((= 2 V676) true) ((even? V676) false) (true (maths.prime-h V676 (isqrt V676) 3)))) + +(defun maths.prime-h (V679 V680 V681) (cond ((> V681 V680) true) ((integer? (/ V679 V681)) false) (true (maths.prime-h V679 V680 (+ V681 2))))) + +(defun maths.sign (V687) (cond ((= 0 V687) 0) ((positive? V687) 1) (true -1))) + +(defun log (V689 V690 V691) (/ (log10 V689 V691) (log10 V690 V691))) + +(defun loge (V695 V696) (log V695 (e) V696)) + +(defun log2 (V699 V700) (log V699 2 V700)) + +(defun log10 (V703 V704) (if (>= V703 1) (maths.log10+ V703 V704) (~ (maths.log10+ (/ 1 V703) V704)))) + +(defun maths.log10+ (V707 V708) (cond ((<= (abs V707) V708) 0) ((>= V707 10) (+ 1 (maths.log10+ (/ V707 10) V708))) (true (* 0.1 (maths.log10+ (power V707 10) (* 10 V708)))))) + +(defun maths.upto (V714 V715 V716 V717 V718 V719) (cond ((V715 V714) V718) (true ((V717 (V719 V714)) (maths.upto (V716 V714) V715 V716 V717 V718 V719))))) + +(defun r# (V732 V733) (cond ((and (integer? V732) (integer? V733)) (let W734 (absvector 3) (let W735 (address-> W734 0 rational.print-rational) (let W736 (address-> W734 1 V732) (let W737 (address-> W734 2 V733) W734))))) (true (simple-error (cn "numerator " (shen.app V732 (cn " and divisor " (shen.app V733 " must be integers +" shen.s)) shen.s)))))) + +(defun rational.print-rational (V740) (shen.app (<-address V740 1) (cn "/" (shen.app (<-address V740 2) "" shen.s)) shen.s)) + +(defun rational? (V742) (trap-error (and (absvector? V742) (and (= (<-address V742 0) rational.print-rational) (and (integer? (<-address V742 1)) (integer? (<-address V742 2))))) (lambda Z743 false))) + +(defun numerator (V745) (<-address V745 1)) + +(defun denominator (V747) (<-address V747 2)) + +(defun r-op1 (V787 V788) (n->r (V787 (r->n V788)))) + +(defun r-op2 (V791 V792 V793) (n->r ((V791 (r->n V792)) (r->n V793)))) + +(defun r->n (V797) (/ (numerator V797) (denominator V797))) + +(defun r->pair (V799) (@p (numerator V799) (denominator V799))) + +(defun n->r (V801) (let W802 (maths.n->r V801 1) (r# (fst W802) (snd W802)))) + +(defun r-reduce (V804) (rational.r-reduce-help (numerator V804) (denominator V804))) + +(defun rational.r-reduce-help (V806 V807) (let W808 (lcd V806 V807) (if (= W808 1) (r# V806 V807) (rational.r-reduce-help (/ V806 W808) (/ V807 W808))))) + +(defun r= (V811 V812) (let W813 (numerator V811) (let W814 (denominator V811) (let W815 (numerator V812) (let W816 (denominator V812) (= (* W813 W816) (* W814 W815))))))) + +(defun r< (V819 V820) (let W821 (numerator V819) (let W822 (denominator V819) (let W823 (numerator V820) (let W824 (denominator V820) (< (* W821 W824) (* W822 W823))))))) + +(defun r> (V827 V828) (not (or (r= V827 V828) (r< V827 V828)))) + +(defun r>= (V831 V832) (or (r= V831 V832) (r> V831 V832))) + +(defun r<= (V835 V836) (or (r= V835 V836) (r< V835 V836))) + +(defun r+ (V839 V840) (let W841 (numerator V839) (let W842 (denominator V839) (let W843 (numerator V840) (let W844 (denominator V840) (r# (+ (* W841 W844) (* W842 W843)) (* W842 W844))))))) + +(defun r- (V847 V848) (let W849 (numerator V847) (let W850 (denominator V847) (let W851 (numerator V848) (let W852 (denominator V848) (r# (- (* W849 W852) (* W850 W851)) (* W850 W852))))))) + +(defun r* (V855 V856) (let W857 (numerator V855) (let W858 (denominator V855) (let W859 (numerator V856) (let W860 (denominator V856) (r# (* W857 W859) (* W858 W860))))))) + +(defun +-inverse (V863) (let W864 (numerator V863) (let W865 (denominator V863) (r# (~ W864) W865)))) + +(defun *-inverse (V867) (let W868 (numerator V867) (let W869 (denominator V867) (r# W869 W868)))) + +(defun r/ (V871 V872) (r* V871 (*-inverse V872))) + +(defun r-expt (V877 V878) (cond ((natural? V878) (let W879 (numerator V877) (let W880 (denominator V877) (r# (power W879 V878) (power W880 V878))))) ((and (integer? V878) (negative? V878)) (let W881 (numerator V877) (let W882 (denominator V877) (r# (power W882 (~ V878)) (power W881 (~ V878)))))) (true (simple-error (cn "cannot exponentiate a rational by a non-integer " (shen.app V878 " +" shen.a)))))) + +(defun r-approx (V885 V886) (rational.approx-r-h (r->n V885) V886 0)) + +(defun rational.approx-r-h (V889 V890 V891) (cond ((> (/ V891 V890) V889) (r# V891 V890)) (true (rational.approx-r-h V889 V890 (+ V891 1))))) + +(defun c# (V901 V902) (cond ((and (number? V901) (number? V902)) (let W903 (absvector 3) (let W904 (address-> W903 0 complex.print-complex) (let W905 (address-> W903 1 V901) (let W906 (address-> W903 2 V902) W903))))) (true (simple-error (cn "real " (shen.app V901 (cn " and imaginary " (shen.app V902 " must be numbers +" shen.a)) shen.a)))))) + +(defun complex.print-complex (V909) (shen.insert (<-address V909 2) (shen.insert (<-address V909 1) (shen.proc-nl (cn "(c" "# ~A ~A)"))))) + +(defun complex? (V911) (trap-error (and (absvector? V911) (and (= (<-address V911 0) complex.print-complex) (and (number? (<-address V911 1)) (number? (<-address V911 2))))) (lambda Z912 false))) + +(defun real (V914) (<-address V914 1)) + +(defun imaginary (V916) (<-address V916 2)) + +(defun c+ (V926 V927) (let W928 (real V926) (let W929 (imaginary V926) (let W930 (real V927) (let W931 (imaginary V927) (c# (+ W928 W930) (+ W929 W931))))))) + +(defun c- (V934 V935) (let W936 (real V934) (let W937 (imaginary V934) (let W938 (real V935) (let W939 (imaginary V935) (c# (- W936 W938) (- W937 W939))))))) + +(defun c* (V942 V943) (let W944 (real V942) (let W945 (imaginary V942) (let W946 (real V943) (let W947 (imaginary V943) (c# (- (* W944 W946) (* W945 W947)) (+ (* W945 W946) (* W944 W947)))))))) + +(defun c/ (V950 V951) (let W952 (real V950) (let W953 (imaginary V950) (let W954 (real V951) (let W955 (imaginary V951) (c# (/ (+ (* W952 W954) (* W953 W955)) (+ (* W954 W954) (* W955 W955))) (/ (- (* W953 W954) (* W952 W955)) (+ (* W954 W954) (* W955 W955))))))))) + +(defun n# (V968 V969) (cond ((and (natural? V968) (and (natural? V969) (> V969 0))) (let W970 (absvector 4) (let W971 (address-> W970 0 numerals.print-numeral) (let W972 (address-> W970 1 (((fn numerals.n->numeral) V968) V969)) (let W973 (address-> W970 2 V969) (let W974 (address-> W970 3 V968) W970)))))) (true (simple-error (cn "N = " (shen.app V968 (cn ", Radix = " (shen.app V969 "; N and Radix must be natural numbers where Radix > 0 +" shen.a)) shen.a)))))) + +(defun radix (V977) (<-address V977 2)) + +(defun numerals.numerals (V979) (<-address V979 1)) + +(defun n#->n (V981) (<-address V981 3)) + +(defun n#->ns (V983) (<-address V983 1)) + +(defun numerals.print-numeral (V985) (let W986 (radix V985) (let W987 (numerals.numerals V985) (@s (numerals.numeric->string W987 W986) (@s "#" (str W986)))))) + +(defun numerals.numeric->string (V991 V992) (cond ((= () V991) "") ((cons? V991) (let W993 (if (< (hd V991) 10) (str (hd V991)) (if (> V992 36) (cn (str (hd V991)) " ") (n->string (+ (hd V991) 55)))) (cn W993 (numerals.numeric->string (tl V991) V992)))) (true (shen.f-error numerals.numeric->string)))) + +(defun numeral? (V996) (and (absvector? V996) (= numerals.print-numeral (<-address V996 0)))) + +(defun numerals.numeral-macro (V1034) (cond ((and (cons? V1034) (and (= n-op2 (hd V1034)) (and (cons? (tl V1034)) (and (cons? (tl (tl V1034))) (and (cons? (tl (tl (tl V1034)))) (= () (tl (tl (tl (tl V1034)))))))))) (cons n-op2 (cons (hd (tl V1034)) (cons (hd (tl (tl V1034))) (cons (hd (tl (tl (tl V1034)))) (cons (cons radix (cons (hd (tl (tl V1034))) ())) ())))))) ((and (cons? V1034) (and (= n-op1 (hd V1034)) (and (cons? (tl V1034)) (and (cons? (tl (tl V1034))) (= () (tl (tl (tl V1034)))))))) (cons n-op1 (cons (hd (tl V1034)) (cons (hd (tl (tl V1034))) (cons (cons radix (tl (tl V1034))) ()))))) ((and (cons? V1034) (and (= n+ (hd V1034)) (and (cons? (tl V1034)) (and (cons? (tl (tl V1034))) (= () (tl (tl (tl V1034)))))))) (cons n+ (cons (hd (tl V1034)) (cons (hd (tl (tl V1034))) (cons (cons radix (cons (hd (tl V1034)) ())) ()))))) ((and (cons? V1034) (and (= n- (hd V1034)) (and (cons? (tl V1034)) (and (cons? (tl (tl V1034))) (= () (tl (tl (tl V1034)))))))) (cons n- (cons (hd (tl V1034)) (cons (hd (tl (tl V1034))) (cons (cons radix (cons (hd (tl V1034)) ())) ()))))) ((and (cons? V1034) (and (= n* (hd V1034)) (and (cons? (tl V1034)) (and (cons? (tl (tl V1034))) (= () (tl (tl (tl V1034)))))))) (cons n* (cons (hd (tl V1034)) (cons (hd (tl (tl V1034))) (cons (cons radix (cons (hd (tl V1034)) ())) ()))))) ((and (cons? V1034) (and (= n/ (hd V1034)) (and (cons? (tl V1034)) (and (cons? (tl (tl V1034))) (= () (tl (tl (tl V1034)))))))) (cons n/ (cons (hd (tl V1034)) (cons (hd (tl (tl V1034))) (cons (cons radix (cons (hd (tl V1034)) ())) ()))))) (true V1034))) + +(defun n-op2 (V1036 V1037 V1038 V1039) (n# ((V1036 (n#->n V1037)) (n#->n V1038)) V1039)) + +(defun n-op1 (V1044 V1045 V1046) (n# (V1044 (n#->n V1045)) V1046)) + +(defun n+ (V1052 V1053 V1054) (n-op2 (lambda Z1055 (lambda Z1056 (+ Z1055 Z1056))) V1052 V1053 V1054)) + +(defun n* (V1062 V1063 V1064) (n-op2 (lambda Z1065 (lambda Z1066 (* Z1065 Z1066))) V1062 V1063 V1064)) + +(defun n- (V1072 V1073 V1074) (n-op2 (lambda Z1075 (lambda Z1076 (- Z1075 Z1076))) V1072 V1073 V1074)) + +(defun n/ (V1082 V1083 V1084) (n-op2 (lambda Z1085 (lambda Z1086 (/ Z1085 Z1086))) V1082 V1083 V1084)) + +(defun binary (V1090) (n# V1090 2)) + +(defun hex (V1092) (n# V1092 16)) + +(defun octal (V1094) (n# V1094 8)) + +(defun duodecimal (V1096) (n# V1096 12)) + +(defun numerals.n->numeral (V1098 V1099) (cond ((> V1099 V1098) (cons V1098 ())) (true (let W1100 (numerals.largest-expt V1098 V1099 0) (let W1101 (power V1099 W1100) (let W1102 (div V1098 W1101) (let W1103 (cons W1102 (numerals.n-zeros W1100)) (let W1104 (- V1098 (* W1102 W1101)) (numerals.add W1103 (numerals.n->numeral W1104 V1099) V1099))))))))) + +(defun numerals.largest-expt (V1107 V1108 V1109) (cond ((> (power V1108 V1109) V1107) (- V1109 1)) (true (numerals.largest-expt V1107 V1108 (+ V1109 1))))) + +(defun numerals.n-zeros (V1113) (cond ((= 0 V1113) ()) (true (cons 0 (numerals.n-zeros (- V1113 1)))))) + +(defun numerals.add (V1115 V1116 V1117) (reverse (numerals.add-h (reverse V1115) (reverse V1116) V1117 0))) + +(defun numerals.add-h (V1125 V1126 V1127 V1128) (cond ((and (= () V1125) (and (= () V1126) (= 0 V1128))) ()) ((and (= () V1125) (= () V1126)) (cons V1128 ())) ((= () V1125) (numerals.add-h (cons 0 ()) V1126 V1127 V1128)) ((= () V1126) (numerals.add-h V1125 (cons 0 ()) V1127 V1128)) ((and (cons? V1125) (cons? V1126)) (let W1129 (+ (hd V1125) (+ (hd V1126) V1128)) (if (< W1129 V1127) (cons W1129 (numerals.add-h (tl V1125) (tl V1126) V1127 0)) (cons (- V1127 W1129) (numerals.add-h (tl V1125) (tl V1126) V1127 1))))) (true (shen.f-error numerals.add-h)))) + +(defun assoc-if (V1240 V1241) (cond ((= () V1241) ()) ((and (cons? V1241) (and (cons? (hd V1241)) (V1240 (hd (hd V1241))))) (hd V1241)) ((cons? V1241) (assoc-if V1240 (tl V1241))) (true (shen.f-error assoc-if)))) + +(defun assoc-if-not (V1249 V1250) (cond ((= () V1250) ()) ((and (cons? V1250) (and (cons? (hd V1250)) (not (V1249 (hd (hd V1250)))))) (hd V1250)) ((cons? V1250) (assoc-if V1249 (tl V1250))) (true (shen.f-error assoc-if-not)))) + +(defun drop (V1255 V1256) (cond ((= 0 V1255) V1256) ((cons? V1256) (drop (- V1255 1) (tl V1256))) (true (shen.f-error drop)))) + +(defun drop-last (V1259 V1260) (reverse (drop V1259 (reverse V1260)))) + +(defun index (V1263 V1264) (list.index-h V1263 V1264 1)) + +(defun list.index-h (V1276 V1277 V1278) (cond ((= () V1277) -1) ((and (cons? V1277) (= V1276 (hd V1277))) V1278) ((cons? V1277) (list.index-h V1276 (tl V1277) (+ V1278 1))) (true (shen.f-error list.index-h)))) + +(defun index-last (V1282 V1283) (let W1284 (length V1283) (let W1285 (index V1282 (reverse V1283)) (if (= W1285 -1) W1285 (+ (- W1284 W1285) 1))))) + +(defun insert (V1290 V1291 V1292) (cond ((= () V1292) (simple-error (cn "cannot insert " (shen.app V1291 " into list: index out of range +" shen.s)))) ((= 1 V1290) (cons V1291 V1292)) ((cons? V1292) (cons (hd V1292) (insert (- V1290 1) V1291 (tl V1292)))) (true (shen.f-error insert)))) + +(defun remove-duplicates (V1296) (cond ((= () V1296) ()) ((and (cons? V1296) (element? (hd V1296) (tl V1296))) (remove-duplicates (tl V1296))) ((cons? V1296) (cons (hd V1296) (remove-duplicates (tl V1296)))) (true (shen.f-error remove-duplicates)))) + +(defun trim-left-if (V1302 V1303) (cond ((= () V1303) ()) ((and (cons? V1303) (V1302 (hd V1303))) (trim-left-if V1302 (tl V1303))) (true V1303))) + +(defun trim-right-if (V1306 V1307) (reverse (trim-left-if V1306 (reverse V1307)))) + +(defun trim-if (V1310 V1311) (trim-right-if V1310 (trim-left-if V1310 V1311))) + +(defun trim-left (V1318 V1319) (cond ((= () V1319) ()) ((and (cons? V1319) (element? (hd V1319) V1318)) (trim-left V1318 (tl V1319))) (true V1319))) + +(defun trim-right (V1322 V1323) (reverse (trim-left V1322 (reverse V1323)))) + +(defun trim (V1326 V1327) (trim-right V1326 (trim-left V1326 V1327))) + +(defun prefix? (V1337 V1338) (cond ((= () V1337) true) ((and (cons? V1337) (and (cons? V1338) (= (hd V1337) (hd V1338)))) (prefix? (tl V1337) (tl V1338))) (true false))) + +(defun infix? (V1345 V1346) (cond ((prefix? V1345 V1346) true) ((= () V1346) false) ((cons? V1346) (infix? V1345 (tl V1346))) (true (shen.f-error infix?)))) + +(defun suffix? (V1349 V1350) (prefix? (reverse V1349) (reverse V1350))) + +(defun subset? (V1359 V1360) (cond ((= () V1359) true) ((and (cons? V1359) (element? (hd V1359) V1360)) (subset? (tl V1359) V1360)) (true false))) + +(defun set=? (V1363 V1364) (and (subset? V1363 V1364) (subset? V1364 V1363))) + +(defun set? (V1369) (cond ((= () V1369) true) ((and (cons? V1369) (element? (hd V1369) (tl V1369))) false) ((cons? V1369) (set? (tl V1369))) (true (shen.f-error set?)))) + +(defun n-times (V1371 V1372) (list.n-times-h V1372 V1371 ())) + +(defun list.n-times-h (V1375 V1376 V1377) (cond ((= 0 V1375) V1377) (true (list.n-times-h (- V1375 1) V1376 (cons V1376 V1377))))) + +(defun subbag? (V1381 V1382) (every? (lambda Z1383 (= (count Z1383 V1381) (count Z1383 V1382))) V1381)) + +(defun bag=? (V1386 V1387) (and (subbag? V1386 V1387) (subbag? V1387 V1386))) + +(defun mapc (V1392 V1393) (cond ((= () V1393) ()) ((cons? V1393) (mapc (do (V1392 (hd V1393)) V1392) (tl V1393))) (true (shen.f-error mapc)))) + +(defun permute (V1396) (cond ((= () V1396) (cons () ())) (true (mapcan (lambda Z1397 (map (lambda Z1398 (cons Z1397 Z1398)) (permute (remove Z1397 V1396)))) V1396)))) + +(defun count-if (V1400 V1401) (length (mapcan (lambda Z1402 (if (V1400 Z1402) (cons Z1402 ()) ())) V1401))) + +(defun count (V1406 V1407) (count-if (lambda Z1408 (= V1406 Z1408)) V1407)) + +(defun some? (V1416 V1417) (cond ((= () V1417) false) ((and (cons? V1417) (V1416 (hd V1417))) true) ((cons? V1417) (some? V1416 (tl V1417))) (true (shen.f-error some?)))) + +(defun every? (V1426 V1427) (cond ((= () V1427) true) ((and (cons? V1427) (V1426 (hd V1427))) (every? V1426 (tl V1427))) (true false))) + +(defun sort (V1434 V1435) (cond ((= () V1435) ()) ((and (cons? V1435) (= () (tl V1435))) V1435) ((cons? V1435) (let W1436 (mapcan (lambda Z1437 (if ((V1434 Z1437) (hd V1435)) (cons Z1437 ()) ())) (tl V1435)) (let W1438 (mapcan (lambda Z1439 (if (not ((V1434 Z1439) (hd V1435))) (cons Z1439 ()) ())) (tl V1435)) (append (sort V1434 W1436) (append (cons (hd V1435) ()) (sort V1434 W1438)))))) (true (shen.f-error sort)))) + +(defun find (V1447 V1448) (cond ((= () V1448) (simple-error "find has found no element +")) ((and (cons? V1448) (V1447 (hd V1448))) (hd V1448)) ((cons? V1448) (find V1447 (tl V1448))) (true (shen.f-error find)))) + +(defun foldr (V1453 V1454 V1455) (cond ((= () V1455) V1454) ((cons? V1455) (foldr V1453 ((V1453 (hd V1455)) V1454) (tl V1455))) (true (shen.f-error foldr)))) + +(defun foldl (V1461 V1462 V1463) (cond ((= () V1463) V1462) ((cons? V1463) (foldl V1461 ((V1461 V1462) (hd V1463)) (tl V1463))) (true (shen.f-error foldl)))) + +(defun mapf (V1471 V1472 V1473) (cond ((= () V1472) ()) ((cons? V1472) ((V1473 (V1471 (hd V1472))) (mapf V1471 (tl V1472) V1473))) (true (shen.f-error mapf)))) + +(defun filter (V1479 V1480) (cond ((= () V1480) ()) ((cons? V1480) (if (V1479 (hd V1480)) (cons (hd V1480) (filter V1479 (tl V1480))) (filter V1479 (tl V1480)))) (true (shen.f-error filter)))) + +(defun remove-if (V1485 V1486) (cond ((= () V1486) ()) ((cons? V1486) (if (V1485 (hd V1486)) (remove-if V1485 (tl V1486)) (cons (hd V1486) (remove-if V1485 (tl V1486))))) (true (shen.f-error remove-if)))) + +(defun list.reduce (V1489 V1490 V1491) (cond ((= () V1491) V1490) ((cons? V1491) (list.reduce V1489 ((V1489 V1490) (hd V1491)) (tl V1491))) (true (shen.f-error list.reduce)))) + +(defun take (V1499 V1500) (cond ((= 0 V1499) ()) ((= () V1500) ()) ((cons? V1500) (cons (hd V1500) (take (- V1499 1) (tl V1500)))) (true (shen.f-error take)))) + +(defun take-last (V1503 V1504) (reverse (take V1503 (reverse V1504)))) + +(defun cartprod (V1509 V1510) (cond ((= () V1509) ()) ((cons? V1509) (append (map (lambda Z1511 (cons (hd V1509) (cons Z1511 ()))) V1510) (cartprod (tl V1509) V1510))) (true (shen.f-error cartprod)))) + +(defun powerset (V1514) (cond ((= () V1514) (cons () ())) ((cons? V1514) (let W1515 (powerset (tl V1514)) (append W1515 (map (lambda Z1516 (cons (hd V1514) Z1516)) W1515)))) (true (shen.f-error powerset)))) + +(defun partition (V1524 V1525) (cond ((= () V1525) ()) ((cons? V1525) (let W1526 (mapcan (lambda Z1527 (if ((V1524 (hd V1525)) Z1527) (cons Z1527 ()) ())) V1525) (let W1528 (difference V1525 W1526) (cons W1526 (partition V1524 W1528))))) (true (simple-error "partition equires a list")))) + +(defun transitive-closure (V1531) (let W1532 (list.transitive-pass V1531 V1531) (if (= W1532 V1531) W1532 (list.transitive-pass W1532 W1532)))) + +(defun list.transitive-pass (V1534 V1535) (cond ((= () V1534) V1535) ((and (cons? V1534) (tuple? (hd V1534))) (let W1536 (list.find-trans (fst (hd V1534)) (snd (hd V1534)) V1535) (union W1536 (list.transitive-pass (tl V1534) V1535)))) (true (shen.f-error list.transitive-pass)))) + +(defun list.find-trans (V1546 V1547 V1548) (cond ((= () V1548) ()) ((and (cons? V1548) (and (tuple? (hd V1548)) (= V1547 (fst (hd V1548))))) (cons (@p V1546 (snd (hd V1548))) (list.find-trans V1546 (fst (hd V1548)) (tl V1548)))) ((cons? V1548) (list.find-trans V1546 V1547 (tl V1548))) (true (shen.f-error list.find-trans)))) + +(defun x->ascii (V1553) (map (lambda Z1554 (string->n Z1554)) (explode V1553))) + +(defun splice (V1556 V1557 V1558) (cond ((= 1 V1556) (append V1557 V1558)) ((cons? V1558) (cons (hd V1558) (splice (- V1556 1) V1557 (tl V1558)))) (true (shen.f-error splice)))) + +(defun string-macros (V1562) (cond ((and (cons? V1562) (and (= s-op1 (hd V1562)) (and (cons? (tl V1562)) (and (cons? (tl (tl V1562))) (= () (tl (tl (tl V1562)))))))) (cons s-op1 (cons (hd (tl V1562)) (cons (hd (tl (tl V1562))) (cons (cons /. (cons X (cons X ()))) ()))))) ((and (cons? V1562) (and (= s-op2 (hd V1562)) (and (cons? (tl V1562)) (and (cons? (tl (tl V1562))) (and (cons? (tl (tl (tl V1562)))) (= () (tl (tl (tl (tl V1562)))))))))) (cons s-op2 (cons (hd (tl V1562)) (cons (hd (tl (tl V1562))) (cons (hd (tl (tl (tl V1562)))) (cons (cons /. (cons X (cons X ()))) ())))))) (true V1562))) + +(defun string->list (V1652) (cond ((= "" V1652) ()) (true (string.s->l-h V1652 1 (pos V1652 0) ())))) + +(defun string.s->l-h (V1654 V1655 V1656 V1657) (cond ((= "" V1656) (reverse V1657)) (true (string.s->l-h V1654 (+ V1655 1) (trap-error (pos V1654 V1655) (lambda Z1658 "")) (cons V1656 V1657))))) + +(defun list->string (V1663) (cond ((= () V1663) "") ((cons? V1663) (cn (hd V1663) (list->string (tl V1663)))) (true (shen.f-error list->string)))) + +(defun s-op1 (V1665 V1666 V1667) (V1667 (V1665 (string->list V1666)))) + +(defun s-op2 (V1671 V1672 V1673 V1674) (V1674 ((V1671 (string->list V1672)) (string->list V1673)))) + +(defun string.count (V1684 V1685) (cond ((= "" V1685) 0) ((and (shen.+string? V1685) (= V1684 (hdstr V1685))) (+ 1 (string.count (hdstr V1685) (tlstr V1685)))) ((shen.+string? V1685) (string.count V1684 (tlstr V1685))) (true (shen.f-error string.count)))) + +(defun string.reverse (V1690) (s-op1 (lambda Z1691 (reverse Z1691)) V1690 (lambda Z1692 (list->string Z1692)))) + +(defun string.element? (V1694 V1695) (s-op1 (lambda Z1696 (element? V1694 Z1696)) V1695 (lambda Z1697 Z1697))) + +(defun string.prefix? (V1702 V1703) (s-op2 (lambda Z1704 (lambda Z1705 (prefix? Z1704 Z1705))) V1702 V1703 (lambda Z1706 Z1706))) + +(defun string.infix? (V1711 V1712) (s-op2 (lambda Z1713 (lambda Z1714 (infix? Z1713 Z1714))) V1711 V1712 (lambda Z1715 Z1715))) + +(defun string.suffix? (V1720 V1721) (s-op2 (lambda Z1722 (lambda Z1723 (suffix? Z1722 Z1723))) V1720 V1721 (lambda Z1724 Z1724))) + +(defun string.subset? (V1729 V1730) (s-op2 (lambda Z1731 (lambda Z1732 (subset? Z1731 Z1732))) V1729 V1730 (lambda Z1733 Z1733))) + +(defun string.set=? (V1738 V1739) (s-op2 (lambda Z1740 (lambda Z1741 (set=? Z1740 Z1741))) V1738 V1739 (lambda Z1742 Z1742))) + +(defun string.set? (V1746) (s-op1 (lambda Z1747 (set? Z1747)) V1746 (lambda Z1748 Z1748))) + +(defun file-extension (V1750 V1751) (cn (strip-extension V1750) V1751)) + +(defun strip-extension (V1756) (cond ((= "" V1756) "") ((and (shen.+string? V1756) (= "." (hdstr V1756))) "") ((shen.+string? V1756) (@s (hdstr V1756) (strip-extension (tlstr V1756)))) (true (shen.f-error strip-extension)))) + +(defun string.length (V1759) (s-op1 (lambda Z1760 (length Z1760)) V1759 (lambda Z1761 Z1761))) + +(defun string.trim (V1765 V1766) (s-op1 (lambda Z1767 (trim V1765 Z1767)) V1766 (lambda Z1768 (list->string Z1768)))) + +(defun string.trim-if (V1773 V1774) (s-op1 (lambda Z1775 (trim-if V1773 Z1775)) V1774 (lambda Z1776 (list->string Z1776)))) + +(defun string.trim-right-if (V1781 V1782) (s-op1 (lambda Z1783 (trim-right-if V1781 Z1783)) V1782 (lambda Z1784 (list->string Z1784)))) + +(defun string.trim-left-if (V1789 V1790) (s-op1 (lambda Z1791 (trim-left-if V1789 Z1791)) V1790 (lambda Z1792 (list->string Z1792)))) + +(defun string.trim-right (V1797 V1798) (s-op1 (lambda Z1799 (trim-right V1797 Z1799)) V1798 (lambda Z1800 (list->string Z1800)))) + +(defun string.trim-left (V1805 V1806) (s-op1 (lambda Z1807 (trim-left V1805 Z1807)) V1806 (lambda Z1808 (list->string Z1808)))) + +(defun string.some? (V1813 V1814) (cond ((= "" V1814) false) ((shen.+string? V1814) (or (V1813 (hdstr V1814)) (string.some? V1813 (tlstr V1814)))) (true (shen.f-error string.some?)))) + +(defun string.every? (V1819 V1820) (cond ((= "" V1820) true) ((shen.+string? V1820) (and (V1819 (hdstr V1820)) (string.every? V1819 (tlstr V1820)))) (true (shen.f-error string.every?)))) + +(defun string.difference (V1826 V1827) (s-op2 (lambda Z1828 (lambda Z1829 (difference Z1828 Z1829))) V1826 V1827 (lambda Z1830 (list->string Z1830)))) + +(defun string.intersection (V1836 V1837) (s-op2 (lambda Z1838 (lambda Z1839 (intersection Z1838 Z1839))) V1836 V1837 (lambda Z1840 (list->string Z1840)))) + +(defun string.nth (V1843 V1844) (pos V1844 (+ V1843 1))) + +(defun whitespace? (V1849) (cond ((shen.+string? V1849) (let W1850 (string->n (hdstr V1849)) (element? W1850 (cons 9 (cons 10 (cons 13 (cons 32 ()))))))) (true (shen.f-error whitespace?)))) + +(defun uppercase? (V1854) (cond ((shen.+string? V1854) (let W1855 (string->n (hdstr V1854)) (and (> W1855 64) (< W1855 91)))) (true (shen.f-error uppercase?)))) + +(defun lowercase? (V1859) (cond ((shen.+string? V1859) (let W1860 (string->n (hdstr V1859)) (and (> W1860 96) (< W1860 123)))) (true (shen.f-error lowercase?)))) + +(defun digit? (V1864) (cond ((shen.+string? V1864) (let W1865 (string->n (hdstr V1864)) (and (> W1865 47) (< W1865 58)))) (true (shen.f-error digit?)))) + +(defun alpha? (V1871) (cond ((shen.+string? V1871) (let W1872 (string->n (hdstr V1871)) (or (and (> W1872 64) (< W1872 91)) (and (> W1872 96) (< W1872 123))))) (true false))) + +(defun alphanum? (V1878) (cond ((shen.+string? V1878) (let W1879 (string->n (hdstr V1878)) (or (and (> W1879 64) (< W1879 91)) (or (and (> W1879 96) (< W1879 123)) (and (> W1879 47) (< W1879 58)))))) (true false))) + +(defun tokenise (V1881 V1882) (string.tokenise-h V1881 V1882 "")) + +(defun string.tokenise-h (V1887 V1888 V1889) (cond ((= "" V1888) (cons V1889 ())) ((and (shen.+string? V1888) (V1887 (hdstr V1888))) (cons V1889 (string.tokenise-h V1887 (tlstr V1888) ""))) ((shen.+string? V1888) (string.tokenise-h V1887 (tlstr V1888) (@s V1889 (hdstr V1888)))) (true (shen.f-error string.tokenise-h)))) + +(defun uppercase (V1893) (cond ((shen.+string? V1893) (if (lowercase? (hdstr V1893)) (@s (n->string (- (string->n (hdstr V1893)) 32)) (tlstr V1893)) V1893)) (true (shen.f-error uppercase)))) + +(defun lowercase (V1895) (cond ((shen.+string? V1895) (if (uppercase? (hdstr V1895)) (@s (n->string (+ (string->n (hdstr V1895)) 32)) (tlstr V1895)) V1895)) (true (shen.f-error lowercase)))) + +(defun string.map (V1899 V1900) (cond ((= "" V1900) "") ((shen.+string? V1900) (@s (V1899 (hdstr V1900)) (string.map V1899 (tlstr V1900)))) (true (shen.f-error string.map)))) + +(defun spell-number (V1904) (cond ((= 0 V1904) "zero") (true (string.scale (map (lambda Z1905 (string.digits Z1905)) (string.triples (explode V1904))))))) + +(defun string.digit (V1907) (cond ((= "0" V1907) "") ((= "1" V1907) "one") ((= "2" V1907) "two") ((= "3" V1907) "three") ((= "4" V1907) "four") ((= "5" V1907) "five") ((= "6" V1907) "six") ((= "7" V1907) "seven") ((= "8" V1907) "eight") ((= "9" V1907) "nine") (true (shen.f-error string.digit)))) + +(defun string.triples (V1909) (string.triples-h (reverse V1909) ())) + +(defun string.triples-h (V1911 V1912) (cond ((and (cons? V1911) (and (cons? (tl V1911)) (cons? (tl (tl V1911))))) (string.triples-h (tl (tl (tl V1911))) (cons (reverse (cons (hd V1911) (cons (hd (tl V1911)) (cons (hd (tl (tl V1911))) ())))) V1912))) (true (cons (reverse V1911) V1912)))) + +(defun string.digits (V1915) (cond ((and (cons? V1915) (and (= "0" (hd V1915)) (and (cons? (tl V1915)) (and (= "0" (hd (tl V1915))) (and (cons? (tl (tl V1915))) (and (= "0" (hd (tl (tl V1915)))) (= () (tl (tl (tl V1915)))))))))) "") ((and (cons? V1915) (and (cons? (tl V1915)) (and (= "0" (hd (tl V1915))) (and (cons? (tl (tl V1915))) (and (= "0" (hd (tl (tl V1915)))) (= () (tl (tl (tl V1915))))))))) (@s (string.digit (hd V1915)) (@s " " "hundred"))) ((and (cons? V1915) (and (= "0" (hd V1915)) (and (cons? (tl V1915)) (and (= "0" (hd (tl V1915))) (and (cons? (tl (tl V1915))) (= () (tl (tl (tl V1915))))))))) (@s "a" (@s "n" (@s "d" (@s " " (string.digit (hd (tl (tl V1915))))))))) ((and (cons? V1915) (and (= "0" (hd V1915)) (and (cons? (tl V1915)) (and (cons? (tl (tl V1915))) (= () (tl (tl (tl V1915)))))))) (@s "a" (@s "n" (@s "d" (@s " " (string.tens (hd (tl V1915)) (hd (tl (tl V1915))))))))) ((and (cons? V1915) (and (cons? (tl V1915)) (and (= "0" (hd (tl V1915))) (and (cons? (tl (tl V1915))) (= () (tl (tl (tl V1915)))))))) (@s (string.digit (hd V1915)) (@s " " (@s "h" (@s "u" (@s "n" (@s "d" (@s "r" (@s "e" (@s "d" (@s " " (@s "a" (@s "n" (@s "d" (@s " " (string.digit (hd (tl (tl V1915))))))))))))))))))) ((and (cons? V1915) (and (cons? (tl V1915)) (and (cons? (tl (tl V1915))) (= () (tl (tl (tl V1915))))))) (@s (string.digit (hd V1915)) (@s " " (@s "h" (@s "u" (@s "n" (@s "d" (@s "r" (@s "e" (@s "d" (@s " " (@s "a" (@s "n" (@s "d" (@s " " (string.tens (hd (tl V1915)) (hd (tl (tl V1915))))))))))))))))))) ((and (cons? V1915) (and (cons? (tl V1915)) (= () (tl (tl V1915))))) (string.tens (hd V1915) (hd (tl V1915)))) ((and (cons? V1915) (= () (tl V1915))) (string.digit (hd V1915))) ((= () V1915) "") (true (shen.f-error string.digits)))) + +(defun string.tens (V1917 V1918) (cond ((= "1" V1917) (if (= V1918 "0") "ten" (if (= V1918 "1") "eleven" (if (= V1918 "2") "twelve" (if (= V1918 "3") "thirteen" (if (= V1918 "4") "fourteen" (if (= V1918 "5") "fifteen" (if (= V1918 "6") "sixteen" (if (= V1918 "7") "seventeen" (if (= V1918 "8") "eighteen" (if (= V1918 "9") "nineteen" (simple-error "error: cases exhausted")))))))))))) ((= "2" V1917) (@s "t" (@s "w" (@s "e" (@s "n" (@s "t" (@s "y" (@s " " (string.digit V1918))))))))) ((= "3" V1917) (@s "t" (@s "h" (@s "i" (@s "r" (@s "t" (@s "y" (@s " " (string.digit V1918))))))))) ((= "4" V1917) (@s "f" (@s "o" (@s "r" (@s "t" (@s "y" (@s " " (string.digit V1918)))))))) ((= "5" V1917) (@s "f" (@s "i" (@s "f" (@s "t" (@s "y" (@s " " (string.digit V1918)))))))) ((= "6" V1917) (@s "s" (@s "i" (@s "x" (@s "t" (@s "y" (@s " " (string.digit V1918)))))))) ((= "7" V1917) (@s "s" (@s "e" (@s "v" (@s "e" (@s "n" (@s "t" (@s "y" (@s " " (string.digit V1918)))))))))) ((= "8" V1917) (@s "e" (@s "i" (@s "g" (@s "h" (@s "t" (@s "y" (@s " " (string.digit V1918))))))))) ((= "9" V1917) (@s "n" (@s "i" (@s "n" (@s "e" (@s "t" (@s "y" (@s " " (string.digit V1918))))))))) (true (shen.f-error string.tens)))) + +(defun string.scale (V1921) (cond ((and (cons? V1921) (= () (tl V1921))) (hd V1921)) ((and (cons? V1921) (= "" (hd V1921))) (string.scale (tl V1921))) ((cons? V1921) (@s (hd V1921) (@s (string.units (length V1921)) (string.scale (tl V1921))))) (true (shen.f-error string.scale)))) + +(defun string.units (V1925) (cond ((= 2 V1925) " thousand ") ((= 3 V1925) " million ") ((= 4 V1925) " billion ") ((= 5 V1925) " trillion ") (true (simple-error "this number has a magnitude beyond our text representation")))) + +(defun string>? (V1931 V1932) (cond ((= "" V1931) false) ((= "" V1932) true) ((and (shen.+string? V1931) (shen.+string? V1932)) (let W1933 (string->n (hdstr V1931)) (let W1934 (string->n (hdstr V1932)) (if (> W1933 W1934) true (if (< W1933 W1934) false (string>? (tlstr V1931) (tlstr V1932))))))) (true (shen.f-error string>?)))) + +(defun stringn (hdstr V1941)) (let W1944 (string->n (hdstr V1942)) (if (< W1943 W1944) true (if (> W1943 W1944) false (string=? (V1947 V1948) (or (= V1947 V1948) (string>? V1947 V1948))) + +(defun string<=? (V1951 V1952) (or (= V1951 V1952) (stringstrings W1965 ()) (let W1967 (compile (fn string.) W1966) (let W1968 (file-extension V1963 V1964) (let W1969 (write-to-file W1968 W1967) W1968)))))) + +(defun string.bytes->strings (V1972 V1973) (cond ((= () V1972) (reverse V1973)) ((cons? V1972) (string.bytes->strings (tl V1972) (cons (n->string (hd V1972)) V1973))) (true (shen.f-error string.bytes->strings)))) + +(defun render (V1976) (compile (fn string.) (string->list V1976))) + +(defun string.rendered? (V1982) (cond ((= "" V1982) true) ((and (shen.+string? V1982) (= "{" (hdstr V1982))) false) ((shen.+string? V1982) (string.rendered? (tlstr V1982))) (true (shen.f-error string.rendered?)))) + +(defun string. (V1989) (let W1990 (if (shen.hds=? V1989 "{") (let W1991 (tail V1989) (let W1992 ((fn string.) W1991) (if (shen.parse-failure? W1992) (shen.parse-failure) (let W1993 (shen.<-out W1992) (let W1994 (shen.in-> W1992) (let W1995 ((fn string.) W1994) (if (shen.parse-failure? W1995) (shen.parse-failure) (let W1996 (shen.in-> W1995) (let W1997 ((fn string.) W1996) (if (shen.parse-failure? W1997) (shen.parse-failure) (let W1998 (shen.<-out W1997) (let W1999 (shen.in-> W1997) (if (shen.hds=? W1999 "}") (let W2000 (tail W1999) (let W2001 ((fn string.) W2000) (if (shen.parse-failure? W2001) (shen.parse-failure) (let W2002 (shen.<-out W2001) (let W2003 (shen.in-> W2001) (shen.comb W2003 (cn (string.recapply (fn (intern W1993)) W1998) W2002))))))) (shen.parse-failure)))))))))))))) (shen.parse-failure)) (if (shen.parse-failure? W1990) (let W2004 (if (shen.hds=? V1989 "{") (let W2005 (tail V1989) (let W2006 ((fn string.) W2005) (if (shen.parse-failure? W2006) (shen.parse-failure) (let W2007 (shen.<-out W2006) (let W2008 (shen.in-> W2006) (if (shen.hds=? W2008 "}") (let W2009 (tail W2008) (let W2010 ((fn string.) W2009) (if (shen.parse-failure? W2010) (shen.parse-failure) (let W2011 (shen.<-out W2010) (let W2012 (shen.in-> W2010) (shen.comb W2012 (cn ((intern W2007)) W2011))))))) (shen.parse-failure))))))) (shen.parse-failure)) (if (shen.parse-failure? W2004) (let W2013 (let W2014 ((fn string.) V1989) (if (shen.parse-failure? W2014) (shen.parse-failure) (let W2015 (shen.<-out W2014) (let W2016 (shen.in-> W2014) (let W2017 ((fn string.) W2016) (if (shen.parse-failure? W2017) (shen.parse-failure) (let W2018 (shen.<-out W2017) (let W2019 (shen.in-> W2017) (shen.comb W2019 (cn W2015 W2018)))))))))) (if (shen.parse-failure? W2013) (let W2020 (let W2021 ( V1989) (if (shen.parse-failure? W2021) (shen.parse-failure) (let W2022 (shen.in-> W2021) (shen.comb W2022 "")))) (if (shen.parse-failure? W2020) (shen.parse-failure) W2020)) W2013)) W2004)) W1990))) + +(defun string. (V2026) (let W2027 (if (cons? V2026) (let W2028 (head V2026) (let W2029 (tail V2026) (if (and (not (= W2028 "}")) (not (= W2028 "\"))) (shen.comb W2029 W2028) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2027) (shen.parse-failure) W2027))) + +(defun string.recapply (V2031 V2032) (cond ((= () V2032) V2031) ((cons? V2032) (string.recapply (V2031 (hd V2032)) (tl V2032))) (true (shen.f-error string.recapply)))) + +(defun string. (V2037) (let W2038 (let W2039 ((fn string.) V2037) (if (shen.parse-failure? W2039) (shen.parse-failure) (let W2040 (shen.<-out W2039) (let W2041 (shen.in-> W2039) (if (shen.hds=? W2041 "\") (let W2042 (tail W2041) (let W2043 ((fn string.) W2042) (if (shen.parse-failure? W2043) (shen.parse-failure) (let W2044 (shen.<-out W2043) (let W2045 (shen.in-> W2043) (shen.comb W2045 (cons W2040 W2044))))))) (shen.parse-failure)))))) (if (shen.parse-failure? W2038) (let W2046 (let W2047 ((fn string.) V2037) (if (shen.parse-failure? W2047) (shen.parse-failure) (let W2048 (shen.<-out W2047) (let W2049 (shen.in-> W2047) (shen.comb W2049 (cons W2048 ())))))) (if (shen.parse-failure? W2046) (shen.parse-failure) W2046)) W2038))) + +(defun string. (V2052) (let W2053 (let W2054 (string. V2052) (if (shen.parse-failure? W2054) (shen.parse-failure) (let W2055 (shen.<-out W2054) (let W2056 (shen.in-> W2054) (shen.comb W2056 W2055))))) (if (shen.parse-failure? W2053) (shen.parse-failure) W2053))) + +(defun string. (V2060) (let W2061 (if (cons? V2060) (let W2062 (head V2060) (let W2063 (tail V2060) (if (and (not (= W2062 "}")) (not (= W2062 "\"))) (shen.comb W2063 W2062) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2061) (shen.parse-failure) W2061))) + +(defun string. (V2067) (let W2068 (if (cons? V2067) (let W2069 (head V2067) (let W2070 (tail V2067) (if (whitespace? W2069) (shen.comb W2070 string.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2068) (shen.parse-failure) W2068))) + +(defun string. (V2073) (let W2074 (let W2075 ((fn string.) V2073) (if (shen.parse-failure? W2075) (shen.parse-failure) (let W2076 (shen.<-out W2075) (let W2077 (shen.in-> W2075) (let W2078 ((fn string.) W2077) (if (shen.parse-failure? W2078) (shen.parse-failure) (let W2079 (shen.<-out W2078) (let W2080 (shen.in-> W2078) (shen.comb W2080 (cn W2076 W2079)))))))))) (if (shen.parse-failure? W2074) (let W2081 (let W2082 ( V2073) (if (shen.parse-failure? W2082) (shen.parse-failure) (let W2083 (shen.in-> W2082) (shen.comb W2083 "")))) (if (shen.parse-failure? W2081) (shen.parse-failure) W2081)) W2074))) + +(defun string. (V2087) (let W2088 (if (cons? V2087) (let W2089 (head V2087) (let W2090 (tail V2087) (if (and (not (= W2089 "}")) (and (not (= W2089 "\")) (not (whitespace? W2089)))) (shen.comb W2090 W2089) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2088) (shen.parse-failure) W2088))) + +(defun vector.vector-macros (V2092) (let GoTo2096 (freeze V2092) (if (cons? V2092) (let Select2136 (hd V2092) (let Select2137 (tl V2092) (let GoTo2121 (freeze (let GoTo2109 (freeze (if (= array Select2136) (if (cons? Select2137) (let Select2107 (hd Select2137) (let Select2108 (tl Select2137) (if (cons? Select2107) (let Select2106 (tl Select2107) (if (= cons (hd Select2107)) (if (cons? Select2106) (let Select2104 (hd Select2106) (let Select2105 (tl Select2106) (if (cons? Select2105) (let Select2103 (tl Select2105) (if (and (= () (hd Select2105)) (and (= () Select2103) (= () Select2108))) (cons vector (cons Select2104 ())) (if (and (= () Select2103) (= () Select2108)) (let W2094 (newv) (let W2095 (newv) (cons let (cons W2094 (cons (cons vector (cons Select2104 ())) (cons (cons do (cons (cons for (cons W2095 (cons = (cons 1 (cons to (cons Select2104 (cons (cons vector-> (cons W2094 (cons W2095 (cons (cons array Select2105) ())))) ()))))))) (cons W2094 ()))) ())))))) (thaw GoTo2096)))) (thaw GoTo2096)))) (thaw GoTo2096)) (thaw GoTo2096))) (thaw GoTo2096)))) (thaw GoTo2096)) (thaw GoTo2096))) (if (cons? Select2137) (let Select2119 (hd Select2137) (let Select2120 (tl Select2137) (if (cons? Select2119) (let Select2118 (tl Select2119) (if (= cons (hd Select2119)) (if (cons? Select2118) (let Select2116 (hd Select2118) (let Select2117 (tl Select2118) (if (cons? Select2117) (let Select2114 (hd Select2117) (let Select2115 (tl Select2117) (if (and (= () Select2114) (and (= () Select2115) (and (cons? Select2120) (and (= := (hd Select2120)) (and (cons? (tl Select2120)) (= () (tl (tl Select2120)))))))) (cons vector-> (cons Select2136 (cons Select2116 (tl Select2120)))) (if (and (= () Select2115) (and (cons? Select2120) (and (= := (hd Select2120)) (and (cons? (tl Select2120)) (= () (tl (tl Select2120))))))) (let W2093 (newv) (cons let (cons W2093 (cons (cons <-vector (cons Select2136 (cons Select2116 ()))) (cons (cons W2093 (cons Select2114 Select2120)) ()))))) (thaw GoTo2109))))) (thaw GoTo2109)))) (thaw GoTo2109)) (thaw GoTo2109))) (thaw GoTo2109)))) (thaw GoTo2109)))) (if (= := Select2136) (if (cons? Select2137) (let Select2134 (hd Select2137) (let Select2135 (tl Select2137) (if (cons? Select2135) (let Select2132 (hd Select2135) (let Select2133 (tl Select2135) (if (cons? Select2132) (let Select2131 (tl Select2132) (if (= cons (hd Select2132)) (if (cons? Select2131) (let Select2129 (hd Select2131) (let Select2130 (tl Select2131) (if (cons? Select2130) (let Select2128 (tl Select2130) (if (and (= () (hd Select2130)) (and (= () Select2128) (= () Select2133))) (cons <-vector (cons Select2134 (cons Select2129 ()))) (if (and (= () Select2128) (= () Select2133)) (cons := (cons (cons <-vector (cons Select2134 (cons Select2129 ()))) Select2130)) (thaw GoTo2121)))) (thaw GoTo2121)))) (thaw GoTo2121)) (thaw GoTo2121))) (thaw GoTo2121)))) (thaw GoTo2121)))) (thaw GoTo2121)) (thaw GoTo2121))))) (thaw GoTo2096)))) + +(defun print.pprint-macro (V2220) (cond ((and (cons? V2220) (and (= pprint (hd V2220)) (and (cons? (tl V2220)) (= () (tl (tl V2220)))))) (cons pprint (cons (hd (tl V2220)) (cons (cons stoutput ()) ())))) ((and (cons? V2220) (and (= pps (hd V2220)) (and (cons? (tl V2220)) (= () (tl (tl V2220)))))) (cons pps (cons (hd (tl V2220)) (cons (cons stoutput ()) ())))) (true V2220))) + +(defun linelength () (value print.*linelength*)) + +(defun indentation () (value print.*indentation*)) + +(defun set-linelength (V2222) (cond ((and (positive? V2222) (integer? V2222)) (set print.*linelength* V2222)) (true (simple-error "line length must be a positive integer +")))) + +(defun set-indentation (V2224) (cond ((and (positive? V2224) (integer? V2224)) (set print.*indentation* V2224)) (true (simple-error "indentation must be a positive integer +")))) + +(defun pps (V2226 V2227) (let W2228 (ps V2226) (let W2229 (shen.app W2228 "" shen.r) (let W2230 (pretty-string W2229) (let W2231 (pr W2230 V2227) (let W2232 (nl 1) V2226)))))) + +(defun pprint (V2235 V2236) (let W2237 (shen.app V2235 "" shen.s) (let W2238 (pretty-string W2237) (let W2239 (pr W2238 V2236) (let W2240 (nl 1) V2235))))) + +(defun pretty-string (V2243) (print.pretty-string-h V2243 0 0)) + +(defun print.pretty-string-h (V2249 V2250 V2251) (cond ((= "" V2249) "") ((and (shen.+string? V2249) (= "[" (hdstr V2249))) (@s (print.indent V2250) (@s "[" (print.pretty-string-h (tlstr V2249) (+ V2250 1) 0)))) ((and (shen.+string? V2249) (= "(" (hdstr V2249))) (@s (print.indent V2250) (@s "(" (print.pretty-string-h (tlstr V2249) (+ V2250 1) 0)))) ((and (shen.+string? V2249) (= "]" (hdstr V2249))) (@s "]" (print.pretty-string-h (tlstr V2249) (- V2250 1) 0))) ((and (shen.+string? V2249) (= ")" (hdstr V2249))) (@s ")" (print.pretty-string-h (tlstr V2249) (- V2250 1) 0))) ((and (shen.+string? V2249) (and (= " " (hdstr V2249)) (> V2251 (linelength)))) (@s (print.indent V2250) (print.pretty-string-h (tlstr V2249) V2250 0))) ((shen.+string? V2249) (@s (hdstr V2249) (print.pretty-string-h (tlstr V2249) V2250 (+ V2251 1)))) (true (shen.f-error print.pretty-string-h)))) + +(defun print.indent (V2255) (cond ((= 0 V2255) "") (true (@s " +" (print.indent-h V2255))))) + +(defun print.indent-h (V2257) (cond ((= 0 V2257) "") (true (cn (print.n-space (indentation)) (print.indent-h (- V2257 1)))))) + +(defun print.n-space (V2259) (cond ((= 0 V2259) "") (true (cn " " (print.n-space (- V2259 1)))))) + +(defun delete-file (V2262) (if (= (language) "Common Lisp") ((fn lisp.delete-file) V2262) (close (open V2262 out)))) + +(defun file.file-macro (V2290) (cond ((and (cons? V2290) (and (= errout (hd V2290)) (and (cons? (tl V2290)) (and (cons? (tl (tl V2290))) (and (cons? (tl (tl (tl V2290)))) (= () (tl (tl (tl (tl V2290)))))))))) (let W2291 (newv) (let W2292 (newv) (let W2293 (newv) (let W2294 (newv) (let W2295 (newv) (cons trap-error (cons (hd (tl V2290)) (cons (cons /. (cons W2295 (cons (cons let (cons W2291 (cons (cons error-to-string (cons W2295 ())) (cons W2292 (cons (cons trap-error (cons (cons reopen (tl (tl (tl V2290)))) (cons (cons /. (cons W2295 (cons (cons open (cons (hd (tl (tl (tl V2290)))) (cons out ()))) ()))) ()))) (cons W2293 (cons (cons pr (cons W2291 (cons W2292 ()))) (cons W2294 (cons (cons close (cons W2292 ())) (cons (hd (tl (tl V2290))) ())))))))))) ()))) ()))))))))) (true V2290))) + +(defun append-files (V2297 V2298) (let W2299 (append-files-with-open-stream V2297 V2298) (let W2300 (close W2299) V2298))) + +(defun append-files-with-open-stream (V2303 V2304) (cond ((element? V2304 V2303) (simple-error (cn "cannot read and write to " (shen.app V2304 " at the same time +" shen.a)))) (true (let W2305 (open V2304 out) (let W2306 (mapc (lambda Z2307 (file.read&write (open Z2307 in) W2305)) V2303) W2305))))) + +(defun file.read&write (V2310 V2311) (file.read&write-h (read-byte V2310) V2310 V2311)) + +(defun file.read&write-h (V2314 V2315 V2316) (cond ((= -1 V2314) -1) (true (file.read&write-h (read-byte V2315) V2315 (do (write-byte V2314 V2316) V2316))))) + +(defun reopen (V2320) (let W2321 (read-file-as-bytelist V2320) (let W2322 (open V2320 out) (let W2323 (mapc (lambda Z2324 (write-byte Z2324 W2322)) W2321) W2322)))) + +(defun copy-file (V2326 V2327) (append-files (cons V2326 ()) V2327)) + +(defun copy-file-with-open-stream (V2330 V2331) (append-files-with-open-stream (cons V2330 ()) V2331)) + +(defun file-exists? (V2334) (trap-error (do (close (open V2334 in)) true) (lambda Z2335 false))) + +(defun file-size (V2337) (let W2338 (open V2337 in) (let W2339 (file.file-size-loop W2338 0 (read-byte W2338)) (let W2340 (close W2338) W2339)))) + +(defun file.file-size-loop (V2346 V2347 V2348) (cond ((= -1 V2348) V2347) (true (file.file-size-loop V2346 (+ 1 V2347) (read-byte V2346))))) + +(defun ascii (V2352 V2353 V2354) (let W2355 (read-file-as-bytelist V2354) (file.scan-bytes V2352 V2353 W2355 ""))) + +(defun file.scan-bytes (V2361 V2362 V2363 V2364) (cond ((= () V2363) V2364) ((and (cons? V2363) (and (>= (hd V2363) V2361) (<= (hd V2363) V2362))) (file.scan-bytes V2361 V2362 (tl V2363) (cn V2364 (n->string (hd V2363))))) ((cons? V2363) (simple-error (cn "character has code " (shen.app (hd V2363) (cn ": parsed to here + +" (shen.app V2364 "" shen.a)) shen.a)))) (true (shen.f-error file.scan-bytes)))) + +(defun pairoff (V2383 V2384) (cond ((= () V2383) ()) ((= () V2384) ()) ((and (cons? V2383) (cons? V2384)) (cons (@p (hd V2383) (hd V2384)) (pairoff (tl V2383) (tl V2384)))) (true (shen.f-error pairoff)))) + +(defun assocp (V2394 V2395) (cond ((= () V2395) (simple-error "pair not found +")) ((and (cons? V2395) (and (tuple? (hd V2395)) (= V2394 (fst (hd V2395))))) (hd V2395)) ((cons? V2395) (assocp V2394 (tl V2395))) (true (shen.f-error assocp)))) + +(defun cartprodp (V2400 V2401) (cond ((= () V2400) ()) ((cons? V2400) (append (map (lambda Z2402 (@p (hd V2400) Z2402)) V2401) (cartprodp (tl V2400) V2401))) (true (shen.f-error cartprodp)))) + +(defun assocp-if (V2410 V2411) (cond ((= () V2411) (simple-error "pair not found +")) ((and (cons? V2411) (and (tuple? (hd V2411)) (V2410 (fst (hd V2411))))) (hd V2411)) ((cons? V2411) (assocp-if V2410 (tl V2411))) (true (shen.f-error assocp-if)))) + +(defun assocp-if-not (V2419 V2420) (cond ((= () V2420) (simple-error "pair not found +")) ((and (cons? V2420) (and (tuple? (hd V2420)) (not (V2419 (fst (hd V2420)))))) (hd V2420)) ((cons? V2420) (assocp-if-not V2419 (tl V2420))) (true (shen.f-error assocp-if-not)))) + +(defun stlib.initialise-environment () (do (set maths.*seed* 95795) (do (set maths.*tolerance* 1e-4) (do (set print.*indentation* 1) (do (set print.*linelength* 60) (do (preclude (cons print ())) (do stlib.void (do (put symbol shen.external-symbols (cons newv (cons concat* ())) (value *property-vector*)) (do (put symbol shen.internal-symbols () (value *property-vector*)) (do (put maths shen.external-symbols (cons expt (cons =r (cons gcd (cons lcd (cons isqrt (cons sqrt (cons nthrt (cons floor (cons ceiling (cons round (cons mod (cons lcm (cons random (cons min (cons max (cons reseed (cons ~ (cons positive? (cons negative? (cons natural? (cons converge (cons series (cons odd? (cons even? (cons cos (cons sin (cons tan (cons radians (cons pi (cons e (cons tan30 (cons cos30 (cons cos45 (cons sin45 (cons sqrt2 (cons tan60 (cons sin120 (cons tan120 (cons sin135 (cons cos135 (cons cos150 (cons tan150 (cons cos210 (cons tan210 (cons sin225 (cons cos225 (cons sin240 (cons tan240 (cons sin300 (cons tan300 (cons sin315 (cons cos315 (cons cos330 (cons tan330 (cons sinh (cons cosh (cons tanh (cons sech (cons csch (cons power (cons factorial (cons prime? (cons unix (cons div (cons modf (cons product (cons summation (cons set-tolerance (cons tolerance (cons coth (cons for (cons sq (cons cube (cons newv (cons abs (cons approx (cons log (cons log2 (cons loge (cons log10 (cons g (cons to (cons stop (cons step (cons constructor (cons end (cons done ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (value *property-vector*)) (do (put maths shen.internal-symbols (cons maths.maths (cons maths.*tolerance* (cons maths.for-h (cons maths.lazyfor-and (cons maths.lazyfor-or (cons maths.n->r (cons maths.expt-h (cons maths.gcd-help (cons maths.gcd-loop (cons maths.lcd-loop (cons maths.isqrt-loop (cons maths.float->pair (cons maths.rounding-loop (cons maths.greatest (cons maths.lcm-h (cons maths.lcm? (cons maths.*seed* (cons maths.bbs (cons maths.converge-help (cons maths.compute-nthrt (cons maths.series-h (cons maths.compute-cos (cons maths.compute-sine (cons maths.sin60 (cons maths.prime-h (cons maths.sign (cons maths.log10+ (cons maths.maths-macro (cons maths.tolerance=n (cons maths.upto (cons maths.process-options (cons maths.step-option (cons maths.constructor-option (cons maths.end-option (cons maths.process ()))))))))))))))))))))))))))))))))))) (value *property-vector*)) (do (put rational shen.external-symbols (cons r-reduce (cons r= (cons r< (cons r> (cons r>= (cons r<= (cons r+ (cons r- (cons r* (cons r/ (cons r-expr (cons +-inverse (cons *-inverse (cons r-expt (cons r->n (cons r->pair (cons n->r (cons maths.n->r (cons r-approx (cons maths.lcd-loop (cons r-op1 (cons r-op2 (cons expt (cons =r (cons gcd (cons lcd (cons isqrt (cons sqrt (cons nthrt (cons floor (cons ceiling (cons round (cons mod (cons lcm (cons random (cons min (cons max (cons reseed (cons ~ (cons positive? (cons negative? (cons natural? (cons converge (cons series (cons odd? (cons even? (cons cos (cons sin (cons tan (cons radians (cons pi (cons e (cons tan30 (cons cos30 (cons cos45 (cons sin45 (cons sqrt2 (cons tan60 (cons sin120 (cons tan120 (cons sin135 (cons cos135 (cons cos150 (cons tan150 (cons cos210 (cons tan210 (cons sin225 (cons cos225 (cons sin240 (cons tan240 (cons sin300 (cons tan300 (cons sin315 (cons cos315 (cons cos330 (cons tan330 (cons sinh (cons cosh (cons tanh (cons sech (cons csch (cons power (cons factorial (cons prime? (cons unix (cons div (cons modf (cons product (cons summation (cons set-tolerance (cons tolerance (cons coth (cons for (cons sq (cons cube (cons newv (cons abs (cons approx (cons log (cons log2 (cons loge (cons log10 (cons g (cons to (cons stop (cons step (cons constructor (cons end (cons done (cons r# (cons rational? (cons rational (cons numerator (cons denominator ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (value *property-vector*)) (do (put rational shen.internal-symbols (cons rational.r-reduce-help (cons rational.approx-r-h (cons rational.print-rational ()))) (value *property-vector*)) (do (put complex shen.external-symbols (cons c+ (cons c- (cons c* (cons c/ (cons expt (cons =r (cons gcd (cons lcd (cons isqrt (cons sqrt (cons nthrt (cons floor (cons ceiling (cons round (cons mod (cons lcm (cons random (cons min (cons max (cons reseed (cons ~ (cons positive? (cons negative? (cons natural? (cons converge (cons series (cons odd? (cons even? (cons cos (cons sin (cons tan (cons radians (cons pi (cons e (cons tan30 (cons cos30 (cons cos45 (cons sin45 (cons sqrt2 (cons tan60 (cons sin120 (cons tan120 (cons sin135 (cons cos135 (cons cos150 (cons tan150 (cons cos210 (cons tan210 (cons sin225 (cons cos225 (cons sin240 (cons tan240 (cons sin300 (cons tan300 (cons sin315 (cons cos315 (cons cos330 (cons tan330 (cons sinh (cons cosh (cons tanh (cons sech (cons csch (cons power (cons factorial (cons prime? (cons unix (cons div (cons modf (cons product (cons summation (cons set-tolerance (cons tolerance (cons coth (cons for (cons sq (cons cube (cons newv (cons abs (cons approx (cons log (cons log2 (cons loge (cons log10 (cons g (cons to (cons stop (cons step (cons constructor (cons end (cons done (cons c# (cons complex? (cons real (cons imaginary (cons complex ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (value *property-vector*)) (do (put complex shen.internal-symbols (cons complex.print-complex ()) (value *property-vector*)) (do (put numerals shen.external-symbols (cons hex (cons octal (cons duodecimal (cons binary (cons n-op2 (cons n-op1 (cons n+ (cons n- (cons n* (cons n/ (cons expt (cons =r (cons gcd (cons lcd (cons isqrt (cons sqrt (cons nthrt (cons floor (cons ceiling (cons round (cons mod (cons lcm (cons random (cons min (cons max (cons reseed (cons ~ (cons positive? (cons negative? (cons natural? (cons converge (cons series (cons odd? (cons even? (cons cos (cons sin (cons tan (cons radians (cons pi (cons e (cons tan30 (cons cos30 (cons cos45 (cons sin45 (cons sqrt2 (cons tan60 (cons sin120 (cons tan120 (cons sin135 (cons cos135 (cons cos150 (cons tan150 (cons cos210 (cons tan210 (cons sin225 (cons cos225 (cons sin240 (cons tan240 (cons sin300 (cons tan300 (cons sin315 (cons cos315 (cons cos330 (cons tan330 (cons sinh (cons cosh (cons tanh (cons sech (cons csch (cons power (cons factorial (cons prime? (cons unix (cons div (cons modf (cons product (cons summation (cons set-tolerance (cons tolerance (cons coth (cons for (cons sq (cons cube (cons newv (cons abs (cons approx (cons log (cons log2 (cons loge (cons log10 (cons g (cons to (cons stop (cons step (cons constructor (cons end (cons done (cons numeral? (cons numeral (cons radix (cons n#->ns (cons n# (cons n#->n ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (value *property-vector*)) (do (put numerals shen.internal-symbols (cons numerals.numeral-macro (cons numerals.largest-expt (cons numerals.n-zeros (cons numerals.add (cons numerals.add-h (cons numerals.n->numeral (cons numerals.numerals (cons numerals.numeric->string (cons numerals.print-numeral ()))))))))) (value *property-vector*)) (do (put list shen.external-symbols (cons prefix? (cons suffix? (cons subset? (cons set=? (cons set? (cons permute (cons nthhd (cons cartprod (cons powerset (cons subbag? (cons bag=? (cons n-times (cons trim-right (cons trim-left (cons trim (cons trim-right-if (cons trim-left-if (cons trim-if (cons assoc-if (cons assoc-if-not (cons infix? (cons count-if (cons count (cons remove-duplicates (cons foldr (cons foldl (cons find (cons mapf (cons remove-if (cons some? (cons every? (cons mapc (cons filter (cons transitive-closure (cons x->ascii (cons take (cons take-last (cons drop (cons drop-last (cons index (cons index-last (cons insert (cons splice (cons sort (cons partition ()))))))))))))))))))))))))))))))))))))))))))))) (value *property-vector*)) (do (put list shen.internal-symbols (cons list.index-h (cons list.n-times-h (cons list.reduce (cons list.transitive-pass (cons list.find-trans ()))))) (value *property-vector*)) (do (put string shen.external-symbols (cons render-file (cons render (cons s-op1 (cons s-op2 (cons string.reverse (cons string.element? (cons string.infix? (cons string.suffix? (cons string.prefix? (cons string.length (cons string.difference (cons string.intersection (cons string.nth (cons whitespace? (cons lowercase? (cons uppercase? (cons digit? (cons alpha? (cons alphanum? (cons string.subset? (cons string.set=? (cons string.set? (cons string.nth (cons string.trim (cons string.trim-right (cons string.trim-left (cons tokenise (cons list->string (cons string->list (cons string.trim-left-if (cons string.trim-right-if (cons string.trim-if (cons uppercase (cons lowercase (cons string.map (cons file-extension (cons strip-extension (cons string.count (cons spell-number (cons string>? (cons string=? (cons string<=? (cons string.some? (cons string.every? (cons prefix? (cons suffix? (cons subset? (cons set=? (cons set? (cons permute (cons nthhd (cons cartprod (cons powerset (cons subbag? (cons bag=? (cons n-times (cons trim-right (cons trim-left (cons trim (cons trim-right-if (cons trim-left-if (cons trim-if (cons assoc-if (cons assoc-if-not (cons infix? (cons count-if (cons count (cons remove-duplicates (cons foldr (cons foldl (cons find (cons mapf (cons remove-if (cons some? (cons every? (cons mapc (cons filter (cons transitive-closure (cons x->ascii (cons take (cons take-last (cons drop (cons drop-last (cons index (cons index-last (cons insert (cons splice (cons sort (cons partition ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (value *property-vector*)) (do (put string shen.internal-symbols (cons string.bytes->strings (cons string.rendered? (cons string. (cons string.recapply (cons string. (cons string. (cons string. (cons string. (cons string. (cons string.skip (cons string. (cons string. (cons string.s->l-h (cons string.tokenise-h (cons string.triples (cons string.triples-h (cons string.digits (cons string.tens (cons string.digit (cons string.scale (cons string.units ()))))))))))))))))))))) (value *property-vector*)) (do (put vector shen.external-symbols (cons newv (cons array (cons for (cons to ())))) (value *property-vector*)) (do (put vector shen.internal-symbols (cons vector.vector-macros ()) (value *property-vector*)) (do (put print shen.external-symbols (cons expt (cons =r (cons gcd (cons lcd (cons isqrt (cons sqrt (cons nthrt (cons floor (cons ceiling (cons round (cons mod (cons lcm (cons random (cons min (cons max (cons reseed (cons ~ (cons positive? (cons negative? (cons natural? (cons converge (cons series (cons odd? (cons even? (cons cos (cons sin (cons tan (cons radians (cons pi (cons e (cons tan30 (cons cos30 (cons cos45 (cons sin45 (cons sqrt2 (cons tan60 (cons sin120 (cons tan120 (cons sin135 (cons cos135 (cons cos150 (cons tan150 (cons cos210 (cons tan210 (cons sin225 (cons cos225 (cons sin240 (cons tan240 (cons sin300 (cons tan300 (cons sin315 (cons cos315 (cons cos330 (cons tan330 (cons sinh (cons cosh (cons tanh (cons sech (cons csch (cons power (cons factorial (cons prime? (cons unix (cons div (cons modf (cons product (cons summation (cons set-tolerance (cons tolerance (cons coth (cons for (cons sq (cons cube (cons newv (cons abs (cons approx (cons log (cons log2 (cons loge (cons log10 (cons g (cons to (cons stop (cons step (cons constructor (cons end (cons done (cons pps (cons pprint (cons pretty-string (cons linelength (cons indentation (cons set-linelength (cons set-indentation ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (value *property-vector*)) (do (put print shen.internal-symbols (cons print.pprint-macro (cons print.*linelength* (cons print.*indentation* (cons print.pretty-string-h (cons print.indent (cons print.indent-h (cons print.n-space ()))))))) (value *property-vector*)) (do (put file shen.external-symbols (cons append-files (cons append-files-with-open-stream (cons mapc (cons copy-file (cons file-size (cons reopen (cons errout (cons copy-file-with-open-stream (cons file-exists? (cons newv (cons ascii ()))))))))))) (value *property-vector*)) (do (put file shen.internal-symbols (cons file.file-macro (cons file.read&write (cons file.read&write-h (cons file.file-size-loop (cons file.scan-bytes ()))))) (value *property-vector*)) (do (put tuple shen.external-symbols (cons pairoff (cons assocp (cons cartprodp (cons assocp-if (cons assocp-if-not ()))))) (value *property-vector*)) (do (put tuple shen.internal-symbols () (value *property-vector*)) (do (put stlib shen.external-symbols (cons prefix? (cons suffix? (cons subset? (cons set=? (cons set? (cons permute (cons nthhd (cons cartprod (cons powerset (cons subbag? (cons bag=? (cons n-times (cons trim-right (cons trim-left (cons trim (cons trim-right-if (cons trim-left-if (cons trim-if (cons assoc-if (cons assoc-if-not (cons infix? (cons count-if (cons count (cons remove-duplicates (cons foldr (cons foldl (cons find (cons mapf (cons remove-if (cons some? (cons every? (cons mapc (cons filter (cons transitive-closure (cons x->ascii (cons take (cons take-last (cons drop (cons drop-last (cons index (cons index-last (cons insert (cons splice (cons sort (cons partition (cons render-file (cons render (cons s-op1 (cons s-op2 (cons string.reverse (cons string.element? (cons string.infix? (cons string.suffix? (cons string.prefix? (cons string.length (cons string.difference (cons string.intersection (cons string.nth (cons whitespace? (cons lowercase? (cons uppercase? (cons digit? (cons alpha? (cons alphanum? (cons string.subset? (cons string.set=? (cons string.set? (cons string.nth (cons string.trim (cons string.trim-right (cons string.trim-left (cons tokenise (cons list->string (cons string->list (cons string.trim-left-if (cons string.trim-right-if (cons string.trim-if (cons uppercase (cons lowercase (cons string.map (cons file-extension (cons strip-extension (cons string.count (cons spell-number (cons string>? (cons string=? (cons string<=? (cons string.some? (cons string.every? (cons prefix? (cons suffix? (cons subset? (cons set=? (cons set? (cons permute (cons nthhd (cons cartprod (cons powerset (cons subbag? (cons bag=? (cons n-times (cons trim-right (cons trim-left (cons trim (cons trim-right-if (cons trim-left-if (cons trim-if (cons assoc-if (cons assoc-if-not (cons infix? (cons count-if (cons count (cons remove-duplicates (cons foldr (cons foldl (cons find (cons mapf (cons remove-if (cons some? (cons every? (cons mapc (cons filter (cons transitive-closure (cons x->ascii (cons take (cons take-last (cons drop (cons drop-last (cons index (cons index-last (cons insert (cons splice (cons sort (cons partition (cons expt (cons =r (cons gcd (cons lcd (cons isqrt (cons sqrt (cons nthrt (cons floor (cons ceiling (cons round (cons mod (cons lcm (cons random (cons min (cons max (cons reseed (cons ~ (cons positive? (cons negative? (cons natural? (cons converge (cons series (cons odd? (cons even? (cons cos (cons sin (cons tan (cons radians (cons pi (cons e (cons tan30 (cons cos30 (cons cos45 (cons sin45 (cons sqrt2 (cons tan60 (cons sin120 (cons tan120 (cons sin135 (cons cos135 (cons cos150 (cons tan150 (cons cos210 (cons tan210 (cons sin225 (cons cos225 (cons sin240 (cons tan240 (cons sin300 (cons tan300 (cons sin315 (cons cos315 (cons cos330 (cons tan330 (cons sinh (cons cosh (cons tanh (cons sech (cons csch (cons power (cons factorial (cons prime? (cons unix (cons div (cons modf (cons product (cons summation (cons set-tolerance (cons tolerance (cons coth (cons for (cons sq (cons cube (cons newv (cons abs (cons approx (cons log (cons log2 (cons loge (cons log10 (cons g (cons to (cons stop (cons step (cons constructor (cons end (cons done (cons newv (cons array (cons for (cons to (cons newv (cons concat* (cons pairoff (cons assocp (cons cartprodp (cons assocp-if (cons assocp-if-not (cons append-files (cons append-files-with-open-stream (cons mapc (cons copy-file (cons file-size (cons reopen (cons errout (cons copy-file-with-open-stream (cons file-exists? (cons newv (cons ascii (cons expt (cons =r (cons gcd (cons lcd (cons isqrt (cons sqrt (cons nthrt (cons floor (cons ceiling (cons round (cons mod (cons lcm (cons random (cons min (cons max (cons reseed (cons ~ (cons positive? (cons negative? (cons natural? (cons converge (cons series (cons odd? (cons even? (cons cos (cons sin (cons tan (cons radians (cons pi (cons e (cons tan30 (cons cos30 (cons cos45 (cons sin45 (cons sqrt2 (cons tan60 (cons sin120 (cons tan120 (cons sin135 (cons cos135 (cons cos150 (cons tan150 (cons cos210 (cons tan210 (cons sin225 (cons cos225 (cons sin240 (cons tan240 (cons sin300 (cons tan300 (cons sin315 (cons cos315 (cons cos330 (cons tan330 (cons sinh (cons cosh (cons tanh (cons sech (cons csch (cons power (cons factorial (cons prime? (cons unix (cons div (cons modf (cons product (cons summation (cons set-tolerance (cons tolerance (cons coth (cons for (cons sq (cons cube (cons newv (cons abs (cons approx (cons log (cons log2 (cons loge (cons log10 (cons g (cons to (cons stop (cons step (cons constructor (cons end (cons done (cons pps (cons pprint (cons pretty-string (cons linelength (cons indentation (cons set-linelength (cons set-indentation ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (value *property-vector*)) (put stlib shen.internal-symbols (cons stlib.void ()) (value *property-vector*)))))))))))))))))))))))))))))))) + +(defun stlib.initialise-arities () (do (update-lambda-table concat* 2) (do (update-lambda-table newv 0) (do (update-lambda-table maths.maths-macro 1) (do (update-lambda-table maths.process-options 2) (do (update-lambda-table maths.step-option 1) (do (update-lambda-table maths.constructor-option 1) (do (update-lambda-table maths.end-option 1) (do (update-lambda-table maths.process 2) (do (update-lambda-table set-tolerance 1) (do (update-lambda-table tolerance 0) (do (update-lambda-table sq 1) (do (update-lambda-table cube 1) (do (update-lambda-table for 5) (do (update-lambda-table maths.for-h 6) (do (update-lambda-table maths.lazyfor-and 4) (do (update-lambda-table maths.lazyfor-or 4) (do (update-lambda-table max 2) (do (update-lambda-table min 2) (do (update-lambda-table expt 3) (do (update-lambda-table maths.n->r 2) (do (update-lambda-table maths.expt-h 3) (do (update-lambda-table gcd 2) (do (update-lambda-table maths.gcd-help 2) (do (update-lambda-table maths.gcd-loop 3) (do (update-lambda-table lcd 2) (do (update-lambda-table maths.lcd-loop 4) (do (update-lambda-table isqrt 1) (do (update-lambda-table maths.isqrt-loop 2) (do (update-lambda-table div 2) (do (update-lambda-table modf 1) (do (update-lambda-table floor 1) (do (update-lambda-table maths.rounding-loop 4) (do (update-lambda-table maths.float->pair 1) (do (update-lambda-table ceiling 1) (do (update-lambda-table round 1) (do (update-lambda-table mod 2) (do (update-lambda-table lcm 1) (do (update-lambda-table maths.greatest 1) (do (update-lambda-table maths.lcm-h 3) (do (update-lambda-table maths.lcm? 2) (do (update-lambda-table random 2) (do (update-lambda-table min 2) (do (update-lambda-table reseed 0) (do (update-lambda-table maths.bbs 1) (do (update-lambda-table ~ 1) (do (update-lambda-table positive? 1) (do (update-lambda-table negative? 1) (do (update-lambda-table natural? 1) (do (update-lambda-table converge 3) (do (update-lambda-table maths.converge-help 4) (do (update-lambda-table nthrt 3) (do (update-lambda-table sqrt 2) (do (update-lambda-table maths.compute-nthrt 4) (do (update-lambda-table approx 1) (do (update-lambda-table abs 1) (do (update-lambda-table series 4) (do (update-lambda-table maths.series-h 5) (do (update-lambda-table product 3) (do (update-lambda-table summation 3) (do (update-lambda-table odd? 1) (do (update-lambda-table even? 1) (do (update-lambda-table maths.compute-sine 2) (do (update-lambda-table maths.compute-cos 2) (do (update-lambda-table cos 2) (do (update-lambda-table sin 2) (do (update-lambda-table tan 2) (do (update-lambda-table radians 1) (do (update-lambda-table g 0) (do (update-lambda-table pi 0) (do (update-lambda-table e 0) (do (update-lambda-table tan30 0) (do (update-lambda-table cos30 0) (do (update-lambda-table cos45 0) (do (update-lambda-table sin45 0) (do (update-lambda-table sqrt2 0) (do (update-lambda-table tan60 0) (do (update-lambda-table maths.sin60 0) (do (update-lambda-table sin120 0) (do (update-lambda-table tan120 0) (do (update-lambda-table sin135 0) (do (update-lambda-table cos135 0) (do (update-lambda-table cos150 0) (do (update-lambda-table tan150 0) (do (update-lambda-table cos210 0) (do (update-lambda-table tan210 0) (do (update-lambda-table sin225 0) (do (update-lambda-table cos225 0) (do (update-lambda-table sin240 0) (do (update-lambda-table tan240 0) (do (update-lambda-table sin300 0) (do (update-lambda-table tan300 0) (do (update-lambda-table sin315 0) (do (update-lambda-table cos315 0) (do (update-lambda-table cos330 0) (do (update-lambda-table tan330 0) (do (update-lambda-table coth 2) (do (update-lambda-table sinh 2) (do (update-lambda-table cosh 2) (do (update-lambda-table tanh 2) (do (update-lambda-table sech 2) (do (update-lambda-table csch 2) (do (update-lambda-table power 2) (do (update-lambda-table factorial 1) (do (update-lambda-table prime? 1) (do (update-lambda-table maths.prime-h 3) (do (update-lambda-table maths.sign 1) (do (update-lambda-table log 3) (do (update-lambda-table loge 2) (do (update-lambda-table log2 2) (do (update-lambda-table log10 2) (do (update-lambda-table maths.log10+ 2) (do (update-lambda-table maths.upto 6) (do (update-lambda-table r# 2) (do (update-lambda-table rational.print-rational 1) (do (update-lambda-table rational? 1) (do (update-lambda-table numerator 1) (do (update-lambda-table denominator 1) (do (update-lambda-table r-op1 2) (do (update-lambda-table r-op2 3) (do (update-lambda-table r->n 1) (do (update-lambda-table r->pair 1) (do (update-lambda-table n->r 1) (do (update-lambda-table r-reduce 1) (do (update-lambda-table rational.r-reduce-help 2) (do (update-lambda-table r= 2) (do (update-lambda-table r< 2) (do (update-lambda-table r> 2) (do (update-lambda-table r>= 2) (do (update-lambda-table r<= 2) (do (update-lambda-table r+ 2) (do (update-lambda-table r- 2) (do (update-lambda-table r* 2) (do (update-lambda-table +-inverse 1) (do (update-lambda-table *-inverse 1) (do (update-lambda-table r/ 2) (do (update-lambda-table r-expt 2) (do (update-lambda-table r-approx 2) (do (update-lambda-table rational.approx-r-h 3) (do (update-lambda-table c# 2) (do (update-lambda-table complex.print-complex 1) (do (update-lambda-table complex? 1) (do (update-lambda-table real 1) (do (update-lambda-table imaginary 1) (do (update-lambda-table c+ 2) (do (update-lambda-table c- 2) (do (update-lambda-table c* 2) (do (update-lambda-table c/ 2) (do (update-lambda-table n# 2) (do (update-lambda-table radix 1) (do (update-lambda-table numerals.numerals 1) (do (update-lambda-table n#->n 1) (do (update-lambda-table n#->ns 1) (do (update-lambda-table numerals.print-numeral 1) (do (update-lambda-table numerals.numeric->string 2) (do (update-lambda-table numeral? 1) (do (update-lambda-table numerals.numeral-macro 1) (do (update-lambda-table n-op2 4) (do (update-lambda-table n-op1 3) (do (update-lambda-table n+ 3) (do (update-lambda-table n* 3) (do (update-lambda-table n- 3) (do (update-lambda-table n/ 3) (do (update-lambda-table binary 1) (do (update-lambda-table hex 1) (do (update-lambda-table octal 1) (do (update-lambda-table duodecimal 1) (do (update-lambda-table numerals.n->numeral 2) (do (update-lambda-table numerals.largest-expt 3) (do (update-lambda-table numerals.n-zeros 1) (do (update-lambda-table numerals.add 3) (do (update-lambda-table numerals.add-h 4) (do (update-lambda-table assoc-if 2) (do (update-lambda-table assoc-if-not 2) (do (update-lambda-table drop 2) (do (update-lambda-table drop-last 2) (do (update-lambda-table index 2) (do (update-lambda-table list.index-h 3) (do (update-lambda-table index-last 2) (do (update-lambda-table insert 3) (do (update-lambda-table remove-duplicates 1) (do (update-lambda-table trim-left-if 2) (do (update-lambda-table trim-right-if 2) (do (update-lambda-table trim-if 2) (do (update-lambda-table trim-left 2) (do (update-lambda-table trim-right 2) (do (update-lambda-table trim 2) (do (update-lambda-table prefix? 2) (do (update-lambda-table infix? 2) (do (update-lambda-table suffix? 2) (do (update-lambda-table subset? 2) (do (update-lambda-table set=? 2) (do (update-lambda-table set? 1) (do (update-lambda-table n-times 2) (do (update-lambda-table list.n-times-h 3) (do (update-lambda-table subbag? 2) (do (update-lambda-table bag=? 2) (do (update-lambda-table mapc 2) (do (update-lambda-table permute 1) (do (update-lambda-table count-if 2) (do (update-lambda-table count 2) (do (update-lambda-table some? 2) (do (update-lambda-table every? 2) (do (update-lambda-table sort 2) (do (update-lambda-table find 2) (do (update-lambda-table foldr 3) (do (update-lambda-table foldl 3) (do (update-lambda-table mapf 3) (do (update-lambda-table filter 2) (do (update-lambda-table remove-if 2) (do (update-lambda-table list.reduce 3) (do (update-lambda-table take 2) (do (update-lambda-table take-last 2) (do (update-lambda-table cartprod 2) (do (update-lambda-table powerset 1) (do (update-lambda-table partition 2) (do (update-lambda-table transitive-closure 1) (do (update-lambda-table list.transitive-pass 2) (do (update-lambda-table list.find-trans 3) (do (update-lambda-table x->ascii 1) (do (update-lambda-table splice 3) (do (update-lambda-table string-macros 1) (do (update-lambda-table string->list 1) (do (update-lambda-table string.s->l-h 4) (do (update-lambda-table list->string 1) (do (update-lambda-table s-op1 3) (do (update-lambda-table s-op2 4) (do (update-lambda-table string.count 2) (do (update-lambda-table string.reverse 1) (do (update-lambda-table string.element? 2) (do (update-lambda-table string.prefix? 2) (do (update-lambda-table string.infix? 2) (do (update-lambda-table string.suffix? 2) (do (update-lambda-table string.subset? 2) (do (update-lambda-table string.set=? 2) (do (update-lambda-table string.set? 1) (do (update-lambda-table file-extension 2) (do (update-lambda-table strip-extension 1) (do (update-lambda-table string.length 1) (do (update-lambda-table string.trim 2) (do (update-lambda-table string.trim-if 2) (do (update-lambda-table string.trim-right-if 2) (do (update-lambda-table string.trim-left-if 2) (do (update-lambda-table string.trim-right 2) (do (update-lambda-table string.trim-left 2) (do (update-lambda-table string.some? 2) (do (update-lambda-table string.every? 2) (do (update-lambda-table string.difference 2) (do (update-lambda-table string.intersection 2) (do (update-lambda-table string.nth 2) (do (update-lambda-table whitespace? 1) (do (update-lambda-table uppercase? 1) (do (update-lambda-table lowercase? 1) (do (update-lambda-table digit? 1) (do (update-lambda-table alpha? 1) (do (update-lambda-table alphanum? 1) (do (update-lambda-table tokenise 2) (do (update-lambda-table string.tokenise-h 3) (do (update-lambda-table uppercase 1) (do (update-lambda-table lowercase 1) (do (update-lambda-table string.map 2) (do (update-lambda-table spell-number 1) (do (update-lambda-table string.digit 1) (do (update-lambda-table string.triples 1) (do (update-lambda-table string.triples-h 2) (do (update-lambda-table string.digits 1) (do (update-lambda-table string.tens 2) (do (update-lambda-table string.scale 1) (do (update-lambda-table string.units 1) (do (update-lambda-table string>? 2) (do (update-lambda-table string=? 2) (do (update-lambda-table string<=? 2) (do (update-lambda-table render-file 2) (do (update-lambda-table string.bytes->strings 2) (do (update-lambda-table render 1) (do (update-lambda-table string.rendered? 1) (do (update-lambda-table string. 1) (do (update-lambda-table string. 1) (do (update-lambda-table string.recapply 2) (do (update-lambda-table string. 1) (do (update-lambda-table string. 1) (do (update-lambda-table string. 1) (do (update-lambda-table string. 1) (do (update-lambda-table string. 1) (do (update-lambda-table string. 1) (do (update-lambda-table vector.vector-macros 1) (do (update-lambda-table print.pprint-macro 1) (do (update-lambda-table linelength 0) (do (update-lambda-table indentation 0) (do (update-lambda-table set-linelength 1) (do (update-lambda-table set-indentation 1) (do (update-lambda-table pps 2) (do (update-lambda-table pprint 2) (do (update-lambda-table pretty-string 1) (do (update-lambda-table print.pretty-string-h 3) (do (update-lambda-table print.indent 1) (do (update-lambda-table print.indent-h 1) (do (update-lambda-table print.n-space 1) (do (update-lambda-table delete-file 1) (do (update-lambda-table file.file-macro 1) (do (update-lambda-table append-files 2) (do (update-lambda-table append-files-with-open-stream 2) (do (update-lambda-table file.read&write 2) (do (update-lambda-table file.read&write-h 3) (do (update-lambda-table reopen 1) (do (update-lambda-table copy-file 2) (do (update-lambda-table copy-file-with-open-stream 2) (do (update-lambda-table file-exists? 1) (do (update-lambda-table file-size 1) (do (update-lambda-table file.file-size-loop 3) (do (update-lambda-table ascii 3) (do (update-lambda-table file.scan-bytes 4) (do (update-lambda-table pairoff 2) (do (update-lambda-table assocp 2) (do (update-lambda-table cartprodp 2) (do (update-lambda-table assocp-if 2) (update-lambda-table assocp-if-not 2)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) + +(defun stlib.initialise-macros () (do (shen.record-macro maths.maths-macro (lambda X (maths.maths-macro X))) (do (shen.record-macro numerals.numeral-macro (lambda X (numerals.numeral-macro X))) (do (shen.record-macro string-macros (lambda X (string-macros X))) (do (shen.record-macro vector.vector-macros (lambda X (vector.vector-macros X))) (do (shen.record-macro print.pprint-macro (lambda X (print.pprint-macro X))) (shen.record-macro file.file-macro (lambda X (file.file-macro X))))))))) + +(defun stlib.initialise-synonyms () ()) + +(defun stlib.initialise-datatypes () (do (shen.process-datatype maths.maths (cons _________________ (cons (cons value (cons maths.*seed* ())) (cons : (cons number (cons ; (cons _______________________ (cons (cons value (cons maths.*tolerance* ())) (cons : (cons number (cons ; ()))))))))))) (shen.process-datatype print (cons _______________________________ (cons (cons value (cons print.*indentation* ())) (cons : (cons number (cons ; (cons _______________________________ (cons (cons value (cons print.*linelength* ())) (cons : (cons number (cons ; ()))))))))))))) + +(defun stlib.initialise-types () (do (declare concat* (cons A (cons --> (cons (cons B (cons --> (cons symbol ()))) ())))) (do (declare newv (cons --> (cons symbol ()))) (do (declare set-tolerance (cons number (cons --> (cons number ())))) (do (declare tolerance (cons --> (cons number ()))) (do (declare sq (cons number (cons --> (cons number ())))) (do (declare cube (cons number (cons --> (cons number ())))) (do (declare for (cons number (cons --> (cons (cons (cons number (cons --> (cons boolean ()))) (cons --> (cons (cons (cons number (cons --> (cons (protect A) ()))) (cons --> (cons (cons (cons number (cons --> (cons number ()))) (cons --> (cons (cons (cons (protect A) (cons --> (cons (cons (protect A) (cons --> (cons (protect A) ()))) ()))) (cons --> (cons (protect A) ()))) ()))) ()))) ()))) ())))) (do (declare maths.for-h (cons number (cons --> (cons (cons (cons number (cons --> (cons boolean ()))) (cons --> (cons (cons (cons number (cons --> (cons (protect A) ()))) (cons --> (cons (cons (cons number (cons --> (cons number ()))) (cons --> (cons (cons (cons (protect A) (cons --> (cons (cons (protect A) (cons --> (cons (protect A) ()))) ()))) (cons --> (cons (cons (protect A) (cons --> (cons (protect A) ()))) ()))) ()))) ()))) ()))) ())))) (do (declare maths.lazyfor-and (cons number (cons --> (cons (cons (cons number (cons --> (cons boolean ()))) (cons --> (cons (cons (cons number (cons --> (cons boolean ()))) (cons --> (cons (cons (cons number (cons --> (cons number ()))) (cons --> (cons boolean ()))) ()))) ()))) ())))) (do (declare maths.lazyfor-or (cons number (cons --> (cons (cons (cons number (cons --> (cons boolean ()))) (cons --> (cons (cons (cons number (cons --> (cons boolean ()))) (cons --> (cons (cons (cons number (cons --> (cons number ()))) (cons --> (cons boolean ()))) ()))) ()))) ())))) (do (declare max (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare min (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare expt (cons number (cons --> (cons (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) ())))) (do (declare maths.n->r (cons number (cons --> (cons (cons number (cons --> (cons (cons number (cons * (cons number ()))) ()))) ())))) (do (declare maths.expt-h (cons number (cons --> (cons (cons (cons number (cons * (cons number ()))) (cons --> (cons (cons number (cons --> (cons number ()))) ()))) ())))) (do (declare gcd (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare maths.gcd-help (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare maths.gcd-loop (cons number (cons --> (cons (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) ())))) (do (declare lcd (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare maths.lcd-loop (cons number (cons --> (cons (cons number (cons --> (cons (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) ()))) ())))) (do (declare isqrt (cons number (cons --> (cons number ())))) (do (declare maths.isqrt-loop (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare div (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare modf (cons number (cons --> (cons (cons number (cons * (cons number ()))) ())))) (do (declare floor (cons number (cons --> (cons number ())))) (do (declare maths.rounding-loop (cons symbol (cons --> (cons (cons number (cons --> (cons (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) ()))) ())))) (do (declare maths.float->pair (cons number (cons --> (cons (cons number (cons * (cons number ()))) ())))) (do (declare ceiling (cons number (cons --> (cons number ())))) (do (declare round (cons number (cons --> (cons number ())))) (do (declare mod (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare lcm (cons (cons list (cons number ())) (cons --> (cons number ())))) (do (declare maths.greatest (cons (cons list (cons number ())) (cons --> (cons number ())))) (do (declare maths.lcm-h (cons number (cons --> (cons (cons number (cons --> (cons (cons (cons list (cons number ())) (cons --> (cons number ()))) ()))) ())))) (do (declare maths.lcm? (cons number (cons --> (cons (cons (cons list (cons number ())) (cons --> (cons boolean ()))) ())))) (do (declare random (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare min (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare reseed (cons --> (cons number ()))) (do (declare maths.bbs (cons number (cons --> (cons number ())))) (do (declare ~ (cons number (cons --> (cons number ())))) (do (declare positive? (cons number (cons --> (cons boolean ())))) (do (declare negative? (cons number (cons --> (cons boolean ())))) (do (declare natural? (cons number (cons --> (cons boolean ())))) (do (declare converge (cons (protect A) (cons --> (cons (cons (cons (protect A) (cons --> (cons (protect A) ()))) (cons --> (cons (cons (cons (protect A) (cons --> (cons (cons (protect A) (cons --> (cons boolean ()))) ()))) (cons --> (cons (protect A) ()))) ()))) ())))) (do (declare maths.converge-help (cons (cons (protect A) (cons --> (cons (protect A) ()))) (cons --> (cons (cons (protect A) (cons --> (cons (cons (protect A) (cons --> (cons (cons (cons (protect A) (cons --> (cons (cons (protect A) (cons --> (cons boolean ()))) ()))) (cons --> (cons (protect A) ()))) ()))) ()))) ())))) (do (declare nthrt (cons number (cons --> (cons (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) ())))) (do (declare sqrt (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare maths.compute-nthrt (cons number (cons --> (cons (cons number (cons --> (cons (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) ()))) ())))) (do (declare approx (cons number (cons --> (cons (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) ())))) (do (declare abs (cons number (cons --> (cons number ())))) (do (declare series (cons number (cons --> (cons (cons (cons number (cons --> (cons number ()))) (cons --> (cons (cons number (cons --> (cons (cons (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) (cons --> (cons number ()))) ()))) ()))) ())))) (do (declare maths.series-h (cons number (cons --> (cons (cons number (cons --> (cons (cons (cons number (cons --> (cons number ()))) (cons --> (cons (cons number (cons --> (cons (cons (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) (cons --> (cons number ()))) ()))) ()))) ()))) ())))) (do (declare product (cons number (cons --> (cons (cons (cons number (cons --> (cons number ()))) (cons --> (cons (cons number (cons --> (cons number ()))) ()))) ())))) (do (declare summation (cons number (cons --> (cons (cons (cons number (cons --> (cons number ()))) (cons --> (cons (cons number (cons --> (cons number ()))) ()))) ())))) (do (declare odd? (cons number (cons --> (cons boolean ())))) (do (declare even? (cons number (cons --> (cons boolean ())))) (do (declare maths.compute-sine (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare maths.compute-cos (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare cos (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare sin (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare tan (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare radians (cons number (cons --> (cons number ())))) (do (declare g (cons --> (cons number ()))) (do (declare pi (cons --> (cons number ()))) (do (declare e (cons --> (cons number ()))) (do (declare tan30 (cons --> (cons number ()))) (do (declare cos30 (cons --> (cons number ()))) (do (declare cos45 (cons --> (cons number ()))) (do (declare sin45 (cons --> (cons number ()))) (do (declare sqrt2 (cons --> (cons number ()))) (do (declare tan60 (cons --> (cons number ()))) (do (declare maths.sin60 (cons --> (cons number ()))) (do (declare sin120 (cons --> (cons number ()))) (do (declare tan120 (cons --> (cons number ()))) (do (declare sin135 (cons --> (cons number ()))) (do (declare cos135 (cons --> (cons number ()))) (do (declare cos150 (cons --> (cons number ()))) (do (declare tan150 (cons --> (cons number ()))) (do (declare cos210 (cons --> (cons number ()))) (do (declare tan210 (cons --> (cons number ()))) (do (declare sin225 (cons --> (cons number ()))) (do (declare cos225 (cons --> (cons number ()))) (do (declare sin240 (cons --> (cons number ()))) (do (declare tan240 (cons --> (cons number ()))) (do (declare sin300 (cons --> (cons number ()))) (do (declare tan300 (cons --> (cons number ()))) (do (declare sin315 (cons --> (cons number ()))) (do (declare cos315 (cons --> (cons number ()))) (do (declare cos330 (cons --> (cons number ()))) (do (declare tan330 (cons --> (cons number ()))) (do (declare coth (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare sinh (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare cosh (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare tanh (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare sech (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare csch (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare power (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare factorial (cons number (cons --> (cons number ())))) (do (declare prime? (cons number (cons --> (cons boolean ())))) (do (declare maths.prime-h (cons number (cons --> (cons (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) ())))) (do (declare maths.sign (cons number (cons --> (cons number ())))) (do (declare log (cons number (cons --> (cons (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) ())))) (do (declare loge (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare log2 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare log10 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare maths.log10+ (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (do (declare maths.upto (cons (protect A) (cons --> (cons (cons (cons (protect A) (cons --> (cons boolean ()))) (cons --> (cons (cons (cons (protect A) (cons --> (cons (protect A) ()))) (cons --> (cons (cons (cons (protect B) (cons --> (cons (cons (protect C) (cons --> (cons (protect C) ()))) ()))) (cons --> (cons (cons (protect C) (cons --> (cons (cons (cons (protect A) (cons --> (cons (protect B) ()))) (cons --> (cons (protect C) ()))) ()))) ()))) ()))) ()))) ())))) (do (declare r# (cons number (cons --> (cons (cons number (cons --> (cons rational ()))) ())))) (do (declare rational? (cons A (cons --> (cons boolean ())))) (do (declare numerator (cons rational (cons --> (cons number ())))) (do (declare denominator (cons rational (cons --> (cons number ())))) (do (declare r-op1 (cons (cons number (cons --> (cons number ()))) (cons --> (cons (cons rational (cons --> (cons rational ()))) ())))) (do (declare r-op2 (cons (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) (cons --> (cons (cons rational (cons --> (cons (cons rational (cons --> (cons rational ()))) ()))) ())))) (do (declare r->n (cons rational (cons --> (cons number ())))) (do (declare r->pair (cons rational (cons --> (cons (cons number (cons * (cons number ()))) ())))) (do (declare n->r (cons number (cons --> (cons rational ())))) (do (declare r-reduce (cons rational (cons --> (cons rational ())))) (do (declare rational.r-reduce-help (cons number (cons --> (cons (cons number (cons --> (cons rational ()))) ())))) (do (declare r= (cons rational (cons --> (cons (cons rational (cons --> (cons boolean ()))) ())))) (do (declare r< (cons rational (cons --> (cons (cons rational (cons --> (cons boolean ()))) ())))) (do (declare r> (cons rational (cons --> (cons (cons rational (cons --> (cons boolean ()))) ())))) (do (declare r>= (cons rational (cons --> (cons (cons rational (cons --> (cons boolean ()))) ())))) (do (declare r<= (cons rational (cons --> (cons (cons rational (cons --> (cons boolean ()))) ())))) (do (declare r+ (cons rational (cons --> (cons (cons rational (cons --> (cons rational ()))) ())))) (do (declare r- (cons rational (cons --> (cons (cons rational (cons --> (cons rational ()))) ())))) (do (declare r* (cons rational (cons --> (cons (cons rational (cons --> (cons rational ()))) ())))) (do (declare +-inverse (cons rational (cons --> (cons rational ())))) (do (declare *-inverse (cons rational (cons --> (cons rational ())))) (do (declare r/ (cons rational (cons --> (cons (cons rational (cons --> (cons rational ()))) ())))) (do (declare r-expt (cons rational (cons --> (cons (cons number (cons --> (cons rational ()))) ())))) (do (declare r-approx (cons rational (cons --> (cons (cons number (cons --> (cons rational ()))) ())))) (do (declare rational.approx-r-h (cons number (cons --> (cons (cons number (cons --> (cons (cons number (cons --> (cons rational ()))) ()))) ())))) (do (declare c# (cons number (cons --> (cons (cons number (cons --> (cons complex ()))) ())))) (do (declare complex? (cons A (cons --> (cons boolean ())))) (do (declare real (cons complex (cons --> (cons number ())))) (do (declare imaginary (cons complex (cons --> (cons number ())))) (do (declare c+ (cons complex (cons --> (cons (cons complex (cons --> (cons complex ()))) ())))) (do (declare c- (cons complex (cons --> (cons (cons complex (cons --> (cons complex ()))) ())))) (do (declare c* (cons complex (cons --> (cons (cons complex (cons --> (cons complex ()))) ())))) (do (declare c/ (cons complex (cons --> (cons (cons complex (cons --> (cons complex ()))) ())))) (do (declare radix (cons numeral (cons --> (cons number ())))) (do (declare n#->ns (cons numeral (cons --> (cons (cons list (cons number ())) ())))) (do (declare n#->n (cons numeral (cons --> (cons number ())))) (do (declare n# (cons number (cons --> (cons (cons number (cons --> (cons numeral ()))) ())))) (do (declare numeral? (cons A (cons --> (cons boolean ())))) (do (declare n-op2 (cons (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) (cons --> (cons (cons numeral (cons --> (cons (cons numeral (cons --> (cons (cons number (cons --> (cons numeral ()))) ()))) ()))) ())))) (do (declare n-op1 (cons (cons number (cons --> (cons number ()))) (cons --> (cons (cons numeral (cons --> (cons (cons number (cons --> (cons numeral ()))) ()))) ())))) (do (declare n+ (cons numeral (cons --> (cons (cons numeral (cons --> (cons (cons number (cons --> (cons numeral ()))) ()))) ())))) (do (declare n* (cons numeral (cons --> (cons (cons numeral (cons --> (cons (cons number (cons --> (cons numeral ()))) ()))) ())))) (do (declare n- (cons numeral (cons --> (cons (cons numeral (cons --> (cons (cons number (cons --> (cons numeral ()))) ()))) ())))) (do (declare n/ (cons numeral (cons --> (cons (cons numeral (cons --> (cons (cons number (cons --> (cons numeral ()))) ()))) ())))) (do (declare binary (cons number (cons --> (cons numeral ())))) (do (declare hex (cons number (cons --> (cons numeral ())))) (do (declare octal (cons number (cons --> (cons numeral ())))) (do (declare duodecimal (cons number (cons --> (cons numeral ())))) (do (declare numerals.n->numeral (cons number (cons --> (cons (cons number (cons --> (cons (cons list (cons number ())) ()))) ())))) (do (declare numerals.largest-expt (cons number (cons --> (cons (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) ())))) (do (declare numerals.n-zeros (cons number (cons --> (cons (cons list (cons number ())) ())))) (do (declare numerals.add (cons (cons list (cons number ())) (cons --> (cons (cons (cons list (cons number ())) (cons --> (cons (cons number (cons --> (cons (cons list (cons number ())) ()))) ()))) ())))) (do (declare numerals.add-h (cons (cons list (cons number ())) (cons --> (cons (cons (cons list (cons number ())) (cons --> (cons (cons number (cons --> (cons (cons number (cons --> (cons (cons list (cons number ())) ()))) ()))) ()))) ())))) (do (declare assoc-if (cons (cons (protect A) (cons --> (cons boolean ()))) (cons --> (cons (cons (cons list (cons (cons list (cons (protect A) ())) ())) (cons --> (cons (cons list (cons (protect A) ())) ()))) ())))) (do (declare assoc-if-not (cons (cons (protect A) (cons --> (cons boolean ()))) (cons --> (cons (cons (cons list (cons (cons list (cons (protect A) ())) ())) (cons --> (cons (cons list (cons (protect A) ())) ()))) ())))) (do (declare drop (cons number (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons (cons list (cons (protect A) ())) ()))) ())))) (do (declare drop-last (cons number (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons (cons list (cons (protect A) ())) ()))) ())))) (do (declare index (cons (protect A) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons number ()))) ())))) (do (declare list.index-h (cons (protect A) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons (cons number (cons --> (cons number ()))) ()))) ())))) (do (declare index-last (cons (protect A) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons number ()))) ())))) (do (declare insert (cons number (cons --> (cons (cons (protect A) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons (cons list (cons (protect A) ())) ()))) ()))) ())))) (do (declare remove-duplicates (cons (cons list (cons (protect A) ())) (cons --> (cons (cons list (cons (protect A) ())) ())))) (do (declare trim-left-if (cons (cons (protect A) (cons --> (cons boolean ()))) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons (cons list (cons (protect A) ())) ()))) ())))) (do (declare trim-right-if (cons (cons (protect A) (cons --> (cons boolean ()))) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons (cons list (cons (protect A) ())) ()))) ())))) (do (declare trim-if (cons (cons (protect A) (cons --> (cons boolean ()))) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons (cons list (cons (protect A) ())) ()))) ())))) (do (declare trim-left (cons (cons list (cons (protect A) ())) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons (cons list (cons (protect A) ())) ()))) ())))) (do (declare trim-right (cons (cons list (cons (protect A) ())) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons (cons list (cons (protect A) ())) ()))) ())))) (do (declare trim (cons (cons list (cons (protect A) ())) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons (cons list (cons (protect A) ())) ()))) ())))) (do (declare prefix? (cons (cons list (cons (protect A) ())) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons boolean ()))) ())))) (do (declare infix? (cons (cons list (cons (protect A) ())) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons boolean ()))) ())))) (do (declare suffix? (cons (cons list (cons (protect A) ())) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons boolean ()))) ())))) (do (declare subset? (cons (cons list (cons (protect A) ())) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons boolean ()))) ())))) (do (declare set=? (cons (cons list (cons (protect A) ())) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons boolean ()))) ())))) (do (declare set? (cons (cons list (cons (protect A) ())) (cons --> (cons boolean ())))) (do (declare n-times (cons (protect A) (cons --> (cons (cons number (cons --> (cons (cons list (cons (protect A) ())) ()))) ())))) (do (declare list.n-times-h (cons number (cons --> (cons (cons (protect A) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons (cons list (cons (protect A) ())) ()))) ()))) ())))) (do (declare subbag? (cons (cons list (cons (protect A) ())) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons boolean ()))) ())))) (do (declare bag=? (cons (cons list (cons (protect A) ())) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons boolean ()))) ())))) (do (declare mapc (cons (cons (protect A) (cons --> (cons (protect B) ()))) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons (cons list (cons (protect C) ())) ()))) ())))) (do (declare permute (cons (cons list (cons (protect A) ())) (cons --> (cons (cons list (cons (cons list (cons (protect A) ())) ())) ())))) (do (declare count-if (cons (cons (protect A) (cons --> (cons boolean ()))) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons number ()))) ())))) (do (declare count (cons (protect A) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons number ()))) ())))) (do (declare some? (cons (cons (protect A) (cons --> (cons boolean ()))) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons boolean ()))) ())))) (do (declare every? (cons (cons (protect A) (cons --> (cons boolean ()))) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons boolean ()))) ())))) (do (declare sort (cons (cons (protect A) (cons --> (cons (cons (protect A) (cons --> (cons boolean ()))) ()))) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons (cons list (cons (protect A) ())) ()))) ())))) (do (declare find (cons (cons (protect A) (cons --> (cons boolean ()))) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons (protect A) ()))) ())))) (do (declare foldr (cons (cons (protect A) (cons --> (cons (cons (protect B) (cons --> (cons (protect B) ()))) ()))) (cons --> (cons (cons (protect B) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons (protect B) ()))) ()))) ())))) (do (declare foldl (cons (cons (protect A) (cons --> (cons (cons (protect B) (cons --> (cons (protect A) ()))) ()))) (cons --> (cons (cons (protect A) (cons --> (cons (cons (cons list (cons (protect B) ())) (cons --> (cons (protect A) ()))) ()))) ())))) (do (declare mapf (cons (cons (protect A) (cons --> (cons (protect B) ()))) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons (cons (cons (protect B) (cons --> (cons (cons (cons list (cons (protect C) ())) (cons --> (cons (cons list (cons (protect C) ())) ()))) ()))) (cons --> (cons (cons list (cons (protect C) ())) ()))) ()))) ())))) (do (declare filter (cons (cons (protect A) (cons --> (cons boolean ()))) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons (cons list (cons (protect A) ())) ()))) ())))) (do (declare remove-if (cons (cons (protect A) (cons --> (cons boolean ()))) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons (cons list (cons (protect A) ())) ()))) ())))) (do (declare list.reduce (cons (cons (protect A) (cons --> (cons (cons (protect B) (cons --> (cons (protect A) ()))) ()))) (cons --> (cons (cons (protect A) (cons --> (cons (cons (cons list (cons (protect B) ())) (cons --> (cons (protect A) ()))) ()))) ())))) (do (declare take (cons number (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons (cons list (cons (protect A) ())) ()))) ())))) (do (declare take-last (cons number (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons (cons list (cons (protect A) ())) ()))) ())))) (do (declare cartprod (cons (cons list (cons (protect A) ())) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons (cons list (cons (cons list (cons (protect A) ())) ())) ()))) ())))) (do (declare powerset (cons (cons list (cons (protect A) ())) (cons --> (cons (cons list (cons (cons list (cons (protect A) ())) ())) ())))) (do (declare partition (cons (cons (protect A) (cons --> (cons (cons (protect A) (cons --> (cons boolean ()))) ()))) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons (cons list (cons (cons list (cons (protect A) ())) ())) ()))) ())))) (do (declare transitive-closure (cons (cons list (cons (cons (protect A) (cons * (cons (protect A) ()))) ())) (cons --> (cons (cons list (cons (cons (protect A) (cons * (cons (protect A) ()))) ())) ())))) (do (declare list.transitive-pass (cons (cons list (cons (cons (protect A) (cons * (cons (protect A) ()))) ())) (cons --> (cons (cons (cons list (cons (cons (protect A) (cons * (cons (protect A) ()))) ())) (cons --> (cons (cons list (cons (cons (protect A) (cons * (cons (protect A) ()))) ())) ()))) ())))) (do (declare list.find-trans (cons (protect A) (cons --> (cons (cons (protect A) (cons --> (cons (cons (cons list (cons (cons (protect A) (cons * (cons (protect A) ()))) ())) (cons --> (cons (cons list (cons (cons (protect A) (cons * (cons (protect A) ()))) ())) ()))) ()))) ())))) (do (declare x->ascii (cons (protect A) (cons --> (cons (cons list (cons number ())) ())))) (do (declare splice (cons number (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons (cons (cons list (cons (protect A) ())) (cons --> (cons (cons list (cons (protect A) ())) ()))) ()))) ())))) (do (declare string->list (cons string (cons --> (cons (cons list (cons string ())) ())))) (do (declare string.s->l-h (cons string (cons --> (cons (cons number (cons --> (cons (cons string (cons --> (cons (cons (cons list (cons string ())) (cons --> (cons (cons list (cons string ())) ()))) ()))) ()))) ())))) (do (declare list->string (cons (cons list (cons string ())) (cons --> (cons string ())))) (do (declare s-op1 (cons (cons (cons list (cons string ())) (cons --> (cons (protect A) ()))) (cons --> (cons (cons string (cons --> (cons (cons (cons (protect A) (cons --> (cons (protect B) ()))) (cons --> (cons (protect B) ()))) ()))) ())))) (do (declare s-op2 (cons (cons (cons list (cons string ())) (cons --> (cons (cons (cons list (cons string ())) (cons --> (cons (protect A) ()))) ()))) (cons --> (cons (cons string (cons --> (cons (cons string (cons --> (cons (cons (cons (protect A) (cons --> (cons (protect B) ()))) (cons --> (cons (protect B) ()))) ()))) ()))) ())))) (do (declare string.count (cons string (cons --> (cons (cons string (cons --> (cons number ()))) ())))) (do (declare string.reverse (cons string (cons --> (cons string ())))) (do (declare string.element? (cons string (cons --> (cons (cons string (cons --> (cons boolean ()))) ())))) (do (declare string.prefix? (cons string (cons --> (cons (cons string (cons --> (cons boolean ()))) ())))) (do (declare string.infix? (cons string (cons --> (cons (cons string (cons --> (cons boolean ()))) ())))) (do (declare string.suffix? (cons string (cons --> (cons (cons string (cons --> (cons boolean ()))) ())))) (do (declare string.subset? (cons string (cons --> (cons (cons string (cons --> (cons boolean ()))) ())))) (do (declare string.set=? (cons string (cons --> (cons (cons string (cons --> (cons boolean ()))) ())))) (do (declare string.set? (cons string (cons --> (cons boolean ())))) (do (declare file-extension (cons string (cons --> (cons (cons string (cons --> (cons string ()))) ())))) (do (declare strip-extension (cons string (cons --> (cons string ())))) (do (declare string.length (cons string (cons --> (cons number ())))) (do (declare string.trim (cons (cons list (cons string ())) (cons --> (cons (cons string (cons --> (cons string ()))) ())))) (do (declare string.trim-if (cons (cons string (cons --> (cons boolean ()))) (cons --> (cons (cons string (cons --> (cons string ()))) ())))) (do (declare string.trim-right-if (cons (cons string (cons --> (cons boolean ()))) (cons --> (cons (cons string (cons --> (cons string ()))) ())))) (do (declare string.trim-left-if (cons (cons string (cons --> (cons boolean ()))) (cons --> (cons (cons string (cons --> (cons string ()))) ())))) (do (declare string.trim-right (cons (cons list (cons string ())) (cons --> (cons (cons string (cons --> (cons string ()))) ())))) (do (declare string.trim-left (cons (cons list (cons string ())) (cons --> (cons (cons string (cons --> (cons string ()))) ())))) (do (declare string.some? (cons (cons string (cons --> (cons boolean ()))) (cons --> (cons (cons string (cons --> (cons boolean ()))) ())))) (do (declare string.every? (cons (cons string (cons --> (cons boolean ()))) (cons --> (cons (cons string (cons --> (cons boolean ()))) ())))) (do (declare string.difference (cons string (cons --> (cons (cons string (cons --> (cons string ()))) ())))) (do (declare string.intersection (cons string (cons --> (cons (cons string (cons --> (cons string ()))) ())))) (do (declare string.nth (cons number (cons --> (cons (cons string (cons --> (cons string ()))) ())))) (do (declare whitespace? (cons string (cons --> (cons boolean ())))) (do (declare uppercase? (cons string (cons --> (cons boolean ())))) (do (declare lowercase? (cons string (cons --> (cons boolean ())))) (do (declare digit? (cons string (cons --> (cons boolean ())))) (do (declare alpha? (cons string (cons --> (cons boolean ())))) (do (declare alphanum? (cons string (cons --> (cons boolean ())))) (do (declare tokenise (cons (cons string (cons --> (cons boolean ()))) (cons --> (cons (cons string (cons --> (cons (cons list (cons string ())) ()))) ())))) (do (declare string.tokenise-h (cons (cons string (cons --> (cons boolean ()))) (cons --> (cons (cons string (cons --> (cons (cons string (cons --> (cons (cons list (cons string ())) ()))) ()))) ())))) (do (declare uppercase (cons string (cons --> (cons string ())))) (do (declare lowercase (cons string (cons --> (cons string ())))) (do (declare string.map (cons (cons string (cons --> (cons string ()))) (cons --> (cons (cons string (cons --> (cons string ()))) ())))) (do (declare spell-number (cons number (cons --> (cons string ())))) (do (declare string.digit (cons string (cons --> (cons string ())))) (do (declare string.triples (cons (cons list (cons (protect A) ())) (cons --> (cons (cons list (cons (cons list (cons (protect A) ())) ())) ())))) (do (declare string.triples-h (cons (cons list (cons (protect A) ())) (cons --> (cons (cons (cons list (cons (cons list (cons (protect A) ())) ())) (cons --> (cons (cons list (cons (cons list (cons (protect A) ())) ())) ()))) ())))) (do (declare string.digits (cons (cons list (cons string ())) (cons --> (cons string ())))) (do (declare string.tens (cons string (cons --> (cons (cons string (cons --> (cons string ()))) ())))) (do (declare string.scale (cons (cons list (cons string ())) (cons --> (cons string ())))) (do (declare string.units (cons number (cons --> (cons string ())))) (do (declare string>? (cons string (cons --> (cons (cons string (cons --> (cons boolean ()))) ())))) (do (declare string (cons (cons string (cons --> (cons boolean ()))) ())))) (do (declare string>=? (cons string (cons --> (cons (cons string (cons --> (cons boolean ()))) ())))) (do (declare string<=? (cons string (cons --> (cons (cons string (cons --> (cons boolean ()))) ())))) (do (declare render (cons string (cons --> (cons string ())))) (do (declare render-file (cons string (cons --> (cons (cons string (cons --> (cons string ()))) ())))) (do (declare linelength (cons --> (cons number ()))) (do (declare indentation (cons --> (cons number ()))) (do (declare set-linelength (cons number (cons --> (cons number ())))) (do (declare set-indentation (cons number (cons --> (cons number ())))) (do (declare pps (cons symbol (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons symbol ()))) ())))) (do (declare pprint (cons (protect A) (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons (protect A) ()))) ())))) (do (declare pretty-string (cons string (cons --> (cons string ())))) (do (declare print.pretty-string-h (cons string (cons --> (cons (cons number (cons --> (cons (cons number (cons --> (cons string ()))) ()))) ())))) (do (declare print.indent (cons number (cons --> (cons string ())))) (do (declare print.indent-h (cons number (cons --> (cons string ())))) (do (declare print.n-space (cons number (cons --> (cons string ())))) (do (declare delete-file (cons string (cons --> (cons (cons list (cons A ())) ())))) (do (declare append-files (cons (cons list (cons string ())) (cons --> (cons (cons string (cons --> (cons string ()))) ())))) (do (declare append-files-with-open-stream (cons (cons list (cons string ())) (cons --> (cons (cons string (cons --> (cons (cons stream (cons out ())) ()))) ())))) (do (declare file.read&write (cons (cons stream (cons in ())) (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons number ()))) ())))) (do (declare file.read&write-h (cons number (cons --> (cons (cons (cons stream (cons in ())) (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons number ()))) ()))) ())))) (do (declare reopen (cons string (cons --> (cons (cons stream (cons out ())) ())))) (do (declare copy-file (cons string (cons --> (cons (cons string (cons --> (cons string ()))) ())))) (do (declare copy-file-with-open-stream (cons string (cons --> (cons (cons string (cons --> (cons (cons stream (cons out ())) ()))) ())))) (do (declare file-exists? (cons string (cons --> (cons boolean ())))) (do (declare file-size (cons string (cons --> (cons number ())))) (do (declare file.file-size-loop (cons (cons stream (cons in ())) (cons --> (cons (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) ())))) (do (declare ascii (cons number (cons --> (cons (cons number (cons --> (cons (cons string (cons --> (cons string ()))) ()))) ())))) (do (declare file.scan-bytes (cons number (cons --> (cons (cons number (cons --> (cons (cons (cons list (cons number ())) (cons --> (cons (cons string (cons --> (cons string ()))) ()))) ()))) ())))) (do (declare pairoff (cons (cons list (cons (protect A) ())) (cons --> (cons (cons (cons list (cons (protect B) ())) (cons --> (cons (cons list (cons (cons (protect A) (cons * (cons (protect B) ()))) ())) ()))) ())))) (do (declare assocp (cons (protect A) (cons --> (cons (cons (cons list (cons (cons (protect A) (cons * (cons (protect B) ()))) ())) (cons --> (cons (cons (protect A) (cons * (cons (protect B) ()))) ()))) ())))) (do (declare cartprodp (cons (cons list (cons (protect A) ())) (cons --> (cons (cons (cons list (cons (protect B) ())) (cons --> (cons (cons list (cons (cons (protect A) (cons * (cons (protect B) ()))) ())) ()))) ())))) (do (declare assocp-if (cons (cons (protect A) (cons --> (cons boolean ()))) (cons --> (cons (cons (cons list (cons (cons (protect A) (cons * (cons (protect B) ()))) ())) (cons --> (cons (cons (protect A) (cons * (cons (protect B) ()))) ()))) ())))) (declare assocp-if-not (cons (cons (protect A) (cons --> (cons boolean ()))) (cons --> (cons (cons (cons list (cons (cons (protect A) (cons * (cons (protect B) ()))) ())) (cons --> (cons (cons (protect A) (cons * (cons (protect B) ()))) ()))) ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) + +(defun stlib.initialise-sources () (do (shen.record-kl concat* (cons defun (cons concat* (cons (cons (protect V3) (cons (protect V4) ())) (cons (cons let (cons (protect W5) (cons (cons concat (cons (protect V3) (cons (protect V4) ()))) (cons (cons if (cons (cons symbol? (cons (protect W5) ())) (cons (protect W5) (cons (cons simple-error (cons (cons cn (cons "'" (cons (cons shen.app (cons (protect W5) (cons "' is not a symbol +" (cons shen.a ())))) ()))) ())) ())))) ())))) ()))))) (do (shen.record-kl newv (cons defun (cons newv (cons () (cons (cons gensym (cons (protect X) ())) ()))))) (do (shen.record-kl maths.maths-macro (cons defun (cons maths.maths-macro (cons (cons (protect V15) ()) (cons (cons let (cons (protect GoTo16) (cons (cons freeze (cons (protect V15) ())) (cons (cons if (cons (cons cons? (cons (protect V15) ())) (cons (cons let (cons (protect Select30) (cons (cons hd (cons (protect V15) ())) (cons (cons let (cons (protect Select31) (cons (cons tl (cons (protect V15) ())) (cons (cons if (cons (cons and (cons (cons = (cons log10 (cons (protect Select30) ()))) (cons (cons and (cons (cons cons? (cons (protect Select31) ())) (cons (cons = (cons () (cons (cons tl (cons (protect Select31) ())) ()))) ()))) ()))) (cons (cons cons (cons log10 (cons (cons cons (cons (cons hd (cons (protect Select31) ())) (cons (cons cons (cons (cons cons (cons tolerance (cons () ()))) (cons () ()))) ()))) ()))) (cons (cons if (cons (cons and (cons (cons = (cons log2 (cons (protect Select30) ()))) (cons (cons and (cons (cons cons? (cons (protect Select31) ())) (cons (cons = (cons () (cons (cons tl (cons (protect Select31) ())) ()))) ()))) ()))) (cons (cons cons (cons log2 (cons (cons cons (cons (cons hd (cons (protect Select31) ())) (cons (cons cons (cons (cons cons (cons tolerance (cons () ()))) (cons () ()))) ()))) ()))) (cons (cons if (cons (cons and (cons (cons = (cons loge (cons (protect Select30) ()))) (cons (cons and (cons (cons cons? (cons (protect Select31) ())) (cons (cons = (cons () (cons (cons tl (cons (protect Select31) ())) ()))) ()))) ()))) (cons (cons cons (cons loge (cons (cons cons (cons (cons hd (cons (protect Select31) ())) (cons (cons cons (cons (cons cons (cons tolerance (cons () ()))) (cons () ()))) ()))) ()))) (cons (cons if (cons (cons and (cons (cons = (cons log (cons (protect Select30) ()))) (cons (cons and (cons (cons cons? (cons (protect Select31) ())) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect Select31) ())) ())) (cons (cons = (cons () (cons (cons tl (cons (cons tl (cons (protect Select31) ())) ())) ()))) ()))) ()))) ()))) (cons (cons cons (cons log (cons (cons cons (cons (cons hd (cons (protect Select31) ())) (cons (cons cons (cons (cons hd (cons (cons tl (cons (protect Select31) ())) ())) (cons (cons cons (cons (cons cons (cons tolerance (cons () ()))) (cons () ()))) ()))) ()))) ()))) (cons (cons if (cons (cons and (cons (cons = (cons sin (cons (protect Select30) ()))) (cons (cons and (cons (cons cons? (cons (protect Select31) ())) (cons (cons = (cons () (cons (cons tl (cons (protect Select31) ())) ()))) ()))) ()))) (cons (cons cons (cons sin (cons (cons cons (cons (cons hd (cons (protect Select31) ())) (cons (cons cons (cons (cons cons (cons tolerance (cons () ()))) (cons () ()))) ()))) ()))) (cons (cons if (cons (cons and (cons (cons = (cons tan (cons (protect Select30) ()))) (cons (cons and (cons (cons cons? (cons (protect Select31) ())) (cons (cons = (cons () (cons (cons tl (cons (protect Select31) ())) ()))) ()))) ()))) (cons (cons cons (cons tan (cons (cons cons (cons (cons hd (cons (protect Select31) ())) (cons (cons cons (cons (cons cons (cons tolerance (cons () ()))) (cons () ()))) ()))) ()))) (cons (cons if (cons (cons and (cons (cons = (cons cos (cons (protect Select30) ()))) (cons (cons and (cons (cons cons? (cons (protect Select31) ())) (cons (cons = (cons () (cons (cons tl (cons (protect Select31) ())) ()))) ()))) ()))) (cons (cons cons (cons cos (cons (cons cons (cons (cons hd (cons (protect Select31) ())) (cons (cons cons (cons (cons cons (cons tolerance (cons () ()))) (cons () ()))) ()))) ()))) (cons (cons if (cons (cons and (cons (cons = (cons tanh (cons (protect Select30) ()))) (cons (cons and (cons (cons cons? (cons (protect Select31) ())) (cons (cons = (cons () (cons (cons tl (cons (protect Select31) ())) ()))) ()))) ()))) (cons (cons cons (cons tanh (cons (cons cons (cons (cons hd (cons (protect Select31) ())) (cons (cons cons (cons (cons cons (cons tolerance (cons () ()))) (cons () ()))) ()))) ()))) (cons (cons if (cons (cons and (cons (cons = (cons cosh (cons (protect Select30) ()))) (cons (cons and (cons (cons cons? (cons (protect Select31) ())) (cons (cons = (cons () (cons (cons tl (cons (protect Select31) ())) ()))) ()))) ()))) (cons (cons cons (cons cosh (cons (cons cons (cons (cons hd (cons (protect Select31) ())) (cons (cons cons (cons (cons cons (cons tolerance (cons () ()))) (cons () ()))) ()))) ()))) (cons (cons if (cons (cons and (cons (cons = (cons sinh (cons (protect Select30) ()))) (cons (cons and (cons (cons cons? (cons (protect Select31) ())) (cons (cons = (cons () (cons (cons tl (cons (protect Select31) ())) ()))) ()))) ()))) (cons (cons cons (cons sinh (cons (cons cons (cons (cons hd (cons (protect Select31) ())) (cons (cons cons (cons (cons cons (cons tolerance (cons () ()))) (cons () ()))) ()))) ()))) (cons (cons if (cons (cons and (cons (cons = (cons sech (cons (protect Select30) ()))) (cons (cons and (cons (cons cons? (cons (protect Select31) ())) (cons (cons = (cons () (cons (cons tl (cons (protect Select31) ())) ()))) ()))) ()))) (cons (cons cons (cons sech (cons (cons cons (cons (cons hd (cons (protect Select31) ())) (cons (cons cons (cons (cons cons (cons tolerance (cons () ()))) (cons () ()))) ()))) ()))) (cons (cons if (cons (cons and (cons (cons = (cons csch (cons (protect Select30) ()))) (cons (cons and (cons (cons cons? (cons (protect Select31) ())) (cons (cons = (cons () (cons (cons tl (cons (protect Select31) ())) ()))) ()))) ()))) (cons (cons cons (cons csch (cons (cons cons (cons (cons hd (cons (protect Select31) ())) (cons (cons cons (cons (cons cons (cons tolerance (cons () ()))) (cons () ()))) ()))) ()))) (cons (cons if (cons (cons and (cons (cons = (cons coth (cons (protect Select30) ()))) (cons (cons and (cons (cons cons? (cons (protect Select31) ())) (cons (cons = (cons () (cons (cons tl (cons (protect Select31) ())) ()))) ()))) ()))) (cons (cons cons (cons coth (cons (cons cons (cons (cons hd (cons (protect Select31) ())) (cons (cons cons (cons (cons cons (cons tolerance (cons () ()))) (cons () ()))) ()))) ()))) (cons (cons if (cons (cons and (cons (cons = (cons nthrt (cons (protect Select30) ()))) (cons (cons and (cons (cons cons? (cons (protect Select31) ())) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect Select31) ())) ())) (cons (cons = (cons () (cons (cons tl (cons (cons tl (cons (protect Select31) ())) ())) ()))) ()))) ()))) ()))) (cons (cons cons (cons nthrt (cons (cons cons (cons (cons hd (cons (protect Select31) ())) (cons (cons cons (cons (cons hd (cons (cons tl (cons (protect Select31) ())) ())) (cons (cons cons (cons (cons cons (cons tolerance (cons () ()))) (cons () ()))) ()))) ()))) ()))) (cons (cons if (cons (cons and (cons (cons = (cons sqrt (cons (protect Select30) ()))) (cons (cons and (cons (cons cons? (cons (protect Select31) ())) (cons (cons = (cons () (cons (cons tl (cons (protect Select31) ())) ()))) ()))) ()))) (cons (cons cons (cons sqrt (cons (cons cons (cons (cons hd (cons (protect Select31) ())) (cons (cons cons (cons (cons cons (cons tolerance (cons () ()))) (cons () ()))) ()))) ()))) (cons (cons if (cons (cons and (cons (cons = (cons expt (cons (protect Select30) ()))) (cons (cons and (cons (cons cons? (cons (protect Select31) ())) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect Select31) ())) ())) (cons (cons = (cons () (cons (cons tl (cons (cons tl (cons (protect Select31) ())) ())) ()))) ()))) ()))) ()))) (cons (cons cons (cons expt (cons (cons cons (cons (cons hd (cons (protect Select31) ())) (cons (cons cons (cons (cons hd (cons (cons tl (cons (protect Select31) ())) ())) (cons (cons cons (cons (cons cons (cons tolerance (cons () ()))) (cons () ()))) ()))) ()))) ()))) (cons (cons if (cons (cons and (cons (cons = (cons max (cons (protect Select30) ()))) (cons (cons and (cons (cons cons? (cons (protect Select31) ())) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect Select31) ())) ())) (cons (cons cons? (cons (cons tl (cons (cons tl (cons (protect Select31) ())) ())) ())) ()))) ()))) ()))) (cons (cons cons (cons max (cons (cons cons (cons (cons hd (cons (protect Select31) ())) (cons (cons cons (cons (cons cons (cons max (cons (cons tl (cons (protect Select31) ())) ()))) (cons () ()))) ()))) ()))) (cons (cons if (cons (cons and (cons (cons = (cons min (cons (protect Select30) ()))) (cons (cons and (cons (cons cons? (cons (protect Select31) ())) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect Select31) ())) ())) (cons (cons cons? (cons (cons tl (cons (cons tl (cons (protect Select31) ())) ())) ())) ()))) ()))) ()))) (cons (cons cons (cons min (cons (cons cons (cons (cons hd (cons (protect Select31) ())) (cons (cons cons (cons (cons cons (cons min (cons (cons tl (cons (protect Select31) ())) ()))) (cons () ()))) ()))) ()))) (cons (cons if (cons (cons and (cons (cons = (cons tolerance (cons (protect Select30) ()))) (cons (cons and (cons (cons cons? (cons (protect Select31) ())) (cons (cons = (cons () (cons (cons tl (cons (protect Select31) ())) ()))) ()))) ()))) (cons (cons cons (cons maths.tolerance=n (cons (protect Select31) ()))) (cons (cons if (cons (cons = (cons for (cons (protect Select30) ()))) (cons (cons if (cons (cons cons? (cons (protect Select31) ())) (cons (cons let (cons (protect Select28) (cons (cons hd (cons (protect Select31) ())) (cons (cons let (cons (protect Select29) (cons (cons tl (cons (protect Select31) ())) (cons (cons if (cons (cons cons? (cons (protect Select29) ())) (cons (cons let (cons (protect Select27) (cons (cons tl (cons (protect Select29) ())) (cons (cons if (cons (cons = (cons = (cons (cons hd (cons (protect Select29) ())) ()))) (cons (cons if (cons (cons cons? (cons (protect Select27) ())) (cons (cons let (cons (protect Select25) (cons (cons hd (cons (protect Select27) ())) (cons (cons let (cons (protect Select26) (cons (cons tl (cons (protect Select27) ())) (cons (cons if (cons (cons cons? (cons (protect Select26) ())) (cons (cons let (cons (protect Select23) (cons (cons hd (cons (protect Select26) ())) (cons (cons let (cons (protect Select24) (cons (cons tl (cons (protect Select26) ())) (cons (cons if (cons (cons and (cons (cons = (cons stop (cons (protect Select23) ()))) (cons (cons cons? (cons (protect Select24) ())) ()))) (cons (cons cons (cons maths.upto (cons (cons cons (cons (protect Select25) (cons (cons cons (cons (cons hd (cons (protect Select24) ())) (cons (cons maths.process-options (cons (protect Select28) (cons (cons tl (cons (protect Select24) ())) ()))) ()))) ()))) ()))) (cons (cons if (cons (cons and (cons (cons = (cons to (cons (protect Select23) ()))) (cons (cons cons? (cons (protect Select24) ())) ()))) (cons (cons cons (cons maths.upto (cons (cons cons (cons (protect Select25) (cons (cons cons (cons (cons cons (cons < (cons (cons cons (cons (cons hd (cons (protect Select24) ())) (cons () ()))) ()))) (cons (cons maths.process-options (cons (protect Select28) (cons (cons tl (cons (protect Select24) ())) ()))) ()))) ()))) ()))) (cons (cons thaw (cons (protect GoTo16) ())) ())))) ())))) ())))) ())))) (cons (cons thaw (cons (protect GoTo16) ())) ())))) ())))) ())))) (cons (cons thaw (cons (protect GoTo16) ())) ())))) (cons (cons thaw (cons (protect GoTo16) ())) ())))) ())))) (cons (cons thaw (cons (protect GoTo16) ())) ())))) ())))) ())))) (cons (cons thaw (cons (protect GoTo16) ())) ())))) (cons (cons thaw (cons (protect GoTo16) ())) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) (cons (cons thaw (cons (protect GoTo16) ())) ())))) ())))) ()))))) (do (shen.record-kl maths.process-options (cons defun (cons maths.process-options (cons (cons (protect V33) (cons (protect V34) ())) (cons (cons append (cons (cons maths.step-option (cons (protect V34) ())) (cons (cons append (cons (cons maths.constructor-option (cons (protect V34) ())) (cons (cons append (cons (cons maths.end-option (cons (protect V34) ())) (cons (cons maths.process (cons (protect V33) (cons (protect V34) ()))) ()))) ()))) ()))) ()))))) (do (shen.record-kl maths.step-option (cons defun (cons maths.step-option (cons (cons (protect V41) ()) (cons (cons if (cons (cons = (cons () (cons (protect V41) ()))) (cons (cons cons (cons (cons cons (cons + (cons (cons cons (cons 1 (cons () ()))) ()))) (cons () ()))) (cons (cons let (cons (protect GoTo42) (cons (cons freeze (cons (cons shen.f-error (cons maths.step-option ())) ())) (cons (cons if (cons (cons cons? (cons (protect V41) ())) (cons (cons let (cons (protect Select43) (cons (cons tl (cons (protect V41) ())) (cons (cons if (cons (cons and (cons (cons = (cons step (cons (cons hd (cons (protect V41) ())) ()))) (cons (cons cons? (cons (protect Select43) ())) ()))) (cons (cons cons (cons (cons hd (cons (protect Select43) ())) (cons () ()))) (cons (cons maths.step-option (cons (protect Select43) ())) ())))) ())))) (cons (cons thaw (cons (protect GoTo42) ())) ())))) ())))) ())))) ()))))) (do (shen.record-kl maths.constructor-option (cons defun (cons maths.constructor-option (cons (cons (protect V49) ()) (cons (cons if (cons (cons = (cons () (cons (protect V49) ()))) (cons (cons cons (cons (cons cons (cons fn (cons (cons cons (cons do (cons () ()))) ()))) (cons () ()))) (cons (cons let (cons (protect GoTo50) (cons (cons freeze (cons (cons shen.f-error (cons maths.constructor-option ())) ())) (cons (cons if (cons (cons cons? (cons (protect V49) ())) (cons (cons let (cons (protect Select51) (cons (cons tl (cons (protect V49) ())) (cons (cons if (cons (cons and (cons (cons = (cons constructor (cons (cons hd (cons (protect V49) ())) ()))) (cons (cons cons? (cons (protect Select51) ())) ()))) (cons (cons cons (cons (cons hd (cons (protect Select51) ())) (cons () ()))) (cons (cons maths.constructor-option (cons (protect Select51) ())) ())))) ())))) (cons (cons thaw (cons (protect GoTo50) ())) ())))) ())))) ())))) ()))))) (do (shen.record-kl maths.end-option (cons defun (cons maths.end-option (cons (cons (protect V57) ()) (cons (cons if (cons (cons = (cons () (cons (protect V57) ()))) (cons (cons cons (cons done (cons () ()))) (cons (cons let (cons (protect GoTo58) (cons (cons freeze (cons (cons shen.f-error (cons maths.end-option ())) ())) (cons (cons if (cons (cons cons? (cons (protect V57) ())) (cons (cons let (cons (protect Select59) (cons (cons tl (cons (protect V57) ())) (cons (cons if (cons (cons and (cons (cons = (cons end (cons (cons hd (cons (protect V57) ())) ()))) (cons (cons cons? (cons (protect Select59) ())) ()))) (cons (cons cons (cons (cons hd (cons (protect Select59) ())) (cons () ()))) (cons (cons maths.end-option (cons (protect Select59) ())) ())))) ())))) (cons (cons thaw (cons (protect GoTo58) ())) ())))) ())))) ())))) ()))))) (do (shen.record-kl maths.process (cons defun (cons maths.process (cons (cons (protect V63) (cons (protect V64) ())) (cons (cons let (cons (protect GoTo65) (cons (cons freeze (cons (cons shen.f-error (cons maths.process ())) ())) (cons (cons if (cons (cons cons? (cons (protect V64) ())) (cons (cons let (cons (protect Select66) (cons (cons tl (cons (protect V64) ())) (cons (cons if (cons (cons = (cons () (cons (protect Select66) ()))) (cons (cons cons (cons (cons cons (cons /. (cons (cons cons (cons (protect V63) (cons (protect V64) ()))) ()))) (cons () ()))) (cons (cons maths.process (cons (protect V63) (cons (protect Select66) ()))) ())))) ())))) (cons (cons thaw (cons (protect GoTo65) ())) ())))) ())))) ()))))) (do (shen.record-kl set-tolerance (cons defun (cons set-tolerance (cons (cons (protect V299) ()) (cons (cons set (cons maths.*tolerance* (cons (protect V299) ()))) ()))))) (do (shen.record-kl tolerance (cons defun (cons tolerance (cons () (cons (cons value (cons maths.*tolerance* ())) ()))))) (do (shen.record-kl sq (cons defun (cons sq (cons (cons (protect V301) ()) (cons (cons * (cons (protect V301) (cons (protect V301) ()))) ()))))) (do (shen.record-kl cube (cons defun (cons cube (cons (cons (protect V303) ()) (cons (cons * (cons (protect V303) (cons (cons * (cons (protect V303) (cons (protect V303) ()))) ()))) ()))))) (do (shen.record-kl for (cons defun (cons for (cons (cons (protect V305) (cons (protect V306) (cons (protect V307) (cons (protect V308) (cons (protect V309) ()))))) (cons (cons maths.for-h (cons (cons (protect V308) (cons (protect V305) ())) (cons (protect V306) (cons (protect V307) (cons (protect V308) (cons (protect V309) (cons (cons (protect V307) (cons (protect V305) ())) ()))))))) ()))))) (do (shen.record-kl maths.for-h (cons defun (cons maths.for-h (cons (cons (protect V318) (cons (protect V319) (cons (protect V320) (cons (protect V321) (cons (protect V322) (cons (protect V323) ())))))) (cons (cons cond (cons (cons (cons not (cons (cons (protect V319) (cons (protect V318) ())) ())) (cons (protect V323) ())) (cons (cons true (cons (cons maths.for-h (cons (cons (protect V321) (cons (protect V318) ())) (cons (protect V319) (cons (protect V320) (cons (protect V321) (cons (protect V322) (cons (cons (cons (protect V322) (cons (protect V323) ())) (cons (cons (protect V320) (cons (protect V318) ())) ())) ()))))))) ())) ()))) ()))))) (do (shen.record-kl maths.lazyfor-and (cons defun (cons maths.lazyfor-and (cons (cons (protect V340) (cons (protect V341) (cons (protect V342) (cons (protect V343) ())))) (cons (cons cond (cons (cons (cons not (cons (cons (protect V341) (cons (protect V340) ())) ())) (cons true ())) (cons (cons (cons (protect V342) (cons (protect V340) ())) (cons (cons maths.lazyfor-and (cons (cons (protect V343) (cons (protect V340) ())) (cons (protect V341) (cons (protect V342) (cons (protect V343) ()))))) ())) (cons (cons true (cons false ())) ())))) ()))))) (do (shen.record-kl maths.lazyfor-or (cons defun (cons maths.lazyfor-or (cons (cons (protect V350) (cons (protect V351) (cons (protect V352) (cons (protect V353) ())))) (cons (cons cond (cons (cons (cons not (cons (cons (protect V351) (cons (protect V350) ())) ())) (cons false ())) (cons (cons (cons (protect V352) (cons (protect V350) ())) (cons true ())) (cons (cons true (cons (cons maths.lazyfor-or (cons (cons (protect V353) (cons (protect V350) ())) (cons (protect V351) (cons (protect V352) (cons (protect V353) ()))))) ())) ())))) ()))))) (do (shen.record-kl max (cons defun (cons max (cons (cons (protect V360) (cons (protect V361) ())) (cons (cons cond (cons (cons (cons > (cons (protect V361) (cons (protect V360) ()))) (cons (protect V361) ())) (cons (cons true (cons (protect V360) ())) ()))) ()))))) (do (shen.record-kl min (cons defun (cons min (cons (cons (protect V366) (cons (protect V367) ())) (cons (cons cond (cons (cons (cons < (cons (protect V367) (cons (protect V366) ()))) (cons (protect V367) ())) (cons (cons true (cons (protect V366) ())) ()))) ()))))) (do (shen.record-kl expt (cons defun (cons expt (cons (cons (protect V370) (cons (protect V371) (cons (protect V372) ()))) (cons (cons if (cons (cons = (cons (protect V371) (cons 0 ()))) (cons 1 (cons (cons if (cons (cons positive? (cons (protect V371) ())) (cons (cons maths.expt-h (cons (protect V370) (cons (cons maths.n->r (cons (protect V371) (cons 1 ()))) (cons (protect V372) ())))) (cons (cons / (cons 1 (cons (cons maths.expt-h (cons (protect V370) (cons (cons maths.n->r (cons (cons ~ (cons (protect V371) ())) (cons 1 ()))) (cons (protect V372) ())))) ()))) ())))) ())))) ()))))) (do (shen.record-kl maths.n->r (cons defun (cons maths.n->r (cons (cons (protect V376) (cons (protect V377) ())) (cons (cons cond (cons (cons (cons integer? (cons (protect V376) ())) (cons (cons @p (cons (protect V376) (cons (protect V377) ()))) ())) (cons (cons true (cons (cons maths.n->r (cons (cons * (cons (protect V376) (cons 10 ()))) (cons (cons * (cons (protect V377) (cons 10 ()))) ()))) ())) ()))) ()))))) (do (shen.record-kl maths.expt-h (cons defun (cons maths.expt-h (cons (cons (protect V380) (cons (protect V381) (cons (protect V382) ()))) (cons (cons cond (cons (cons (cons tuple? (cons (protect V381) ())) (cons (cons power (cons (cons nthrt (cons (protect V380) (cons (cons snd (cons (protect V381) ())) (cons (protect V382) ())))) (cons (cons fst (cons (protect V381) ())) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons maths.expt-h ())) ())) ()))) ()))))) (do (shen.record-kl gcd (cons defun (cons gcd (cons (cons (protect V386) (cons (protect V387) ())) (cons (cons if (cons (cons and (cons (cons integer? (cons (protect V386) ())) (cons (cons integer? (cons (protect V387) ())) ()))) (cons (cons let (cons (protect W388) (cons (cons abs (cons (protect V386) ())) (cons (cons let (cons (protect W389) (cons (cons abs (cons (protect V387) ())) (cons (cons if (cons (cons > (cons (protect W388) (cons (protect W389) ()))) (cons (cons maths.gcd-help (cons (cons - (cons (protect W388) (cons (protect W389) ()))) (cons (protect W389) ()))) (cons (cons maths.gcd-help (cons (protect W388) (cons (cons - (cons (protect W389) (cons (protect W388) ()))) ()))) ())))) ())))) ())))) (cons (cons simple-error (cons "gcd expects integer inputs" ())) ())))) ()))))) (do (shen.record-kl maths.gcd-help (cons defun (cons maths.gcd-help (cons (cons (protect V392) (cons (protect V393) ())) (cons (cons if (cons (cons > (cons (protect V392) (cons (protect V393) ()))) (cons (cons maths.gcd-loop (cons (protect V392) (cons (protect V393) (cons (protect V393) ())))) (cons (cons maths.gcd-loop (cons (protect V392) (cons (protect V393) (cons (protect V392) ())))) ())))) ()))))) (do (shen.record-kl maths.gcd-loop (cons defun (cons maths.gcd-loop (cons (cons (protect V400) (cons (protect V401) (cons (protect V402) ()))) (cons (cons cond (cons (cons (cons = (cons 1 (cons (protect V402) ()))) (cons 1 ())) (cons (cons (cons and (cons (cons integer? (cons (cons / (cons (protect V400) (cons (protect V402) ()))) ())) (cons (cons integer? (cons (cons / (cons (protect V401) (cons (protect V402) ()))) ())) ()))) (cons (protect V402) ())) (cons (cons true (cons (cons maths.gcd-loop (cons (protect V400) (cons (protect V401) (cons (cons - (cons (protect V402) (cons 1 ()))) ())))) ())) ())))) ()))))) (do (shen.record-kl lcd (cons defun (cons lcd (cons (cons (protect V406) (cons (protect V407) ())) (cons (cons cond (cons (cons (cons and (cons (cons even? (cons (protect V406) ())) (cons (cons even? (cons (protect V407) ())) ()))) (cons 2 ())) (cons (cons true (cons (cons maths.lcd-loop (cons (protect V406) (cons (protect V407) (cons (cons if (cons (cons > (cons (protect V406) (cons (protect V407) ()))) (cons (protect V407) (cons (protect V406) ())))) (cons 3 ()))))) ())) ()))) ()))))) (do (shen.record-kl maths.lcd-loop (cons defun (cons maths.lcd-loop (cons (cons (protect V413) (cons (protect V414) (cons (protect V415) (cons (protect V416) ())))) (cons (cons cond (cons (cons (cons > (cons (protect V416) (cons (protect V415) ()))) (cons 1 ())) (cons (cons (cons and (cons (cons integer? (cons (cons / (cons (protect V413) (cons (protect V416) ()))) ())) (cons (cons integer? (cons (cons / (cons (protect V414) (cons (protect V416) ()))) ())) ()))) (cons (protect V416) ())) (cons (cons true (cons (cons maths.lcd-loop (cons (protect V413) (cons (protect V414) (cons (protect V415) (cons (cons + (cons 2 (cons (protect V416) ()))) ()))))) ())) ())))) ()))))) (do (shen.record-kl isqrt (cons defun (cons isqrt (cons (cons (protect V421) ()) (cons (cons maths.isqrt-loop (cons (protect V421) (cons 0 ()))) ()))))) (do (shen.record-kl maths.isqrt-loop (cons defun (cons maths.isqrt-loop (cons (cons (protect V423) (cons (protect V424) ())) (cons (cons cond (cons (cons (cons = (cons (cons * (cons (protect V424) (cons (protect V424) ()))) (cons (protect V423) ()))) (cons (protect V424) ())) (cons (cons (cons > (cons (cons * (cons (protect V424) (cons (protect V424) ()))) (cons (protect V423) ()))) (cons (cons - (cons (protect V424) (cons 1 ()))) ())) (cons (cons true (cons (cons maths.isqrt-loop (cons (protect V423) (cons (cons + (cons (protect V424) (cons 1 ()))) ()))) ())) ())))) ()))))) (do (shen.record-kl div (cons defun (cons div (cons (cons (protect V427) (cons (protect V428) ())) (cons (cons floor (cons (cons / (cons (protect V427) (cons (protect V428) ()))) ())) ()))))) (do (shen.record-kl modf (cons defun (cons modf (cons (cons (protect V431) ()) (cons (cons let (cons (protect W432) (cons (cons floor (cons (protect V431) ())) (cons (cons @p (cons (protect W432) (cons (cons - (cons (protect V431) (cons (protect W432) ()))) ()))) ())))) ()))))) (do (shen.record-kl floor (cons defun (cons floor (cons (cons (protect V434) ()) (cons (cons cond (cons (cons (cons negative? (cons (protect V434) ())) (cons (cons ~ (cons (cons ceiling (cons (cons ~ (cons (protect V434) ())) ())) ())) ())) (cons (cons true (cons (cons maths.rounding-loop (cons floor (cons (protect V434) (cons 15 (cons 0 ()))))) ())) ()))) ()))))) (do (shen.record-kl maths.rounding-loop (cons defun (cons maths.rounding-loop (cons (cons (protect V439) (cons (protect V440) (cons (protect V441) (cons (protect V442) ())))) (cons (cons cond (cons (cons (cons and (cons (cons = (cons 0 (cons (protect V441) ()))) (cons (cons = (cons (protect V440) (cons (protect V442) ()))) ()))) (cons (protect V442) ())) (cons (cons (cons and (cons (cons = (cons 0 (cons (protect V441) ()))) (cons (cons > (cons (protect V442) (cons (protect V440) ()))) ()))) (cons (cons if (cons (cons = (cons (protect V439) (cons floor ()))) (cons (cons - (cons (protect V442) (cons 1 ()))) (cons (cons if (cons (cons = (cons (protect V439) (cons ceiling ()))) (cons (protect V442) (cons (cons if (cons (cons = (cons (protect V439) (cons round ()))) (cons (cons let (cons (protect W443) (cons (cons - (cons (protect V442) (cons (protect V440) ()))) (cons (cons let (cons (protect W444) (cons (cons - (cons (protect V440) (cons (cons - (cons (protect V442) (cons 1 ()))) ()))) (cons (cons if (cons (cons > (cons (protect W443) (cons (protect W444) ()))) (cons (cons - (cons (protect V442) (cons 1 ()))) (cons (protect V442) ())))) ())))) ())))) (cons (cons simple-error (cons "error: cases exhausted" ())) ())))) ())))) ())))) ())) (cons (cons (cons > (cons (protect V440) (cons (protect V442) ()))) (cons (cons maths.rounding-loop (cons (protect V439) (cons (protect V440) (cons (protect V441) (cons (cons + (cons (protect V442) (cons (cons power (cons 10 (cons (protect V441) ()))) ()))) ()))))) ())) (cons (cons true (cons (cons maths.rounding-loop (cons (protect V439) (cons (protect V440) (cons (cons - (cons (protect V441) (cons 1 ()))) (cons (cons - (cons (protect V442) (cons (cons power (cons 10 (cons (protect V441) ()))) ()))) ()))))) ())) ()))))) ()))))) (do (shen.record-kl maths.float->pair (cons defun (cons maths.float->pair (cons (cons (protect V449) ()) (cons (cons let (cons (protect W450) (cons (cons floor (cons (protect V449) ())) (cons (cons @p (cons (protect W450) (cons (cons - (cons (protect V449) (cons (protect W450) ()))) ()))) ())))) ()))))) (do (shen.record-kl ceiling (cons defun (cons ceiling (cons (cons (protect V452) ()) (cons (cons cond (cons (cons (cons negative? (cons (protect V452) ())) (cons (cons ~ (cons (cons floor (cons (cons ~ (cons (protect V452) ())) ())) ())) ())) (cons (cons true (cons (cons maths.rounding-loop (cons ceiling (cons (protect V452) (cons 15 (cons 0 ()))))) ())) ()))) ()))))) (do (shen.record-kl round (cons defun (cons round (cons (cons (protect V454) ()) (cons (cons cond (cons (cons (cons negative? (cons (protect V454) ())) (cons (cons ~ (cons (cons round (cons (cons ~ (cons (protect V454) ())) ())) ())) ())) (cons (cons true (cons (cons maths.rounding-loop (cons round (cons (protect V454) (cons 15 (cons 0 ()))))) ())) ()))) ()))))) (do (shen.record-kl mod (cons defun (cons mod (cons (cons (protect V456) (cons (protect V457) ())) (cons (cons let (cons (protect W458) (cons (cons / (cons (protect V456) (cons (protect V457) ()))) (cons (cons let (cons (protect W459) (cons (cons floor (cons (protect W458) ())) (cons (cons if (cons (cons and (cons (cons integer? (cons (protect V456) ())) (cons (cons integer? (cons (protect V457) ())) ()))) (cons (cons round (cons (cons * (cons (protect V457) (cons (cons - (cons (protect W458) (cons (protect W459) ()))) ()))) ())) (cons (cons * (cons (protect V457) (cons (cons - (cons (protect W458) (cons (protect W459) ()))) ()))) ())))) ())))) ())))) ()))))) (do (shen.record-kl lcm (cons defun (cons lcm (cons (cons (protect V462) ()) (cons (cons let (cons (protect W463) (cons (cons maths.greatest (cons (protect V462) ())) (cons (cons maths.lcm-h (cons (protect W463) (cons (protect W463) (cons (protect V462) ())))) ())))) ()))))) (do (shen.record-kl maths.greatest (cons defun (cons maths.greatest (cons (cons (protect V467) ()) (cons (cons cond (cons (cons (cons and (cons (cons cons? (cons (protect V467) ())) (cons (cons = (cons () (cons (cons tl (cons (protect V467) ())) ()))) ()))) (cons (cons hd (cons (protect V467) ())) ())) (cons (cons (cons and (cons (cons cons? (cons (protect V467) ())) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect V467) ())) ())) (cons (cons > (cons (cons hd (cons (protect V467) ())) (cons (cons hd (cons (cons tl (cons (protect V467) ())) ())) ()))) ()))) ()))) (cons (cons maths.greatest (cons (cons cons (cons (cons hd (cons (protect V467) ())) (cons (cons tl (cons (cons tl (cons (protect V467) ())) ())) ()))) ())) ())) (cons (cons (cons and (cons (cons cons? (cons (protect V467) ())) (cons (cons cons? (cons (cons tl (cons (protect V467) ())) ())) ()))) (cons (cons maths.greatest (cons (cons tl (cons (protect V467) ())) ())) ())) (cons (cons true (cons (cons shen.f-error (cons maths.greatest ())) ())) ()))))) ()))))) (do (shen.record-kl maths.lcm-h (cons defun (cons maths.lcm-h (cons (cons (protect V469) (cons (protect V470) (cons (protect V471) ()))) (cons (cons cond (cons (cons (cons maths.lcm? (cons (protect V469) (cons (protect V471) ()))) (cons (protect V469) ())) (cons (cons true (cons (cons maths.lcm-h (cons (cons + (cons (protect V469) (cons (protect V470) ()))) (cons (protect V470) (cons (protect V471) ())))) ())) ()))) ()))))) (do (shen.record-kl maths.lcm? (cons defun (cons maths.lcm? (cons (cons (protect V477) (cons (protect V478) ())) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V478) ()))) (cons true ())) (cons (cons (cons cons? (cons (protect V478) ())) (cons (cons and (cons (cons integer? (cons (cons / (cons (protect V477) (cons (cons hd (cons (protect V478) ())) ()))) ())) (cons (cons maths.lcm? (cons (protect V477) (cons (cons tl (cons (protect V478) ())) ()))) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons maths.lcm? ())) ())) ())))) ()))))) (do (shen.record-kl random (cons defun (cons random (cons (cons (protect V481) (cons (protect V482) ())) (cons (cons let (cons (protect W483) (cons (cons maths.bbs (cons (cons value (cons maths.*seed* ())) ())) (cons (cons let (cons (protect W484) (cons (cons set (cons maths.*seed* (cons (protect W483) ()))) (cons (cons let (cons (protect W485) (cons (cons min (cons (protect V481) (cons (protect V482) ()))) (cons (cons + (cons (protect W485) (cons (cons mod (cons (protect W484) (cons (cons abs (cons (cons + (cons 1 (cons (cons - (cons (protect V482) (cons (protect V481) ()))) ()))) ())) ()))) ()))) ())))) ())))) ())))) ()))))) (do (shen.record-kl min (cons defun (cons min (cons (cons (protect V490) (cons (protect V491) ())) (cons (cons cond (cons (cons (cons > (cons (protect V490) (cons (protect V491) ()))) (cons (protect V491) ())) (cons (cons true (cons (protect V490) ())) ()))) ()))))) (do (shen.record-kl reseed (cons defun (cons reseed (cons () (cons (cons set (cons maths.*seed* (cons (cons get-time (cons unix ())) ()))) ()))))) (do (shen.record-kl maths.bbs (cons defun (cons maths.bbs (cons (cons (protect V494) ()) (cons (cons let (cons (protect W495) (cons (cons * (cons 1201 (cons 1213 ()))) (cons (cons mod (cons (cons * (cons (protect V494) (cons (protect V494) ()))) (cons (protect W495) ()))) ())))) ()))))) (do (shen.record-kl ~ (cons defun (cons ~ (cons (cons (protect V497) ()) (cons (cons - (cons 0 (cons (protect V497) ()))) ()))))) (do (shen.record-kl positive? (cons defun (cons positive? (cons (cons (protect V499) ()) (cons (cons > (cons (protect V499) (cons 0 ()))) ()))))) (do (shen.record-kl negative? (cons defun (cons negative? (cons (cons (protect V501) ()) (cons (cons < (cons (protect V501) (cons 0 ()))) ()))))) (do (shen.record-kl natural? (cons defun (cons natural? (cons (cons (protect V503) ()) (cons (cons cond (cons (cons (cons = (cons 0 (cons (protect V503) ()))) (cons true ())) (cons (cons true (cons (cons and (cons (cons integer? (cons (protect V503) ())) (cons (cons positive? (cons (protect V503) ())) ()))) ())) ()))) ()))))) (do (shen.record-kl converge (cons defun (cons converge (cons (cons (protect V505) (cons (protect V506) (cons (protect V507) ()))) (cons (cons maths.converge-help (cons (protect V506) (cons (cons (protect V506) (cons (protect V505) ())) (cons (protect V505) (cons (protect V507) ()))))) ()))))) (do (shen.record-kl maths.converge-help (cons defun (cons maths.converge-help (cons (cons (protect V514) (cons (protect V515) (cons (protect V516) (cons (protect V517) ())))) (cons (cons cond (cons (cons (cons (cons (protect V517) (cons (protect V516) ())) (cons (protect V515) ())) (cons (protect V515) ())) (cons (cons true (cons (cons maths.converge-help (cons (protect V514) (cons (cons (protect V514) (cons (protect V515) ())) (cons (protect V515) (cons (protect V517) ()))))) ())) ()))) ()))))) (do (shen.record-kl nthrt (cons defun (cons nthrt (cons (cons (protect V526) (cons (protect V527) (cons (protect V528) ()))) (cons (cons cond (cons (cons (cons positive? (cons (protect V526) ())) (cons (cons converge (cons (protect V526) (cons (cons lambda (cons (protect Z529) (cons (cons maths.compute-nthrt (cons (protect V526) (cons (protect Z529) (cons (protect V527) (cons (protect V528) ()))))) ()))) (cons (cons approx (cons (protect V528) ())) ())))) ())) (cons (cons true (cons (cons simple-error (cons (cons cn (cons "nthrt: negA must be a positive numberneg%" (cons "" ()))) ())) ())) ()))) ()))))) (do (shen.record-kl sqrt (cons defun (cons sqrt (cons (cons (protect V533) (cons (protect V534) ())) (cons (cons nthrt (cons (protect V533) (cons 2 (cons (protect V534) ())))) ()))))) (do (shen.record-kl maths.compute-nthrt (cons defun (cons maths.compute-nthrt (cons (cons (protect V537) (cons (protect V538) (cons (protect V539) (cons (protect V540) ())))) (cons (cons let (cons (protect W541) (cons (cons / (cons 1 (cons (protect V539) ()))) (cons (cons let (cons (protect W542) (cons (cons * (cons (cons - (cons (protect V539) (cons 1 ()))) (cons (protect V538) ()))) (cons (cons let (cons (protect W543) (cons (cons expt (cons (protect V538) (cons (cons - (cons (protect V539) (cons 1 ()))) (cons (protect V540) ())))) (cons (cons let (cons (protect W544) (cons (cons / (cons (protect V537) (cons (protect W543) ()))) (cons (cons let (cons (protect W545) (cons (cons + (cons (protect W542) (cons (protect W544) ()))) (cons (cons * (cons (protect W541) (cons (protect W545) ()))) ())))) ())))) ())))) ())))) ())))) ()))))) (do (shen.record-kl approx (cons defun (cons approx (cons (cons (protect V550) ()) (cons (cons lambda (cons (protect Z551) (cons (cons lambda (cons (protect Z552) (cons (cons let (cons (protect W553) (cons (cons - (cons (protect Z551) (cons (protect Z552) ()))) (cons (cons >= (cons (protect V550) (cons (cons abs (cons (protect W553) ())) ()))) ())))) ()))) ()))) ()))))) (do (shen.record-kl abs (cons defun (cons abs (cons (cons (protect V555) ()) (cons (cons if (cons (cons >= (cons (protect V555) (cons 0 ()))) (cons (protect V555) (cons (cons - (cons 0 (cons (protect V555) ()))) ())))) ()))))) (do (shen.record-kl series (cons defun (cons series (cons (cons (protect V557) (cons (protect V558) (cons (protect V559) (cons (protect V560) ())))) (cons (cons maths.series-h (cons (cons + (cons (protect V557) (cons 1 ()))) (cons (protect V559) (cons (protect V558) (cons (cons (protect V558) (cons (protect V557) ())) (cons (protect V560) ())))))) ()))))) (do (shen.record-kl maths.series-h (cons defun (cons maths.series-h (cons (cons (protect V565) (cons (protect V566) (cons (protect V567) (cons (protect V568) (cons (protect V569) ()))))) (cons (cons let (cons (protect W570) (cons (cons (cons (protect V569) (cons (cons (protect V567) (cons (protect V565) ())) ())) (cons (protect V568) ())) (cons (cons if (cons (cons <= (cons (cons abs (cons (cons - (cons (protect V568) (cons (protect W570) ()))) ())) (cons (protect V566) ()))) (cons (protect W570) (cons (cons maths.series-h (cons (cons + (cons (protect V565) (cons 1 ()))) (cons (protect V566) (cons (protect V567) (cons (protect W570) (cons (protect V569) ())))))) ())))) ())))) ()))))) (do (shen.record-kl product (cons defun (cons product (cons (cons (protect V578) (cons (protect V579) (cons (protect V580) ()))) (cons (cons series (cons (protect V578) (cons (protect V579) (cons (protect V580) (cons (cons lambda (cons (protect Z581) (cons (cons lambda (cons (protect Z582) (cons (cons * (cons (protect Z581) (cons (protect Z582) ()))) ()))) ()))) ()))))) ()))))) (do (shen.record-kl summation (cons defun (cons summation (cons (cons (protect V588) (cons (protect V589) (cons (protect V590) ()))) (cons (cons series (cons (protect V588) (cons (protect V589) (cons (protect V590) (cons (cons lambda (cons (protect Z591) (cons (cons lambda (cons (protect Z592) (cons (cons + (cons (protect Z591) (cons (protect Z592) ()))) ()))) ()))) ()))))) ()))))) (do (shen.record-kl odd? (cons defun (cons odd? (cons (cons (protect V596) ()) (cons (cons and (cons (cons integer? (cons (protect V596) ())) (cons (cons not (cons (cons integer? (cons (cons / (cons (protect V596) (cons 2 ()))) ())) ())) ()))) ()))))) (do (shen.record-kl even? (cons defun (cons even? (cons (cons (protect V598) ()) (cons (cons and (cons (cons integer? (cons (protect V598) ())) (cons (cons integer? (cons (cons / (cons (protect V598) (cons 2 ()))) ())) ()))) ()))))) (do (shen.record-kl maths.compute-sine (cons defun (cons maths.compute-sine (cons (cons (protect V600) (cons (protect V601) ())) (cons (cons let (cons (protect W602) (cons (cons + (cons (cons * (cons 2 (cons (protect V601) ()))) (cons 1 ()))) (cons (cons let (cons (protect W603) (cons (cons * (cons (cons power (cons -1 (cons (protect V601) ()))) (cons (cons power (cons (protect V600) (cons (protect W602) ()))) ()))) (cons (cons let (cons (protect W604) (cons (cons factorial (cons (protect W602) ())) (cons (cons / (cons (protect W603) (cons (protect W604) ()))) ())))) ())))) ())))) ()))))) (do (shen.record-kl maths.compute-cos (cons defun (cons maths.compute-cos (cons (cons (protect V607) (cons (protect V608) ())) (cons (cons let (cons (protect W609) (cons (cons * (cons 2 (cons (protect V608) ()))) (cons (cons let (cons (protect W610) (cons (cons * (cons (cons power (cons -1 (cons (protect V608) ()))) (cons (cons power (cons (protect V607) (cons (protect W609) ()))) ()))) (cons (cons let (cons (protect W611) (cons (cons factorial (cons (protect W609) ())) (cons (cons / (cons (protect W610) (cons (protect W611) ()))) ())))) ())))) ())))) ()))))) (do (shen.record-kl cos (cons defun (cons cos (cons (cons (protect V615) (cons (protect V616) ())) (cons (cons let (cons (protect W617) (cons (cons radians (cons (protect V615) ())) (cons (cons summation (cons 0 (cons (cons lambda (cons (protect Z618) (cons (cons maths.compute-cos (cons (protect W617) (cons (protect Z618) ()))) ()))) (cons (protect V616) ())))) ())))) ()))))) (do (shen.record-kl sin (cons defun (cons sin (cons (cons (protect V622) (cons (protect V623) ())) (cons (cons let (cons (protect W624) (cons (cons radians (cons (protect V622) ())) (cons (cons summation (cons 0 (cons (cons lambda (cons (protect Z625) (cons (cons maths.compute-sine (cons (protect W624) (cons (protect Z625) ()))) ()))) (cons (protect V623) ())))) ())))) ()))))) (do (shen.record-kl tan (cons defun (cons tan (cons (cons (protect V628) (cons (protect V629) ())) (cons (cons / (cons (cons sin (cons (protect V628) (cons (protect V629) ()))) (cons (cons cos (cons (protect V628) (cons (protect V629) ()))) ()))) ()))))) (do (shen.record-kl radians (cons defun (cons radians (cons (cons (protect V632) ()) (cons (cons * (cons (cons / (cons (protect V632) (cons 180 ()))) (cons (cons pi ()) ()))) ()))))) (do (shen.record-kl g (cons defun (cons g (cons () (cons 1.6180339887498 ()))))) (do (shen.record-kl pi (cons defun (cons pi (cons () (cons 3.1415926535897 ()))))) (do (shen.record-kl e (cons defun (cons e (cons () (cons 2.7182818284590002 ()))))) (do (shen.record-kl tan30 (cons defun (cons tan30 (cons () (cons 0.5773502691896 ()))))) (do (shen.record-kl cos30 (cons defun (cons cos30 (cons () (cons 0.8660254037844001 ()))))) (do (shen.record-kl cos45 (cons defun (cons cos45 (cons () (cons 0.70710678118651 ()))))) (do (shen.record-kl sin45 (cons defun (cons sin45 (cons () (cons 0.7071067811865 ()))))) (do (shen.record-kl sqrt2 (cons defun (cons sqrt2 (cons () (cons 1.4142135623731 ()))))) (do (shen.record-kl tan60 (cons defun (cons tan60 (cons () (cons 1.7320508075692 ()))))) (do (shen.record-kl maths.sin60 (cons defun (cons maths.sin60 (cons () (cons 0.8660254037844001 ()))))) (do (shen.record-kl sin120 (cons defun (cons sin120 (cons () (cons 0.8660254037844001 ()))))) (do (shen.record-kl tan120 (cons defun (cons tan120 (cons () (cons -1.7320508075692 ()))))) (do (shen.record-kl sin135 (cons defun (cons sin135 (cons () (cons 0.7071067811865 ()))))) (do (shen.record-kl cos135 (cons defun (cons cos135 (cons () (cons -0.7071067811865 ()))))) (do (shen.record-kl cos150 (cons defun (cons cos150 (cons () (cons -0.8660254037844001 ()))))) (do (shen.record-kl tan150 (cons defun (cons tan150 (cons () (cons -0.5773502691905 ()))))) (do (shen.record-kl cos210 (cons defun (cons cos210 (cons () (cons -0.8660254037844001 ()))))) (do (shen.record-kl tan210 (cons defun (cons tan210 (cons () (cons 0.5773502691905 ()))))) (do (shen.record-kl sin225 (cons defun (cons sin225 (cons () (cons -0.7071067811865 ()))))) (do (shen.record-kl cos225 (cons defun (cons cos225 (cons () (cons -0.7071067811865 ()))))) (do (shen.record-kl sin240 (cons defun (cons sin240 (cons () (cons -0.8660254037844001 ()))))) (do (shen.record-kl tan240 (cons defun (cons tan240 (cons () (cons 1.7320508075692 ()))))) (do (shen.record-kl sin300 (cons defun (cons sin300 (cons () (cons -0.8660254037844001 ()))))) (do (shen.record-kl tan300 (cons defun (cons tan300 (cons () (cons -1.7320508075692 ()))))) (do (shen.record-kl sin315 (cons defun (cons sin315 (cons () (cons -0.7071067811865 ()))))) (do (shen.record-kl cos315 (cons defun (cons cos315 (cons () (cons 0.7071067811865 ()))))) (do (shen.record-kl cos330 (cons defun (cons cos330 (cons () (cons 0.8660254037844001 ()))))) (do (shen.record-kl tan330 (cons defun (cons tan330 (cons () (cons -0.5773502691905 ()))))) (do (shen.record-kl coth (cons defun (cons coth (cons (cons (protect V634) (cons (protect V635) ())) (cons (cons let (cons (protect W636) (cons (cons e ()) (cons (cons let (cons (protect W637) (cons (cons expt (cons (protect W636) (cons (cons ~ (cons (cons * (cons 2 (cons (protect V634) ()))) ())) (cons (protect V635) ())))) (cons (cons / (cons (cons + (cons 1 (cons (protect W637) ()))) (cons (cons - (cons 1 (cons (protect W637) ()))) ()))) ())))) ())))) ()))))) (do (shen.record-kl sinh (cons defun (cons sinh (cons (cons (protect V640) (cons (protect V641) ())) (cons (cons let (cons (protect W642) (cons (cons e ()) (cons (cons let (cons (protect W643) (cons (cons expt (cons (protect W642) (cons (protect V640) (cons (protect V641) ())))) (cons (cons let (cons (protect W644) (cons (cons expt (cons (protect W642) (cons (cons ~ (cons (protect V640) ())) (cons (protect V641) ())))) (cons (cons let (cons (protect W645) (cons (cons - (cons (protect W643) (cons (protect W644) ()))) (cons (cons / (cons (protect W645) (cons 2 ()))) ())))) ())))) ())))) ())))) ()))))) (do (shen.record-kl cosh (cons defun (cons cosh (cons (cons (protect V648) (cons (protect V649) ())) (cons (cons let (cons (protect W650) (cons (cons e ()) (cons (cons let (cons (protect W651) (cons (cons expt (cons (protect W650) (cons (protect V648) (cons (protect V649) ())))) (cons (cons let (cons (protect W652) (cons (cons expt (cons (protect W650) (cons (cons ~ (cons (protect V648) ())) (cons (protect V649) ())))) (cons (cons let (cons (protect W653) (cons (cons + (cons (protect W651) (cons (protect W652) ()))) (cons (cons / (cons (protect W653) (cons 2 ()))) ())))) ())))) ())))) ())))) ()))))) (do (shen.record-kl tanh (cons defun (cons tanh (cons (cons (protect V656) (cons (protect V657) ())) (cons (cons / (cons (cons sinh (cons (protect V656) (cons (protect V657) ()))) (cons (cons cosh (cons (protect V656) (cons (protect V657) ()))) ()))) ()))))) (do (shen.record-kl sech (cons defun (cons sech (cons (cons (protect V660) (cons (protect V661) ())) (cons (cons / (cons 1 (cons (cons cosh (cons (protect V660) (cons (protect V661) ()))) ()))) ()))))) (do (shen.record-kl csch (cons defun (cons csch (cons (cons (protect V664) (cons (protect V665) ())) (cons (cons / (cons 1 (cons (cons sinh (cons (protect V664) (cons (protect V665) ()))) ()))) ()))))) (do (shen.record-kl power (cons defun (cons power (cons (cons (protect V670) (cons (protect V671) ())) (cons (cons cond (cons (cons (cons = (cons 0 (cons (protect V671) ()))) (cons 1 ())) (cons (cons true (cons (cons * (cons (protect V670) (cons (cons power (cons (protect V670) (cons (cons - (cons (protect V671) (cons 1 ()))) ()))) ()))) ())) ()))) ()))))) (do (shen.record-kl factorial (cons defun (cons factorial (cons (cons (protect V674) ()) (cons (cons cond (cons (cons (cons = (cons 0 (cons (protect V674) ()))) (cons 1 ())) (cons (cons true (cons (cons * (cons (protect V674) (cons (cons factorial (cons (cons - (cons (protect V674) (cons 1 ()))) ())) ()))) ())) ()))) ()))))) (do (shen.record-kl prime? (cons defun (cons prime? (cons (cons (protect V676) ()) (cons (cons cond (cons (cons (cons = (cons 2 (cons (protect V676) ()))) (cons true ())) (cons (cons (cons even? (cons (protect V676) ())) (cons false ())) (cons (cons true (cons (cons maths.prime-h (cons (protect V676) (cons (cons isqrt (cons (protect V676) ())) (cons 3 ())))) ())) ())))) ()))))) (do (shen.record-kl maths.prime-h (cons defun (cons maths.prime-h (cons (cons (protect V679) (cons (protect V680) (cons (protect V681) ()))) (cons (cons cond (cons (cons (cons > (cons (protect V681) (cons (protect V680) ()))) (cons true ())) (cons (cons (cons integer? (cons (cons / (cons (protect V679) (cons (protect V681) ()))) ())) (cons false ())) (cons (cons true (cons (cons maths.prime-h (cons (protect V679) (cons (protect V680) (cons (cons + (cons (protect V681) (cons 2 ()))) ())))) ())) ())))) ()))))) (do (shen.record-kl maths.sign (cons defun (cons maths.sign (cons (cons (protect V687) ()) (cons (cons cond (cons (cons (cons = (cons 0 (cons (protect V687) ()))) (cons 0 ())) (cons (cons (cons positive? (cons (protect V687) ())) (cons 1 ())) (cons (cons true (cons -1 ())) ())))) ()))))) (do (shen.record-kl log (cons defun (cons log (cons (cons (protect V689) (cons (protect V690) (cons (protect V691) ()))) (cons (cons / (cons (cons log10 (cons (protect V689) (cons (protect V691) ()))) (cons (cons log10 (cons (protect V690) (cons (protect V691) ()))) ()))) ()))))) (do (shen.record-kl loge (cons defun (cons loge (cons (cons (protect V695) (cons (protect V696) ())) (cons (cons log (cons (protect V695) (cons (cons e ()) (cons (protect V696) ())))) ()))))) (do (shen.record-kl log2 (cons defun (cons log2 (cons (cons (protect V699) (cons (protect V700) ())) (cons (cons log (cons (protect V699) (cons 2 (cons (protect V700) ())))) ()))))) (do (shen.record-kl log10 (cons defun (cons log10 (cons (cons (protect V703) (cons (protect V704) ())) (cons (cons if (cons (cons >= (cons (protect V703) (cons 1 ()))) (cons (cons maths.log10+ (cons (protect V703) (cons (protect V704) ()))) (cons (cons ~ (cons (cons maths.log10+ (cons (cons / (cons 1 (cons (protect V703) ()))) (cons (protect V704) ()))) ())) ())))) ()))))) (do (shen.record-kl maths.log10+ (cons defun (cons maths.log10+ (cons (cons (protect V707) (cons (protect V708) ())) (cons (cons cond (cons (cons (cons <= (cons (cons abs (cons (protect V707) ())) (cons (protect V708) ()))) (cons 0 ())) (cons (cons (cons >= (cons (protect V707) (cons 10 ()))) (cons (cons + (cons 1 (cons (cons maths.log10+ (cons (cons / (cons (protect V707) (cons 10 ()))) (cons (protect V708) ()))) ()))) ())) (cons (cons true (cons (cons * (cons 0.1 (cons (cons maths.log10+ (cons (cons power (cons (protect V707) (cons 10 ()))) (cons (cons * (cons 10 (cons (protect V708) ()))) ()))) ()))) ())) ())))) ()))))) (do (shen.record-kl maths.upto (cons defun (cons maths.upto (cons (cons (protect V714) (cons (protect V715) (cons (protect V716) (cons (protect V717) (cons (protect V718) (cons (protect V719) ())))))) (cons (cons cond (cons (cons (cons (protect V715) (cons (protect V714) ())) (cons (protect V718) ())) (cons (cons true (cons (cons (cons (protect V717) (cons (cons (protect V719) (cons (protect V714) ())) ())) (cons (cons maths.upto (cons (cons (protect V716) (cons (protect V714) ())) (cons (protect V715) (cons (protect V716) (cons (protect V717) (cons (protect V718) (cons (protect V719) ()))))))) ())) ())) ()))) ()))))) (do (shen.record-kl r# (cons defun (cons r# (cons (cons (protect V732) (cons (protect V733) ())) (cons (cons cond (cons (cons (cons and (cons (cons integer? (cons (protect V732) ())) (cons (cons integer? (cons (protect V733) ())) ()))) (cons (cons let (cons (protect W734) (cons (cons absvector (cons 3 ())) (cons (cons let (cons (protect W735) (cons (cons address-> (cons (protect W734) (cons 0 (cons rational.print-rational ())))) (cons (cons let (cons (protect W736) (cons (cons address-> (cons (protect W734) (cons 1 (cons (protect V732) ())))) (cons (cons let (cons (protect W737) (cons (cons address-> (cons (protect W734) (cons 2 (cons (protect V733) ())))) (cons (protect W734) ())))) ())))) ())))) ())))) ())) (cons (cons true (cons (cons simple-error (cons (cons cn (cons "numerator " (cons (cons shen.app (cons (protect V732) (cons (cons cn (cons " and divisor " (cons (cons shen.app (cons (protect V733) (cons " must be integers +" (cons shen.s ())))) ()))) (cons shen.s ())))) ()))) ())) ())) ()))) ()))))) (do (shen.record-kl rational.print-rational (cons defun (cons rational.print-rational (cons (cons (protect V740) ()) (cons (cons shen.app (cons (cons <-address (cons (protect V740) (cons 1 ()))) (cons (cons cn (cons "/" (cons (cons shen.app (cons (cons <-address (cons (protect V740) (cons 2 ()))) (cons "" (cons shen.s ())))) ()))) (cons shen.s ())))) ()))))) (do (shen.record-kl rational? (cons defun (cons rational? (cons (cons (protect V742) ()) (cons (cons trap-error (cons (cons and (cons (cons absvector? (cons (protect V742) ())) (cons (cons and (cons (cons = (cons (cons <-address (cons (protect V742) (cons 0 ()))) (cons rational.print-rational ()))) (cons (cons and (cons (cons integer? (cons (cons <-address (cons (protect V742) (cons 1 ()))) ())) (cons (cons integer? (cons (cons <-address (cons (protect V742) (cons 2 ()))) ())) ()))) ()))) ()))) (cons (cons lambda (cons (protect Z743) (cons false ()))) ()))) ()))))) (do (shen.record-kl numerator (cons defun (cons numerator (cons (cons (protect V745) ()) (cons (cons <-address (cons (protect V745) (cons 1 ()))) ()))))) (do (shen.record-kl denominator (cons defun (cons denominator (cons (cons (protect V747) ()) (cons (cons <-address (cons (protect V747) (cons 2 ()))) ()))))) (do (shen.record-kl r-op1 (cons defun (cons r-op1 (cons (cons (protect V787) (cons (protect V788) ())) (cons (cons n->r (cons (cons (protect V787) (cons (cons r->n (cons (protect V788) ())) ())) ())) ()))))) (do (shen.record-kl r-op2 (cons defun (cons r-op2 (cons (cons (protect V791) (cons (protect V792) (cons (protect V793) ()))) (cons (cons n->r (cons (cons (cons (protect V791) (cons (cons r->n (cons (protect V792) ())) ())) (cons (cons r->n (cons (protect V793) ())) ())) ())) ()))))) (do (shen.record-kl r->n (cons defun (cons r->n (cons (cons (protect V797) ()) (cons (cons / (cons (cons numerator (cons (protect V797) ())) (cons (cons denominator (cons (protect V797) ())) ()))) ()))))) (do (shen.record-kl r->pair (cons defun (cons r->pair (cons (cons (protect V799) ()) (cons (cons @p (cons (cons numerator (cons (protect V799) ())) (cons (cons denominator (cons (protect V799) ())) ()))) ()))))) (do (shen.record-kl n->r (cons defun (cons n->r (cons (cons (protect V801) ()) (cons (cons let (cons (protect W802) (cons (cons maths.n->r (cons (protect V801) (cons 1 ()))) (cons (cons r# (cons (cons fst (cons (protect W802) ())) (cons (cons snd (cons (protect W802) ())) ()))) ())))) ()))))) (do (shen.record-kl r-reduce (cons defun (cons r-reduce (cons (cons (protect V804) ()) (cons (cons rational.r-reduce-help (cons (cons numerator (cons (protect V804) ())) (cons (cons denominator (cons (protect V804) ())) ()))) ()))))) (do (shen.record-kl rational.r-reduce-help (cons defun (cons rational.r-reduce-help (cons (cons (protect V806) (cons (protect V807) ())) (cons (cons let (cons (protect W808) (cons (cons lcd (cons (protect V806) (cons (protect V807) ()))) (cons (cons if (cons (cons = (cons (protect W808) (cons 1 ()))) (cons (cons r# (cons (protect V806) (cons (protect V807) ()))) (cons (cons rational.r-reduce-help (cons (cons / (cons (protect V806) (cons (protect W808) ()))) (cons (cons / (cons (protect V807) (cons (protect W808) ()))) ()))) ())))) ())))) ()))))) (do (shen.record-kl r= (cons defun (cons r= (cons (cons (protect V811) (cons (protect V812) ())) (cons (cons let (cons (protect W813) (cons (cons numerator (cons (protect V811) ())) (cons (cons let (cons (protect W814) (cons (cons denominator (cons (protect V811) ())) (cons (cons let (cons (protect W815) (cons (cons numerator (cons (protect V812) ())) (cons (cons let (cons (protect W816) (cons (cons denominator (cons (protect V812) ())) (cons (cons = (cons (cons * (cons (protect W813) (cons (protect W816) ()))) (cons (cons * (cons (protect W814) (cons (protect W815) ()))) ()))) ())))) ())))) ())))) ())))) ()))))) (do (shen.record-kl r< (cons defun (cons r< (cons (cons (protect V819) (cons (protect V820) ())) (cons (cons let (cons (protect W821) (cons (cons numerator (cons (protect V819) ())) (cons (cons let (cons (protect W822) (cons (cons denominator (cons (protect V819) ())) (cons (cons let (cons (protect W823) (cons (cons numerator (cons (protect V820) ())) (cons (cons let (cons (protect W824) (cons (cons denominator (cons (protect V820) ())) (cons (cons < (cons (cons * (cons (protect W821) (cons (protect W824) ()))) (cons (cons * (cons (protect W822) (cons (protect W823) ()))) ()))) ())))) ())))) ())))) ())))) ()))))) (do (shen.record-kl r> (cons defun (cons r> (cons (cons (protect V827) (cons (protect V828) ())) (cons (cons not (cons (cons or (cons (cons r= (cons (protect V827) (cons (protect V828) ()))) (cons (cons r< (cons (protect V827) (cons (protect V828) ()))) ()))) ())) ()))))) (do (shen.record-kl r>= (cons defun (cons r>= (cons (cons (protect V831) (cons (protect V832) ())) (cons (cons or (cons (cons r= (cons (protect V831) (cons (protect V832) ()))) (cons (cons r> (cons (protect V831) (cons (protect V832) ()))) ()))) ()))))) (do (shen.record-kl r<= (cons defun (cons r<= (cons (cons (protect V835) (cons (protect V836) ())) (cons (cons or (cons (cons r= (cons (protect V835) (cons (protect V836) ()))) (cons (cons r< (cons (protect V835) (cons (protect V836) ()))) ()))) ()))))) (do (shen.record-kl r+ (cons defun (cons r+ (cons (cons (protect V839) (cons (protect V840) ())) (cons (cons let (cons (protect W841) (cons (cons numerator (cons (protect V839) ())) (cons (cons let (cons (protect W842) (cons (cons denominator (cons (protect V839) ())) (cons (cons let (cons (protect W843) (cons (cons numerator (cons (protect V840) ())) (cons (cons let (cons (protect W844) (cons (cons denominator (cons (protect V840) ())) (cons (cons r# (cons (cons + (cons (cons * (cons (protect W841) (cons (protect W844) ()))) (cons (cons * (cons (protect W842) (cons (protect W843) ()))) ()))) (cons (cons * (cons (protect W842) (cons (protect W844) ()))) ()))) ())))) ())))) ())))) ())))) ()))))) (do (shen.record-kl r- (cons defun (cons r- (cons (cons (protect V847) (cons (protect V848) ())) (cons (cons let (cons (protect W849) (cons (cons numerator (cons (protect V847) ())) (cons (cons let (cons (protect W850) (cons (cons denominator (cons (protect V847) ())) (cons (cons let (cons (protect W851) (cons (cons numerator (cons (protect V848) ())) (cons (cons let (cons (protect W852) (cons (cons denominator (cons (protect V848) ())) (cons (cons r# (cons (cons - (cons (cons * (cons (protect W849) (cons (protect W852) ()))) (cons (cons * (cons (protect W850) (cons (protect W851) ()))) ()))) (cons (cons * (cons (protect W850) (cons (protect W852) ()))) ()))) ())))) ())))) ())))) ())))) ()))))) (do (shen.record-kl r* (cons defun (cons r* (cons (cons (protect V855) (cons (protect V856) ())) (cons (cons let (cons (protect W857) (cons (cons numerator (cons (protect V855) ())) (cons (cons let (cons (protect W858) (cons (cons denominator (cons (protect V855) ())) (cons (cons let (cons (protect W859) (cons (cons numerator (cons (protect V856) ())) (cons (cons let (cons (protect W860) (cons (cons denominator (cons (protect V856) ())) (cons (cons r# (cons (cons * (cons (protect W857) (cons (protect W859) ()))) (cons (cons * (cons (protect W858) (cons (protect W860) ()))) ()))) ())))) ())))) ())))) ())))) ()))))) (do (shen.record-kl +-inverse (cons defun (cons +-inverse (cons (cons (protect V863) ()) (cons (cons let (cons (protect W864) (cons (cons numerator (cons (protect V863) ())) (cons (cons let (cons (protect W865) (cons (cons denominator (cons (protect V863) ())) (cons (cons r# (cons (cons ~ (cons (protect W864) ())) (cons (protect W865) ()))) ())))) ())))) ()))))) (do (shen.record-kl *-inverse (cons defun (cons *-inverse (cons (cons (protect V867) ()) (cons (cons let (cons (protect W868) (cons (cons numerator (cons (protect V867) ())) (cons (cons let (cons (protect W869) (cons (cons denominator (cons (protect V867) ())) (cons (cons r# (cons (protect W869) (cons (protect W868) ()))) ())))) ())))) ()))))) (do (shen.record-kl r/ (cons defun (cons r/ (cons (cons (protect V871) (cons (protect V872) ())) (cons (cons r* (cons (protect V871) (cons (cons *-inverse (cons (protect V872) ())) ()))) ()))))) (do (shen.record-kl r-expt (cons defun (cons r-expt (cons (cons (protect V877) (cons (protect V878) ())) (cons (cons cond (cons (cons (cons natural? (cons (protect V878) ())) (cons (cons let (cons (protect W879) (cons (cons numerator (cons (protect V877) ())) (cons (cons let (cons (protect W880) (cons (cons denominator (cons (protect V877) ())) (cons (cons r# (cons (cons power (cons (protect W879) (cons (protect V878) ()))) (cons (cons power (cons (protect W880) (cons (protect V878) ()))) ()))) ())))) ())))) ())) (cons (cons (cons and (cons (cons integer? (cons (protect V878) ())) (cons (cons negative? (cons (protect V878) ())) ()))) (cons (cons let (cons (protect W881) (cons (cons numerator (cons (protect V877) ())) (cons (cons let (cons (protect W882) (cons (cons denominator (cons (protect V877) ())) (cons (cons r# (cons (cons power (cons (protect W882) (cons (cons ~ (cons (protect V878) ())) ()))) (cons (cons power (cons (protect W881) (cons (cons ~ (cons (protect V878) ())) ()))) ()))) ())))) ())))) ())) (cons (cons true (cons (cons simple-error (cons (cons cn (cons "cannot exponentiate a rational by a non-integer " (cons (cons shen.app (cons (protect V878) (cons " +" (cons shen.a ())))) ()))) ())) ())) ())))) ()))))) (do (shen.record-kl r-approx (cons defun (cons r-approx (cons (cons (protect V885) (cons (protect V886) ())) (cons (cons rational.approx-r-h (cons (cons r->n (cons (protect V885) ())) (cons (protect V886) (cons 0 ())))) ()))))) (do (shen.record-kl rational.approx-r-h (cons defun (cons rational.approx-r-h (cons (cons (protect V889) (cons (protect V890) (cons (protect V891) ()))) (cons (cons cond (cons (cons (cons > (cons (cons / (cons (protect V891) (cons (protect V890) ()))) (cons (protect V889) ()))) (cons (cons r# (cons (protect V891) (cons (protect V890) ()))) ())) (cons (cons true (cons (cons rational.approx-r-h (cons (protect V889) (cons (protect V890) (cons (cons + (cons (protect V891) (cons 1 ()))) ())))) ())) ()))) ()))))) (do (shen.record-kl c# (cons defun (cons c# (cons (cons (protect V901) (cons (protect V902) ())) (cons (cons cond (cons (cons (cons and (cons (cons number? (cons (protect V901) ())) (cons (cons number? (cons (protect V902) ())) ()))) (cons (cons let (cons (protect W903) (cons (cons absvector (cons 3 ())) (cons (cons let (cons (protect W904) (cons (cons address-> (cons (protect W903) (cons 0 (cons complex.print-complex ())))) (cons (cons let (cons (protect W905) (cons (cons address-> (cons (protect W903) (cons 1 (cons (protect V901) ())))) (cons (cons let (cons (protect W906) (cons (cons address-> (cons (protect W903) (cons 2 (cons (protect V902) ())))) (cons (protect W903) ())))) ())))) ())))) ())))) ())) (cons (cons true (cons (cons simple-error (cons (cons cn (cons "real " (cons (cons shen.app (cons (protect V901) (cons (cons cn (cons " and imaginary " (cons (cons shen.app (cons (protect V902) (cons " must be numbers +" (cons shen.a ())))) ()))) (cons shen.a ())))) ()))) ())) ())) ()))) ()))))) (do (shen.record-kl complex.print-complex (cons defun (cons complex.print-complex (cons (cons (protect V909) ()) (cons (cons shen.insert (cons (cons <-address (cons (protect V909) (cons 2 ()))) (cons (cons shen.insert (cons (cons <-address (cons (protect V909) (cons 1 ()))) (cons (cons shen.proc-nl (cons (cons cn (cons "(c" (cons "# ~A ~A)" ()))) ())) ()))) ()))) ()))))) (do (shen.record-kl complex? (cons defun (cons complex? (cons (cons (protect V911) ()) (cons (cons trap-error (cons (cons and (cons (cons absvector? (cons (protect V911) ())) (cons (cons and (cons (cons = (cons (cons <-address (cons (protect V911) (cons 0 ()))) (cons complex.print-complex ()))) (cons (cons and (cons (cons number? (cons (cons <-address (cons (protect V911) (cons 1 ()))) ())) (cons (cons number? (cons (cons <-address (cons (protect V911) (cons 2 ()))) ())) ()))) ()))) ()))) (cons (cons lambda (cons (protect Z912) (cons false ()))) ()))) ()))))) (do (shen.record-kl real (cons defun (cons real (cons (cons (protect V914) ()) (cons (cons <-address (cons (protect V914) (cons 1 ()))) ()))))) (do (shen.record-kl imaginary (cons defun (cons imaginary (cons (cons (protect V916) ()) (cons (cons <-address (cons (protect V916) (cons 2 ()))) ()))))) (do (shen.record-kl c+ (cons defun (cons c+ (cons (cons (protect V926) (cons (protect V927) ())) (cons (cons let (cons (protect W928) (cons (cons real (cons (protect V926) ())) (cons (cons let (cons (protect W929) (cons (cons imaginary (cons (protect V926) ())) (cons (cons let (cons (protect W930) (cons (cons real (cons (protect V927) ())) (cons (cons let (cons (protect W931) (cons (cons imaginary (cons (protect V927) ())) (cons (cons c# (cons (cons + (cons (protect W928) (cons (protect W930) ()))) (cons (cons + (cons (protect W929) (cons (protect W931) ()))) ()))) ())))) ())))) ())))) ())))) ()))))) (do (shen.record-kl c- (cons defun (cons c- (cons (cons (protect V934) (cons (protect V935) ())) (cons (cons let (cons (protect W936) (cons (cons real (cons (protect V934) ())) (cons (cons let (cons (protect W937) (cons (cons imaginary (cons (protect V934) ())) (cons (cons let (cons (protect W938) (cons (cons real (cons (protect V935) ())) (cons (cons let (cons (protect W939) (cons (cons imaginary (cons (protect V935) ())) (cons (cons c# (cons (cons - (cons (protect W936) (cons (protect W938) ()))) (cons (cons - (cons (protect W937) (cons (protect W939) ()))) ()))) ())))) ())))) ())))) ())))) ()))))) (do (shen.record-kl c* (cons defun (cons c* (cons (cons (protect V942) (cons (protect V943) ())) (cons (cons let (cons (protect W944) (cons (cons real (cons (protect V942) ())) (cons (cons let (cons (protect W945) (cons (cons imaginary (cons (protect V942) ())) (cons (cons let (cons (protect W946) (cons (cons real (cons (protect V943) ())) (cons (cons let (cons (protect W947) (cons (cons imaginary (cons (protect V943) ())) (cons (cons c# (cons (cons - (cons (cons * (cons (protect W944) (cons (protect W946) ()))) (cons (cons * (cons (protect W945) (cons (protect W947) ()))) ()))) (cons (cons + (cons (cons * (cons (protect W945) (cons (protect W946) ()))) (cons (cons * (cons (protect W944) (cons (protect W947) ()))) ()))) ()))) ())))) ())))) ())))) ())))) ()))))) (do (shen.record-kl c/ (cons defun (cons c/ (cons (cons (protect V950) (cons (protect V951) ())) (cons (cons let (cons (protect W952) (cons (cons real (cons (protect V950) ())) (cons (cons let (cons (protect W953) (cons (cons imaginary (cons (protect V950) ())) (cons (cons let (cons (protect W954) (cons (cons real (cons (protect V951) ())) (cons (cons let (cons (protect W955) (cons (cons imaginary (cons (protect V951) ())) (cons (cons c# (cons (cons / (cons (cons + (cons (cons * (cons (protect W952) (cons (protect W954) ()))) (cons (cons * (cons (protect W953) (cons (protect W955) ()))) ()))) (cons (cons + (cons (cons * (cons (protect W954) (cons (protect W954) ()))) (cons (cons * (cons (protect W955) (cons (protect W955) ()))) ()))) ()))) (cons (cons / (cons (cons - (cons (cons * (cons (protect W953) (cons (protect W954) ()))) (cons (cons * (cons (protect W952) (cons (protect W955) ()))) ()))) (cons (cons + (cons (cons * (cons (protect W954) (cons (protect W954) ()))) (cons (cons * (cons (protect W955) (cons (protect W955) ()))) ()))) ()))) ()))) ())))) ())))) ())))) ())))) ()))))) (do (shen.record-kl n# (cons defun (cons n# (cons (cons (protect V968) (cons (protect V969) ())) (cons (cons cond (cons (cons (cons and (cons (cons natural? (cons (protect V968) ())) (cons (cons and (cons (cons natural? (cons (protect V969) ())) (cons (cons > (cons (protect V969) (cons 0 ()))) ()))) ()))) (cons (cons let (cons (protect W970) (cons (cons absvector (cons 4 ())) (cons (cons let (cons (protect W971) (cons (cons address-> (cons (protect W970) (cons 0 (cons numerals.print-numeral ())))) (cons (cons let (cons (protect W972) (cons (cons address-> (cons (protect W970) (cons 1 (cons (cons (cons (cons fn (cons numerals.n->numeral ())) (cons (protect V968) ())) (cons (protect V969) ())) ())))) (cons (cons let (cons (protect W973) (cons (cons address-> (cons (protect W970) (cons 2 (cons (protect V969) ())))) (cons (cons let (cons (protect W974) (cons (cons address-> (cons (protect W970) (cons 3 (cons (protect V968) ())))) (cons (protect W970) ())))) ())))) ())))) ())))) ())))) ())) (cons (cons true (cons (cons simple-error (cons (cons cn (cons "N = " (cons (cons shen.app (cons (protect V968) (cons (cons cn (cons ", Radix = " (cons (cons shen.app (cons (protect V969) (cons "; N and Radix must be natural numbers where Radix > 0 +" (cons shen.a ())))) ()))) (cons shen.a ())))) ()))) ())) ())) ()))) ()))))) (do (shen.record-kl radix (cons defun (cons radix (cons (cons (protect V977) ()) (cons (cons <-address (cons (protect V977) (cons 2 ()))) ()))))) (do (shen.record-kl numerals.numerals (cons defun (cons numerals.numerals (cons (cons (protect V979) ()) (cons (cons <-address (cons (protect V979) (cons 1 ()))) ()))))) (do (shen.record-kl n#->n (cons defun (cons n#->n (cons (cons (protect V981) ()) (cons (cons <-address (cons (protect V981) (cons 3 ()))) ()))))) (do (shen.record-kl n#->ns (cons defun (cons n#->ns (cons (cons (protect V983) ()) (cons (cons <-address (cons (protect V983) (cons 1 ()))) ()))))) (do (shen.record-kl numerals.print-numeral (cons defun (cons numerals.print-numeral (cons (cons (protect V985) ()) (cons (cons let (cons (protect W986) (cons (cons radix (cons (protect V985) ())) (cons (cons let (cons (protect W987) (cons (cons numerals.numerals (cons (protect V985) ())) (cons (cons @s (cons (cons numerals.numeric->string (cons (protect W987) (cons (protect W986) ()))) (cons (cons @s (cons "#" (cons (cons str (cons (protect W986) ())) ()))) ()))) ())))) ())))) ()))))) (do (shen.record-kl numerals.numeric->string (cons defun (cons numerals.numeric->string (cons (cons (protect V991) (cons (protect V992) ())) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V991) ()))) (cons "" ())) (cons (cons (cons cons? (cons (protect V991) ())) (cons (cons let (cons (protect W993) (cons (cons if (cons (cons < (cons (cons hd (cons (protect V991) ())) (cons 10 ()))) (cons (cons str (cons (cons hd (cons (protect V991) ())) ())) (cons (cons if (cons (cons > (cons (protect V992) (cons 36 ()))) (cons (cons cn (cons (cons str (cons (cons hd (cons (protect V991) ())) ())) (cons " " ()))) (cons (cons n->string (cons (cons + (cons (cons hd (cons (protect V991) ())) (cons 55 ()))) ())) ())))) ())))) (cons (cons cn (cons (protect W993) (cons (cons numerals.numeric->string (cons (cons tl (cons (protect V991) ())) (cons (protect V992) ()))) ()))) ())))) ())) (cons (cons true (cons (cons shen.f-error (cons numerals.numeric->string ())) ())) ())))) ()))))) (do (shen.record-kl numeral? (cons defun (cons numeral? (cons (cons (protect V996) ()) (cons (cons and (cons (cons absvector? (cons (protect V996) ())) (cons (cons = (cons numerals.print-numeral (cons (cons <-address (cons (protect V996) (cons 0 ()))) ()))) ()))) ()))))) (do (shen.record-kl numerals.numeral-macro (cons defun (cons numerals.numeral-macro (cons (cons (protect V1034) ()) (cons (cons cond (cons (cons (cons and (cons (cons cons? (cons (protect V1034) ())) (cons (cons and (cons (cons = (cons n-op2 (cons (cons hd (cons (protect V1034) ())) ()))) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect V1034) ())) ())) (cons (cons and (cons (cons cons? (cons (cons tl (cons (cons tl (cons (protect V1034) ())) ())) ())) (cons (cons and (cons (cons cons? (cons (cons tl (cons (cons tl (cons (cons tl (cons (protect V1034) ())) ())) ())) ())) (cons (cons = (cons () (cons (cons tl (cons (cons tl (cons (cons tl (cons (cons tl (cons (protect V1034) ())) ())) ())) ())) ()))) ()))) ()))) ()))) ()))) ()))) (cons (cons cons (cons n-op2 (cons (cons cons (cons (cons hd (cons (cons tl (cons (protect V1034) ())) ())) (cons (cons cons (cons (cons hd (cons (cons tl (cons (cons tl (cons (protect V1034) ())) ())) ())) (cons (cons cons (cons (cons hd (cons (cons tl (cons (cons tl (cons (cons tl (cons (protect V1034) ())) ())) ())) ())) (cons (cons cons (cons (cons cons (cons radix (cons (cons cons (cons (cons hd (cons (cons tl (cons (cons tl (cons (protect V1034) ())) ())) ())) (cons () ()))) ()))) (cons () ()))) ()))) ()))) ()))) ()))) ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1034) ())) (cons (cons and (cons (cons = (cons n-op1 (cons (cons hd (cons (protect V1034) ())) ()))) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect V1034) ())) ())) (cons (cons and (cons (cons cons? (cons (cons tl (cons (cons tl (cons (protect V1034) ())) ())) ())) (cons (cons = (cons () (cons (cons tl (cons (cons tl (cons (cons tl (cons (protect V1034) ())) ())) ())) ()))) ()))) ()))) ()))) ()))) (cons (cons cons (cons n-op1 (cons (cons cons (cons (cons hd (cons (cons tl (cons (protect V1034) ())) ())) (cons (cons cons (cons (cons hd (cons (cons tl (cons (cons tl (cons (protect V1034) ())) ())) ())) (cons (cons cons (cons (cons cons (cons radix (cons (cons tl (cons (cons tl (cons (protect V1034) ())) ())) ()))) (cons () ()))) ()))) ()))) ()))) ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1034) ())) (cons (cons and (cons (cons = (cons n+ (cons (cons hd (cons (protect V1034) ())) ()))) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect V1034) ())) ())) (cons (cons and (cons (cons cons? (cons (cons tl (cons (cons tl (cons (protect V1034) ())) ())) ())) (cons (cons = (cons () (cons (cons tl (cons (cons tl (cons (cons tl (cons (protect V1034) ())) ())) ())) ()))) ()))) ()))) ()))) ()))) (cons (cons cons (cons n+ (cons (cons cons (cons (cons hd (cons (cons tl (cons (protect V1034) ())) ())) (cons (cons cons (cons (cons hd (cons (cons tl (cons (cons tl (cons (protect V1034) ())) ())) ())) (cons (cons cons (cons (cons cons (cons radix (cons (cons cons (cons (cons hd (cons (cons tl (cons (protect V1034) ())) ())) (cons () ()))) ()))) (cons () ()))) ()))) ()))) ()))) ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1034) ())) (cons (cons and (cons (cons = (cons n- (cons (cons hd (cons (protect V1034) ())) ()))) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect V1034) ())) ())) (cons (cons and (cons (cons cons? (cons (cons tl (cons (cons tl (cons (protect V1034) ())) ())) ())) (cons (cons = (cons () (cons (cons tl (cons (cons tl (cons (cons tl (cons (protect V1034) ())) ())) ())) ()))) ()))) ()))) ()))) ()))) (cons (cons cons (cons n- (cons (cons cons (cons (cons hd (cons (cons tl (cons (protect V1034) ())) ())) (cons (cons cons (cons (cons hd (cons (cons tl (cons (cons tl (cons (protect V1034) ())) ())) ())) (cons (cons cons (cons (cons cons (cons radix (cons (cons cons (cons (cons hd (cons (cons tl (cons (protect V1034) ())) ())) (cons () ()))) ()))) (cons () ()))) ()))) ()))) ()))) ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1034) ())) (cons (cons and (cons (cons = (cons n* (cons (cons hd (cons (protect V1034) ())) ()))) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect V1034) ())) ())) (cons (cons and (cons (cons cons? (cons (cons tl (cons (cons tl (cons (protect V1034) ())) ())) ())) (cons (cons = (cons () (cons (cons tl (cons (cons tl (cons (cons tl (cons (protect V1034) ())) ())) ())) ()))) ()))) ()))) ()))) ()))) (cons (cons cons (cons n* (cons (cons cons (cons (cons hd (cons (cons tl (cons (protect V1034) ())) ())) (cons (cons cons (cons (cons hd (cons (cons tl (cons (cons tl (cons (protect V1034) ())) ())) ())) (cons (cons cons (cons (cons cons (cons radix (cons (cons cons (cons (cons hd (cons (cons tl (cons (protect V1034) ())) ())) (cons () ()))) ()))) (cons () ()))) ()))) ()))) ()))) ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1034) ())) (cons (cons and (cons (cons = (cons n/ (cons (cons hd (cons (protect V1034) ())) ()))) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect V1034) ())) ())) (cons (cons and (cons (cons cons? (cons (cons tl (cons (cons tl (cons (protect V1034) ())) ())) ())) (cons (cons = (cons () (cons (cons tl (cons (cons tl (cons (cons tl (cons (protect V1034) ())) ())) ())) ()))) ()))) ()))) ()))) ()))) (cons (cons cons (cons n/ (cons (cons cons (cons (cons hd (cons (cons tl (cons (protect V1034) ())) ())) (cons (cons cons (cons (cons hd (cons (cons tl (cons (cons tl (cons (protect V1034) ())) ())) ())) (cons (cons cons (cons (cons cons (cons radix (cons (cons cons (cons (cons hd (cons (cons tl (cons (protect V1034) ())) ())) (cons () ()))) ()))) (cons () ()))) ()))) ()))) ()))) ())) (cons (cons true (cons (protect V1034) ())) ())))))))) ()))))) (do (shen.record-kl n-op2 (cons defun (cons n-op2 (cons (cons (protect V1036) (cons (protect V1037) (cons (protect V1038) (cons (protect V1039) ())))) (cons (cons n# (cons (cons (cons (protect V1036) (cons (cons n#->n (cons (protect V1037) ())) ())) (cons (cons n#->n (cons (protect V1038) ())) ())) (cons (protect V1039) ()))) ()))))) (do (shen.record-kl n-op1 (cons defun (cons n-op1 (cons (cons (protect V1044) (cons (protect V1045) (cons (protect V1046) ()))) (cons (cons n# (cons (cons (protect V1044) (cons (cons n#->n (cons (protect V1045) ())) ())) (cons (protect V1046) ()))) ()))))) (do (shen.record-kl n+ (cons defun (cons n+ (cons (cons (protect V1052) (cons (protect V1053) (cons (protect V1054) ()))) (cons (cons n-op2 (cons (cons lambda (cons (protect Z1055) (cons (cons lambda (cons (protect Z1056) (cons (cons + (cons (protect Z1055) (cons (protect Z1056) ()))) ()))) ()))) (cons (protect V1052) (cons (protect V1053) (cons (protect V1054) ()))))) ()))))) (do (shen.record-kl n* (cons defun (cons n* (cons (cons (protect V1062) (cons (protect V1063) (cons (protect V1064) ()))) (cons (cons n-op2 (cons (cons lambda (cons (protect Z1065) (cons (cons lambda (cons (protect Z1066) (cons (cons * (cons (protect Z1065) (cons (protect Z1066) ()))) ()))) ()))) (cons (protect V1062) (cons (protect V1063) (cons (protect V1064) ()))))) ()))))) (do (shen.record-kl n- (cons defun (cons n- (cons (cons (protect V1072) (cons (protect V1073) (cons (protect V1074) ()))) (cons (cons n-op2 (cons (cons lambda (cons (protect Z1075) (cons (cons lambda (cons (protect Z1076) (cons (cons - (cons (protect Z1075) (cons (protect Z1076) ()))) ()))) ()))) (cons (protect V1072) (cons (protect V1073) (cons (protect V1074) ()))))) ()))))) (do (shen.record-kl n/ (cons defun (cons n/ (cons (cons (protect V1082) (cons (protect V1083) (cons (protect V1084) ()))) (cons (cons n-op2 (cons (cons lambda (cons (protect Z1085) (cons (cons lambda (cons (protect Z1086) (cons (cons / (cons (protect Z1085) (cons (protect Z1086) ()))) ()))) ()))) (cons (protect V1082) (cons (protect V1083) (cons (protect V1084) ()))))) ()))))) (do (shen.record-kl binary (cons defun (cons binary (cons (cons (protect V1090) ()) (cons (cons n# (cons (protect V1090) (cons 2 ()))) ()))))) (do (shen.record-kl hex (cons defun (cons hex (cons (cons (protect V1092) ()) (cons (cons n# (cons (protect V1092) (cons 16 ()))) ()))))) (do (shen.record-kl octal (cons defun (cons octal (cons (cons (protect V1094) ()) (cons (cons n# (cons (protect V1094) (cons 8 ()))) ()))))) (do (shen.record-kl duodecimal (cons defun (cons duodecimal (cons (cons (protect V1096) ()) (cons (cons n# (cons (protect V1096) (cons 12 ()))) ()))))) (do (shen.record-kl numerals.n->numeral (cons defun (cons numerals.n->numeral (cons (cons (protect V1098) (cons (protect V1099) ())) (cons (cons cond (cons (cons (cons > (cons (protect V1099) (cons (protect V1098) ()))) (cons (cons cons (cons (protect V1098) (cons () ()))) ())) (cons (cons true (cons (cons let (cons (protect W1100) (cons (cons numerals.largest-expt (cons (protect V1098) (cons (protect V1099) (cons 0 ())))) (cons (cons let (cons (protect W1101) (cons (cons power (cons (protect V1099) (cons (protect W1100) ()))) (cons (cons let (cons (protect W1102) (cons (cons div (cons (protect V1098) (cons (protect W1101) ()))) (cons (cons let (cons (protect W1103) (cons (cons cons (cons (protect W1102) (cons (cons numerals.n-zeros (cons (protect W1100) ())) ()))) (cons (cons let (cons (protect W1104) (cons (cons - (cons (protect V1098) (cons (cons * (cons (protect W1102) (cons (protect W1101) ()))) ()))) (cons (cons numerals.add (cons (protect W1103) (cons (cons numerals.n->numeral (cons (protect W1104) (cons (protect V1099) ()))) (cons (protect V1099) ())))) ())))) ())))) ())))) ())))) ())))) ())) ()))) ()))))) (do (shen.record-kl numerals.largest-expt (cons defun (cons numerals.largest-expt (cons (cons (protect V1107) (cons (protect V1108) (cons (protect V1109) ()))) (cons (cons cond (cons (cons (cons > (cons (cons power (cons (protect V1108) (cons (protect V1109) ()))) (cons (protect V1107) ()))) (cons (cons - (cons (protect V1109) (cons 1 ()))) ())) (cons (cons true (cons (cons numerals.largest-expt (cons (protect V1107) (cons (protect V1108) (cons (cons + (cons (protect V1109) (cons 1 ()))) ())))) ())) ()))) ()))))) (do (shen.record-kl numerals.n-zeros (cons defun (cons numerals.n-zeros (cons (cons (protect V1113) ()) (cons (cons cond (cons (cons (cons = (cons 0 (cons (protect V1113) ()))) (cons () ())) (cons (cons true (cons (cons cons (cons 0 (cons (cons numerals.n-zeros (cons (cons - (cons (protect V1113) (cons 1 ()))) ())) ()))) ())) ()))) ()))))) (do (shen.record-kl numerals.add (cons defun (cons numerals.add (cons (cons (protect V1115) (cons (protect V1116) (cons (protect V1117) ()))) (cons (cons reverse (cons (cons numerals.add-h (cons (cons reverse (cons (protect V1115) ())) (cons (cons reverse (cons (protect V1116) ())) (cons (protect V1117) (cons 0 ()))))) ())) ()))))) (do (shen.record-kl numerals.add-h (cons defun (cons numerals.add-h (cons (cons (protect V1125) (cons (protect V1126) (cons (protect V1127) (cons (protect V1128) ())))) (cons (cons cond (cons (cons (cons and (cons (cons = (cons () (cons (protect V1125) ()))) (cons (cons and (cons (cons = (cons () (cons (protect V1126) ()))) (cons (cons = (cons 0 (cons (protect V1128) ()))) ()))) ()))) (cons () ())) (cons (cons (cons and (cons (cons = (cons () (cons (protect V1125) ()))) (cons (cons = (cons () (cons (protect V1126) ()))) ()))) (cons (cons cons (cons (protect V1128) (cons () ()))) ())) (cons (cons (cons = (cons () (cons (protect V1125) ()))) (cons (cons numerals.add-h (cons (cons cons (cons 0 (cons () ()))) (cons (protect V1126) (cons (protect V1127) (cons (protect V1128) ()))))) ())) (cons (cons (cons = (cons () (cons (protect V1126) ()))) (cons (cons numerals.add-h (cons (protect V1125) (cons (cons cons (cons 0 (cons () ()))) (cons (protect V1127) (cons (protect V1128) ()))))) ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1125) ())) (cons (cons cons? (cons (protect V1126) ())) ()))) (cons (cons let (cons (protect W1129) (cons (cons + (cons (cons hd (cons (protect V1125) ())) (cons (cons + (cons (cons hd (cons (protect V1126) ())) (cons (protect V1128) ()))) ()))) (cons (cons if (cons (cons < (cons (protect W1129) (cons (protect V1127) ()))) (cons (cons cons (cons (protect W1129) (cons (cons numerals.add-h (cons (cons tl (cons (protect V1125) ())) (cons (cons tl (cons (protect V1126) ())) (cons (protect V1127) (cons 0 ()))))) ()))) (cons (cons cons (cons (cons - (cons (protect V1127) (cons (protect W1129) ()))) (cons (cons numerals.add-h (cons (cons tl (cons (protect V1125) ())) (cons (cons tl (cons (protect V1126) ())) (cons (protect V1127) (cons 1 ()))))) ()))) ())))) ())))) ())) (cons (cons true (cons (cons shen.f-error (cons numerals.add-h ())) ())) ()))))))) ()))))) (do (shen.record-kl assoc-if (cons defun (cons assoc-if (cons (cons (protect V1240) (cons (protect V1241) ())) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1241) ()))) (cons () ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1241) ())) (cons (cons and (cons (cons cons? (cons (cons hd (cons (protect V1241) ())) ())) (cons (cons (protect V1240) (cons (cons hd (cons (cons hd (cons (protect V1241) ())) ())) ())) ()))) ()))) (cons (cons hd (cons (protect V1241) ())) ())) (cons (cons (cons cons? (cons (protect V1241) ())) (cons (cons assoc-if (cons (protect V1240) (cons (cons tl (cons (protect V1241) ())) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons assoc-if ())) ())) ()))))) ()))))) (do (shen.record-kl assoc-if-not (cons defun (cons assoc-if-not (cons (cons (protect V1249) (cons (protect V1250) ())) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1250) ()))) (cons () ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1250) ())) (cons (cons and (cons (cons cons? (cons (cons hd (cons (protect V1250) ())) ())) (cons (cons not (cons (cons (protect V1249) (cons (cons hd (cons (cons hd (cons (protect V1250) ())) ())) ())) ())) ()))) ()))) (cons (cons hd (cons (protect V1250) ())) ())) (cons (cons (cons cons? (cons (protect V1250) ())) (cons (cons assoc-if (cons (protect V1249) (cons (cons tl (cons (protect V1250) ())) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons assoc-if-not ())) ())) ()))))) ()))))) (do (shen.record-kl drop (cons defun (cons drop (cons (cons (protect V1255) (cons (protect V1256) ())) (cons (cons cond (cons (cons (cons = (cons 0 (cons (protect V1255) ()))) (cons (protect V1256) ())) (cons (cons (cons cons? (cons (protect V1256) ())) (cons (cons drop (cons (cons - (cons (protect V1255) (cons 1 ()))) (cons (cons tl (cons (protect V1256) ())) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons drop ())) ())) ())))) ()))))) (do (shen.record-kl drop-last (cons defun (cons drop-last (cons (cons (protect V1259) (cons (protect V1260) ())) (cons (cons reverse (cons (cons drop (cons (protect V1259) (cons (cons reverse (cons (protect V1260) ())) ()))) ())) ()))))) (do (shen.record-kl index (cons defun (cons index (cons (cons (protect V1263) (cons (protect V1264) ())) (cons (cons list.index-h (cons (protect V1263) (cons (protect V1264) (cons 1 ())))) ()))))) (do (shen.record-kl list.index-h (cons defun (cons list.index-h (cons (cons (protect V1276) (cons (protect V1277) (cons (protect V1278) ()))) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1277) ()))) (cons -1 ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1277) ())) (cons (cons = (cons (protect V1276) (cons (cons hd (cons (protect V1277) ())) ()))) ()))) (cons (protect V1278) ())) (cons (cons (cons cons? (cons (protect V1277) ())) (cons (cons list.index-h (cons (protect V1276) (cons (cons tl (cons (protect V1277) ())) (cons (cons + (cons (protect V1278) (cons 1 ()))) ())))) ())) (cons (cons true (cons (cons shen.f-error (cons list.index-h ())) ())) ()))))) ()))))) (do (shen.record-kl index-last (cons defun (cons index-last (cons (cons (protect V1282) (cons (protect V1283) ())) (cons (cons let (cons (protect W1284) (cons (cons length (cons (protect V1283) ())) (cons (cons let (cons (protect W1285) (cons (cons index (cons (protect V1282) (cons (cons reverse (cons (protect V1283) ())) ()))) (cons (cons if (cons (cons = (cons (protect W1285) (cons -1 ()))) (cons (protect W1285) (cons (cons + (cons (cons - (cons (protect W1284) (cons (protect W1285) ()))) (cons 1 ()))) ())))) ())))) ())))) ()))))) (do (shen.record-kl insert (cons defun (cons insert (cons (cons (protect V1290) (cons (protect V1291) (cons (protect V1292) ()))) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1292) ()))) (cons (cons simple-error (cons (cons cn (cons "cannot insert " (cons (cons shen.app (cons (protect V1291) (cons " into list: index out of range +" (cons shen.s ())))) ()))) ())) ())) (cons (cons (cons = (cons 1 (cons (protect V1290) ()))) (cons (cons cons (cons (protect V1291) (cons (protect V1292) ()))) ())) (cons (cons (cons cons? (cons (protect V1292) ())) (cons (cons cons (cons (cons hd (cons (protect V1292) ())) (cons (cons insert (cons (cons - (cons (protect V1290) (cons 1 ()))) (cons (protect V1291) (cons (cons tl (cons (protect V1292) ())) ())))) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons insert ())) ())) ()))))) ()))))) (do (shen.record-kl remove-duplicates (cons defun (cons remove-duplicates (cons (cons (protect V1296) ()) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1296) ()))) (cons () ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1296) ())) (cons (cons element? (cons (cons hd (cons (protect V1296) ())) (cons (cons tl (cons (protect V1296) ())) ()))) ()))) (cons (cons remove-duplicates (cons (cons tl (cons (protect V1296) ())) ())) ())) (cons (cons (cons cons? (cons (protect V1296) ())) (cons (cons cons (cons (cons hd (cons (protect V1296) ())) (cons (cons remove-duplicates (cons (cons tl (cons (protect V1296) ())) ())) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons remove-duplicates ())) ())) ()))))) ()))))) (do (shen.record-kl trim-left-if (cons defun (cons trim-left-if (cons (cons (protect V1302) (cons (protect V1303) ())) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1303) ()))) (cons () ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1303) ())) (cons (cons (protect V1302) (cons (cons hd (cons (protect V1303) ())) ())) ()))) (cons (cons trim-left-if (cons (protect V1302) (cons (cons tl (cons (protect V1303) ())) ()))) ())) (cons (cons true (cons (protect V1303) ())) ())))) ()))))) (do (shen.record-kl trim-right-if (cons defun (cons trim-right-if (cons (cons (protect V1306) (cons (protect V1307) ())) (cons (cons reverse (cons (cons trim-left-if (cons (protect V1306) (cons (cons reverse (cons (protect V1307) ())) ()))) ())) ()))))) (do (shen.record-kl trim-if (cons defun (cons trim-if (cons (cons (protect V1310) (cons (protect V1311) ())) (cons (cons trim-right-if (cons (protect V1310) (cons (cons trim-left-if (cons (protect V1310) (cons (protect V1311) ()))) ()))) ()))))) (do (shen.record-kl trim-left (cons defun (cons trim-left (cons (cons (protect V1318) (cons (protect V1319) ())) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1319) ()))) (cons () ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1319) ())) (cons (cons element? (cons (cons hd (cons (protect V1319) ())) (cons (protect V1318) ()))) ()))) (cons (cons trim-left (cons (protect V1318) (cons (cons tl (cons (protect V1319) ())) ()))) ())) (cons (cons true (cons (protect V1319) ())) ())))) ()))))) (do (shen.record-kl trim-right (cons defun (cons trim-right (cons (cons (protect V1322) (cons (protect V1323) ())) (cons (cons reverse (cons (cons trim-left (cons (protect V1322) (cons (cons reverse (cons (protect V1323) ())) ()))) ())) ()))))) (do (shen.record-kl trim (cons defun (cons trim (cons (cons (protect V1326) (cons (protect V1327) ())) (cons (cons trim-right (cons (protect V1326) (cons (cons trim-left (cons (protect V1326) (cons (protect V1327) ()))) ()))) ()))))) (do (shen.record-kl prefix? (cons defun (cons prefix? (cons (cons (protect V1337) (cons (protect V1338) ())) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1337) ()))) (cons true ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1337) ())) (cons (cons and (cons (cons cons? (cons (protect V1338) ())) (cons (cons = (cons (cons hd (cons (protect V1337) ())) (cons (cons hd (cons (protect V1338) ())) ()))) ()))) ()))) (cons (cons prefix? (cons (cons tl (cons (protect V1337) ())) (cons (cons tl (cons (protect V1338) ())) ()))) ())) (cons (cons true (cons false ())) ())))) ()))))) (do (shen.record-kl infix? (cons defun (cons infix? (cons (cons (protect V1345) (cons (protect V1346) ())) (cons (cons cond (cons (cons (cons prefix? (cons (protect V1345) (cons (protect V1346) ()))) (cons true ())) (cons (cons (cons = (cons () (cons (protect V1346) ()))) (cons false ())) (cons (cons (cons cons? (cons (protect V1346) ())) (cons (cons infix? (cons (protect V1345) (cons (cons tl (cons (protect V1346) ())) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons infix? ())) ())) ()))))) ()))))) (do (shen.record-kl suffix? (cons defun (cons suffix? (cons (cons (protect V1349) (cons (protect V1350) ())) (cons (cons prefix? (cons (cons reverse (cons (protect V1349) ())) (cons (cons reverse (cons (protect V1350) ())) ()))) ()))))) (do (shen.record-kl subset? (cons defun (cons subset? (cons (cons (protect V1359) (cons (protect V1360) ())) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1359) ()))) (cons true ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1359) ())) (cons (cons element? (cons (cons hd (cons (protect V1359) ())) (cons (protect V1360) ()))) ()))) (cons (cons subset? (cons (cons tl (cons (protect V1359) ())) (cons (protect V1360) ()))) ())) (cons (cons true (cons false ())) ())))) ()))))) (do (shen.record-kl set=? (cons defun (cons set=? (cons (cons (protect V1363) (cons (protect V1364) ())) (cons (cons and (cons (cons subset? (cons (protect V1363) (cons (protect V1364) ()))) (cons (cons subset? (cons (protect V1364) (cons (protect V1363) ()))) ()))) ()))))) (do (shen.record-kl set? (cons defun (cons set? (cons (cons (protect V1369) ()) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1369) ()))) (cons true ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1369) ())) (cons (cons element? (cons (cons hd (cons (protect V1369) ())) (cons (cons tl (cons (protect V1369) ())) ()))) ()))) (cons false ())) (cons (cons (cons cons? (cons (protect V1369) ())) (cons (cons set? (cons (cons tl (cons (protect V1369) ())) ())) ())) (cons (cons true (cons (cons shen.f-error (cons set? ())) ())) ()))))) ()))))) (do (shen.record-kl n-times (cons defun (cons n-times (cons (cons (protect V1371) (cons (protect V1372) ())) (cons (cons list.n-times-h (cons (protect V1372) (cons (protect V1371) (cons () ())))) ()))))) (do (shen.record-kl list.n-times-h (cons defun (cons list.n-times-h (cons (cons (protect V1375) (cons (protect V1376) (cons (protect V1377) ()))) (cons (cons cond (cons (cons (cons = (cons 0 (cons (protect V1375) ()))) (cons (protect V1377) ())) (cons (cons true (cons (cons list.n-times-h (cons (cons - (cons (protect V1375) (cons 1 ()))) (cons (protect V1376) (cons (cons cons (cons (protect V1376) (cons (protect V1377) ()))) ())))) ())) ()))) ()))))) (do (shen.record-kl subbag? (cons defun (cons subbag? (cons (cons (protect V1381) (cons (protect V1382) ())) (cons (cons every? (cons (cons lambda (cons (protect Z1383) (cons (cons = (cons (cons count (cons (protect Z1383) (cons (protect V1381) ()))) (cons (cons count (cons (protect Z1383) (cons (protect V1382) ()))) ()))) ()))) (cons (protect V1381) ()))) ()))))) (do (shen.record-kl bag=? (cons defun (cons bag=? (cons (cons (protect V1386) (cons (protect V1387) ())) (cons (cons and (cons (cons subbag? (cons (protect V1386) (cons (protect V1387) ()))) (cons (cons subbag? (cons (protect V1387) (cons (protect V1386) ()))) ()))) ()))))) (do (shen.record-kl mapc (cons defun (cons mapc (cons (cons (protect V1392) (cons (protect V1393) ())) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1393) ()))) (cons () ())) (cons (cons (cons cons? (cons (protect V1393) ())) (cons (cons mapc (cons (cons do (cons (cons (protect V1392) (cons (cons hd (cons (protect V1393) ())) ())) (cons (protect V1392) ()))) (cons (cons tl (cons (protect V1393) ())) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons mapc ())) ())) ())))) ()))))) (do (shen.record-kl permute (cons defun (cons permute (cons (cons (protect V1396) ()) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1396) ()))) (cons (cons cons (cons () (cons () ()))) ())) (cons (cons true (cons (cons mapcan (cons (cons lambda (cons (protect Z1397) (cons (cons map (cons (cons lambda (cons (protect Z1398) (cons (cons cons (cons (protect Z1397) (cons (protect Z1398) ()))) ()))) (cons (cons permute (cons (cons remove (cons (protect Z1397) (cons (protect V1396) ()))) ())) ()))) ()))) (cons (protect V1396) ()))) ())) ()))) ()))))) (do (shen.record-kl count-if (cons defun (cons count-if (cons (cons (protect V1400) (cons (protect V1401) ())) (cons (cons length (cons (cons mapcan (cons (cons lambda (cons (protect Z1402) (cons (cons if (cons (cons (protect V1400) (cons (protect Z1402) ())) (cons (cons cons (cons (protect Z1402) (cons () ()))) (cons () ())))) ()))) (cons (protect V1401) ()))) ())) ()))))) (do (shen.record-kl count (cons defun (cons count (cons (cons (protect V1406) (cons (protect V1407) ())) (cons (cons count-if (cons (cons lambda (cons (protect Z1408) (cons (cons = (cons (protect V1406) (cons (protect Z1408) ()))) ()))) (cons (protect V1407) ()))) ()))))) (do (shen.record-kl some? (cons defun (cons some? (cons (cons (protect V1416) (cons (protect V1417) ())) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1417) ()))) (cons false ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1417) ())) (cons (cons (protect V1416) (cons (cons hd (cons (protect V1417) ())) ())) ()))) (cons true ())) (cons (cons (cons cons? (cons (protect V1417) ())) (cons (cons some? (cons (protect V1416) (cons (cons tl (cons (protect V1417) ())) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons some? ())) ())) ()))))) ()))))) (do (shen.record-kl every? (cons defun (cons every? (cons (cons (protect V1426) (cons (protect V1427) ())) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1427) ()))) (cons true ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1427) ())) (cons (cons (protect V1426) (cons (cons hd (cons (protect V1427) ())) ())) ()))) (cons (cons every? (cons (protect V1426) (cons (cons tl (cons (protect V1427) ())) ()))) ())) (cons (cons true (cons false ())) ())))) ()))))) (do (shen.record-kl sort (cons defun (cons sort (cons (cons (protect V1434) (cons (protect V1435) ())) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1435) ()))) (cons () ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1435) ())) (cons (cons = (cons () (cons (cons tl (cons (protect V1435) ())) ()))) ()))) (cons (protect V1435) ())) (cons (cons (cons cons? (cons (protect V1435) ())) (cons (cons let (cons (protect W1436) (cons (cons mapcan (cons (cons lambda (cons (protect Z1437) (cons (cons if (cons (cons (cons (protect V1434) (cons (protect Z1437) ())) (cons (cons hd (cons (protect V1435) ())) ())) (cons (cons cons (cons (protect Z1437) (cons () ()))) (cons () ())))) ()))) (cons (cons tl (cons (protect V1435) ())) ()))) (cons (cons let (cons (protect W1438) (cons (cons mapcan (cons (cons lambda (cons (protect Z1439) (cons (cons if (cons (cons not (cons (cons (cons (protect V1434) (cons (protect Z1439) ())) (cons (cons hd (cons (protect V1435) ())) ())) ())) (cons (cons cons (cons (protect Z1439) (cons () ()))) (cons () ())))) ()))) (cons (cons tl (cons (protect V1435) ())) ()))) (cons (cons append (cons (cons sort (cons (protect V1434) (cons (protect W1436) ()))) (cons (cons append (cons (cons cons (cons (cons hd (cons (protect V1435) ())) (cons () ()))) (cons (cons sort (cons (protect V1434) (cons (protect W1438) ()))) ()))) ()))) ())))) ())))) ())) (cons (cons true (cons (cons shen.f-error (cons sort ())) ())) ()))))) ()))))) (do (shen.record-kl find (cons defun (cons find (cons (cons (protect V1447) (cons (protect V1448) ())) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1448) ()))) (cons (cons simple-error (cons "find has found no element +" ())) ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1448) ())) (cons (cons (protect V1447) (cons (cons hd (cons (protect V1448) ())) ())) ()))) (cons (cons hd (cons (protect V1448) ())) ())) (cons (cons (cons cons? (cons (protect V1448) ())) (cons (cons find (cons (protect V1447) (cons (cons tl (cons (protect V1448) ())) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons find ())) ())) ()))))) ()))))) (do (shen.record-kl foldr (cons defun (cons foldr (cons (cons (protect V1453) (cons (protect V1454) (cons (protect V1455) ()))) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1455) ()))) (cons (protect V1454) ())) (cons (cons (cons cons? (cons (protect V1455) ())) (cons (cons foldr (cons (protect V1453) (cons (cons (cons (protect V1453) (cons (cons hd (cons (protect V1455) ())) ())) (cons (protect V1454) ())) (cons (cons tl (cons (protect V1455) ())) ())))) ())) (cons (cons true (cons (cons shen.f-error (cons foldr ())) ())) ())))) ()))))) (do (shen.record-kl foldl (cons defun (cons foldl (cons (cons (protect V1461) (cons (protect V1462) (cons (protect V1463) ()))) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1463) ()))) (cons (protect V1462) ())) (cons (cons (cons cons? (cons (protect V1463) ())) (cons (cons foldl (cons (protect V1461) (cons (cons (cons (protect V1461) (cons (protect V1462) ())) (cons (cons hd (cons (protect V1463) ())) ())) (cons (cons tl (cons (protect V1463) ())) ())))) ())) (cons (cons true (cons (cons shen.f-error (cons foldl ())) ())) ())))) ()))))) (do (shen.record-kl mapf (cons defun (cons mapf (cons (cons (protect V1471) (cons (protect V1472) (cons (protect V1473) ()))) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1472) ()))) (cons () ())) (cons (cons (cons cons? (cons (protect V1472) ())) (cons (cons (cons (protect V1473) (cons (cons (protect V1471) (cons (cons hd (cons (protect V1472) ())) ())) ())) (cons (cons mapf (cons (protect V1471) (cons (cons tl (cons (protect V1472) ())) (cons (protect V1473) ())))) ())) ())) (cons (cons true (cons (cons shen.f-error (cons mapf ())) ())) ())))) ()))))) (do (shen.record-kl filter (cons defun (cons filter (cons (cons (protect V1479) (cons (protect V1480) ())) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1480) ()))) (cons () ())) (cons (cons (cons cons? (cons (protect V1480) ())) (cons (cons if (cons (cons (protect V1479) (cons (cons hd (cons (protect V1480) ())) ())) (cons (cons cons (cons (cons hd (cons (protect V1480) ())) (cons (cons filter (cons (protect V1479) (cons (cons tl (cons (protect V1480) ())) ()))) ()))) (cons (cons filter (cons (protect V1479) (cons (cons tl (cons (protect V1480) ())) ()))) ())))) ())) (cons (cons true (cons (cons shen.f-error (cons filter ())) ())) ())))) ()))))) (do (shen.record-kl remove-if (cons defun (cons remove-if (cons (cons (protect V1485) (cons (protect V1486) ())) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1486) ()))) (cons () ())) (cons (cons (cons cons? (cons (protect V1486) ())) (cons (cons if (cons (cons (protect V1485) (cons (cons hd (cons (protect V1486) ())) ())) (cons (cons remove-if (cons (protect V1485) (cons (cons tl (cons (protect V1486) ())) ()))) (cons (cons cons (cons (cons hd (cons (protect V1486) ())) (cons (cons remove-if (cons (protect V1485) (cons (cons tl (cons (protect V1486) ())) ()))) ()))) ())))) ())) (cons (cons true (cons (cons shen.f-error (cons remove-if ())) ())) ())))) ()))))) (do (shen.record-kl list.reduce (cons defun (cons list.reduce (cons (cons (protect V1489) (cons (protect V1490) (cons (protect V1491) ()))) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1491) ()))) (cons (protect V1490) ())) (cons (cons (cons cons? (cons (protect V1491) ())) (cons (cons list.reduce (cons (protect V1489) (cons (cons (cons (protect V1489) (cons (protect V1490) ())) (cons (cons hd (cons (protect V1491) ())) ())) (cons (cons tl (cons (protect V1491) ())) ())))) ())) (cons (cons true (cons (cons shen.f-error (cons list.reduce ())) ())) ())))) ()))))) (do (shen.record-kl take (cons defun (cons take (cons (cons (protect V1499) (cons (protect V1500) ())) (cons (cons cond (cons (cons (cons = (cons 0 (cons (protect V1499) ()))) (cons () ())) (cons (cons (cons = (cons () (cons (protect V1500) ()))) (cons () ())) (cons (cons (cons cons? (cons (protect V1500) ())) (cons (cons cons (cons (cons hd (cons (protect V1500) ())) (cons (cons take (cons (cons - (cons (protect V1499) (cons 1 ()))) (cons (cons tl (cons (protect V1500) ())) ()))) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons take ())) ())) ()))))) ()))))) (do (shen.record-kl take-last (cons defun (cons take-last (cons (cons (protect V1503) (cons (protect V1504) ())) (cons (cons reverse (cons (cons take (cons (protect V1503) (cons (cons reverse (cons (protect V1504) ())) ()))) ())) ()))))) (do (shen.record-kl cartprod (cons defun (cons cartprod (cons (cons (protect V1509) (cons (protect V1510) ())) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1509) ()))) (cons () ())) (cons (cons (cons cons? (cons (protect V1509) ())) (cons (cons append (cons (cons map (cons (cons lambda (cons (protect Z1511) (cons (cons cons (cons (cons hd (cons (protect V1509) ())) (cons (cons cons (cons (protect Z1511) (cons () ()))) ()))) ()))) (cons (protect V1510) ()))) (cons (cons cartprod (cons (cons tl (cons (protect V1509) ())) (cons (protect V1510) ()))) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons cartprod ())) ())) ())))) ()))))) (do (shen.record-kl powerset (cons defun (cons powerset (cons (cons (protect V1514) ()) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1514) ()))) (cons (cons cons (cons () (cons () ()))) ())) (cons (cons (cons cons? (cons (protect V1514) ())) (cons (cons let (cons (protect W1515) (cons (cons powerset (cons (cons tl (cons (protect V1514) ())) ())) (cons (cons append (cons (protect W1515) (cons (cons map (cons (cons lambda (cons (protect Z1516) (cons (cons cons (cons (cons hd (cons (protect V1514) ())) (cons (protect Z1516) ()))) ()))) (cons (protect W1515) ()))) ()))) ())))) ())) (cons (cons true (cons (cons shen.f-error (cons powerset ())) ())) ())))) ()))))) (do (shen.record-kl partition (cons defun (cons partition (cons (cons (protect V1524) (cons (protect V1525) ())) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1525) ()))) (cons () ())) (cons (cons (cons cons? (cons (protect V1525) ())) (cons (cons let (cons (protect W1526) (cons (cons mapcan (cons (cons lambda (cons (protect Z1527) (cons (cons if (cons (cons (cons (protect V1524) (cons (cons hd (cons (protect V1525) ())) ())) (cons (protect Z1527) ())) (cons (cons cons (cons (protect Z1527) (cons () ()))) (cons () ())))) ()))) (cons (protect V1525) ()))) (cons (cons let (cons (protect W1528) (cons (cons difference (cons (protect V1525) (cons (protect W1526) ()))) (cons (cons cons (cons (protect W1526) (cons (cons partition (cons (protect V1524) (cons (protect W1528) ()))) ()))) ())))) ())))) ())) (cons (cons true (cons (cons simple-error (cons "partition equires a list" ())) ())) ())))) ()))))) (do (shen.record-kl transitive-closure (cons defun (cons transitive-closure (cons (cons (protect V1531) ()) (cons (cons let (cons (protect W1532) (cons (cons list.transitive-pass (cons (protect V1531) (cons (protect V1531) ()))) (cons (cons if (cons (cons = (cons (protect W1532) (cons (protect V1531) ()))) (cons (protect W1532) (cons (cons list.transitive-pass (cons (protect W1532) (cons (protect W1532) ()))) ())))) ())))) ()))))) (do (shen.record-kl list.transitive-pass (cons defun (cons list.transitive-pass (cons (cons (protect V1534) (cons (protect V1535) ())) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1534) ()))) (cons (protect V1535) ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1534) ())) (cons (cons tuple? (cons (cons hd (cons (protect V1534) ())) ())) ()))) (cons (cons let (cons (protect W1536) (cons (cons list.find-trans (cons (cons fst (cons (cons hd (cons (protect V1534) ())) ())) (cons (cons snd (cons (cons hd (cons (protect V1534) ())) ())) (cons (protect V1535) ())))) (cons (cons union (cons (protect W1536) (cons (cons list.transitive-pass (cons (cons tl (cons (protect V1534) ())) (cons (protect V1535) ()))) ()))) ())))) ())) (cons (cons true (cons (cons shen.f-error (cons list.transitive-pass ())) ())) ())))) ()))))) (do (shen.record-kl list.find-trans (cons defun (cons list.find-trans (cons (cons (protect V1546) (cons (protect V1547) (cons (protect V1548) ()))) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1548) ()))) (cons () ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1548) ())) (cons (cons and (cons (cons tuple? (cons (cons hd (cons (protect V1548) ())) ())) (cons (cons = (cons (protect V1547) (cons (cons fst (cons (cons hd (cons (protect V1548) ())) ())) ()))) ()))) ()))) (cons (cons cons (cons (cons @p (cons (protect V1546) (cons (cons snd (cons (cons hd (cons (protect V1548) ())) ())) ()))) (cons (cons list.find-trans (cons (protect V1546) (cons (cons fst (cons (cons hd (cons (protect V1548) ())) ())) (cons (cons tl (cons (protect V1548) ())) ())))) ()))) ())) (cons (cons (cons cons? (cons (protect V1548) ())) (cons (cons list.find-trans (cons (protect V1546) (cons (protect V1547) (cons (cons tl (cons (protect V1548) ())) ())))) ())) (cons (cons true (cons (cons shen.f-error (cons list.find-trans ())) ())) ()))))) ()))))) (do (shen.record-kl x->ascii (cons defun (cons x->ascii (cons (cons (protect V1553) ()) (cons (cons map (cons (cons lambda (cons (protect Z1554) (cons (cons string->n (cons (protect Z1554) ())) ()))) (cons (cons explode (cons (protect V1553) ())) ()))) ()))))) (do (shen.record-kl splice (cons defun (cons splice (cons (cons (protect V1556) (cons (protect V1557) (cons (protect V1558) ()))) (cons (cons cond (cons (cons (cons = (cons 1 (cons (protect V1556) ()))) (cons (cons append (cons (protect V1557) (cons (protect V1558) ()))) ())) (cons (cons (cons cons? (cons (protect V1558) ())) (cons (cons cons (cons (cons hd (cons (protect V1558) ())) (cons (cons splice (cons (cons - (cons (protect V1556) (cons 1 ()))) (cons (protect V1557) (cons (cons tl (cons (protect V1558) ())) ())))) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons splice ())) ())) ())))) ()))))) (do (shen.record-kl string-macros (cons defun (cons string-macros (cons (cons (protect V1562) ()) (cons (cons cond (cons (cons (cons and (cons (cons cons? (cons (protect V1562) ())) (cons (cons and (cons (cons = (cons s-op1 (cons (cons hd (cons (protect V1562) ())) ()))) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect V1562) ())) ())) (cons (cons and (cons (cons cons? (cons (cons tl (cons (cons tl (cons (protect V1562) ())) ())) ())) (cons (cons = (cons () (cons (cons tl (cons (cons tl (cons (cons tl (cons (protect V1562) ())) ())) ())) ()))) ()))) ()))) ()))) ()))) (cons (cons cons (cons s-op1 (cons (cons cons (cons (cons hd (cons (cons tl (cons (protect V1562) ())) ())) (cons (cons cons (cons (cons hd (cons (cons tl (cons (cons tl (cons (protect V1562) ())) ())) ())) (cons (cons cons (cons (cons cons (cons /. (cons (cons cons (cons (protect X) (cons (cons cons (cons (protect X) (cons () ()))) ()))) ()))) (cons () ()))) ()))) ()))) ()))) ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1562) ())) (cons (cons and (cons (cons = (cons s-op2 (cons (cons hd (cons (protect V1562) ())) ()))) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect V1562) ())) ())) (cons (cons and (cons (cons cons? (cons (cons tl (cons (cons tl (cons (protect V1562) ())) ())) ())) (cons (cons and (cons (cons cons? (cons (cons tl (cons (cons tl (cons (cons tl (cons (protect V1562) ())) ())) ())) ())) (cons (cons = (cons () (cons (cons tl (cons (cons tl (cons (cons tl (cons (cons tl (cons (protect V1562) ())) ())) ())) ())) ()))) ()))) ()))) ()))) ()))) ()))) (cons (cons cons (cons s-op2 (cons (cons cons (cons (cons hd (cons (cons tl (cons (protect V1562) ())) ())) (cons (cons cons (cons (cons hd (cons (cons tl (cons (cons tl (cons (protect V1562) ())) ())) ())) (cons (cons cons (cons (cons hd (cons (cons tl (cons (cons tl (cons (cons tl (cons (protect V1562) ())) ())) ())) ())) (cons (cons cons (cons (cons cons (cons /. (cons (cons cons (cons (protect X) (cons (cons cons (cons (protect X) (cons () ()))) ()))) ()))) (cons () ()))) ()))) ()))) ()))) ()))) ())) (cons (cons true (cons (protect V1562) ())) ())))) ()))))) (do (shen.record-kl string->list (cons defun (cons string->list (cons (cons (protect V1652) ()) (cons (cons cond (cons (cons (cons = (cons "" (cons (protect V1652) ()))) (cons () ())) (cons (cons true (cons (cons string.s->l-h (cons (protect V1652) (cons 1 (cons (cons pos (cons (protect V1652) (cons 0 ()))) (cons () ()))))) ())) ()))) ()))))) (do (shen.record-kl string.s->l-h (cons defun (cons string.s->l-h (cons (cons (protect V1654) (cons (protect V1655) (cons (protect V1656) (cons (protect V1657) ())))) (cons (cons cond (cons (cons (cons = (cons "" (cons (protect V1656) ()))) (cons (cons reverse (cons (protect V1657) ())) ())) (cons (cons true (cons (cons string.s->l-h (cons (protect V1654) (cons (cons + (cons (protect V1655) (cons 1 ()))) (cons (cons trap-error (cons (cons pos (cons (protect V1654) (cons (protect V1655) ()))) (cons (cons lambda (cons (protect Z1658) (cons "" ()))) ()))) (cons (cons cons (cons (protect V1656) (cons (protect V1657) ()))) ()))))) ())) ()))) ()))))) (do (shen.record-kl list->string (cons defun (cons list->string (cons (cons (protect V1663) ()) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1663) ()))) (cons "" ())) (cons (cons (cons cons? (cons (protect V1663) ())) (cons (cons cn (cons (cons hd (cons (protect V1663) ())) (cons (cons list->string (cons (cons tl (cons (protect V1663) ())) ())) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons list->string ())) ())) ())))) ()))))) (do (shen.record-kl s-op1 (cons defun (cons s-op1 (cons (cons (protect V1665) (cons (protect V1666) (cons (protect V1667) ()))) (cons (cons (protect V1667) (cons (cons (protect V1665) (cons (cons string->list (cons (protect V1666) ())) ())) ())) ()))))) (do (shen.record-kl s-op2 (cons defun (cons s-op2 (cons (cons (protect V1671) (cons (protect V1672) (cons (protect V1673) (cons (protect V1674) ())))) (cons (cons (protect V1674) (cons (cons (cons (protect V1671) (cons (cons string->list (cons (protect V1672) ())) ())) (cons (cons string->list (cons (protect V1673) ())) ())) ())) ()))))) (do (shen.record-kl string.count (cons defun (cons string.count (cons (cons (protect V1684) (cons (protect V1685) ())) (cons (cons cond (cons (cons (cons = (cons "" (cons (protect V1685) ()))) (cons 0 ())) (cons (cons (cons and (cons (cons shen.+string? (cons (protect V1685) ())) (cons (cons = (cons (protect V1684) (cons (cons hdstr (cons (protect V1685) ())) ()))) ()))) (cons (cons + (cons 1 (cons (cons string.count (cons (cons hdstr (cons (protect V1685) ())) (cons (cons tlstr (cons (protect V1685) ())) ()))) ()))) ())) (cons (cons (cons shen.+string? (cons (protect V1685) ())) (cons (cons string.count (cons (protect V1684) (cons (cons tlstr (cons (protect V1685) ())) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons string.count ())) ())) ()))))) ()))))) (do (shen.record-kl string.reverse (cons defun (cons string.reverse (cons (cons (protect V1690) ()) (cons (cons s-op1 (cons (cons lambda (cons (protect Z1691) (cons (cons reverse (cons (protect Z1691) ())) ()))) (cons (protect V1690) (cons (cons lambda (cons (protect Z1692) (cons (cons list->string (cons (protect Z1692) ())) ()))) ())))) ()))))) (do (shen.record-kl string.element? (cons defun (cons string.element? (cons (cons (protect V1694) (cons (protect V1695) ())) (cons (cons s-op1 (cons (cons lambda (cons (protect Z1696) (cons (cons element? (cons (protect V1694) (cons (protect Z1696) ()))) ()))) (cons (protect V1695) (cons (cons lambda (cons (protect Z1697) (cons (protect Z1697) ()))) ())))) ()))))) (do (shen.record-kl string.prefix? (cons defun (cons string.prefix? (cons (cons (protect V1702) (cons (protect V1703) ())) (cons (cons s-op2 (cons (cons lambda (cons (protect Z1704) (cons (cons lambda (cons (protect Z1705) (cons (cons prefix? (cons (protect Z1704) (cons (protect Z1705) ()))) ()))) ()))) (cons (protect V1702) (cons (protect V1703) (cons (cons lambda (cons (protect Z1706) (cons (protect Z1706) ()))) ()))))) ()))))) (do (shen.record-kl string.infix? (cons defun (cons string.infix? (cons (cons (protect V1711) (cons (protect V1712) ())) (cons (cons s-op2 (cons (cons lambda (cons (protect Z1713) (cons (cons lambda (cons (protect Z1714) (cons (cons infix? (cons (protect Z1713) (cons (protect Z1714) ()))) ()))) ()))) (cons (protect V1711) (cons (protect V1712) (cons (cons lambda (cons (protect Z1715) (cons (protect Z1715) ()))) ()))))) ()))))) (do (shen.record-kl string.suffix? (cons defun (cons string.suffix? (cons (cons (protect V1720) (cons (protect V1721) ())) (cons (cons s-op2 (cons (cons lambda (cons (protect Z1722) (cons (cons lambda (cons (protect Z1723) (cons (cons suffix? (cons (protect Z1722) (cons (protect Z1723) ()))) ()))) ()))) (cons (protect V1720) (cons (protect V1721) (cons (cons lambda (cons (protect Z1724) (cons (protect Z1724) ()))) ()))))) ()))))) (do (shen.record-kl string.subset? (cons defun (cons string.subset? (cons (cons (protect V1729) (cons (protect V1730) ())) (cons (cons s-op2 (cons (cons lambda (cons (protect Z1731) (cons (cons lambda (cons (protect Z1732) (cons (cons subset? (cons (protect Z1731) (cons (protect Z1732) ()))) ()))) ()))) (cons (protect V1729) (cons (protect V1730) (cons (cons lambda (cons (protect Z1733) (cons (protect Z1733) ()))) ()))))) ()))))) (do (shen.record-kl string.set=? (cons defun (cons string.set=? (cons (cons (protect V1738) (cons (protect V1739) ())) (cons (cons s-op2 (cons (cons lambda (cons (protect Z1740) (cons (cons lambda (cons (protect Z1741) (cons (cons set=? (cons (protect Z1740) (cons (protect Z1741) ()))) ()))) ()))) (cons (protect V1738) (cons (protect V1739) (cons (cons lambda (cons (protect Z1742) (cons (protect Z1742) ()))) ()))))) ()))))) (do (shen.record-kl string.set? (cons defun (cons string.set? (cons (cons (protect V1746) ()) (cons (cons s-op1 (cons (cons lambda (cons (protect Z1747) (cons (cons set? (cons (protect Z1747) ())) ()))) (cons (protect V1746) (cons (cons lambda (cons (protect Z1748) (cons (protect Z1748) ()))) ())))) ()))))) (do (shen.record-kl file-extension (cons defun (cons file-extension (cons (cons (protect V1750) (cons (protect V1751) ())) (cons (cons cn (cons (cons strip-extension (cons (protect V1750) ())) (cons (protect V1751) ()))) ()))))) (do (shen.record-kl strip-extension (cons defun (cons strip-extension (cons (cons (protect V1756) ()) (cons (cons cond (cons (cons (cons = (cons "" (cons (protect V1756) ()))) (cons "" ())) (cons (cons (cons and (cons (cons shen.+string? (cons (protect V1756) ())) (cons (cons = (cons "." (cons (cons hdstr (cons (protect V1756) ())) ()))) ()))) (cons "" ())) (cons (cons (cons shen.+string? (cons (protect V1756) ())) (cons (cons @s (cons (cons hdstr (cons (protect V1756) ())) (cons (cons strip-extension (cons (cons tlstr (cons (protect V1756) ())) ())) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons strip-extension ())) ())) ()))))) ()))))) (do (shen.record-kl string.length (cons defun (cons string.length (cons (cons (protect V1759) ()) (cons (cons s-op1 (cons (cons lambda (cons (protect Z1760) (cons (cons length (cons (protect Z1760) ())) ()))) (cons (protect V1759) (cons (cons lambda (cons (protect Z1761) (cons (protect Z1761) ()))) ())))) ()))))) (do (shen.record-kl string.trim (cons defun (cons string.trim (cons (cons (protect V1765) (cons (protect V1766) ())) (cons (cons s-op1 (cons (cons lambda (cons (protect Z1767) (cons (cons trim (cons (protect V1765) (cons (protect Z1767) ()))) ()))) (cons (protect V1766) (cons (cons lambda (cons (protect Z1768) (cons (cons list->string (cons (protect Z1768) ())) ()))) ())))) ()))))) (do (shen.record-kl string.trim-if (cons defun (cons string.trim-if (cons (cons (protect V1773) (cons (protect V1774) ())) (cons (cons s-op1 (cons (cons lambda (cons (protect Z1775) (cons (cons trim-if (cons (protect V1773) (cons (protect Z1775) ()))) ()))) (cons (protect V1774) (cons (cons lambda (cons (protect Z1776) (cons (cons list->string (cons (protect Z1776) ())) ()))) ())))) ()))))) (do (shen.record-kl string.trim-right-if (cons defun (cons string.trim-right-if (cons (cons (protect V1781) (cons (protect V1782) ())) (cons (cons s-op1 (cons (cons lambda (cons (protect Z1783) (cons (cons trim-right-if (cons (protect V1781) (cons (protect Z1783) ()))) ()))) (cons (protect V1782) (cons (cons lambda (cons (protect Z1784) (cons (cons list->string (cons (protect Z1784) ())) ()))) ())))) ()))))) (do (shen.record-kl string.trim-left-if (cons defun (cons string.trim-left-if (cons (cons (protect V1789) (cons (protect V1790) ())) (cons (cons s-op1 (cons (cons lambda (cons (protect Z1791) (cons (cons trim-left-if (cons (protect V1789) (cons (protect Z1791) ()))) ()))) (cons (protect V1790) (cons (cons lambda (cons (protect Z1792) (cons (cons list->string (cons (protect Z1792) ())) ()))) ())))) ()))))) (do (shen.record-kl string.trim-right (cons defun (cons string.trim-right (cons (cons (protect V1797) (cons (protect V1798) ())) (cons (cons s-op1 (cons (cons lambda (cons (protect Z1799) (cons (cons trim-right (cons (protect V1797) (cons (protect Z1799) ()))) ()))) (cons (protect V1798) (cons (cons lambda (cons (protect Z1800) (cons (cons list->string (cons (protect Z1800) ())) ()))) ())))) ()))))) (do (shen.record-kl string.trim-left (cons defun (cons string.trim-left (cons (cons (protect V1805) (cons (protect V1806) ())) (cons (cons s-op1 (cons (cons lambda (cons (protect Z1807) (cons (cons trim-left (cons (protect V1805) (cons (protect Z1807) ()))) ()))) (cons (protect V1806) (cons (cons lambda (cons (protect Z1808) (cons (cons list->string (cons (protect Z1808) ())) ()))) ())))) ()))))) (do (shen.record-kl string.some? (cons defun (cons string.some? (cons (cons (protect V1813) (cons (protect V1814) ())) (cons (cons cond (cons (cons (cons = (cons "" (cons (protect V1814) ()))) (cons false ())) (cons (cons (cons shen.+string? (cons (protect V1814) ())) (cons (cons or (cons (cons (protect V1813) (cons (cons hdstr (cons (protect V1814) ())) ())) (cons (cons string.some? (cons (protect V1813) (cons (cons tlstr (cons (protect V1814) ())) ()))) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons string.some? ())) ())) ())))) ()))))) (do (shen.record-kl string.every? (cons defun (cons string.every? (cons (cons (protect V1819) (cons (protect V1820) ())) (cons (cons cond (cons (cons (cons = (cons "" (cons (protect V1820) ()))) (cons true ())) (cons (cons (cons shen.+string? (cons (protect V1820) ())) (cons (cons and (cons (cons (protect V1819) (cons (cons hdstr (cons (protect V1820) ())) ())) (cons (cons string.every? (cons (protect V1819) (cons (cons tlstr (cons (protect V1820) ())) ()))) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons string.every? ())) ())) ())))) ()))))) (do (shen.record-kl string.difference (cons defun (cons string.difference (cons (cons (protect V1826) (cons (protect V1827) ())) (cons (cons s-op2 (cons (cons lambda (cons (protect Z1828) (cons (cons lambda (cons (protect Z1829) (cons (cons difference (cons (protect Z1828) (cons (protect Z1829) ()))) ()))) ()))) (cons (protect V1826) (cons (protect V1827) (cons (cons lambda (cons (protect Z1830) (cons (cons list->string (cons (protect Z1830) ())) ()))) ()))))) ()))))) (do (shen.record-kl string.intersection (cons defun (cons string.intersection (cons (cons (protect V1836) (cons (protect V1837) ())) (cons (cons s-op2 (cons (cons lambda (cons (protect Z1838) (cons (cons lambda (cons (protect Z1839) (cons (cons intersection (cons (protect Z1838) (cons (protect Z1839) ()))) ()))) ()))) (cons (protect V1836) (cons (protect V1837) (cons (cons lambda (cons (protect Z1840) (cons (cons list->string (cons (protect Z1840) ())) ()))) ()))))) ()))))) (do (shen.record-kl string.nth (cons defun (cons string.nth (cons (cons (protect V1843) (cons (protect V1844) ())) (cons (cons pos (cons (protect V1844) (cons (cons + (cons (protect V1843) (cons 1 ()))) ()))) ()))))) (do (shen.record-kl whitespace? (cons defun (cons whitespace? (cons (cons (protect V1849) ()) (cons (cons cond (cons (cons (cons shen.+string? (cons (protect V1849) ())) (cons (cons let (cons (protect W1850) (cons (cons string->n (cons (cons hdstr (cons (protect V1849) ())) ())) (cons (cons element? (cons (protect W1850) (cons (cons cons (cons 9 (cons (cons cons (cons 10 (cons (cons cons (cons 13 (cons (cons cons (cons 32 (cons () ()))) ()))) ()))) ()))) ()))) ())))) ())) (cons (cons true (cons (cons shen.f-error (cons whitespace? ())) ())) ()))) ()))))) (do (shen.record-kl uppercase? (cons defun (cons uppercase? (cons (cons (protect V1854) ()) (cons (cons cond (cons (cons (cons shen.+string? (cons (protect V1854) ())) (cons (cons let (cons (protect W1855) (cons (cons string->n (cons (cons hdstr (cons (protect V1854) ())) ())) (cons (cons and (cons (cons > (cons (protect W1855) (cons 64 ()))) (cons (cons < (cons (protect W1855) (cons 91 ()))) ()))) ())))) ())) (cons (cons true (cons (cons shen.f-error (cons uppercase? ())) ())) ()))) ()))))) (do (shen.record-kl lowercase? (cons defun (cons lowercase? (cons (cons (protect V1859) ()) (cons (cons cond (cons (cons (cons shen.+string? (cons (protect V1859) ())) (cons (cons let (cons (protect W1860) (cons (cons string->n (cons (cons hdstr (cons (protect V1859) ())) ())) (cons (cons and (cons (cons > (cons (protect W1860) (cons 96 ()))) (cons (cons < (cons (protect W1860) (cons 123 ()))) ()))) ())))) ())) (cons (cons true (cons (cons shen.f-error (cons lowercase? ())) ())) ()))) ()))))) (do (shen.record-kl digit? (cons defun (cons digit? (cons (cons (protect V1864) ()) (cons (cons cond (cons (cons (cons shen.+string? (cons (protect V1864) ())) (cons (cons let (cons (protect W1865) (cons (cons string->n (cons (cons hdstr (cons (protect V1864) ())) ())) (cons (cons and (cons (cons > (cons (protect W1865) (cons 47 ()))) (cons (cons < (cons (protect W1865) (cons 58 ()))) ()))) ())))) ())) (cons (cons true (cons (cons shen.f-error (cons digit? ())) ())) ()))) ()))))) (do (shen.record-kl alpha? (cons defun (cons alpha? (cons (cons (protect V1871) ()) (cons (cons cond (cons (cons (cons shen.+string? (cons (protect V1871) ())) (cons (cons let (cons (protect W1872) (cons (cons string->n (cons (cons hdstr (cons (protect V1871) ())) ())) (cons (cons or (cons (cons and (cons (cons > (cons (protect W1872) (cons 64 ()))) (cons (cons < (cons (protect W1872) (cons 91 ()))) ()))) (cons (cons and (cons (cons > (cons (protect W1872) (cons 96 ()))) (cons (cons < (cons (protect W1872) (cons 123 ()))) ()))) ()))) ())))) ())) (cons (cons true (cons false ())) ()))) ()))))) (do (shen.record-kl alphanum? (cons defun (cons alphanum? (cons (cons (protect V1878) ()) (cons (cons cond (cons (cons (cons shen.+string? (cons (protect V1878) ())) (cons (cons let (cons (protect W1879) (cons (cons string->n (cons (cons hdstr (cons (protect V1878) ())) ())) (cons (cons or (cons (cons and (cons (cons > (cons (protect W1879) (cons 64 ()))) (cons (cons < (cons (protect W1879) (cons 91 ()))) ()))) (cons (cons or (cons (cons and (cons (cons > (cons (protect W1879) (cons 96 ()))) (cons (cons < (cons (protect W1879) (cons 123 ()))) ()))) (cons (cons and (cons (cons > (cons (protect W1879) (cons 47 ()))) (cons (cons < (cons (protect W1879) (cons 58 ()))) ()))) ()))) ()))) ())))) ())) (cons (cons true (cons false ())) ()))) ()))))) (do (shen.record-kl tokenise (cons defun (cons tokenise (cons (cons (protect V1881) (cons (protect V1882) ())) (cons (cons string.tokenise-h (cons (protect V1881) (cons (protect V1882) (cons "" ())))) ()))))) (do (shen.record-kl string.tokenise-h (cons defun (cons string.tokenise-h (cons (cons (protect V1887) (cons (protect V1888) (cons (protect V1889) ()))) (cons (cons cond (cons (cons (cons = (cons "" (cons (protect V1888) ()))) (cons (cons cons (cons (protect V1889) (cons () ()))) ())) (cons (cons (cons and (cons (cons shen.+string? (cons (protect V1888) ())) (cons (cons (protect V1887) (cons (cons hdstr (cons (protect V1888) ())) ())) ()))) (cons (cons cons (cons (protect V1889) (cons (cons string.tokenise-h (cons (protect V1887) (cons (cons tlstr (cons (protect V1888) ())) (cons "" ())))) ()))) ())) (cons (cons (cons shen.+string? (cons (protect V1888) ())) (cons (cons string.tokenise-h (cons (protect V1887) (cons (cons tlstr (cons (protect V1888) ())) (cons (cons @s (cons (protect V1889) (cons (cons hdstr (cons (protect V1888) ())) ()))) ())))) ())) (cons (cons true (cons (cons shen.f-error (cons string.tokenise-h ())) ())) ()))))) ()))))) (do (shen.record-kl uppercase (cons defun (cons uppercase (cons (cons (protect V1893) ()) (cons (cons cond (cons (cons (cons shen.+string? (cons (protect V1893) ())) (cons (cons if (cons (cons lowercase? (cons (cons hdstr (cons (protect V1893) ())) ())) (cons (cons @s (cons (cons n->string (cons (cons - (cons (cons string->n (cons (cons hdstr (cons (protect V1893) ())) ())) (cons 32 ()))) ())) (cons (cons tlstr (cons (protect V1893) ())) ()))) (cons (protect V1893) ())))) ())) (cons (cons true (cons (cons shen.f-error (cons uppercase ())) ())) ()))) ()))))) (do (shen.record-kl lowercase (cons defun (cons lowercase (cons (cons (protect V1895) ()) (cons (cons cond (cons (cons (cons shen.+string? (cons (protect V1895) ())) (cons (cons if (cons (cons uppercase? (cons (cons hdstr (cons (protect V1895) ())) ())) (cons (cons @s (cons (cons n->string (cons (cons + (cons (cons string->n (cons (cons hdstr (cons (protect V1895) ())) ())) (cons 32 ()))) ())) (cons (cons tlstr (cons (protect V1895) ())) ()))) (cons (protect V1895) ())))) ())) (cons (cons true (cons (cons shen.f-error (cons lowercase ())) ())) ()))) ()))))) (do (shen.record-kl string.map (cons defun (cons string.map (cons (cons (protect V1899) (cons (protect V1900) ())) (cons (cons cond (cons (cons (cons = (cons "" (cons (protect V1900) ()))) (cons "" ())) (cons (cons (cons shen.+string? (cons (protect V1900) ())) (cons (cons @s (cons (cons (protect V1899) (cons (cons hdstr (cons (protect V1900) ())) ())) (cons (cons string.map (cons (protect V1899) (cons (cons tlstr (cons (protect V1900) ())) ()))) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons string.map ())) ())) ())))) ()))))) (do (shen.record-kl spell-number (cons defun (cons spell-number (cons (cons (protect V1904) ()) (cons (cons cond (cons (cons (cons = (cons 0 (cons (protect V1904) ()))) (cons "zero" ())) (cons (cons true (cons (cons string.scale (cons (cons map (cons (cons lambda (cons (protect Z1905) (cons (cons string.digits (cons (protect Z1905) ())) ()))) (cons (cons string.triples (cons (cons explode (cons (protect V1904) ())) ())) ()))) ())) ())) ()))) ()))))) (do (shen.record-kl string.digit (cons defun (cons string.digit (cons (cons (protect V1907) ()) (cons (cons cond (cons (cons (cons = (cons "0" (cons (protect V1907) ()))) (cons "" ())) (cons (cons (cons = (cons "1" (cons (protect V1907) ()))) (cons "one" ())) (cons (cons (cons = (cons "2" (cons (protect V1907) ()))) (cons "two" ())) (cons (cons (cons = (cons "3" (cons (protect V1907) ()))) (cons "three" ())) (cons (cons (cons = (cons "4" (cons (protect V1907) ()))) (cons "four" ())) (cons (cons (cons = (cons "5" (cons (protect V1907) ()))) (cons "five" ())) (cons (cons (cons = (cons "6" (cons (protect V1907) ()))) (cons "six" ())) (cons (cons (cons = (cons "7" (cons (protect V1907) ()))) (cons "seven" ())) (cons (cons (cons = (cons "8" (cons (protect V1907) ()))) (cons "eight" ())) (cons (cons (cons = (cons "9" (cons (protect V1907) ()))) (cons "nine" ())) (cons (cons true (cons (cons shen.f-error (cons string.digit ())) ())) ())))))))))))) ()))))) (do (shen.record-kl string.triples (cons defun (cons string.triples (cons (cons (protect V1909) ()) (cons (cons string.triples-h (cons (cons reverse (cons (protect V1909) ())) (cons () ()))) ()))))) (do (shen.record-kl string.triples-h (cons defun (cons string.triples-h (cons (cons (protect V1911) (cons (protect V1912) ())) (cons (cons cond (cons (cons (cons and (cons (cons cons? (cons (protect V1911) ())) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect V1911) ())) ())) (cons (cons cons? (cons (cons tl (cons (cons tl (cons (protect V1911) ())) ())) ())) ()))) ()))) (cons (cons string.triples-h (cons (cons tl (cons (cons tl (cons (cons tl (cons (protect V1911) ())) ())) ())) (cons (cons cons (cons (cons reverse (cons (cons cons (cons (cons hd (cons (protect V1911) ())) (cons (cons cons (cons (cons hd (cons (cons tl (cons (protect V1911) ())) ())) (cons (cons cons (cons (cons hd (cons (cons tl (cons (cons tl (cons (protect V1911) ())) ())) ())) (cons () ()))) ()))) ()))) ())) (cons (protect V1912) ()))) ()))) ())) (cons (cons true (cons (cons cons (cons (cons reverse (cons (protect V1911) ())) (cons (protect V1912) ()))) ())) ()))) ()))))) (do (shen.record-kl string.digits (cons defun (cons string.digits (cons (cons (protect V1915) ()) (cons (cons cond (cons (cons (cons and (cons (cons cons? (cons (protect V1915) ())) (cons (cons and (cons (cons = (cons "0" (cons (cons hd (cons (protect V1915) ())) ()))) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect V1915) ())) ())) (cons (cons and (cons (cons = (cons "0" (cons (cons hd (cons (cons tl (cons (protect V1915) ())) ())) ()))) (cons (cons and (cons (cons cons? (cons (cons tl (cons (cons tl (cons (protect V1915) ())) ())) ())) (cons (cons and (cons (cons = (cons "0" (cons (cons hd (cons (cons tl (cons (cons tl (cons (protect V1915) ())) ())) ())) ()))) (cons (cons = (cons () (cons (cons tl (cons (cons tl (cons (cons tl (cons (protect V1915) ())) ())) ())) ()))) ()))) ()))) ()))) ()))) ()))) ()))) (cons "" ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1915) ())) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect V1915) ())) ())) (cons (cons and (cons (cons = (cons "0" (cons (cons hd (cons (cons tl (cons (protect V1915) ())) ())) ()))) (cons (cons and (cons (cons cons? (cons (cons tl (cons (cons tl (cons (protect V1915) ())) ())) ())) (cons (cons and (cons (cons = (cons "0" (cons (cons hd (cons (cons tl (cons (cons tl (cons (protect V1915) ())) ())) ())) ()))) (cons (cons = (cons () (cons (cons tl (cons (cons tl (cons (cons tl (cons (protect V1915) ())) ())) ())) ()))) ()))) ()))) ()))) ()))) ()))) (cons (cons @s (cons (cons string.digit (cons (cons hd (cons (protect V1915) ())) ())) (cons (cons @s (cons " " (cons "hundred" ()))) ()))) ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1915) ())) (cons (cons and (cons (cons = (cons "0" (cons (cons hd (cons (protect V1915) ())) ()))) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect V1915) ())) ())) (cons (cons and (cons (cons = (cons "0" (cons (cons hd (cons (cons tl (cons (protect V1915) ())) ())) ()))) (cons (cons and (cons (cons cons? (cons (cons tl (cons (cons tl (cons (protect V1915) ())) ())) ())) (cons (cons = (cons () (cons (cons tl (cons (cons tl (cons (cons tl (cons (protect V1915) ())) ())) ())) ()))) ()))) ()))) ()))) ()))) ()))) (cons (cons @s (cons "a" (cons (cons @s (cons "n" (cons (cons @s (cons "d" (cons (cons @s (cons " " (cons (cons string.digit (cons (cons hd (cons (cons tl (cons (cons tl (cons (protect V1915) ())) ())) ())) ())) ()))) ()))) ()))) ()))) ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1915) ())) (cons (cons and (cons (cons = (cons "0" (cons (cons hd (cons (protect V1915) ())) ()))) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect V1915) ())) ())) (cons (cons and (cons (cons cons? (cons (cons tl (cons (cons tl (cons (protect V1915) ())) ())) ())) (cons (cons = (cons () (cons (cons tl (cons (cons tl (cons (cons tl (cons (protect V1915) ())) ())) ())) ()))) ()))) ()))) ()))) ()))) (cons (cons @s (cons "a" (cons (cons @s (cons "n" (cons (cons @s (cons "d" (cons (cons @s (cons " " (cons (cons string.tens (cons (cons hd (cons (cons tl (cons (protect V1915) ())) ())) (cons (cons hd (cons (cons tl (cons (cons tl (cons (protect V1915) ())) ())) ())) ()))) ()))) ()))) ()))) ()))) ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1915) ())) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect V1915) ())) ())) (cons (cons and (cons (cons = (cons "0" (cons (cons hd (cons (cons tl (cons (protect V1915) ())) ())) ()))) (cons (cons and (cons (cons cons? (cons (cons tl (cons (cons tl (cons (protect V1915) ())) ())) ())) (cons (cons = (cons () (cons (cons tl (cons (cons tl (cons (cons tl (cons (protect V1915) ())) ())) ())) ()))) ()))) ()))) ()))) ()))) (cons (cons @s (cons (cons string.digit (cons (cons hd (cons (protect V1915) ())) ())) (cons (cons @s (cons " " (cons (cons @s (cons "h" (cons (cons @s (cons "u" (cons (cons @s (cons "n" (cons (cons @s (cons "d" (cons (cons @s (cons "r" (cons (cons @s (cons "e" (cons (cons @s (cons "d" (cons (cons @s (cons " " (cons (cons @s (cons "a" (cons (cons @s (cons "n" (cons (cons @s (cons "d" (cons (cons @s (cons " " (cons (cons string.digit (cons (cons hd (cons (cons tl (cons (cons tl (cons (protect V1915) ())) ())) ())) ())) ()))) ()))) ()))) ()))) ()))) ()))) ()))) ()))) ()))) ()))) ()))) ()))) ()))) ()))) ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1915) ())) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect V1915) ())) ())) (cons (cons and (cons (cons cons? (cons (cons tl (cons (cons tl (cons (protect V1915) ())) ())) ())) (cons (cons = (cons () (cons (cons tl (cons (cons tl (cons (cons tl (cons (protect V1915) ())) ())) ())) ()))) ()))) ()))) ()))) (cons (cons @s (cons (cons string.digit (cons (cons hd (cons (protect V1915) ())) ())) (cons (cons @s (cons " " (cons (cons @s (cons "h" (cons (cons @s (cons "u" (cons (cons @s (cons "n" (cons (cons @s (cons "d" (cons (cons @s (cons "r" (cons (cons @s (cons "e" (cons (cons @s (cons "d" (cons (cons @s (cons " " (cons (cons @s (cons "a" (cons (cons @s (cons "n" (cons (cons @s (cons "d" (cons (cons @s (cons " " (cons (cons string.tens (cons (cons hd (cons (cons tl (cons (protect V1915) ())) ())) (cons (cons hd (cons (cons tl (cons (cons tl (cons (protect V1915) ())) ())) ())) ()))) ()))) ()))) ()))) ()))) ()))) ()))) ()))) ()))) ()))) ()))) ()))) ()))) ()))) ()))) ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1915) ())) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect V1915) ())) ())) (cons (cons = (cons () (cons (cons tl (cons (cons tl (cons (protect V1915) ())) ())) ()))) ()))) ()))) (cons (cons string.tens (cons (cons hd (cons (protect V1915) ())) (cons (cons hd (cons (cons tl (cons (protect V1915) ())) ())) ()))) ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1915) ())) (cons (cons = (cons () (cons (cons tl (cons (protect V1915) ())) ()))) ()))) (cons (cons string.digit (cons (cons hd (cons (protect V1915) ())) ())) ())) (cons (cons (cons = (cons () (cons (protect V1915) ()))) (cons "" ())) (cons (cons true (cons (cons shen.f-error (cons string.digits ())) ())) ()))))))))))) ()))))) (do (shen.record-kl string.tens (cons defun (cons string.tens (cons (cons (protect V1917) (cons (protect V1918) ())) (cons (cons cond (cons (cons (cons = (cons "1" (cons (protect V1917) ()))) (cons (cons if (cons (cons = (cons (protect V1918) (cons "0" ()))) (cons "ten" (cons (cons if (cons (cons = (cons (protect V1918) (cons "1" ()))) (cons "eleven" (cons (cons if (cons (cons = (cons (protect V1918) (cons "2" ()))) (cons "twelve" (cons (cons if (cons (cons = (cons (protect V1918) (cons "3" ()))) (cons "thirteen" (cons (cons if (cons (cons = (cons (protect V1918) (cons "4" ()))) (cons "fourteen" (cons (cons if (cons (cons = (cons (protect V1918) (cons "5" ()))) (cons "fifteen" (cons (cons if (cons (cons = (cons (protect V1918) (cons "6" ()))) (cons "sixteen" (cons (cons if (cons (cons = (cons (protect V1918) (cons "7" ()))) (cons "seventeen" (cons (cons if (cons (cons = (cons (protect V1918) (cons "8" ()))) (cons "eighteen" (cons (cons if (cons (cons = (cons (protect V1918) (cons "9" ()))) (cons "nineteen" (cons (cons simple-error (cons "error: cases exhausted" ())) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())) (cons (cons (cons = (cons "2" (cons (protect V1917) ()))) (cons (cons @s (cons "t" (cons (cons @s (cons "w" (cons (cons @s (cons "e" (cons (cons @s (cons "n" (cons (cons @s (cons "t" (cons (cons @s (cons "y" (cons (cons @s (cons " " (cons (cons string.digit (cons (protect V1918) ())) ()))) ()))) ()))) ()))) ()))) ()))) ()))) ())) (cons (cons (cons = (cons "3" (cons (protect V1917) ()))) (cons (cons @s (cons "t" (cons (cons @s (cons "h" (cons (cons @s (cons "i" (cons (cons @s (cons "r" (cons (cons @s (cons "t" (cons (cons @s (cons "y" (cons (cons @s (cons " " (cons (cons string.digit (cons (protect V1918) ())) ()))) ()))) ()))) ()))) ()))) ()))) ()))) ())) (cons (cons (cons = (cons "4" (cons (protect V1917) ()))) (cons (cons @s (cons "f" (cons (cons @s (cons "o" (cons (cons @s (cons "r" (cons (cons @s (cons "t" (cons (cons @s (cons "y" (cons (cons @s (cons " " (cons (cons string.digit (cons (protect V1918) ())) ()))) ()))) ()))) ()))) ()))) ()))) ())) (cons (cons (cons = (cons "5" (cons (protect V1917) ()))) (cons (cons @s (cons "f" (cons (cons @s (cons "i" (cons (cons @s (cons "f" (cons (cons @s (cons "t" (cons (cons @s (cons "y" (cons (cons @s (cons " " (cons (cons string.digit (cons (protect V1918) ())) ()))) ()))) ()))) ()))) ()))) ()))) ())) (cons (cons (cons = (cons "6" (cons (protect V1917) ()))) (cons (cons @s (cons "s" (cons (cons @s (cons "i" (cons (cons @s (cons "x" (cons (cons @s (cons "t" (cons (cons @s (cons "y" (cons (cons @s (cons " " (cons (cons string.digit (cons (protect V1918) ())) ()))) ()))) ()))) ()))) ()))) ()))) ())) (cons (cons (cons = (cons "7" (cons (protect V1917) ()))) (cons (cons @s (cons "s" (cons (cons @s (cons "e" (cons (cons @s (cons "v" (cons (cons @s (cons "e" (cons (cons @s (cons "n" (cons (cons @s (cons "t" (cons (cons @s (cons "y" (cons (cons @s (cons " " (cons (cons string.digit (cons (protect V1918) ())) ()))) ()))) ()))) ()))) ()))) ()))) ()))) ()))) ())) (cons (cons (cons = (cons "8" (cons (protect V1917) ()))) (cons (cons @s (cons "e" (cons (cons @s (cons "i" (cons (cons @s (cons "g" (cons (cons @s (cons "h" (cons (cons @s (cons "t" (cons (cons @s (cons "y" (cons (cons @s (cons " " (cons (cons string.digit (cons (protect V1918) ())) ()))) ()))) ()))) ()))) ()))) ()))) ()))) ())) (cons (cons (cons = (cons "9" (cons (protect V1917) ()))) (cons (cons @s (cons "n" (cons (cons @s (cons "i" (cons (cons @s (cons "n" (cons (cons @s (cons "e" (cons (cons @s (cons "t" (cons (cons @s (cons "y" (cons (cons @s (cons " " (cons (cons string.digit (cons (protect V1918) ())) ()))) ()))) ()))) ()))) ()))) ()))) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons string.tens ())) ())) ()))))))))))) ()))))) (do (shen.record-kl string.scale (cons defun (cons string.scale (cons (cons (protect V1921) ()) (cons (cons cond (cons (cons (cons and (cons (cons cons? (cons (protect V1921) ())) (cons (cons = (cons () (cons (cons tl (cons (protect V1921) ())) ()))) ()))) (cons (cons hd (cons (protect V1921) ())) ())) (cons (cons (cons and (cons (cons cons? (cons (protect V1921) ())) (cons (cons = (cons "" (cons (cons hd (cons (protect V1921) ())) ()))) ()))) (cons (cons string.scale (cons (cons tl (cons (protect V1921) ())) ())) ())) (cons (cons (cons cons? (cons (protect V1921) ())) (cons (cons @s (cons (cons hd (cons (protect V1921) ())) (cons (cons @s (cons (cons string.units (cons (cons length (cons (protect V1921) ())) ())) (cons (cons string.scale (cons (cons tl (cons (protect V1921) ())) ())) ()))) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons string.scale ())) ())) ()))))) ()))))) (do (shen.record-kl string.units (cons defun (cons string.units (cons (cons (protect V1925) ()) (cons (cons cond (cons (cons (cons = (cons 2 (cons (protect V1925) ()))) (cons " thousand " ())) (cons (cons (cons = (cons 3 (cons (protect V1925) ()))) (cons " million " ())) (cons (cons (cons = (cons 4 (cons (protect V1925) ()))) (cons " billion " ())) (cons (cons (cons = (cons 5 (cons (protect V1925) ()))) (cons " trillion " ())) (cons (cons true (cons (cons simple-error (cons "this number has a magnitude beyond our text representation" ())) ())) ())))))) ()))))) (do (shen.record-kl string>? (cons defun (cons string>? (cons (cons (protect V1931) (cons (protect V1932) ())) (cons (cons cond (cons (cons (cons = (cons "" (cons (protect V1931) ()))) (cons false ())) (cons (cons (cons = (cons "" (cons (protect V1932) ()))) (cons true ())) (cons (cons (cons and (cons (cons shen.+string? (cons (protect V1931) ())) (cons (cons shen.+string? (cons (protect V1932) ())) ()))) (cons (cons let (cons (protect W1933) (cons (cons string->n (cons (cons hdstr (cons (protect V1931) ())) ())) (cons (cons let (cons (protect W1934) (cons (cons string->n (cons (cons hdstr (cons (protect V1932) ())) ())) (cons (cons if (cons (cons > (cons (protect W1933) (cons (protect W1934) ()))) (cons true (cons (cons if (cons (cons < (cons (protect W1933) (cons (protect W1934) ()))) (cons false (cons (cons string>? (cons (cons tlstr (cons (protect V1931) ())) (cons (cons tlstr (cons (protect V1932) ())) ()))) ())))) ())))) ())))) ())))) ())) (cons (cons true (cons (cons shen.f-error (cons string>? ())) ())) ()))))) ()))))) (do (shen.record-kl stringn (cons (cons hdstr (cons (protect V1941) ())) ())) (cons (cons let (cons (protect W1944) (cons (cons string->n (cons (cons hdstr (cons (protect V1942) ())) ())) (cons (cons if (cons (cons < (cons (protect W1943) (cons (protect W1944) ()))) (cons true (cons (cons if (cons (cons > (cons (protect W1943) (cons (protect W1944) ()))) (cons false (cons (cons string=? (cons defun (cons string>=? (cons (cons (protect V1947) (cons (protect V1948) ())) (cons (cons or (cons (cons = (cons (protect V1947) (cons (protect V1948) ()))) (cons (cons string>? (cons (protect V1947) (cons (protect V1948) ()))) ()))) ()))))) (do (shen.record-kl string<=? (cons defun (cons string<=? (cons (cons (protect V1951) (cons (protect V1952) ())) (cons (cons or (cons (cons = (cons (protect V1951) (cons (protect V1952) ()))) (cons (cons stringstrings (cons (protect W1965) (cons () ()))) (cons (cons let (cons (protect W1967) (cons (cons compile (cons (cons fn (cons string. ())) (cons (protect W1966) ()))) (cons (cons let (cons (protect W1968) (cons (cons file-extension (cons (protect V1963) (cons (protect V1964) ()))) (cons (cons let (cons (protect W1969) (cons (cons write-to-file (cons (protect W1968) (cons (protect W1967) ()))) (cons (protect W1968) ())))) ())))) ())))) ())))) ())))) ()))))) (do (shen.record-kl string.bytes->strings (cons defun (cons string.bytes->strings (cons (cons (protect V1972) (cons (protect V1973) ())) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V1972) ()))) (cons (cons reverse (cons (protect V1973) ())) ())) (cons (cons (cons cons? (cons (protect V1972) ())) (cons (cons string.bytes->strings (cons (cons tl (cons (protect V1972) ())) (cons (cons cons (cons (cons n->string (cons (cons hd (cons (protect V1972) ())) ())) (cons (protect V1973) ()))) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons string.bytes->strings ())) ())) ())))) ()))))) (do (shen.record-kl render (cons defun (cons render (cons (cons (protect V1976) ()) (cons (cons compile (cons (cons fn (cons string. ())) (cons (cons string->list (cons (protect V1976) ())) ()))) ()))))) (do (shen.record-kl string.rendered? (cons defun (cons string.rendered? (cons (cons (protect V1982) ()) (cons (cons cond (cons (cons (cons = (cons "" (cons (protect V1982) ()))) (cons true ())) (cons (cons (cons and (cons (cons shen.+string? (cons (protect V1982) ())) (cons (cons = (cons "{" (cons (cons hdstr (cons (protect V1982) ())) ()))) ()))) (cons false ())) (cons (cons (cons shen.+string? (cons (protect V1982) ())) (cons (cons string.rendered? (cons (cons tlstr (cons (protect V1982) ())) ())) ())) (cons (cons true (cons (cons shen.f-error (cons string.rendered? ())) ())) ()))))) ()))))) (do (shen.record-kl string. (cons defun (cons string. (cons (cons (protect V1989) ()) (cons (cons let (cons (protect W1990) (cons (cons if (cons (cons shen.hds=? (cons (protect V1989) (cons "{" ()))) (cons (cons let (cons (protect W1991) (cons (cons tail (cons (protect V1989) ())) (cons (cons let (cons (protect W1992) (cons (cons (cons fn (cons string. ())) (cons (protect W1991) ())) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W1992) ())) (cons (cons shen.parse-failure ()) (cons (cons let (cons (protect W1993) (cons (cons shen.<-out (cons (protect W1992) ())) (cons (cons let (cons (protect W1994) (cons (cons shen.in-> (cons (protect W1992) ())) (cons (cons let (cons (protect W1995) (cons (cons (cons fn (cons string. ())) (cons (protect W1994) ())) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W1995) ())) (cons (cons shen.parse-failure ()) (cons (cons let (cons (protect W1996) (cons (cons shen.in-> (cons (protect W1995) ())) (cons (cons let (cons (protect W1997) (cons (cons (cons fn (cons string. ())) (cons (protect W1996) ())) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W1997) ())) (cons (cons shen.parse-failure ()) (cons (cons let (cons (protect W1998) (cons (cons shen.<-out (cons (protect W1997) ())) (cons (cons let (cons (protect W1999) (cons (cons shen.in-> (cons (protect W1997) ())) (cons (cons if (cons (cons shen.hds=? (cons (protect W1999) (cons "}" ()))) (cons (cons let (cons (protect W2000) (cons (cons tail (cons (protect W1999) ())) (cons (cons let (cons (protect W2001) (cons (cons (cons fn (cons string. ())) (cons (protect W2000) ())) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W2001) ())) (cons (cons shen.parse-failure ()) (cons (cons let (cons (protect W2002) (cons (cons shen.<-out (cons (protect W2001) ())) (cons (cons let (cons (protect W2003) (cons (cons shen.in-> (cons (protect W2001) ())) (cons (cons shen.comb (cons (protect W2003) (cons (cons cn (cons (cons string.recapply (cons (cons fn (cons (cons intern (cons (protect W1993) ())) ())) (cons (protect W1998) ()))) (cons (protect W2002) ()))) ()))) ())))) ())))) ())))) ())))) ())))) (cons (cons shen.parse-failure ()) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) (cons (cons shen.parse-failure ()) ())))) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W1990) ())) (cons (cons let (cons (protect W2004) (cons (cons if (cons (cons shen.hds=? (cons (protect V1989) (cons "{" ()))) (cons (cons let (cons (protect W2005) (cons (cons tail (cons (protect V1989) ())) (cons (cons let (cons (protect W2006) (cons (cons (cons fn (cons string. ())) (cons (protect W2005) ())) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W2006) ())) (cons (cons shen.parse-failure ()) (cons (cons let (cons (protect W2007) (cons (cons shen.<-out (cons (protect W2006) ())) (cons (cons let (cons (protect W2008) (cons (cons shen.in-> (cons (protect W2006) ())) (cons (cons if (cons (cons shen.hds=? (cons (protect W2008) (cons "}" ()))) (cons (cons let (cons (protect W2009) (cons (cons tail (cons (protect W2008) ())) (cons (cons let (cons (protect W2010) (cons (cons (cons fn (cons string. ())) (cons (protect W2009) ())) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W2010) ())) (cons (cons shen.parse-failure ()) (cons (cons let (cons (protect W2011) (cons (cons shen.<-out (cons (protect W2010) ())) (cons (cons let (cons (protect W2012) (cons (cons shen.in-> (cons (protect W2010) ())) (cons (cons shen.comb (cons (protect W2012) (cons (cons cn (cons (cons (cons intern (cons (protect W2007) ())) ()) (cons (protect W2011) ()))) ()))) ())))) ())))) ())))) ())))) ())))) (cons (cons shen.parse-failure ()) ())))) ())))) ())))) ())))) ())))) ())))) (cons (cons shen.parse-failure ()) ())))) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W2004) ())) (cons (cons let (cons (protect W2013) (cons (cons let (cons (protect W2014) (cons (cons (cons fn (cons string. ())) (cons (protect V1989) ())) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W2014) ())) (cons (cons shen.parse-failure ()) (cons (cons let (cons (protect W2015) (cons (cons shen.<-out (cons (protect W2014) ())) (cons (cons let (cons (protect W2016) (cons (cons shen.in-> (cons (protect W2014) ())) (cons (cons let (cons (protect W2017) (cons (cons (cons fn (cons string. ())) (cons (protect W2016) ())) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W2017) ())) (cons (cons shen.parse-failure ()) (cons (cons let (cons (protect W2018) (cons (cons shen.<-out (cons (protect W2017) ())) (cons (cons let (cons (protect W2019) (cons (cons shen.in-> (cons (protect W2017) ())) (cons (cons shen.comb (cons (protect W2019) (cons (cons cn (cons (protect W2015) (cons (protect W2018) ()))) ()))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W2013) ())) (cons (cons let (cons (protect W2020) (cons (cons let (cons (protect W2021) (cons (cons (cons (protect V1989) ())) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W2021) ())) (cons (cons shen.parse-failure ()) (cons (cons let (cons (protect W2022) (cons (cons shen.in-> (cons (protect W2021) ())) (cons (cons shen.comb (cons (protect W2022) (cons "" ()))) ())))) ())))) ())))) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W2020) ())) (cons (cons shen.parse-failure ()) (cons (protect W2020) ())))) ())))) (cons (protect W2013) ())))) ())))) (cons (protect W2004) ())))) ())))) (cons (protect W1990) ())))) ())))) ()))))) (do (shen.record-kl string. (cons defun (cons string. (cons (cons (protect V2026) ()) (cons (cons let (cons (protect W2027) (cons (cons if (cons (cons cons? (cons (protect V2026) ())) (cons (cons let (cons (protect W2028) (cons (cons head (cons (protect V2026) ())) (cons (cons let (cons (protect W2029) (cons (cons tail (cons (protect V2026) ())) (cons (cons if (cons (cons and (cons (cons not (cons (cons = (cons (protect W2028) (cons "}" ()))) ())) (cons (cons not (cons (cons = (cons (protect W2028) (cons "\" ()))) ())) ()))) (cons (cons shen.comb (cons (protect W2029) (cons (protect W2028) ()))) (cons (cons shen.parse-failure ()) ())))) ())))) ())))) (cons (cons shen.parse-failure ()) ())))) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W2027) ())) (cons (cons shen.parse-failure ()) (cons (protect W2027) ())))) ())))) ()))))) (do (shen.record-kl string.recapply (cons defun (cons string.recapply (cons (cons (protect V2031) (cons (protect V2032) ())) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V2032) ()))) (cons (protect V2031) ())) (cons (cons (cons cons? (cons (protect V2032) ())) (cons (cons string.recapply (cons (cons (protect V2031) (cons (cons hd (cons (protect V2032) ())) ())) (cons (cons tl (cons (protect V2032) ())) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons string.recapply ())) ())) ())))) ()))))) (do (shen.record-kl string. (cons defun (cons string. (cons (cons (protect V2037) ()) (cons (cons let (cons (protect W2038) (cons (cons let (cons (protect W2039) (cons (cons (cons fn (cons string. ())) (cons (protect V2037) ())) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W2039) ())) (cons (cons shen.parse-failure ()) (cons (cons let (cons (protect W2040) (cons (cons shen.<-out (cons (protect W2039) ())) (cons (cons let (cons (protect W2041) (cons (cons shen.in-> (cons (protect W2039) ())) (cons (cons if (cons (cons shen.hds=? (cons (protect W2041) (cons "\" ()))) (cons (cons let (cons (protect W2042) (cons (cons tail (cons (protect W2041) ())) (cons (cons let (cons (protect W2043) (cons (cons (cons fn (cons string. ())) (cons (protect W2042) ())) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W2043) ())) (cons (cons shen.parse-failure ()) (cons (cons let (cons (protect W2044) (cons (cons shen.<-out (cons (protect W2043) ())) (cons (cons let (cons (protect W2045) (cons (cons shen.in-> (cons (protect W2043) ())) (cons (cons shen.comb (cons (protect W2045) (cons (cons cons (cons (protect W2040) (cons (protect W2044) ()))) ()))) ())))) ())))) ())))) ())))) ())))) (cons (cons shen.parse-failure ()) ())))) ())))) ())))) ())))) ())))) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W2038) ())) (cons (cons let (cons (protect W2046) (cons (cons let (cons (protect W2047) (cons (cons (cons fn (cons string. ())) (cons (protect V2037) ())) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W2047) ())) (cons (cons shen.parse-failure ()) (cons (cons let (cons (protect W2048) (cons (cons shen.<-out (cons (protect W2047) ())) (cons (cons let (cons (protect W2049) (cons (cons shen.in-> (cons (protect W2047) ())) (cons (cons shen.comb (cons (protect W2049) (cons (cons cons (cons (protect W2048) (cons () ()))) ()))) ())))) ())))) ())))) ())))) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W2046) ())) (cons (cons shen.parse-failure ()) (cons (protect W2046) ())))) ())))) (cons (protect W2038) ())))) ())))) ()))))) (do (shen.record-kl string. (cons defun (cons string. (cons (cons (protect V2052) ()) (cons (cons let (cons (protect W2053) (cons (cons let (cons (protect W2054) (cons (cons string. (cons (protect V2052) ())) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W2054) ())) (cons (cons shen.parse-failure ()) (cons (cons let (cons (protect W2055) (cons (cons shen.<-out (cons (protect W2054) ())) (cons (cons let (cons (protect W2056) (cons (cons shen.in-> (cons (protect W2054) ())) (cons (cons shen.comb (cons (protect W2056) (cons (protect W2055) ()))) ())))) ())))) ())))) ())))) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W2053) ())) (cons (cons shen.parse-failure ()) (cons (protect W2053) ())))) ())))) ()))))) (do (shen.record-kl string. (cons defun (cons string. (cons (cons (protect V2060) ()) (cons (cons let (cons (protect W2061) (cons (cons if (cons (cons cons? (cons (protect V2060) ())) (cons (cons let (cons (protect W2062) (cons (cons head (cons (protect V2060) ())) (cons (cons let (cons (protect W2063) (cons (cons tail (cons (protect V2060) ())) (cons (cons if (cons (cons and (cons (cons not (cons (cons = (cons (protect W2062) (cons "}" ()))) ())) (cons (cons not (cons (cons = (cons (protect W2062) (cons "\" ()))) ())) ()))) (cons (cons shen.comb (cons (protect W2063) (cons (protect W2062) ()))) (cons (cons shen.parse-failure ()) ())))) ())))) ())))) (cons (cons shen.parse-failure ()) ())))) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W2061) ())) (cons (cons shen.parse-failure ()) (cons (protect W2061) ())))) ())))) ()))))) (do (shen.record-kl string. (cons defun (cons string. (cons (cons (protect V2067) ()) (cons (cons let (cons (protect W2068) (cons (cons if (cons (cons cons? (cons (protect V2067) ())) (cons (cons let (cons (protect W2069) (cons (cons head (cons (protect V2067) ())) (cons (cons let (cons (protect W2070) (cons (cons tail (cons (protect V2067) ())) (cons (cons if (cons (cons whitespace? (cons (protect W2069) ())) (cons (cons shen.comb (cons (protect W2070) (cons string.skip ()))) (cons (cons shen.parse-failure ()) ())))) ())))) ())))) (cons (cons shen.parse-failure ()) ())))) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W2068) ())) (cons (cons shen.parse-failure ()) (cons (protect W2068) ())))) ())))) ()))))) (do (shen.record-kl string. (cons defun (cons string. (cons (cons (protect V2073) ()) (cons (cons let (cons (protect W2074) (cons (cons let (cons (protect W2075) (cons (cons (cons fn (cons string. ())) (cons (protect V2073) ())) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W2075) ())) (cons (cons shen.parse-failure ()) (cons (cons let (cons (protect W2076) (cons (cons shen.<-out (cons (protect W2075) ())) (cons (cons let (cons (protect W2077) (cons (cons shen.in-> (cons (protect W2075) ())) (cons (cons let (cons (protect W2078) (cons (cons (cons fn (cons string. ())) (cons (protect W2077) ())) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W2078) ())) (cons (cons shen.parse-failure ()) (cons (cons let (cons (protect W2079) (cons (cons shen.<-out (cons (protect W2078) ())) (cons (cons let (cons (protect W2080) (cons (cons shen.in-> (cons (protect W2078) ())) (cons (cons shen.comb (cons (protect W2080) (cons (cons cn (cons (protect W2076) (cons (protect W2079) ()))) ()))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) ())))) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W2074) ())) (cons (cons let (cons (protect W2081) (cons (cons let (cons (protect W2082) (cons (cons (cons (protect V2073) ())) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W2082) ())) (cons (cons shen.parse-failure ()) (cons (cons let (cons (protect W2083) (cons (cons shen.in-> (cons (protect W2082) ())) (cons (cons shen.comb (cons (protect W2083) (cons "" ()))) ())))) ())))) ())))) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W2081) ())) (cons (cons shen.parse-failure ()) (cons (protect W2081) ())))) ())))) (cons (protect W2074) ())))) ())))) ()))))) (do (shen.record-kl string. (cons defun (cons string. (cons (cons (protect V2087) ()) (cons (cons let (cons (protect W2088) (cons (cons if (cons (cons cons? (cons (protect V2087) ())) (cons (cons let (cons (protect W2089) (cons (cons head (cons (protect V2087) ())) (cons (cons let (cons (protect W2090) (cons (cons tail (cons (protect V2087) ())) (cons (cons if (cons (cons and (cons (cons not (cons (cons = (cons (protect W2089) (cons "}" ()))) ())) (cons (cons and (cons (cons not (cons (cons = (cons (protect W2089) (cons "\" ()))) ())) (cons (cons not (cons (cons whitespace? (cons (protect W2089) ())) ())) ()))) ()))) (cons (cons shen.comb (cons (protect W2090) (cons (protect W2089) ()))) (cons (cons shen.parse-failure ()) ())))) ())))) ())))) (cons (cons shen.parse-failure ()) ())))) (cons (cons if (cons (cons shen.parse-failure? (cons (protect W2088) ())) (cons (cons shen.parse-failure ()) (cons (protect W2088) ())))) ())))) ()))))) (do (shen.record-kl vector.vector-macros (cons defun (cons vector.vector-macros (cons (cons (protect V2092) ()) (cons (cons let (cons (protect GoTo2096) (cons (cons freeze (cons (protect V2092) ())) (cons (cons if (cons (cons cons? (cons (protect V2092) ())) (cons (cons let (cons (protect Select2136) (cons (cons hd (cons (protect V2092) ())) (cons (cons let (cons (protect Select2137) (cons (cons tl (cons (protect V2092) ())) (cons (cons let (cons (protect GoTo2121) (cons (cons freeze (cons (cons let (cons (protect GoTo2109) (cons (cons freeze (cons (cons if (cons (cons = (cons array (cons (protect Select2136) ()))) (cons (cons if (cons (cons cons? (cons (protect Select2137) ())) (cons (cons let (cons (protect Select2107) (cons (cons hd (cons (protect Select2137) ())) (cons (cons let (cons (protect Select2108) (cons (cons tl (cons (protect Select2137) ())) (cons (cons if (cons (cons cons? (cons (protect Select2107) ())) (cons (cons let (cons (protect Select2106) (cons (cons tl (cons (protect Select2107) ())) (cons (cons if (cons (cons = (cons cons (cons (cons hd (cons (protect Select2107) ())) ()))) (cons (cons if (cons (cons cons? (cons (protect Select2106) ())) (cons (cons let (cons (protect Select2104) (cons (cons hd (cons (protect Select2106) ())) (cons (cons let (cons (protect Select2105) (cons (cons tl (cons (protect Select2106) ())) (cons (cons if (cons (cons cons? (cons (protect Select2105) ())) (cons (cons let (cons (protect Select2103) (cons (cons tl (cons (protect Select2105) ())) (cons (cons if (cons (cons and (cons (cons = (cons () (cons (cons hd (cons (protect Select2105) ())) ()))) (cons (cons and (cons (cons = (cons () (cons (protect Select2103) ()))) (cons (cons = (cons () (cons (protect Select2108) ()))) ()))) ()))) (cons (cons cons (cons vector (cons (cons cons (cons (protect Select2104) (cons () ()))) ()))) (cons (cons if (cons (cons and (cons (cons = (cons () (cons (protect Select2103) ()))) (cons (cons = (cons () (cons (protect Select2108) ()))) ()))) (cons (cons let (cons (protect W2094) (cons (cons newv ()) (cons (cons let (cons (protect W2095) (cons (cons newv ()) (cons (cons cons (cons let (cons (cons cons (cons (protect W2094) (cons (cons cons (cons (cons cons (cons vector (cons (cons cons (cons (protect Select2104) (cons () ()))) ()))) (cons (cons cons (cons (cons cons (cons do (cons (cons cons (cons (cons cons (cons for (cons (cons cons (cons (protect W2095) (cons (cons cons (cons = (cons (cons cons (cons 1 (cons (cons cons (cons to (cons (cons cons (cons (protect Select2104) (cons (cons cons (cons (cons cons (cons vector-> (cons (cons cons (cons (protect W2094) (cons (cons cons (cons (protect W2095) (cons (cons cons (cons (cons cons (cons array (cons (protect Select2105) ()))) (cons () ()))) ()))) ()))) ()))) (cons () ()))) ()))) ()))) ()))) ()))) ()))) ()))) (cons (cons cons (cons (protect W2094) (cons () ()))) ()))) ()))) (cons () ()))) ()))) ()))) ()))) ())))) ())))) (cons (cons thaw (cons (protect GoTo2096) ())) ())))) ())))) ())))) (cons (cons thaw (cons (protect GoTo2096) ())) ())))) ())))) ())))) (cons (cons thaw (cons (protect GoTo2096) ())) ())))) (cons (cons thaw (cons (protect GoTo2096) ())) ())))) ())))) (cons (cons thaw (cons (protect GoTo2096) ())) ())))) ())))) ())))) (cons (cons thaw (cons (protect GoTo2096) ())) ())))) (cons (cons thaw (cons (protect GoTo2096) ())) ())))) ())) (cons (cons if (cons (cons cons? (cons (protect Select2137) ())) (cons (cons let (cons (protect Select2119) (cons (cons hd (cons (protect Select2137) ())) (cons (cons let (cons (protect Select2120) (cons (cons tl (cons (protect Select2137) ())) (cons (cons if (cons (cons cons? (cons (protect Select2119) ())) (cons (cons let (cons (protect Select2118) (cons (cons tl (cons (protect Select2119) ())) (cons (cons if (cons (cons = (cons cons (cons (cons hd (cons (protect Select2119) ())) ()))) (cons (cons if (cons (cons cons? (cons (protect Select2118) ())) (cons (cons let (cons (protect Select2116) (cons (cons hd (cons (protect Select2118) ())) (cons (cons let (cons (protect Select2117) (cons (cons tl (cons (protect Select2118) ())) (cons (cons if (cons (cons cons? (cons (protect Select2117) ())) (cons (cons let (cons (protect Select2114) (cons (cons hd (cons (protect Select2117) ())) (cons (cons let (cons (protect Select2115) (cons (cons tl (cons (protect Select2117) ())) (cons (cons if (cons (cons and (cons (cons = (cons () (cons (protect Select2114) ()))) (cons (cons and (cons (cons = (cons () (cons (protect Select2115) ()))) (cons (cons and (cons (cons cons? (cons (protect Select2120) ())) (cons (cons and (cons (cons = (cons := (cons (cons hd (cons (protect Select2120) ())) ()))) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect Select2120) ())) ())) (cons (cons = (cons () (cons (cons tl (cons (cons tl (cons (protect Select2120) ())) ())) ()))) ()))) ()))) ()))) ()))) ()))) (cons (cons cons (cons vector-> (cons (cons cons (cons (protect Select2136) (cons (cons cons (cons (protect Select2116) (cons (cons tl (cons (protect Select2120) ())) ()))) ()))) ()))) (cons (cons if (cons (cons and (cons (cons = (cons () (cons (protect Select2115) ()))) (cons (cons and (cons (cons cons? (cons (protect Select2120) ())) (cons (cons and (cons (cons = (cons := (cons (cons hd (cons (protect Select2120) ())) ()))) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect Select2120) ())) ())) (cons (cons = (cons () (cons (cons tl (cons (cons tl (cons (protect Select2120) ())) ())) ()))) ()))) ()))) ()))) ()))) (cons (cons let (cons (protect W2093) (cons (cons newv ()) (cons (cons cons (cons let (cons (cons cons (cons (protect W2093) (cons (cons cons (cons (cons cons (cons <-vector (cons (cons cons (cons (protect Select2136) (cons (cons cons (cons (protect Select2116) (cons () ()))) ()))) ()))) (cons (cons cons (cons (cons cons (cons (protect W2093) (cons (cons cons (cons (protect Select2114) (cons (protect Select2120) ()))) ()))) (cons () ()))) ()))) ()))) ()))) ())))) (cons (cons thaw (cons (protect GoTo2109) ())) ())))) ())))) ())))) ())))) (cons (cons thaw (cons (protect GoTo2109) ())) ())))) ())))) ())))) (cons (cons thaw (cons (protect GoTo2109) ())) ())))) (cons (cons thaw (cons (protect GoTo2109) ())) ())))) ())))) (cons (cons thaw (cons (protect GoTo2109) ())) ())))) ())))) ())))) (cons (cons thaw (cons (protect GoTo2109) ())) ())))) ())))) ())) (cons (cons if (cons (cons = (cons := (cons (protect Select2136) ()))) (cons (cons if (cons (cons cons? (cons (protect Select2137) ())) (cons (cons let (cons (protect Select2134) (cons (cons hd (cons (protect Select2137) ())) (cons (cons let (cons (protect Select2135) (cons (cons tl (cons (protect Select2137) ())) (cons (cons if (cons (cons cons? (cons (protect Select2135) ())) (cons (cons let (cons (protect Select2132) (cons (cons hd (cons (protect Select2135) ())) (cons (cons let (cons (protect Select2133) (cons (cons tl (cons (protect Select2135) ())) (cons (cons if (cons (cons cons? (cons (protect Select2132) ())) (cons (cons let (cons (protect Select2131) (cons (cons tl (cons (protect Select2132) ())) (cons (cons if (cons (cons = (cons cons (cons (cons hd (cons (protect Select2132) ())) ()))) (cons (cons if (cons (cons cons? (cons (protect Select2131) ())) (cons (cons let (cons (protect Select2129) (cons (cons hd (cons (protect Select2131) ())) (cons (cons let (cons (protect Select2130) (cons (cons tl (cons (protect Select2131) ())) (cons (cons if (cons (cons cons? (cons (protect Select2130) ())) (cons (cons let (cons (protect Select2128) (cons (cons tl (cons (protect Select2130) ())) (cons (cons if (cons (cons and (cons (cons = (cons () (cons (cons hd (cons (protect Select2130) ())) ()))) (cons (cons and (cons (cons = (cons () (cons (protect Select2128) ()))) (cons (cons = (cons () (cons (protect Select2133) ()))) ()))) ()))) (cons (cons cons (cons <-vector (cons (cons cons (cons (protect Select2134) (cons (cons cons (cons (protect Select2129) (cons () ()))) ()))) ()))) (cons (cons if (cons (cons and (cons (cons = (cons () (cons (protect Select2128) ()))) (cons (cons = (cons () (cons (protect Select2133) ()))) ()))) (cons (cons cons (cons := (cons (cons cons (cons (cons cons (cons <-vector (cons (cons cons (cons (protect Select2134) (cons (cons cons (cons (protect Select2129) (cons () ()))) ()))) ()))) (cons (protect Select2130) ()))) ()))) (cons (cons thaw (cons (protect GoTo2121) ())) ())))) ())))) ())))) (cons (cons thaw (cons (protect GoTo2121) ())) ())))) ())))) ())))) (cons (cons thaw (cons (protect GoTo2121) ())) ())))) (cons (cons thaw (cons (protect GoTo2121) ())) ())))) ())))) (cons (cons thaw (cons (protect GoTo2121) ())) ())))) ())))) ())))) (cons (cons thaw (cons (protect GoTo2121) ())) ())))) ())))) ())))) (cons (cons thaw (cons (protect GoTo2121) ())) ())))) (cons (cons thaw (cons (protect GoTo2121) ())) ())))) ())))) ())))) ())))) (cons (cons thaw (cons (protect GoTo2096) ())) ())))) ())))) ()))))) (do (shen.record-kl print.pprint-macro (cons defun (cons print.pprint-macro (cons (cons (protect V2220) ()) (cons (cons cond (cons (cons (cons and (cons (cons cons? (cons (protect V2220) ())) (cons (cons and (cons (cons = (cons pprint (cons (cons hd (cons (protect V2220) ())) ()))) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect V2220) ())) ())) (cons (cons = (cons () (cons (cons tl (cons (cons tl (cons (protect V2220) ())) ())) ()))) ()))) ()))) ()))) (cons (cons cons (cons pprint (cons (cons cons (cons (cons hd (cons (cons tl (cons (protect V2220) ())) ())) (cons (cons cons (cons (cons cons (cons stoutput (cons () ()))) (cons () ()))) ()))) ()))) ())) (cons (cons (cons and (cons (cons cons? (cons (protect V2220) ())) (cons (cons and (cons (cons = (cons pps (cons (cons hd (cons (protect V2220) ())) ()))) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect V2220) ())) ())) (cons (cons = (cons () (cons (cons tl (cons (cons tl (cons (protect V2220) ())) ())) ()))) ()))) ()))) ()))) (cons (cons cons (cons pps (cons (cons cons (cons (cons hd (cons (cons tl (cons (protect V2220) ())) ())) (cons (cons cons (cons (cons cons (cons stoutput (cons () ()))) (cons () ()))) ()))) ()))) ())) (cons (cons true (cons (protect V2220) ())) ())))) ()))))) (do (shen.record-kl linelength (cons defun (cons linelength (cons () (cons (cons value (cons print.*linelength* ())) ()))))) (do (shen.record-kl indentation (cons defun (cons indentation (cons () (cons (cons value (cons print.*indentation* ())) ()))))) (do (shen.record-kl set-linelength (cons defun (cons set-linelength (cons (cons (protect V2222) ()) (cons (cons cond (cons (cons (cons and (cons (cons positive? (cons (protect V2222) ())) (cons (cons integer? (cons (protect V2222) ())) ()))) (cons (cons set (cons print.*linelength* (cons (protect V2222) ()))) ())) (cons (cons true (cons (cons simple-error (cons "line length must be a positive integer +" ())) ())) ()))) ()))))) (do (shen.record-kl set-indentation (cons defun (cons set-indentation (cons (cons (protect V2224) ()) (cons (cons cond (cons (cons (cons and (cons (cons positive? (cons (protect V2224) ())) (cons (cons integer? (cons (protect V2224) ())) ()))) (cons (cons set (cons print.*indentation* (cons (protect V2224) ()))) ())) (cons (cons true (cons (cons simple-error (cons "indentation must be a positive integer +" ())) ())) ()))) ()))))) (do (shen.record-kl pps (cons defun (cons pps (cons (cons (protect V2226) (cons (protect V2227) ())) (cons (cons let (cons (protect W2228) (cons (cons ps (cons (protect V2226) ())) (cons (cons let (cons (protect W2229) (cons (cons shen.app (cons (protect W2228) (cons "" (cons shen.r ())))) (cons (cons let (cons (protect W2230) (cons (cons pretty-string (cons (protect W2229) ())) (cons (cons let (cons (protect W2231) (cons (cons pr (cons (protect W2230) (cons (protect V2227) ()))) (cons (cons let (cons (protect W2232) (cons (cons nl (cons 1 ())) (cons (protect V2226) ())))) ())))) ())))) ())))) ())))) ()))))) (do (shen.record-kl pprint (cons defun (cons pprint (cons (cons (protect V2235) (cons (protect V2236) ())) (cons (cons let (cons (protect W2237) (cons (cons shen.app (cons (protect V2235) (cons "" (cons shen.s ())))) (cons (cons let (cons (protect W2238) (cons (cons pretty-string (cons (protect W2237) ())) (cons (cons let (cons (protect W2239) (cons (cons pr (cons (protect W2238) (cons (protect V2236) ()))) (cons (cons let (cons (protect W2240) (cons (cons nl (cons 1 ())) (cons (protect V2235) ())))) ())))) ())))) ())))) ()))))) (do (shen.record-kl pretty-string (cons defun (cons pretty-string (cons (cons (protect V2243) ()) (cons (cons print.pretty-string-h (cons (protect V2243) (cons 0 (cons 0 ())))) ()))))) (do (shen.record-kl print.pretty-string-h (cons defun (cons print.pretty-string-h (cons (cons (protect V2249) (cons (protect V2250) (cons (protect V2251) ()))) (cons (cons cond (cons (cons (cons = (cons "" (cons (protect V2249) ()))) (cons "" ())) (cons (cons (cons and (cons (cons shen.+string? (cons (protect V2249) ())) (cons (cons = (cons "[" (cons (cons hdstr (cons (protect V2249) ())) ()))) ()))) (cons (cons @s (cons (cons print.indent (cons (protect V2250) ())) (cons (cons @s (cons "[" (cons (cons print.pretty-string-h (cons (cons tlstr (cons (protect V2249) ())) (cons (cons + (cons (protect V2250) (cons 1 ()))) (cons 0 ())))) ()))) ()))) ())) (cons (cons (cons and (cons (cons shen.+string? (cons (protect V2249) ())) (cons (cons = (cons "(" (cons (cons hdstr (cons (protect V2249) ())) ()))) ()))) (cons (cons @s (cons (cons print.indent (cons (protect V2250) ())) (cons (cons @s (cons "(" (cons (cons print.pretty-string-h (cons (cons tlstr (cons (protect V2249) ())) (cons (cons + (cons (protect V2250) (cons 1 ()))) (cons 0 ())))) ()))) ()))) ())) (cons (cons (cons and (cons (cons shen.+string? (cons (protect V2249) ())) (cons (cons = (cons "]" (cons (cons hdstr (cons (protect V2249) ())) ()))) ()))) (cons (cons @s (cons "]" (cons (cons print.pretty-string-h (cons (cons tlstr (cons (protect V2249) ())) (cons (cons - (cons (protect V2250) (cons 1 ()))) (cons 0 ())))) ()))) ())) (cons (cons (cons and (cons (cons shen.+string? (cons (protect V2249) ())) (cons (cons = (cons ")" (cons (cons hdstr (cons (protect V2249) ())) ()))) ()))) (cons (cons @s (cons ")" (cons (cons print.pretty-string-h (cons (cons tlstr (cons (protect V2249) ())) (cons (cons - (cons (protect V2250) (cons 1 ()))) (cons 0 ())))) ()))) ())) (cons (cons (cons and (cons (cons shen.+string? (cons (protect V2249) ())) (cons (cons and (cons (cons = (cons " " (cons (cons hdstr (cons (protect V2249) ())) ()))) (cons (cons > (cons (protect V2251) (cons (cons linelength ()) ()))) ()))) ()))) (cons (cons @s (cons (cons print.indent (cons (protect V2250) ())) (cons (cons print.pretty-string-h (cons (cons tlstr (cons (protect V2249) ())) (cons (protect V2250) (cons 0 ())))) ()))) ())) (cons (cons (cons shen.+string? (cons (protect V2249) ())) (cons (cons @s (cons (cons hdstr (cons (protect V2249) ())) (cons (cons print.pretty-string-h (cons (cons tlstr (cons (protect V2249) ())) (cons (protect V2250) (cons (cons + (cons (protect V2251) (cons 1 ()))) ())))) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons print.pretty-string-h ())) ())) ()))))))))) ()))))) (do (shen.record-kl print.indent (cons defun (cons print.indent (cons (cons (protect V2255) ()) (cons (cons cond (cons (cons (cons = (cons 0 (cons (protect V2255) ()))) (cons "" ())) (cons (cons true (cons (cons @s (cons " +" (cons (cons print.indent-h (cons (protect V2255) ())) ()))) ())) ()))) ()))))) (do (shen.record-kl print.indent-h (cons defun (cons print.indent-h (cons (cons (protect V2257) ()) (cons (cons cond (cons (cons (cons = (cons 0 (cons (protect V2257) ()))) (cons "" ())) (cons (cons true (cons (cons cn (cons (cons print.n-space (cons (cons indentation ()) ())) (cons (cons print.indent-h (cons (cons - (cons (protect V2257) (cons 1 ()))) ())) ()))) ())) ()))) ()))))) (do (shen.record-kl print.n-space (cons defun (cons print.n-space (cons (cons (protect V2259) ()) (cons (cons cond (cons (cons (cons = (cons 0 (cons (protect V2259) ()))) (cons "" ())) (cons (cons true (cons (cons cn (cons " " (cons (cons print.n-space (cons (cons - (cons (protect V2259) (cons 1 ()))) ())) ()))) ())) ()))) ()))))) (do (shen.record-kl delete-file (cons defun (cons delete-file (cons (cons (protect V2262) ()) (cons (cons if (cons (cons = (cons (cons language ()) (cons "Common Lisp" ()))) (cons (cons (cons fn (cons lisp.delete-file ())) (cons (protect V2262) ())) (cons (cons close (cons (cons open (cons (protect V2262) (cons out ()))) ())) ())))) ()))))) (do (shen.record-kl file.file-macro (cons defun (cons file.file-macro (cons (cons (protect V2290) ()) (cons (cons cond (cons (cons (cons and (cons (cons cons? (cons (protect V2290) ())) (cons (cons and (cons (cons = (cons errout (cons (cons hd (cons (protect V2290) ())) ()))) (cons (cons and (cons (cons cons? (cons (cons tl (cons (protect V2290) ())) ())) (cons (cons and (cons (cons cons? (cons (cons tl (cons (cons tl (cons (protect V2290) ())) ())) ())) (cons (cons and (cons (cons cons? (cons (cons tl (cons (cons tl (cons (cons tl (cons (protect V2290) ())) ())) ())) ())) (cons (cons = (cons () (cons (cons tl (cons (cons tl (cons (cons tl (cons (cons tl (cons (protect V2290) ())) ())) ())) ())) ()))) ()))) ()))) ()))) ()))) ()))) (cons (cons let (cons (protect W2291) (cons (cons newv ()) (cons (cons let (cons (protect W2292) (cons (cons newv ()) (cons (cons let (cons (protect W2293) (cons (cons newv ()) (cons (cons let (cons (protect W2294) (cons (cons newv ()) (cons (cons let (cons (protect W2295) (cons (cons newv ()) (cons (cons cons (cons trap-error (cons (cons cons (cons (cons hd (cons (cons tl (cons (protect V2290) ())) ())) (cons (cons cons (cons (cons cons (cons /. (cons (cons cons (cons (protect W2295) (cons (cons cons (cons (cons cons (cons let (cons (cons cons (cons (protect W2291) (cons (cons cons (cons (cons cons (cons error-to-string (cons (cons cons (cons (protect W2295) (cons () ()))) ()))) (cons (cons cons (cons (protect W2292) (cons (cons cons (cons (cons cons (cons trap-error (cons (cons cons (cons (cons cons (cons reopen (cons (cons tl (cons (cons tl (cons (cons tl (cons (protect V2290) ())) ())) ())) ()))) (cons (cons cons (cons (cons cons (cons /. (cons (cons cons (cons (protect W2295) (cons (cons cons (cons (cons cons (cons open (cons (cons cons (cons (cons hd (cons (cons tl (cons (cons tl (cons (cons tl (cons (protect V2290) ())) ())) ())) ())) (cons (cons cons (cons out (cons () ()))) ()))) ()))) (cons () ()))) ()))) ()))) (cons () ()))) ()))) ()))) (cons (cons cons (cons (protect W2293) (cons (cons cons (cons (cons cons (cons pr (cons (cons cons (cons (protect W2291) (cons (cons cons (cons (protect W2292) (cons () ()))) ()))) ()))) (cons (cons cons (cons (protect W2294) (cons (cons cons (cons (cons cons (cons close (cons (cons cons (cons (protect W2292) (cons () ()))) ()))) (cons (cons cons (cons (cons hd (cons (cons tl (cons (cons tl (cons (protect V2290) ())) ())) ())) (cons () ()))) ()))) ()))) ()))) ()))) ()))) ()))) ()))) ()))) ()))) (cons () ()))) ()))) ()))) (cons () ()))) ()))) ()))) ())))) ())))) ())))) ())))) ())))) ())) (cons (cons true (cons (protect V2290) ())) ()))) ()))))) (do (shen.record-kl append-files (cons defun (cons append-files (cons (cons (protect V2297) (cons (protect V2298) ())) (cons (cons let (cons (protect W2299) (cons (cons append-files-with-open-stream (cons (protect V2297) (cons (protect V2298) ()))) (cons (cons let (cons (protect W2300) (cons (cons close (cons (protect W2299) ())) (cons (protect V2298) ())))) ())))) ()))))) (do (shen.record-kl append-files-with-open-stream (cons defun (cons append-files-with-open-stream (cons (cons (protect V2303) (cons (protect V2304) ())) (cons (cons cond (cons (cons (cons element? (cons (protect V2304) (cons (protect V2303) ()))) (cons (cons simple-error (cons (cons cn (cons "cannot read and write to " (cons (cons shen.app (cons (protect V2304) (cons " at the same time +" (cons shen.a ())))) ()))) ())) ())) (cons (cons true (cons (cons let (cons (protect W2305) (cons (cons open (cons (protect V2304) (cons out ()))) (cons (cons let (cons (protect W2306) (cons (cons mapc (cons (cons lambda (cons (protect Z2307) (cons (cons file.read&write (cons (cons open (cons (protect Z2307) (cons in ()))) (cons (protect W2305) ()))) ()))) (cons (protect V2303) ()))) (cons (protect W2305) ())))) ())))) ())) ()))) ()))))) (do (shen.record-kl file.read&write (cons defun (cons file.read&write (cons (cons (protect V2310) (cons (protect V2311) ())) (cons (cons file.read&write-h (cons (cons read-byte (cons (protect V2310) ())) (cons (protect V2310) (cons (protect V2311) ())))) ()))))) (do (shen.record-kl file.read&write-h (cons defun (cons file.read&write-h (cons (cons (protect V2314) (cons (protect V2315) (cons (protect V2316) ()))) (cons (cons cond (cons (cons (cons = (cons -1 (cons (protect V2314) ()))) (cons -1 ())) (cons (cons true (cons (cons file.read&write-h (cons (cons read-byte (cons (protect V2315) ())) (cons (protect V2315) (cons (cons do (cons (cons write-byte (cons (protect V2314) (cons (protect V2316) ()))) (cons (protect V2316) ()))) ())))) ())) ()))) ()))))) (do (shen.record-kl reopen (cons defun (cons reopen (cons (cons (protect V2320) ()) (cons (cons let (cons (protect W2321) (cons (cons read-file-as-bytelist (cons (protect V2320) ())) (cons (cons let (cons (protect W2322) (cons (cons open (cons (protect V2320) (cons out ()))) (cons (cons let (cons (protect W2323) (cons (cons mapc (cons (cons lambda (cons (protect Z2324) (cons (cons write-byte (cons (protect Z2324) (cons (protect W2322) ()))) ()))) (cons (protect W2321) ()))) (cons (protect W2322) ())))) ())))) ())))) ()))))) (do (shen.record-kl copy-file (cons defun (cons copy-file (cons (cons (protect V2326) (cons (protect V2327) ())) (cons (cons append-files (cons (cons cons (cons (protect V2326) (cons () ()))) (cons (protect V2327) ()))) ()))))) (do (shen.record-kl copy-file-with-open-stream (cons defun (cons copy-file-with-open-stream (cons (cons (protect V2330) (cons (protect V2331) ())) (cons (cons append-files-with-open-stream (cons (cons cons (cons (protect V2330) (cons () ()))) (cons (protect V2331) ()))) ()))))) (do (shen.record-kl file-exists? (cons defun (cons file-exists? (cons (cons (protect V2334) ()) (cons (cons trap-error (cons (cons do (cons (cons close (cons (cons open (cons (protect V2334) (cons in ()))) ())) (cons true ()))) (cons (cons lambda (cons (protect Z2335) (cons false ()))) ()))) ()))))) (do (shen.record-kl file-size (cons defun (cons file-size (cons (cons (protect V2337) ()) (cons (cons let (cons (protect W2338) (cons (cons open (cons (protect V2337) (cons in ()))) (cons (cons let (cons (protect W2339) (cons (cons file.file-size-loop (cons (protect W2338) (cons 0 (cons (cons read-byte (cons (protect W2338) ())) ())))) (cons (cons let (cons (protect W2340) (cons (cons close (cons (protect W2338) ())) (cons (protect W2339) ())))) ())))) ())))) ()))))) (do (shen.record-kl file.file-size-loop (cons defun (cons file.file-size-loop (cons (cons (protect V2346) (cons (protect V2347) (cons (protect V2348) ()))) (cons (cons cond (cons (cons (cons = (cons -1 (cons (protect V2348) ()))) (cons (protect V2347) ())) (cons (cons true (cons (cons file.file-size-loop (cons (protect V2346) (cons (cons + (cons 1 (cons (protect V2347) ()))) (cons (cons read-byte (cons (protect V2346) ())) ())))) ())) ()))) ()))))) (do (shen.record-kl ascii (cons defun (cons ascii (cons (cons (protect V2352) (cons (protect V2353) (cons (protect V2354) ()))) (cons (cons let (cons (protect W2355) (cons (cons read-file-as-bytelist (cons (protect V2354) ())) (cons (cons file.scan-bytes (cons (protect V2352) (cons (protect V2353) (cons (protect W2355) (cons "" ()))))) ())))) ()))))) (do (shen.record-kl file.scan-bytes (cons defun (cons file.scan-bytes (cons (cons (protect V2361) (cons (protect V2362) (cons (protect V2363) (cons (protect V2364) ())))) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V2363) ()))) (cons (protect V2364) ())) (cons (cons (cons and (cons (cons cons? (cons (protect V2363) ())) (cons (cons and (cons (cons >= (cons (cons hd (cons (protect V2363) ())) (cons (protect V2361) ()))) (cons (cons <= (cons (cons hd (cons (protect V2363) ())) (cons (protect V2362) ()))) ()))) ()))) (cons (cons file.scan-bytes (cons (protect V2361) (cons (protect V2362) (cons (cons tl (cons (protect V2363) ())) (cons (cons cn (cons (protect V2364) (cons (cons n->string (cons (cons hd (cons (protect V2363) ())) ())) ()))) ()))))) ())) (cons (cons (cons cons? (cons (protect V2363) ())) (cons (cons simple-error (cons (cons cn (cons "character has code " (cons (cons shen.app (cons (cons hd (cons (protect V2363) ())) (cons (cons cn (cons ": parsed to here + +" (cons (cons shen.app (cons (protect V2364) (cons "" (cons shen.a ())))) ()))) (cons shen.a ())))) ()))) ())) ())) (cons (cons true (cons (cons shen.f-error (cons file.scan-bytes ())) ())) ()))))) ()))))) (do (shen.record-kl pairoff (cons defun (cons pairoff (cons (cons (protect V2383) (cons (protect V2384) ())) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V2383) ()))) (cons () ())) (cons (cons (cons = (cons () (cons (protect V2384) ()))) (cons () ())) (cons (cons (cons and (cons (cons cons? (cons (protect V2383) ())) (cons (cons cons? (cons (protect V2384) ())) ()))) (cons (cons cons (cons (cons @p (cons (cons hd (cons (protect V2383) ())) (cons (cons hd (cons (protect V2384) ())) ()))) (cons (cons pairoff (cons (cons tl (cons (protect V2383) ())) (cons (cons tl (cons (protect V2384) ())) ()))) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons pairoff ())) ())) ()))))) ()))))) (do (shen.record-kl assocp (cons defun (cons assocp (cons (cons (protect V2394) (cons (protect V2395) ())) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V2395) ()))) (cons (cons simple-error (cons "pair not found +" ())) ())) (cons (cons (cons and (cons (cons cons? (cons (protect V2395) ())) (cons (cons and (cons (cons tuple? (cons (cons hd (cons (protect V2395) ())) ())) (cons (cons = (cons (protect V2394) (cons (cons fst (cons (cons hd (cons (protect V2395) ())) ())) ()))) ()))) ()))) (cons (cons hd (cons (protect V2395) ())) ())) (cons (cons (cons cons? (cons (protect V2395) ())) (cons (cons assocp (cons (protect V2394) (cons (cons tl (cons (protect V2395) ())) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons assocp ())) ())) ()))))) ()))))) (do (shen.record-kl cartprodp (cons defun (cons cartprodp (cons (cons (protect V2400) (cons (protect V2401) ())) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V2400) ()))) (cons () ())) (cons (cons (cons cons? (cons (protect V2400) ())) (cons (cons append (cons (cons map (cons (cons lambda (cons (protect Z2402) (cons (cons @p (cons (cons hd (cons (protect V2400) ())) (cons (protect Z2402) ()))) ()))) (cons (protect V2401) ()))) (cons (cons cartprodp (cons (cons tl (cons (protect V2400) ())) (cons (protect V2401) ()))) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons cartprodp ())) ())) ())))) ()))))) (do (shen.record-kl assocp-if (cons defun (cons assocp-if (cons (cons (protect V2410) (cons (protect V2411) ())) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V2411) ()))) (cons (cons simple-error (cons "pair not found +" ())) ())) (cons (cons (cons and (cons (cons cons? (cons (protect V2411) ())) (cons (cons and (cons (cons tuple? (cons (cons hd (cons (protect V2411) ())) ())) (cons (cons (protect V2410) (cons (cons fst (cons (cons hd (cons (protect V2411) ())) ())) ())) ()))) ()))) (cons (cons hd (cons (protect V2411) ())) ())) (cons (cons (cons cons? (cons (protect V2411) ())) (cons (cons assocp-if (cons (protect V2410) (cons (cons tl (cons (protect V2411) ())) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons assocp-if ())) ())) ()))))) ()))))) (shen.record-kl assocp-if-not (cons defun (cons assocp-if-not (cons (cons (protect V2419) (cons (protect V2420) ())) (cons (cons cond (cons (cons (cons = (cons () (cons (protect V2420) ()))) (cons (cons simple-error (cons "pair not found +" ())) ())) (cons (cons (cons and (cons (cons cons? (cons (protect V2420) ())) (cons (cons and (cons (cons tuple? (cons (cons hd (cons (protect V2420) ())) ())) (cons (cons not (cons (cons (protect V2419) (cons (cons fst (cons (cons hd (cons (protect V2420) ())) ())) ())) ())) ()))) ()))) (cons (cons hd (cons (protect V2420) ())) ())) (cons (cons (cons cons? (cons (protect V2420) ())) (cons (cons assocp-if-not (cons (protect V2419) (cons (cons tl (cons (protect V2420) ())) ()))) ())) (cons (cons true (cons (cons shen.f-error (cons assocp-if-not ())) ())) ()))))) ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) + +(defun stlib.initialise-final () (do (let External (external stlib) (let ExternalF (filter (lambda X (> (arity X) -1)) External) (let SystemfResult (map (lambda Y2424 (systemf Y2424)) ExternalF) ok))) (do (preclude-all-but ()) (do (set shen.*userdefs* ()) (do (cd "") (tc -)))))) + +(defun stlib.initialise () (do (stlib.initialise-environment) (do (stlib.initialise-arities) (do (stlib.initialise-macros) (do (stlib.initialise-synonyms) (do (stlib.initialise-datatypes) (do (stlib.initialise-types) (do (stlib.initialise-sources) (stlib.initialise-final))))))))) + diff --git a/klambda/sys.kl b/klambda/sys.kl index d4a65b0..90ea359 100644 --- a/klambda/sys.kl +++ b/klambda/sys.kl @@ -1,16 +1,16 @@ -(defun thaw (V3444) (V3444)) +(defun thaw (V3830) (V3830)) -(defun eval (V3445) (eval-kl (shen.shen->kl (shen.process-applications (macroexpand V3445) (shen.find-types V3445))))) +(defun eval (V3831) (eval-kl (shen.shen->kl (shen.process-applications (macroexpand V3831) (shen.find-types V3831))))) -(defun external (V3446) (cond ((= null V3446) ()) (true (trap-error (get V3446 shen.external-symbols (value *property-vector*)) (lambda Z3447 (simple-error (cn "package " (shen.app V3446 " does not exist. +(defun external (V3832) (cond ((= null V3832) ()) (true (trap-error (get V3832 shen.external-symbols (value *property-vector*)) (lambda Z3833 (simple-error (cn "package " (shen.app V3832 " does not exist. ;" shen.a)))))))) -(defun internal (V3448) (cond ((= null V3448) ()) (true (trap-error (get V3448 shen.internal-symbols (value *property-vector*)) (lambda Z3449 (simple-error (cn "package " (shen.app V3448 " does not exist. +(defun internal (V3834) (cond ((= null V3834) ()) (true (trap-error (get V3834 shen.internal-symbols (value *property-vector*)) (lambda Z3835 (simple-error (cn "package " (shen.app V3834 " does not exist. ;" shen.a)))))))) -(defun fail-if (V3450 V3451) (if (V3450 V3451) (fail) V3451)) +(defun fail-if (V3836 V3837) (if (V3836 V3837) (fail) V3837)) -(defun @s (V3452 V3453) (cn V3452 V3453)) +(defun @s (V3838 V3839) (cn V3838 V3839)) (defun tc? () (value shen.*tc*)) @@ -20,191 +20,195 @@ (defun tracked () (value shen.*tracking*)) -(defun ps (V3454) (trap-error (get V3454 shen.source (value *property-vector*)) (lambda Z3455 (simple-error (shen.app V3454 " not found. +(defun ps (V3840) (trap-error (get V3840 shen.source (value *property-vector*)) (lambda Z3841 (simple-error (shen.app V3840 " not found. " shen.a))))) (defun stinput () (value *stinput*)) -(defun vector (V3456) (let W3457 (absvector (+ V3456 1)) (let W3458 (address-> W3457 0 V3456) (let W3459 (if (= V3456 0) W3458 (shen.fillvector W3458 1 V3456 (fail))) W3459)))) +(defun vector (V3842) (let W3843 (absvector (+ V3842 1)) (let W3844 (address-> W3843 0 V3842) (let W3845 (if (= V3842 0) W3844 (shen.fillvector W3844 1 V3842 (fail))) W3845)))) -(defun shen.fillvector (V3461 V3462 V3463 V3464) (cond ((= V3462 V3463) (address-> V3461 V3463 V3464)) (true (shen.fillvector (address-> V3461 V3462 V3464) (+ 1 V3462) V3463 V3464)))) +(defun shen.fillvector (V3847 V3848 V3849 V3850) (cond ((= V3848 V3849) (address-> V3847 V3849 V3850)) (true (shen.fillvector (address-> V3847 V3848 V3850) (+ 1 V3848) V3849 V3850)))) -(defun vector? (V3465) (and (absvector? V3465) (trap-error (>= (<-address V3465 0) 0) (lambda Z3466 false)))) +(defun vector? (V3851) (and (absvector? V3851) (let W3852 (trap-error (<-address V3851 0) (lambda Z3853 -1)) (and (number? W3852) (>= W3852 0))))) -(defun vector-> (V3467 V3468 V3469) (if (= V3468 0) (simple-error "cannot access 0th element of a vector -") (address-> V3467 V3468 V3469))) +(defun vector-> (V3854 V3855 V3856) (if (= V3855 0) (simple-error "cannot access 0th element of a vector +") (address-> V3854 V3855 V3856))) -(defun <-vector (V3470 V3471) (if (= V3471 0) (simple-error "cannot access 0th element of a vector -") (let W3472 (<-address V3470 V3471) (if (= W3472 (fail)) (simple-error "vector element not found -") W3472)))) +(defun <-vector (V3857 V3858) (if (= V3858 0) (simple-error "cannot access 0th element of a vector +") (let W3859 (<-address V3857 V3858) (if (= W3859 (fail)) (simple-error "vector element not found +") W3859)))) -(defun shen.posint? (V3473) (and (integer? V3473) (>= V3473 0))) +(defun shen.posint? (V3860) (and (integer? V3860) (>= V3860 0))) -(defun limit (V3474) (<-address V3474 0)) +(defun limit (V3861) (<-address V3861 0)) -(defun symbol? (V3475) (cond ((or (boolean? V3475) (or (number? V3475) (or (string? V3475) (or (cons? V3475) (or (empty? V3475) (vector? V3475)))))) false) ((element? V3475 (cons { (cons } (cons (intern ":") (cons (intern ";") (cons (intern ",") ())))))) true) (true (trap-error (let W3476 (str V3475) (shen.analyse-symbol? W3476)) (lambda Z3477 false))))) +(defun symbol? (V3862) (cond ((or (boolean? V3862) (or (number? V3862) (or (string? V3862) (or (cons? V3862) (or (empty? V3862) (vector? V3862)))))) false) ((element? V3862 (cons { (cons } (cons (intern ":") (cons (intern ";") (cons (intern ",") ())))))) true) (true (trap-error (let W3863 (str V3862) (shen.analyse-symbol? W3863)) (lambda Z3864 false))))) -(defun shen.analyse-symbol? (V3480) (cond ((shen.+string? V3480) (and (shen.alpha? (string->n (hdstr V3480))) (shen.alphanums? (tlstr V3480)))) (true (simple-error "implementation error in shen.analyse-symbol?")))) +(defun shen.analyse-symbol? (V3867) (cond ((shen.+string? V3867) (and (shen.alpha? (string->n (hdstr V3867))) (shen.alphanums? (tlstr V3867)))) (true (simple-error "implementation error in shen.analyse-symbol?")))) -(defun shen.alphanums? (V3483) (cond ((= "" V3483) true) ((shen.+string? V3483) (let W3484 (string->n (hdstr V3483)) (and (or (shen.alpha? W3484) (shen.digit? W3484)) (shen.alphanums? (tlstr V3483))))) (true (simple-error "implementation error in shen.alphanums?")))) +(defun shen.alphanums? (V3870) (cond ((= "" V3870) true) ((shen.+string? V3870) (let W3871 (string->n (hdstr V3870)) (and (or (shen.alpha? W3871) (shen.digit? W3871)) (shen.alphanums? (tlstr V3870))))) (true (simple-error "implementation error in shen.alphanums?")))) -(defun variable? (V3485) (cond ((or (boolean? V3485) (or (number? V3485) (string? V3485))) false) (true (trap-error (let W3486 (str V3485) (shen.analyse-variable? W3486)) (lambda Z3487 false))))) +(defun variable? (V3872) (cond ((or (boolean? V3872) (or (number? V3872) (string? V3872))) false) (true (trap-error (let W3873 (str V3872) (shen.analyse-variable? W3873)) (lambda Z3874 false))))) -(defun shen.analyse-variable? (V3490) (cond ((shen.+string? V3490) (and (shen.uppercase? (string->n (hdstr V3490))) (shen.alphanums? (tlstr V3490)))) (true (simple-error "implementation error in shen.analyse-variable?")))) +(defun shen.analyse-variable? (V3877) (cond ((shen.+string? V3877) (and (shen.uppercase? (string->n (hdstr V3877))) (shen.alphanums? (tlstr V3877)))) (true (simple-error "implementation error in shen.analyse-variable?")))) -(defun gensym (V3491) (concat V3491 (set shen.*gensym* (+ 1 (value shen.*gensym*))))) +(defun gensym (V3878) (concat V3878 (set shen.*gensym* (+ 1 (value shen.*gensym*))))) -(defun concat (V3492 V3493) (intern (cn (str V3492) (str V3493)))) +(defun concat (V3879 V3880) (intern (cn (str V3879) (str V3880)))) -(defun @p (V3494 V3495) (let W3496 (absvector 3) (let W3497 (address-> W3496 0 shen.tuple) (let W3498 (address-> W3496 1 V3494) (let W3499 (address-> W3496 2 V3495) W3496))))) +(defun @p (V3881 V3882) (let W3883 (absvector 3) (let W3884 (address-> W3883 0 shen.tuple) (let W3885 (address-> W3883 1 V3881) (let W3886 (address-> W3883 2 V3882) W3883))))) -(defun fst (V3500) (<-address V3500 1)) +(defun fst (V3887) (<-address V3887 1)) -(defun snd (V3501) (<-address V3501 2)) +(defun snd (V3888) (<-address V3888 2)) -(defun tuple? (V3502) (trap-error (and (absvector? V3502) (= shen.tuple (<-address V3502 0))) (lambda Z3503 false))) +(defun tuple? (V3889) (and (absvector? V3889) (= shen.tuple (trap-error (<-address V3889 0) (lambda Z3890 shen.not-tuple))))) -(defun append (V3508 V3509) (cond ((= () V3508) V3509) ((cons? V3508) (cons (hd V3508) (append (tl V3508) V3509))) (true (simple-error "attempt to append a non-list")))) +(defun append (V3895 V3896) (cond ((= () V3895) V3896) ((cons? V3895) (cons (hd V3895) (append (tl V3895) V3896))) (true (simple-error "attempt to append a non-list")))) -(defun @v (V3510 V3511) (let W3512 (limit V3511) (let W3513 (vector (+ W3512 1)) (let W3514 (vector-> W3513 1 V3510) (if (= W3512 0) W3514 (shen.@v-help V3511 1 W3512 W3514)))))) +(defun @v (V3897 V3898) (let W3899 (limit V3898) (let W3900 (vector (+ W3899 1)) (let W3901 (vector-> W3900 1 V3897) (if (= W3899 0) W3901 (shen.@v-help V3898 1 W3899 W3901)))))) -(defun shen.@v-help (V3516 V3517 V3518 V3519) (cond ((= V3517 V3518) (shen.copyfromvector V3516 V3519 V3518 (+ V3518 1))) (true (shen.@v-help V3516 (+ V3517 1) V3518 (shen.copyfromvector V3516 V3519 V3517 (+ V3517 1)))))) +(defun shen.@v-help (V3903 V3904 V3905 V3906) (cond ((= V3904 V3905) (shen.copyfromvector V3903 V3906 V3905 (+ V3905 1))) (true (shen.@v-help V3903 (+ V3904 1) V3905 (shen.copyfromvector V3903 V3906 V3904 (+ V3904 1)))))) -(defun shen.copyfromvector (V3520 V3521 V3522 V3523) (trap-error (vector-> V3521 V3523 (<-vector V3520 V3522)) (lambda Z3524 V3521))) +(defun shen.copyfromvector (V3907 V3908 V3909 V3910) (trap-error (vector-> V3908 V3910 (<-vector V3907 V3909)) (lambda Z3911 V3908))) -(defun hdv (V3525) (trap-error (<-vector V3525 1) (lambda Z3526 (simple-error "hdv needs a non-empty vector as an argument +(defun hdv (V3912) (trap-error (<-vector V3912 1) (lambda Z3913 (simple-error "hdv needs a non-empty vector as an argument ")))) -(defun tlv (V3527) (let W3528 (limit V3527) (if (= W3528 0) (simple-error "cannot take the tail of the empty vector -") (if (= W3528 1) (vector 0) (let W3529 (vector (- W3528 1)) (shen.tlv-help V3527 2 W3528 (vector (- W3528 1)))))))) +(defun tlv (V3914) (let W3915 (limit V3914) (if (= W3915 0) (simple-error "cannot take the tail of the empty vector +") (if (= W3915 1) (vector 0) (let W3916 (vector (- W3915 1)) (shen.tlv-help V3914 2 W3915 (vector (- W3915 1)))))))) -(defun shen.tlv-help (V3531 V3532 V3533 V3534) (cond ((= V3532 V3533) (shen.copyfromvector V3531 V3534 V3533 (- V3533 1))) (true (shen.tlv-help V3531 (+ V3532 1) V3533 (shen.copyfromvector V3531 V3534 V3532 (- V3532 1)))))) +(defun shen.tlv-help (V3918 V3919 V3920 V3921) (cond ((= V3919 V3920) (shen.copyfromvector V3918 V3921 V3920 (- V3920 1))) (true (shen.tlv-help V3918 (+ V3919 1) V3920 (shen.copyfromvector V3918 V3921 V3919 (- V3919 1)))))) -(defun assoc (V3546 V3547) (cond ((= () V3547) ()) ((and (cons? V3547) (and (cons? (hd V3547)) (= V3546 (hd (hd V3547))))) (hd V3547)) ((cons? V3547) (assoc V3546 (tl V3547))) (true (simple-error "attempt to search a non-list with assoc +(defun assoc (V3933 V3934) (cond ((= () V3934) ()) ((and (cons? V3934) (and (cons? (hd V3934)) (= V3933 (hd (hd V3934))))) (hd V3934)) ((cons? V3934) (assoc V3933 (tl V3934))) (true (simple-error "attempt to search a non-list with assoc ")))) -(defun boolean? (V3550) (cond ((= true V3550) true) ((= false V3550) true) (true false))) +(defun shen.assoc-set (V3938 V3939 V3940) (cond ((= () V3940) (cons (cons V3938 V3939) ())) ((and (cons? V3940) (and (cons? (hd V3940)) (= V3938 (hd (hd V3940))))) (cons (cons (hd (hd V3940)) V3939) (tl V3940))) ((cons? V3940) (cons (hd V3940) (shen.assoc-set V3938 V3939 (tl V3940)))) (true (shen.f-error shen.assoc-set)))) -(defun nl (V3551) (cond ((= 0 V3551) 0) (true (do (pr " -" (stoutput)) (nl (- V3551 1)))))) +(defun shen.assoc-rm (V3944 V3945) (cond ((= () V3945) ()) ((and (cons? V3945) (and (cons? (hd V3945)) (= V3944 (hd (hd V3945))))) (tl V3945)) ((cons? V3945) (cons (hd V3945) (shen.assoc-rm V3944 (tl V3945)))) (true (shen.f-error shen.assoc-rm)))) -(defun difference (V3558 V3559) (cond ((= () V3558) ()) ((cons? V3558) (if (element? (hd V3558) V3559) (difference (tl V3558) V3559) (cons (hd V3558) (difference (tl V3558) V3559)))) (true (simple-error "attempt to find the difference with a non-list -")))) +(defun boolean? (V3948) (cond ((= true V3948) true) ((= false V3948) true) (true false))) -(defun do (V3560 V3561) V3561) +(defun nl (V3949) (cond ((= 0 V3949) 0) (true (do (pr " +" (stoutput)) (nl (- V3949 1)))))) -(defun element? (V3573 V3574) (cond ((= () V3574) false) ((and (cons? V3574) (= V3573 (hd V3574))) true) ((cons? V3574) (element? V3573 (tl V3574))) (true (simple-error "attempt to find an element in a non-list +(defun difference (V3956 V3957) (cond ((= () V3956) ()) ((cons? V3956) (if (element? (hd V3956) V3957) (difference (tl V3956) V3957) (cons (hd V3956) (difference (tl V3956) V3957)))) (true (simple-error "attempt to find the difference with a non-list ")))) -(defun empty? (V3577) (cond ((= () V3577) true) (true false))) +(defun do (V3958 V3959) V3959) -(defun fix (V3578 V3579) (shen.fix-help V3578 V3579 (V3578 V3579))) +(defun element? (V3971 V3972) (cond ((= () V3972) false) ((and (cons? V3972) (= V3971 (hd V3972))) true) ((cons? V3972) (element? V3971 (tl V3972))) (true (simple-error "attempt to find an element in a non-list +")))) -(defun shen.fix-help (V3585 V3586 V3587) (cond ((= V3586 V3587) V3587) (true (shen.fix-help V3585 V3587 (V3585 V3587))))) +(defun empty? (V3975) (cond ((= () V3975) true) (true false))) -(defun put (V3588 V3589 V3590 V3591) (let W3592 (hash V3588 (limit V3591)) (let W3593 (trap-error (<-vector V3591 W3592) (lambda Z3594 ())) (let W3595 (vector-> V3591 W3592 (shen.change-pointer-value V3588 V3589 V3590 W3593)) V3590)))) +(defun fix (V3976 V3977) (shen.fix-help V3976 V3977 (V3976 V3977))) -(defun unput (V3596 V3597 V3598) (let W3599 (hash V3596 (limit V3598)) (let W3600 (trap-error (<-vector V3598 W3599) (lambda Z3601 ())) (let W3602 (vector-> V3598 W3599 (shen.remove-pointer V3596 V3597 W3600)) V3596)))) +(defun shen.fix-help (V3983 V3984 V3985) (cond ((= V3984 V3985) V3985) (true (shen.fix-help V3983 V3985 (V3983 V3985))))) -(defun shen.remove-pointer (V3613 V3614 V3615) (cond ((= () V3615) ()) ((and (cons? V3615) (and (cons? (hd V3615)) (and (cons? (hd (hd V3615))) (and (cons? (tl (hd (hd V3615)))) (and (= () (tl (tl (hd (hd V3615))))) (and (= V3614 (hd (tl (hd (hd V3615))))) (= V3613 (hd (hd (hd V3615)))))))))) (tl V3615)) ((cons? V3615) (cons (hd V3615) (shen.remove-pointer V3613 V3614 (tl V3615)))) (true (simple-error "implementation error in shen.remove-pointer")))) +(defun put (V3986 V3987 V3988 V3989) (let W3990 (trap-error (shen.<-dict V3989 V3986) (lambda Z3991 ())) (let W3992 (shen.assoc-set V3987 V3988 W3990) (let W3993 (shen.dict-> V3989 V3986 W3992) V3988)))) -(defun shen.change-pointer-value (V3628 V3629 V3630 V3631) (cond ((= () V3631) (cons (cons (cons V3628 (cons V3629 ())) V3630) ())) ((and (cons? V3631) (and (cons? (hd V3631)) (and (cons? (hd (hd V3631))) (and (cons? (tl (hd (hd V3631)))) (and (= () (tl (tl (hd (hd V3631))))) (and (= V3629 (hd (tl (hd (hd V3631))))) (= V3628 (hd (hd (hd V3631)))))))))) (cons (cons (hd (hd V3631)) V3630) (tl V3631))) ((cons? V3631) (cons (hd V3631) (shen.change-pointer-value V3628 V3629 V3630 (tl V3631)))) (true (simple-error "implementation error in shen.change-pointer-value")))) +(defun unput (V3994 V3995 V3996) (let W3997 (trap-error (shen.<-dict V3996 V3994) (lambda Z3998 ())) (let W3999 (shen.assoc-rm V3995 W3997) (let W4000 (shen.dict-> V3996 V3994 W3999) V3994)))) -(defun get (V3632 V3633 V3634) (let W3635 (hash V3632 (limit V3634)) (let W3636 (trap-error (<-vector V3634 W3635) (lambda Z3637 (simple-error (shen.app V3632 (cn " has no attributes: " (shen.app V3633 " -" shen.s)) shen.a)))) (let W3638 (assoc (cons V3632 (cons V3633 ())) W3636) (if (empty? W3638) (simple-error (cn "attribute " (shen.app V3633 (cn " not found for " (shen.app V3632 " -" shen.s)) shen.s))) (tl W3638)))))) +(defun get (V4001 V4002 V4003) (let W4004 (trap-error (shen.<-dict V4003 V4001) (lambda Z4005 (simple-error (shen.app V4001 (cn " has no attributes: " (shen.app V4002 " +" shen.s)) shen.a)))) (let W4006 (assoc V4002 W4004) (if (empty? W4006) (simple-error (cn "attribute " (shen.app V4002 (cn " not found for " (shen.app V4001 " +" shen.s)) shen.s))) (tl W4006))))) -(defun hash (V3639 V3640) (let W3641 (shen.mod (shen.hashkey V3639) V3640) (if (= W3641 0) 1 W3641))) +(defun hash (V4007 V4008) (let W4009 (shen.mod (shen.hashkey V4007) V4008) (if (= W4009 0) 1 W4009))) -(defun shen.hashkey (V3642) (let W3643 (map (lambda Z3644 (string->n Z3644)) (explode V3642)) (shen.prodbutzero W3643 1))) +(defun shen.hashkey (V4010) (let W4011 (map (lambda Z4012 (string->n Z4012)) (explode V4010)) (shen.prodbutzero W4011 1))) -(defun shen.prodbutzero (V3645 V3646) (cond ((= () V3645) V3646) ((and (cons? V3645) (= 0 (hd V3645))) (shen.prodbutzero (tl V3645) V3646)) ((cons? V3645) (if (> V3646 10000000000) (shen.prodbutzero (tl V3645) (+ V3646 (hd V3645))) (shen.prodbutzero (tl V3645) (* V3646 (hd V3645))))) (true (simple-error "partial function shen.prodbutzero")))) +(defun shen.prodbutzero (V4013 V4014) (cond ((= () V4013) V4014) ((and (cons? V4013) (= 0 (hd V4013))) (shen.prodbutzero (tl V4013) V4014)) ((cons? V4013) (if (> V4014 10000000000) (shen.prodbutzero (tl V4013) (+ V4014 (hd V4013))) (shen.prodbutzero (tl V4013) (* V4014 (hd V4013))))) (true (shen.f-error shen.prodbutzero)))) -(defun shen.mod (V3647 V3648) (shen.modh V3647 (shen.multiples V3647 (cons V3648 ())))) +(defun shen.mod (V4015 V4016) (shen.modh V4015 (shen.multiples V4015 (cons V4016 ())))) -(defun shen.multiples (V3653 V3654) (cond ((and (cons? V3654) (> (hd V3654) V3653)) (tl V3654)) ((cons? V3654) (shen.multiples V3653 (cons (* 2 (hd V3654)) V3654))) (true (simple-error "implementation error in shen.multiples")))) +(defun shen.multiples (V4021 V4022) (cond ((and (cons? V4022) (> (hd V4022) V4021)) (tl V4022)) ((cons? V4022) (shen.multiples V4021 (cons (* 2 (hd V4022)) V4022))) (true (simple-error "implementation error in shen.multiples")))) -(defun shen.modh (V3661 V3662) (cond ((= 0 V3661) 0) ((= () V3662) V3661) ((and (cons? V3662) (> (hd V3662) V3661)) (if (empty? (tl V3662)) V3661 (shen.modh V3661 (tl V3662)))) ((cons? V3662) (shen.modh (- V3661 (hd V3662)) V3662)) (true (simple-error "implementation error in shen.modh")))) +(defun shen.modh (V4029 V4030) (cond ((= 0 V4029) 0) ((= () V4030) V4029) ((and (cons? V4030) (> (hd V4030) V4029)) (if (empty? (tl V4030)) V4029 (shen.modh V4029 (tl V4030)))) ((cons? V4030) (shen.modh (- V4029 (hd V4030)) V4030)) (true (simple-error "implementation error in shen.modh")))) -(defun sum (V3665) (cond ((= () V3665) 0) ((cons? V3665) (+ (hd V3665) (sum (tl V3665)))) (true (simple-error "attempt to sum a non-list +(defun sum (V4033) (cond ((= () V4033) 0) ((cons? V4033) (+ (hd V4033) (sum (tl V4033)))) (true (simple-error "attempt to sum a non-list ")))) -(defun head (V3670) (cond ((cons? V3670) (hd V3670)) (true (simple-error "head expects a non-empty list +(defun head (V4038) (cond ((cons? V4038) (hd V4038)) (true (simple-error "head expects a non-empty list ")))) -(defun tail (V3675) (cond ((cons? V3675) (tl V3675)) (true (simple-error "tail expects a non-empty list +(defun tail (V4043) (cond ((cons? V4043) (tl V4043)) (true (simple-error "tail expects a non-empty list ")))) -(defun hdstr (V3676) (pos V3676 0)) +(defun hdstr (V4044) (pos V4044 0)) -(defun intersection (V3683 V3684) (cond ((= () V3683) ()) ((cons? V3683) (if (element? (hd V3683) V3684) (cons (hd V3683) (intersection (tl V3683) V3684)) (intersection (tl V3683) V3684))) (true (simple-error "attempt to find the intersection with a non-list +(defun intersection (V4051 V4052) (cond ((= () V4051) ()) ((cons? V4051) (if (element? (hd V4051) V4052) (cons (hd V4051) (intersection (tl V4051) V4052)) (intersection (tl V4051) V4052))) (true (simple-error "attempt to find the intersection with a non-list ")))) -(defun reverse (V3685) (shen.reverse-help V3685 ())) +(defun reverse (V4053) (shen.reverse-help V4053 ())) -(defun shen.reverse-help (V3690 V3691) (cond ((= () V3690) V3691) ((cons? V3690) (shen.reverse-help (tl V3690) (cons (hd V3690) V3691))) (true (simple-error "attempt to reverse a non-list +(defun shen.reverse-help (V4058 V4059) (cond ((= () V4058) V4059) ((cons? V4058) (shen.reverse-help (tl V4058) (cons (hd V4058) V4059))) (true (simple-error "attempt to reverse a non-list ")))) -(defun union (V3696 V3697) (cond ((= () V3696) V3697) ((cons? V3696) (if (element? (hd V3696) V3697) (union (tl V3696) V3697) (cons (hd V3696) (union (tl V3696) V3697)))) (true (simple-error "attempt to find the union with a non-list +(defun union (V4064 V4065) (cond ((= () V4064) V4065) ((cons? V4064) (if (element? (hd V4064) V4065) (union (tl V4064) V4065) (cons (hd V4064) (union (tl V4064) V4065)))) (true (simple-error "attempt to find the union with a non-list ")))) -(defun y-or-n? (V3698) (let W3699 (pr (shen.proc-nl V3698) (stoutput)) (let W3700 (pr " (y/n) " (stoutput)) (let W3701 (shen.app (read (stinput)) "" shen.s) (if (= "y" W3701) true (if (= "n" W3701) false (do (pr "please answer y or n -" (stoutput)) (y-or-n? V3698)))))))) +(defun y-or-n? (V4066) (let W4067 (pr (shen.proc-nl V4066) (stoutput)) (let W4068 (pr " (y/n) " (stoutput)) (let W4069 (shen.app (read (stinput)) "" shen.s) (if (= "y" W4069) true (if (= "n" W4069) false (do (pr "please answer y or n +" (stoutput)) (y-or-n? V4066)))))))) -(defun not (V3702) (if V3702 false true)) +(defun not (V4070) (if V4070 false true)) (defun abort () (simple-error "")) -(defun subst (V3708 V3709 V3710) (cond ((= V3709 V3710) V3708) ((cons? V3710) (cons (subst V3708 V3709 (hd V3710)) (subst V3708 V3709 (tl V3710)))) (true V3710))) +(defun subst (V4076 V4077 V4078) (cond ((= V4077 V4078) V4076) ((cons? V4078) (cons (subst V4076 V4077 (hd V4078)) (subst V4076 V4077 (tl V4078)))) (true V4078))) -(defun explode (V3711) (shen.explode-h (shen.app V3711 "" shen.a))) +(defun explode (V4079) (shen.explode-h (shen.app V4079 "" shen.a))) -(defun shen.explode-h (V3714) (cond ((= "" V3714) ()) ((shen.+string? V3714) (cons (hdstr V3714) (shen.explode-h (tlstr V3714)))) (true (simple-error "implementation error in explode-h")))) +(defun shen.explode-h (V4082) (cond ((= "" V4082) ()) ((shen.+string? V4082) (cons (hdstr V4082) (shen.explode-h (tlstr V4082)))) (true (simple-error "implementation error in explode-h")))) -(defun cd (V3715) (set *home-directory* (if (= V3715 "") "" (shen.app V3715 "/" shen.a)))) +(defun cd (V4083) (set *home-directory* (if (= V4083 "") "" (shen.app V4083 "/" shen.a)))) -(defun map (V3716 V3717) (shen.map-h V3716 V3717 ())) +(defun shen.for-each (V4084 V4085) (cond ((= () V4085) true) ((cons? V4085) (let W4086 (V4084 (hd V4085)) (shen.for-each V4084 (tl V4085)))) (true (shen.f-error shen.for-each)))) -(defun shen.map-h (V3718 V3719 V3720) (cond ((= () V3719) (reverse V3720)) ((cons? V3719) (shen.map-h V3718 (tl V3719) (cons (V3718 (hd V3719)) V3720))) (true (simple-error "partial function shen.map-h")))) +(defun map (V4087 V4088) (shen.map-h V4087 V4088 ())) -(defun length (V3721) (shen.length-h V3721 0)) +(defun shen.map-h (V4089 V4090 V4091) (cond ((= () V4090) (reverse V4091)) ((cons? V4090) (shen.map-h V4089 (tl V4090) (cons (V4089 (hd V4090)) V4091))) (true (shen.f-error shen.map-h)))) -(defun shen.length-h (V3726 V3727) (cond ((= () V3726) V3727) (true (shen.length-h (tl V3726) (+ V3727 1))))) +(defun length (V4092) (shen.length-h V4092 0)) -(defun occurrences (V3733 V3734) (cond ((= V3733 V3734) 1) ((cons? V3734) (+ (occurrences V3733 (hd V3734)) (occurrences V3733 (tl V3734)))) (true 0))) +(defun shen.length-h (V4097 V4098) (cond ((= () V4097) V4098) (true (shen.length-h (tl V4097) (+ V4098 1))))) -(defun nth (V3739 V3740) (cond ((and (= 1 V3739) (cons? V3740)) (hd V3740)) ((cons? V3740) (nth (- V3739 1) (tl V3740))) (true (simple-error (cn "nth applied to " (shen.app V3739 (cn ", " (shen.app V3740 " +(defun occurrences (V4104 V4105) (cond ((= V4104 V4105) 1) ((cons? V4105) (+ (occurrences V4104 (hd V4105)) (occurrences V4104 (tl V4105)))) (true 0))) + +(defun nth (V4110 V4111) (cond ((and (= 1 V4110) (cons? V4111)) (hd V4111)) ((cons? V4111) (nth (- V4110 1) (tl V4111))) (true (simple-error (cn "nth applied to " (shen.app V4110 (cn ", " (shen.app V4111 " " shen.a)) shen.a)))))) -(defun integer? (V3741) (and (number? V3741) (let W3742 (shen.abs V3741) (shen.integer-test? W3742 (shen.magless W3742 1))))) +(defun integer? (V4112) (and (number? V4112) (let W4113 (shen.abs V4112) (shen.integer-test? W4113 (shen.magless W4113 1))))) -(defun shen.abs (V3743) (if (> V3743 0) V3743 (- 0 V3743))) +(defun shen.abs (V4114) (if (> V4114 0) V4114 (- 0 V4114))) -(defun shen.magless (V3744 V3745) (let W3746 (* V3745 2) (if (> W3746 V3744) V3745 (shen.magless V3744 W3746)))) +(defun shen.magless (V4115 V4116) (let W4117 (* V4116 2) (if (> W4117 V4115) V4116 (shen.magless V4115 W4117)))) -(defun shen.integer-test? (V3750 V3751) (cond ((= 0 V3750) true) ((> 1 V3750) false) (true (let W3752 (- V3750 V3751) (if (> 0 W3752) (integer? V3750) (shen.integer-test? W3752 V3751)))))) +(defun shen.integer-test? (V4121 V4122) (cond ((= 0 V4121) true) ((> 1 V4121) false) (true (let W4123 (- V4121 V4122) (if (> 0 W4123) (integer? V4121) (shen.integer-test? W4123 V4122)))))) -(defun mapcan (V3759 V3760) (cond ((= () V3760) ()) ((cons? V3760) (append (V3759 (hd V3760)) (mapcan V3759 (tl V3760)))) (true (simple-error "attempt to mapcan over a non-list +(defun mapcan (V4130 V4131) (cond ((= () V4131) ()) ((cons? V4131) (append (V4130 (hd V4131)) (mapcan V4130 (tl V4131)))) (true (simple-error "attempt to mapcan over a non-list ")))) -(defun == (V3766 V3767) (cond ((= V3766 V3767) true) (true false))) +(defun == (V4137 V4138) (cond ((= V4137 V4138) true) (true false))) -(defun bound? (V3768) (and (symbol? V3768) (let W3769 (trap-error (value V3768) (lambda Z3770 shen.this-symbol-is-unbound)) (if (= W3769 shen.this-symbol-is-unbound) false true)))) +(defun bound? (V4139) (and (symbol? V4139) (let W4140 (trap-error (value V4139) (lambda Z4141 shen.this-symbol-is-unbound)) (if (= W4140 shen.this-symbol-is-unbound) false true)))) -(defun shen.string->bytes (V3771) (cond ((= "" V3771) ()) (true (cons (string->n (pos V3771 0)) (shen.string->bytes (tlstr V3771)))))) +(defun shen.string->bytes (V4142) (cond ((= "" V4142) ()) (true (cons (string->n (pos V4142 0)) (shen.string->bytes (tlstr V4142)))))) -(defun maxinferences (V3772) (if (< V3772 0) (value shen.*maxinferences*) (if (integer? V3772) (set shen.*maxinferences* V3772) (simple-error "maxinferences expects an integer value +(defun maxinferences (V4143) (if (< V4143 0) (value shen.*maxinferences*) (if (integer? V4143) (set shen.*maxinferences* V4143) (simple-error "maxinferences expects an integer value ")))) (defun inferences () (value shen.*infs*)) -(defun protect (V3773) V3773) +(defun protect (V4144) V4144) + +(defun sterror () (value *sterror*)) (defun stoutput () (value *stoutput*)) -(defun string->symbol (V3774) (let W3775 (intern V3774) (if (symbol? W3775) W3775 (simple-error (cn "cannot intern " (shen.app V3774 " to a symbol" shen.s)))))) +(defun string->symbol (V4145) (let W4146 (intern V4145) (if (symbol? W4146) W4146 (simple-error (cn "cannot intern " (shen.app V4145 " to a symbol" shen.s)))))) -(defun optimise (V3778) (cond ((= + V3778) (set shen.*optimise* true)) ((= - V3778) (set shen.*optimise* false)) (true (simple-error "optimise expects a + or a -. +(defun optimise (V4149) (cond ((= + V4149) (set shen.*optimise* true)) ((= - V4149) (set shen.*optimise* false)) (true (simple-error "optimise expects a + or a -. ")))) (defun os () (value *os*)) @@ -221,7 +225,7 @@ (defun release () (value *release*)) -(defun package? (V3779) (cond ((= null V3779) true) (true (trap-error (do (external V3779) true) (lambda Z3780 false))))) +(defun package? (V4150) (cond ((= null V4150) true) (true (trap-error (do (external V4150) true) (lambda Z4151 false))))) (defun fail () shen.fail!)(defun userdefs () (value shen.*userdefs*)) @@ -231,31 +235,31 @@ (defun system-S? () (value shen.*shen-type-theory-enabled?*)) -(defun enable-type-theory (V3783) (cond ((= + V3783) (set shen.*shen-type-theory-enabled?* true)) ((= - V3783) (set shen.*shen-type-theory-enabled?* false)) (true (simple-error "enable-type-theory expects a + or a - +(defun enable-type-theory (V4154) (cond ((= + V4154) (set shen.*shen-type-theory-enabled?* true)) ((= - V4154) (set shen.*shen-type-theory-enabled?* false)) (true (simple-error "enable-type-theory expects a + or a - ")))) -(defun shen.hush (V3786) (cond ((= + V3786) (set *hush* true)) ((= - V3786) (set *hush* false)) (true (simple-error "hush expects a + or a - +(defun hush (V4157) (cond ((= + V4157) (set *hush* true)) ((= - V4157) (set *hush* false)) (true (simple-error "hush expects a + or a - ")))) -(defun tc (V3789) (cond ((= + V3789) (set shen.*tc* true)) ((= - V3789) (set shen.*tc* false)) (true (simple-error "tc expects a + or -")))) +(defun tc (V4160) (cond ((= + V4160) (set shen.*tc* true)) ((= - V4160) (set shen.*tc* false)) (true (simple-error "tc expects a + or -")))) -(defun destroy (V3790) (do (set shen.*sigf* (shen.unassoc V3790 (value shen.*sigf*))) V3790)) +(defun destroy (V4161) (do (set shen.*sigf* (shen.unassoc V4161 (value shen.*sigf*))) V4161)) -(defun shen.unassoc (V3800 V3801) (cond ((= () V3801) ()) ((and (cons? V3801) (and (cons? (hd V3801)) (= V3800 (hd (hd V3801))))) (tl V3801)) ((cons? V3801) (cons (hd V3801) (shen.unassoc V3800 (tl V3801)))) (true (simple-error "implementation error in shen.unassoc")))) +(defun shen.unassoc (V4171 V4172) (cond ((= () V4172) ()) ((and (cons? V4172) (and (cons? (hd V4172)) (= V4171 (hd (hd V4172))))) (tl V4172)) ((cons? V4172) (cons (hd V4172) (shen.unassoc V4171 (tl V4172)))) (true (simple-error "implementation error in shen.unassoc")))) -(defun in-package (V3802) (if (package? V3802) (set shen.*package* V3802) (simple-error (cn "package " (shen.app V3802 " does not exist +(defun in-package (V4173) (if (package? V4173) (set shen.*package* V4173) (simple-error (cn "package " (shen.app V4173 " does not exist " shen.a))))) -(defun write-to-file (V3803 V3804) (let W3805 (open V3803 out) (let W3806 (if (string? V3804) V3804 (shen.app V3804 "" shen.s)) (let W3807 (pr W3806 W3805) (let W3808 (close W3805) V3804))))) +(defun write-to-file (V4174 V4175) (let W4176 (open V4174 out) (let W4177 (if (string? V4175) V4175 (shen.app V4175 "" shen.s)) (let W4178 (pr W4177 W4176) (let W4179 (close W4176) V4175))))) (defun fresh () (shen.freshterm (gensym shen.t))) -(defun update-lambda-table (V3809 V3810) (let W3811 (put V3809 arity V3810 (value *property-vector*)) (let W3812 (shen.lambda-entry V3809) (let W3813 (set shen.*lambdatable* (cons W3812 (value shen.*lambdatable*))) V3809)))) +(defun update-lambda-table (V4180 V4181) (let W4182 (put V4180 arity V4181 (value *property-vector*)) (let W4183 (shen.lambda-entry V4180) (let W4184 (if (empty? W4183) (unput V4180 shen.lambda-form (value *property-vector*)) (shen.set-lambda-form-entry W4183)) V4180)))) -(defun specialise (V3816 V3817) (cond ((= 0 V3817) (do (set shen.*special* (remove V3816 (value shen.*special*))) (do (set shen.*extraspecial* (remove V3816 (value shen.*extraspecial*))) V3816))) ((= 1 V3817) (do (set shen.*special* (adjoin V3816 (value shen.*special*))) (do (set shen.*extraspecial* (remove V3816 (value shen.*extraspecial*))) V3816))) ((= 2 V3817) (do (set shen.*special* (remove V3816 (value shen.*special*))) (do (set shen.*extraspecial* (adjoin V3816 (value shen.*extraspecial*))) V3816))) (true (simple-error "specialise requires values of 0, 1 or 2 +(defun specialise (V4187 V4188) (cond ((= 0 V4188) (do (set shen.*special* (remove V4187 (value shen.*special*))) (do (set shen.*extraspecial* (remove V4187 (value shen.*extraspecial*))) V4187))) ((= 1 V4188) (do (set shen.*special* (adjoin V4187 (value shen.*special*))) (do (set shen.*extraspecial* (remove V4187 (value shen.*extraspecial*))) V4187))) ((= 2 V4188) (do (set shen.*special* (remove V4187 (value shen.*special*))) (do (set shen.*extraspecial* (adjoin V4187 (value shen.*extraspecial*))) V4187))) (true (simple-error "specialise requires values of 0, 1 or 2 ")))) -(defun absolute (V3818) (set *absolute* (cons V3818 (value *absolute*)))) +(defun absolute (V4189) (set *absolute* (cons V4189 (value *absolute*)))) -(defun unabsolute (V3819) (set *absolute* (remove V3819 (value *absolute*)))) +(defun unabsolute (V4190) (set *absolute* (remove V4190 (value *absolute*)))) diff --git a/klambda/t-star.kl b/klambda/t-star.kl index de1b34e..bea9eed 100644 --- a/klambda/t-star.kl +++ b/klambda/t-star.kl @@ -1,104 +1,108 @@ -(defun shen.typecheck (V4448 V4449) (let W4450 (shen.extract-vars V4449) (let W4451 (shen.rectify-type V4449) (let W4452 (shen.curry V4448) (((((lambda Z4453 (lambda Z4454 (lambda Z4455 (lambda Z4456 (let W4457 (shen.newpv Z4453) (shen.gc Z4453 (do (shen.incinfs) (shen.insert-prolog-variables (receive (shen.deref W4450 Z4453)) (receive (shen.deref W4451 Z4453)) W4457 Z4453 Z4454 Z4455 (freeze (shen.toplevel-forms (receive (shen.deref W4452 Z4453)) W4457 Z4453 Z4454 Z4455 (freeze (return W4457 Z4453 Z4454 Z4455 Z4456)))))))))))) (shen.prolog-vector)) (@v true (@v 0 (vector 0)))) 0) (freeze true)))))) +(defun shen.typecheck (V4921 V4922) (let W4923 (shen.extract-vars V4922) (let W4924 (shen.rectify-type V4922) (let W4925 (shen.curry V4921) (((((lambda Z4926 (lambda Z4927 (lambda Z4928 (lambda Z4929 (let W4930 (shen.newpv Z4926) (shen.gc Z4926 (do (shen.incinfs) (shen.insert-prolog-variables (receive (shen.deref W4923 Z4926)) (receive (shen.deref W4924 Z4926)) W4930 Z4926 Z4927 Z4928 (freeze (shen.toplevel-forms (receive (shen.deref W4925 Z4926)) W4930 Z4926 Z4927 Z4928 (freeze (return W4930 Z4926 Z4927 Z4928 Z4929)))))))))))) (shen.prolog-vector)) (@v true (@v 0 (vector 0)))) 0) (freeze true)))))) -(defun shen.insert-prolog-variables (V4458 V4459 V4460 V4461 V4462 V4463 V4464) (let W4465 (if (shen.unlocked? V4462) (let W4466 (shen.lazyderef V4458 V4461) (if (= W4466 ()) (do (shen.incinfs) (is! V4459 V4460 V4461 V4462 V4463 V4464)) false)) false) (if (= W4465 false) (if (shen.unlocked? V4462) (let W4467 (shen.lazyderef V4458 V4461) (if (cons? W4467) (let W4468 (hd W4467) (let W4469 (tl W4467) (let W4470 (shen.newpv V4461) (shen.gc V4461 (do (shen.incinfs) (shen.insert-prolog-variables W4469 (subst (shen.deref W4470 V4461) W4468 V4459) V4460 V4461 V4462 V4463 V4464)))))) false)) false) W4465))) +(defun shen.insert-prolog-variables (V4931 V4932 V4933 V4934 V4935 V4936 V4937) (let W4938 (if (shen.unlocked? V4935) (let W4939 (shen.lazyderef V4931 V4934) (if (= W4939 ()) (do (shen.incinfs) (is! V4932 V4933 V4934 V4935 V4936 V4937)) false)) false) (if (= W4938 false) (if (shen.unlocked? V4935) (let W4940 (shen.lazyderef V4931 V4934) (if (cons? W4940) (let W4941 (hd W4940) (let W4942 (tl W4940) (let W4943 (shen.newpv V4934) (shen.gc V4934 (do (shen.incinfs) (shen.insert-prolog-variables W4942 (subst (shen.deref W4943 V4934) W4941 V4932) V4933 V4934 V4935 V4936 V4937)))))) false)) false) W4938))) -(defun shen.toplevel-forms (V4471 V4472 V4473 V4474 V4475 V4476) (let W4477 (+ V4475 1) (let W4478 (if (shen.unlocked? V4474) (let W4479 (shen.lazyderef V4471 V4473) (if (cons? W4479) (let W4480 (shen.lazyderef (hd W4479) V4473) (if (= W4480 define) (let W4481 (shen.lazyderef (tl W4479) V4473) (if (cons? W4481) (let W4482 (hd W4481) (let W4483 (tl W4481) (do (shen.incinfs) (when (shen.type-theory-enabled?) V4473 V4474 W4477 (freeze (shen.cut V4473 V4474 W4477 (freeze (shen.signal-def (value shen.*spy*) W4482 V4473 V4474 W4477 (freeze (shen.t* (cons define (cons W4482 W4483)) V4472 V4473 V4474 W4477 V4476)))))))))) false)) false)) false)) false) (if (= W4478 false) (let W4484 (if (shen.unlocked? V4474) (do (shen.incinfs) (shen.system-S (cons V4471 (cons (intern ":") (cons V4472 ()))) () V4473 V4474 W4477 V4476)) false) (if (= W4484 false) (shen.unlock V4474 W4477) W4484)) W4478)))) +(defun shen.toplevel-forms (V4944 V4945 V4946 V4947 V4948 V4949) (let W4950 (+ V4948 1) (let W4951 (if (shen.unlocked? V4947) (let W4952 (shen.lazyderef V4944 V4946) (if (cons? W4952) (let W4953 (shen.lazyderef (hd W4952) V4946) (if (= W4953 define) (let W4954 (shen.lazyderef (tl W4952) V4946) (if (cons? W4954) (let W4955 (hd W4954) (let W4956 (tl W4954) (do (shen.incinfs) (when (shen.type-theory-enabled?) V4946 V4947 W4950 (freeze (shen.cut V4946 V4947 W4950 (freeze (shen.signal-def (value shen.*spy*) W4955 V4946 V4947 W4950 (freeze (shen.t* (cons define (cons W4955 W4956)) V4945 V4946 V4947 W4950 V4949)))))))))) false)) false)) false)) false) (if (= W4951 false) (let W4957 (if (shen.unlocked? V4947) (do (shen.incinfs) (shen.system-S (cons V4944 (cons (intern ":") (cons V4945 ()))) () V4946 V4947 W4950 V4949)) false) (if (= W4957 false) (shen.unlock V4947 W4950) W4957)) W4951)))) -(defun shen.signal-def (V4485 V4486 V4487 V4488 V4489 V4490) (let W4491 (if (shen.unlocked? V4488) (let W4492 (shen.lazyderef V4485 V4487) (if (= W4492 false) (do (shen.incinfs) (thaw V4490)) false)) false) (if (= W4491 false) (if (shen.unlocked? V4488) (let W4493 (shen.lazyderef V4485 V4487) (if (= W4493 true) (let W4494 (shen.newpv V4487) (shen.gc V4487 (do (shen.incinfs) (is W4494 (pr (cn " -typechecking (fn " (shen.app (shen.deref V4486 V4487) ") -" shen.a)) (stoutput)) V4487 V4488 V4489 V4490)))) false)) false) W4491))) +(defun shen.signal-def (V4958 V4959 V4960 V4961 V4962 V4963) (let W4964 (if (shen.unlocked? V4961) (let W4965 (shen.lazyderef V4958 V4960) (if (= W4965 false) (do (shen.incinfs) (thaw V4963)) false)) false) (if (= W4964 false) (if (shen.unlocked? V4961) (let W4966 (shen.lazyderef V4958 V4960) (if (= W4966 true) (let W4967 (shen.newpv V4960) (shen.gc V4960 (do (shen.incinfs) (is W4967 (pr (cn " +typechecking (fn " (shen.app (shen.deref V4959 V4960) ") +" shen.a)) (stoutput)) V4960 V4961 V4962 V4963)))) false)) false) W4964))) -(defun shen.rectify-type (V4495) (shen.demodulate (shen.curry-type V4495))) +(defun shen.rectify-type (V4968) (shen.demodulate (shen.curry-type V4968))) -(defun shen.demodulate (V4496) (trap-error (let W4497 (shen.walk (lambda Z4498 (shen.demod Z4498)) V4496) (if (= W4497 V4496) V4496 (shen.demodulate W4497))) (lambda Z4499 V4496))) +(defun shen.demodulate (V4969) (trap-error (let W4970 (shen.walk (lambda Z4971 (shen.demod Z4971)) V4969) (if (= W4970 V4969) V4969 (shen.demodulate W4970))) (lambda Z4972 V4969))) -(defun shen.curry-type (V4500) (cond ((and (cons? V4500) (and (cons? (tl V4500)) (and (= --> (hd (tl V4500))) (and (cons? (tl (tl V4500))) (and (cons? (tl (tl (tl V4500)))) (= --> (hd (tl (tl (tl V4500)))))))))) (shen.curry-type (cons (hd V4500) (cons --> (cons (tl (tl V4500)) ()))))) ((and (cons? V4500) (and (cons? (hd V4500)) (and (= list (hd (hd V4500))) (and (cons? (tl (hd V4500))) (and (= () (tl (tl (hd V4500)))) (and (cons? (tl V4500)) (and (= ==> (hd (tl V4500))) (and (cons? (tl (tl V4500))) (= () (tl (tl (tl V4500)))))))))))) (shen.curry-type (cons (hd V4500) (cons --> (cons (cons str (cons (hd V4500) (tl (tl V4500)))) ()))))) ((and (cons? V4500) (and (cons? (tl V4500)) (and (= * (hd (tl V4500))) (and (cons? (tl (tl V4500))) (and (cons? (tl (tl (tl V4500)))) (= * (hd (tl (tl (tl V4500)))))))))) (shen.curry-type (cons (hd V4500) (cons * (cons (tl (tl V4500)) ()))))) ((cons? V4500) (map (lambda Z4501 (shen.curry-type Z4501)) V4500)) (true V4500))) +(defun shen.curry-type (V4973) (cond ((and (cons? V4973) (and (cons? (tl V4973)) (and (= --> (hd (tl V4973))) (and (cons? (tl (tl V4973))) (and (cons? (tl (tl (tl V4973)))) (= --> (hd (tl (tl (tl V4973)))))))))) (shen.curry-type (cons (hd V4973) (cons --> (cons (tl (tl V4973)) ()))))) ((and (cons? V4973) (and (cons? (hd V4973)) (and (= list (hd (hd V4973))) (and (cons? (tl (hd V4973))) (and (= () (tl (tl (hd V4973)))) (and (cons? (tl V4973)) (and (= ==> (hd (tl V4973))) (and (cons? (tl (tl V4973))) (= () (tl (tl (tl V4973)))))))))))) (shen.curry-type (cons (hd V4973) (cons --> (cons (cons str (cons (hd V4973) (tl (tl V4973)))) ()))))) ((and (cons? V4973) (and (cons? (tl V4973)) (and (= * (hd (tl V4973))) (and (cons? (tl (tl V4973))) (and (cons? (tl (tl (tl V4973)))) (= * (hd (tl (tl (tl V4973)))))))))) (shen.curry-type (cons (hd V4973) (cons * (cons (tl (tl V4973)) ()))))) ((cons? V4973) (map (lambda Z4974 (shen.curry-type Z4974)) V4973)) (true V4973))) -(defun shen.curry (V4502) (cond ((and (cons? V4502) (and (= define (hd V4502)) (cons? (tl V4502)))) V4502) ((and (cons? V4502) (and (= type (hd V4502)) (and (cons? (tl V4502)) (and (cons? (tl (tl V4502))) (= () (tl (tl (tl V4502)))))))) (cons type (cons (shen.curry (hd (tl V4502))) (tl (tl V4502))))) ((and (cons? V4502) (shen.special? (hd V4502))) (cons (hd V4502) (map (lambda Z4503 (shen.curry Z4503)) (tl V4502)))) ((and (cons? V4502) (shen.extraspecial? (hd V4502))) V4502) ((and (cons? V4502) (and (cons? (tl V4502)) (cons? (tl (tl V4502))))) (shen.curry (cons (cons (hd V4502) (cons (hd (tl V4502)) ())) (tl (tl V4502))))) ((and (cons? V4502) (and (cons? (tl V4502)) (= () (tl (tl V4502))))) (cons (shen.curry (hd V4502)) (cons (shen.curry (hd (tl V4502))) ()))) (true V4502))) +(defun shen.curry (V4975) (cond ((and (cons? V4975) (and (= define (hd V4975)) (cons? (tl V4975)))) V4975) ((and (cons? V4975) (and (= type (hd V4975)) (and (cons? (tl V4975)) (and (cons? (tl (tl V4975))) (= () (tl (tl (tl V4975)))))))) (cons type (cons (shen.curry (hd (tl V4975))) (tl (tl V4975))))) ((and (cons? V4975) (shen.special? (hd V4975))) (cons (hd V4975) (map (lambda Z4976 (shen.curry Z4976)) (tl V4975)))) ((and (cons? V4975) (shen.extraspecial? (hd V4975))) V4975) ((and (cons? V4975) (and (cons? (tl V4975)) (cons? (tl (tl V4975))))) (shen.curry (cons (cons (hd V4975) (cons (hd (tl V4975)) ())) (tl (tl V4975))))) ((and (cons? V4975) (and (cons? (tl V4975)) (= () (tl (tl V4975))))) (cons (shen.curry (hd V4975)) (cons (shen.curry (hd (tl V4975))) ()))) (true V4975))) -(defun shen.special? (V4504) (element? V4504 (value shen.*special*))) +(defun shen.special? (V4977) (element? V4977 (value shen.*special*))) -(defun shen.extraspecial? (V4505) (element? V4505 (value shen.*extraspecial*))) +(defun shen.extraspecial? (V4978) (element? V4978 (value shen.*extraspecial*))) -(defun shen.system-S (V4506 V4507 V4508 V4509 V4510 V4511) (let W4512 (+ V4510 1) (let W4513 (if (shen.unlocked? V4509) (do (shen.incinfs) (when (shen.maxinfexceeded?) V4508 V4509 W4512 V4511)) false) (if (= W4513 false) (let W4514 (if (shen.unlocked? V4509) (let W4515 (shen.lazyderef V4506 V4508) (if (cons? W4515) (let W4516 (hd W4515) (let W4517 (shen.lazyderef (tl W4515) V4508) (if (cons? W4517) (let W4518 (hd W4517) (let W4519 (shen.lazyderef (tl W4517) V4508) (if (cons? W4519) (let W4520 (hd W4519) (let W4521 (shen.lazyderef (tl W4519) V4508) (if (= W4521 ()) (do (shen.incinfs) (when (= (shen.deref W4518 V4508) (intern ":")) V4508 V4509 W4512 (freeze (when (shen.type-theory-enabled?) V4508 V4509 W4512 (freeze (shen.cut V4508 V4509 W4512 (freeze (shen.system-S-h W4516 W4520 V4507 V4508 V4509 W4512 V4511)))))))) false))) false))) false))) false)) false) (if (= W4514 false) (let W4522 (if (shen.unlocked? V4509) (do (shen.incinfs) (when (value shen.*spy*) V4508 V4509 W4512 (freeze (shen.show V4506 V4507 V4508 V4509 W4512 V4511)))) false) (if (= W4522 false) (let W4523 (if (shen.unlocked? V4509) (do (shen.incinfs) (shen.search-user-datatypes V4506 V4507 (value shen.*datatypes*) V4508 V4509 W4512 V4511)) false) (if (= W4523 false) (shen.unlock V4509 W4512) W4523)) W4522)) W4514)) W4513)))) +(defun shen.system-S (V4979 V4980 V4981 V4982 V4983 V4984) (let W4985 (+ V4983 1) (let W4986 (if (shen.unlocked? V4982) (do (shen.incinfs) (when (shen.maxinfexceeded?) V4981 V4982 W4985 V4984)) false) (if (= W4986 false) (let W4987 (if (shen.unlocked? V4982) (let W4988 (shen.lazyderef V4979 V4981) (if (cons? W4988) (let W4989 (hd W4988) (let W4990 (shen.lazyderef (tl W4988) V4981) (if (cons? W4990) (let W4991 (hd W4990) (let W4992 (shen.lazyderef (tl W4990) V4981) (if (cons? W4992) (let W4993 (hd W4992) (let W4994 (shen.lazyderef (tl W4992) V4981) (if (= W4994 ()) (do (shen.incinfs) (when (= (shen.deref W4991 V4981) (intern ":")) V4981 V4982 W4985 (freeze (when (shen.type-theory-enabled?) V4981 V4982 W4985 (freeze (shen.cut V4981 V4982 W4985 (freeze (shen.system-S-h W4989 W4993 V4980 V4981 V4982 W4985 V4984)))))))) false))) false))) false))) false)) false) (if (= W4987 false) (let W4995 (if (shen.unlocked? V4982) (do (shen.incinfs) (when (value shen.*spy*) V4981 V4982 W4985 (freeze (shen.show V4979 V4980 V4981 V4982 W4985 V4984)))) false) (if (= W4995 false) (let W4996 (if (shen.unlocked? V4982) (do (shen.incinfs) (shen.search-user-datatypes V4979 V4980 (value shen.*datatypes*) V4981 V4982 W4985 V4984)) false) (if (= W4996 false) (shen.unlock V4982 W4985) W4996)) W4995)) W4987)) W4986)))) -(defun shen.show (V4530 V4531 V4532 V4533 V4534 V4535) (do (shen.line) (do (shen.show-p (shen.deref V4530 V4532)) (do (nl 2) (do (shen.show-assumptions (shen.deref V4531 V4532) 1) (do (shen.pause-for-user) false)))))) +(defun shen.show (V5003 V5004 V5005 V5006 V5007 V5008) (do (shen.line) (do (shen.show-p (shen.deref V5003 V5005)) (do (nl 2) (do (shen.show-assumptions (shen.deref V5004 V5005) 1) (do (shen.pause-for-user) false)))))) -(defun shen.line () (let W4536 (inferences) (pr (cn "____________________________________________________________ " (shen.app W4536 (cn " inference" (shen.app (if (= 1 W4536) "" "s") " +(defun shen.line () (let W5009 (inferences) (pr (cn "____________________________________________________________ " (shen.app W5009 (cn " inference" (shen.app (if (= 1 W5009) "" "s") " ?- " shen.a)) shen.a)) (stoutput)))) -(defun shen.show-p (V4537) (cond ((and (cons? V4537) (and (cons? (tl V4537)) (and (cons? (tl (tl V4537))) (and (= () (tl (tl (tl V4537)))) (= (hd (tl V4537)) (intern ":")))))) (do (shen.prterm (hd V4537)) (do (pr " : " (stoutput)) (pr (shen.app (hd (tl (tl V4537))) "" shen.r) (stoutput))))) (true (shen.prterm V4537)))) +(defun shen.show-p (V5010) (cond ((and (cons? V5010) (and (cons? (tl V5010)) (and (cons? (tl (tl V5010))) (and (= () (tl (tl (tl V5010)))) (= (hd (tl V5010)) (intern ":")))))) (do (shen.prterm (hd V5010)) (do (pr " : " (stoutput)) (pr (shen.app (hd (tl (tl V5010))) "" shen.r) (stoutput))))) (true (shen.prterm V5010)))) -(defun shen.prterm (V4538) (cond ((and (cons? V4538) (and (= cons (hd V4538)) (and (cons? (tl V4538)) (and (cons? (tl (tl V4538))) (= () (tl (tl (tl V4538)))))))) (do (pr "[" (stoutput)) (do (shen.prterm (hd (tl V4538))) (do (shen.prtl (hd (tl (tl V4538)))) (pr "]" (stoutput)))))) ((cons? V4538) (do (pr "(" (stoutput)) (do (shen.prterm (hd V4538)) (do (map (lambda Z4539 (do (pr " " (stoutput)) (shen.prterm Z4539))) (tl V4538)) (pr ")" (stoutput)))))) (true (print V4538)))) +(defun shen.prterm (V5011) (cond ((and (cons? V5011) (and (= cons (hd V5011)) (and (cons? (tl V5011)) (and (cons? (tl (tl V5011))) (= () (tl (tl (tl V5011)))))))) (do (pr "[" (stoutput)) (do (shen.prterm (hd (tl V5011))) (do (shen.prtl (hd (tl (tl V5011)))) (pr "]" (stoutput)))))) ((cons? V5011) (do (pr "(" (stoutput)) (do (shen.prterm (hd V5011)) (do (map (lambda Z5012 (do (pr " " (stoutput)) (shen.prterm Z5012))) (tl V5011)) (pr ")" (stoutput)))))) (true (print V5011)))) -(defun shen.prtl (V4540) (cond ((= () V4540) "") ((and (cons? V4540) (and (= cons (hd V4540)) (and (cons? (tl V4540)) (and (cons? (tl (tl V4540))) (= () (tl (tl (tl V4540)))))))) (do (pr " " (stoutput)) (do (shen.prterm (hd (tl V4540))) (shen.prtl (hd (tl (tl V4540))))))) (true (do (pr " | " (stoutput)) (shen.prterm V4540))))) +(defun shen.prtl (V5013) (cond ((= () V5013) "") ((and (cons? V5013) (and (= cons (hd V5013)) (and (cons? (tl V5013)) (and (cons? (tl (tl V5013))) (= () (tl (tl (tl V5013)))))))) (do (pr " " (stoutput)) (do (shen.prterm (hd (tl V5013))) (shen.prtl (hd (tl (tl V5013))))))) (true (do (pr " | " (stoutput)) (shen.prterm V5013))))) -(defun shen.show-assumptions (V4547 V4548) (cond ((= () V4547) (pr " -> " (stoutput))) ((cons? V4547) (do (pr (shen.app V4548 ". " shen.a) (stoutput)) (do (shen.show-p (hd V4547)) (do (nl 1) (shen.show-assumptions (tl V4547) (+ V4548 1)))))) (true (simple-error "implementation error in shen.show-assumptions")))) +(defun shen.show-assumptions (V5020 V5021) (cond ((= () V5020) (pr " +> " (stoutput))) ((cons? V5020) (do (pr (shen.app V5021 ". " shen.a) (stoutput)) (do (shen.show-p (hd V5020)) (do (nl 1) (shen.show-assumptions (tl V5020) (+ V5021 1)))))) (true (simple-error "implementation error in shen.show-assumptions")))) -(defun shen.pause-for-user () (let W4549 (read-byte (stinput)) (if (= W4549 94) (simple-error "input aborted +(defun shen.pause-for-user () (let W5022 (read-byte (stinput)) (if (= W5022 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 (V4550 V4551 V4552 V4553 V4554 V4555 V4556) (let W4557 (+ V4555 1) (let W4558 (if (shen.unlocked? V4554) (do (shen.incinfs) (when (value shen.*spy*) V4553 V4554 W4557 (freeze (shen.show (cons V4550 (cons (intern ":") (cons V4551 ()))) V4552 V4553 V4554 W4557 V4556)))) false) (if (= W4558 false) (let W4559 (if (shen.unlocked? V4554) (do (shen.incinfs) (when (not (cons? (shen.lazyderef V4550 V4553))) V4553 V4554 W4557 (freeze (shen.primitive V4550 V4551 V4553 V4554 W4557 V4556)))) false) (if (= W4559 false) (let W4560 (if (shen.unlocked? V4554) (do (shen.incinfs) (shen.by-hypothesis V4550 V4551 V4552 V4553 V4554 W4557 V4556)) false) (if (= W4560 false) (let W4561 (if (shen.unlocked? V4554) (let W4562 (shen.lazyderef V4550 V4553) (if (cons? W4562) (let W4563 (hd W4562) (let W4564 (shen.lazyderef (tl W4562) V4553) (if (= W4564 ()) (do (shen.incinfs) (shen.lookupsig W4563 (cons --> (cons V4551 ())) V4553 V4554 W4557 V4556)) false))) false)) false) (if (= W4561 false) (let W4565 (if (shen.unlocked? V4554) (let W4566 (shen.lazyderef V4550 V4553) (if (cons? W4566) (let W4567 (shen.lazyderef (hd W4566) V4553) (if (= W4567 fn) (let W4568 (shen.lazyderef (tl W4566) V4553) (if (cons? W4568) (let W4569 (hd W4568) (let W4570 (shen.lazyderef (tl W4568) V4553) (if (= W4570 ()) (do (shen.incinfs) (when (= (arity (shen.deref W4569 V4553)) 0) V4553 V4554 W4557 (freeze (shen.cut V4553 V4554 W4557 (freeze (shen.system-S-h (cons W4569 ()) V4551 V4552 V4553 V4554 W4557 V4556)))))) false))) false)) false)) false)) false) (if (= W4565 false) (let W4571 (if (shen.unlocked? V4554) (let W4572 (shen.lazyderef V4550 V4553) (if (cons? W4572) (let W4573 (shen.lazyderef (hd W4572) V4553) (if (= W4573 fn) (let W4574 (shen.lazyderef (tl W4572) V4553) (if (cons? W4574) (let W4575 (hd W4574) (let W4576 (shen.lazyderef (tl W4574) V4553) (if (= W4576 ()) (do (shen.incinfs) (shen.lookupsig W4575 V4551 V4553 V4554 W4557 V4556)) false))) false)) false)) false)) false) (if (= W4571 false) (let W4577 (if (shen.unlocked? V4554) (let W4578 (shen.lazyderef V4550 V4553) (if (cons? W4578) (let W4579 (hd W4578) (let W4580 (shen.lazyderef (tl W4578) V4553) (if (cons? W4580) (let W4581 (hd W4580) (let W4582 (shen.lazyderef (tl W4580) V4553) (if (= W4582 ()) (let W4583 (shen.newpv V4553) (shen.gc V4553 (do (shen.incinfs) (when (not (cons? (shen.lazyderef W4579 V4553))) V4553 V4554 W4557 (freeze (shen.lookupsig W4579 (cons W4583 (cons --> (cons V4551 ()))) V4553 V4554 W4557 (freeze (shen.system-S-h W4581 W4583 V4552 V4553 V4554 W4557 V4556)))))))) false))) false))) false)) false) (if (= W4577 false) (let W4584 (if (shen.unlocked? V4554) (let W4585 (shen.lazyderef V4550 V4553) (if (cons? W4585) (let W4586 (hd W4585) (let W4587 (shen.lazyderef (tl W4585) V4553) (if (cons? W4587) (let W4588 (hd W4587) (let W4589 (shen.lazyderef (tl W4587) V4553) (if (= W4589 ()) (let W4590 (shen.newpv V4553) (shen.gc V4553 (do (shen.incinfs) (shen.system-S-h W4586 (cons W4590 (cons --> (cons V4551 ()))) V4552 V4553 V4554 W4557 (freeze (shen.system-S-h W4588 W4590 V4552 V4553 V4554 W4557 V4556)))))) false))) false))) false)) false) (if (= W4584 false) (let W4591 (if (shen.unlocked? V4554) (let W4592 (shen.lazyderef V4550 V4553) (if (cons? W4592) (let W4593 (shen.lazyderef (hd W4592) V4553) (if (= W4593 cons) (let W4594 (shen.lazyderef (tl W4592) V4553) (if (cons? W4594) (let W4595 (hd W4594) (let W4596 (shen.lazyderef (tl W4594) V4553) (if (cons? W4596) (let W4597 (hd W4596) (let W4598 (shen.lazyderef (tl W4596) V4553) (if (= W4598 ()) (let W4599 (shen.lazyderef V4551 V4553) (let W4600 (lambda Z4601 (do (shen.incinfs) (shen.system-S-h W4595 Z4601 V4552 V4553 V4554 W4557 (freeze (shen.system-S-h W4597 (cons list (cons Z4601 ())) V4552 V4553 V4554 W4557 V4556))))) (if (cons? W4599) (let W4602 (shen.lazyderef (hd W4599) V4553) (let W4603 (freeze (let W4604 (shen.lazyderef (tl W4599) V4553) (let W4605 (lambda Z4606 (W4600 Z4606)) (if (cons? W4604) (let W4607 (hd W4604) (let W4608 (shen.lazyderef (tl W4604) V4553) (let W4609 (freeze (W4605 W4607)) (if (= W4608 ()) (thaw W4609) (if (shen.pvar? W4608) (shen.bind! W4608 () V4553 W4609) false))))) (if (shen.pvar? W4604) (let W4610 (shen.newpv V4553) (shen.gc V4553 (shen.bind! W4604 (cons W4610 ()) V4553 (freeze (W4605 W4610))))) false))))) (if (= W4602 list) (thaw W4603) (if (shen.pvar? W4602) (shen.bind! W4602 list V4553 W4603) false)))) (if (shen.pvar? W4599) (let W4611 (shen.newpv V4553) (shen.gc V4553 (shen.bind! W4599 (cons list (cons W4611 ())) V4553 (freeze (W4600 W4611))))) false)))) false))) false))) false)) false)) false)) false) (if (= W4591 false) (let W4612 (if (shen.unlocked? V4554) (let W4613 (shen.lazyderef V4550 V4553) (if (cons? W4613) (let W4614 (shen.lazyderef (hd W4613) V4553) (if (= W4614 @p) (let W4615 (shen.lazyderef (tl W4613) V4553) (if (cons? W4615) (let W4616 (hd W4615) (let W4617 (shen.lazyderef (tl W4615) V4553) (if (cons? W4617) (let W4618 (hd W4617) (let W4619 (shen.lazyderef (tl W4617) V4553) (if (= W4619 ()) (let W4620 (shen.lazyderef V4551 V4553) (let W4621 (lambda Z4622 (lambda Z4623 (do (shen.incinfs) (shen.system-S-h W4616 Z4622 V4552 V4553 V4554 W4557 (freeze (shen.system-S-h W4618 Z4623 V4552 V4553 V4554 W4557 V4556)))))) (if (cons? W4620) (let W4624 (hd W4620) (let W4625 (shen.lazyderef (tl W4620) V4553) (let W4626 (lambda Z4627 ((W4621 W4624) Z4627)) (if (cons? W4625) (let W4628 (shen.lazyderef (hd W4625) V4553) (let W4629 (freeze (let W4630 (shen.lazyderef (tl W4625) V4553) (let W4631 (lambda Z4632 (W4626 Z4632)) (if (cons? W4630) (let W4633 (hd W4630) (let W4634 (shen.lazyderef (tl W4630) V4553) (let W4635 (freeze (W4631 W4633)) (if (= W4634 ()) (thaw W4635) (if (shen.pvar? W4634) (shen.bind! W4634 () V4553 W4635) false))))) (if (shen.pvar? W4630) (let W4636 (shen.newpv V4553) (shen.gc V4553 (shen.bind! W4630 (cons W4636 ()) V4553 (freeze (W4631 W4636))))) false))))) (if (= W4628 *) (thaw W4629) (if (shen.pvar? W4628) (shen.bind! W4628 * V4553 W4629) false)))) (if (shen.pvar? W4625) (let W4637 (shen.newpv V4553) (shen.gc V4553 (shen.bind! W4625 (cons * (cons W4637 ())) V4553 (freeze (W4626 W4637))))) false))))) (if (shen.pvar? W4620) (let W4638 (shen.newpv V4553) (shen.gc V4553 (let W4639 (shen.newpv V4553) (shen.gc V4553 (shen.bind! W4620 (cons W4638 (cons * (cons W4639 ()))) V4553 (freeze ((W4621 W4638) W4639))))))) false)))) false))) false))) false)) false)) false)) false) (if (= W4612 false) (let W4640 (if (shen.unlocked? V4554) (let W4641 (shen.lazyderef V4550 V4553) (if (cons? W4641) (let W4642 (shen.lazyderef (hd W4641) V4553) (if (= W4642 @v) (let W4643 (shen.lazyderef (tl W4641) V4553) (if (cons? W4643) (let W4644 (hd W4643) (let W4645 (shen.lazyderef (tl W4643) V4553) (if (cons? W4645) (let W4646 (hd W4645) (let W4647 (shen.lazyderef (tl W4645) V4553) (if (= W4647 ()) (let W4648 (shen.lazyderef V4551 V4553) (let W4649 (lambda Z4650 (do (shen.incinfs) (shen.system-S-h W4644 Z4650 V4552 V4553 V4554 W4557 (freeze (shen.system-S-h W4646 (cons vector (cons Z4650 ())) V4552 V4553 V4554 W4557 V4556))))) (if (cons? W4648) (let W4651 (shen.lazyderef (hd W4648) V4553) (let W4652 (freeze (let W4653 (shen.lazyderef (tl W4648) V4553) (let W4654 (lambda Z4655 (W4649 Z4655)) (if (cons? W4653) (let W4656 (hd W4653) (let W4657 (shen.lazyderef (tl W4653) V4553) (let W4658 (freeze (W4654 W4656)) (if (= W4657 ()) (thaw W4658) (if (shen.pvar? W4657) (shen.bind! W4657 () V4553 W4658) false))))) (if (shen.pvar? W4653) (let W4659 (shen.newpv V4553) (shen.gc V4553 (shen.bind! W4653 (cons W4659 ()) V4553 (freeze (W4654 W4659))))) false))))) (if (= W4651 vector) (thaw W4652) (if (shen.pvar? W4651) (shen.bind! W4651 vector V4553 W4652) false)))) (if (shen.pvar? W4648) (let W4660 (shen.newpv V4553) (shen.gc V4553 (shen.bind! W4648 (cons vector (cons W4660 ())) V4553 (freeze (W4649 W4660))))) false)))) false))) false))) false)) false)) false)) false) (if (= W4640 false) (let W4661 (if (shen.unlocked? V4554) (let W4662 (shen.lazyderef V4550 V4553) (if (cons? W4662) (let W4663 (shen.lazyderef (hd W4662) V4553) (if (= W4663 @s) (let W4664 (shen.lazyderef (tl W4662) V4553) (if (cons? W4664) (let W4665 (hd W4664) (let W4666 (shen.lazyderef (tl W4664) V4553) (if (cons? W4666) (let W4667 (hd W4666) (let W4668 (shen.lazyderef (tl W4666) V4553) (if (= W4668 ()) (let W4669 (shen.lazyderef V4551 V4553) (let W4670 (freeze (do (shen.incinfs) (shen.system-S-h W4665 string V4552 V4553 V4554 W4557 (freeze (shen.system-S-h W4667 string V4552 V4553 V4554 W4557 V4556))))) (if (= W4669 string) (thaw W4670) (if (shen.pvar? W4669) (shen.bind! W4669 string V4553 W4670) false)))) false))) false))) false)) false)) false)) false) (if (= W4661 false) (let W4671 (if (shen.unlocked? V4554) (let W4672 (shen.lazyderef V4550 V4553) (if (cons? W4672) (let W4673 (shen.lazyderef (hd W4672) V4553) (if (= W4673 lambda) (let W4674 (shen.lazyderef (tl W4672) V4553) (if (cons? W4674) (let W4675 (hd W4674) (let W4676 (shen.lazyderef (tl W4674) V4553) (if (cons? W4676) (let W4677 (hd W4676) (let W4678 (shen.lazyderef (tl W4676) V4553) (if (= W4678 ()) (let W4679 (shen.lazyderef V4551 V4553) (let W4680 (lambda Z4681 (lambda Z4682 (let W4683 (shen.newpv V4553) (shen.gc V4553 (let W4684 (shen.newpv V4553) (shen.gc V4553 (do (shen.incinfs) (bind W4684 (shen.freshterm (shen.lazyderef W4675 V4553)) V4553 V4554 W4557 (freeze (bind W4683 (shen.beta (shen.lazyderef W4675 V4553) (shen.deref W4684 V4553) (shen.deref W4677 V4553)) V4553 V4554 W4557 (freeze (shen.system-S-h W4683 Z4682 (cons (cons W4684 (cons (intern ":") (cons Z4681 ()))) V4552) V4553 V4554 W4557 V4556)))))))))))) (if (cons? W4679) (let W4685 (hd W4679) (let W4686 (shen.lazyderef (tl W4679) V4553) (let W4687 (lambda Z4688 ((W4680 W4685) Z4688)) (if (cons? W4686) (let W4689 (shen.lazyderef (hd W4686) V4553) (let W4690 (freeze (let W4691 (shen.lazyderef (tl W4686) V4553) (let W4692 (lambda Z4693 (W4687 Z4693)) (if (cons? W4691) (let W4694 (hd W4691) (let W4695 (shen.lazyderef (tl W4691) V4553) (let W4696 (freeze (W4692 W4694)) (if (= W4695 ()) (thaw W4696) (if (shen.pvar? W4695) (shen.bind! W4695 () V4553 W4696) false))))) (if (shen.pvar? W4691) (let W4697 (shen.newpv V4553) (shen.gc V4553 (shen.bind! W4691 (cons W4697 ()) V4553 (freeze (W4692 W4697))))) false))))) (if (= W4689 -->) (thaw W4690) (if (shen.pvar? W4689) (shen.bind! W4689 --> V4553 W4690) false)))) (if (shen.pvar? W4686) (let W4698 (shen.newpv V4553) (shen.gc V4553 (shen.bind! W4686 (cons --> (cons W4698 ())) V4553 (freeze (W4687 W4698))))) false))))) (if (shen.pvar? W4679) (let W4699 (shen.newpv V4553) (shen.gc V4553 (let W4700 (shen.newpv V4553) (shen.gc V4553 (shen.bind! W4679 (cons W4699 (cons --> (cons W4700 ()))) V4553 (freeze ((W4680 W4699) W4700))))))) false)))) false))) false))) false)) false)) false)) false) (if (= W4671 false) (let W4701 (if (shen.unlocked? V4554) (let W4702 (shen.lazyderef V4550 V4553) (if (cons? W4702) (let W4703 (shen.lazyderef (hd W4702) V4553) (if (= W4703 let) (let W4704 (shen.lazyderef (tl W4702) V4553) (if (cons? W4704) (let W4705 (hd W4704) (let W4706 (shen.lazyderef (tl W4704) V4553) (if (cons? W4706) (let W4707 (hd W4706) (let W4708 (shen.lazyderef (tl W4706) V4553) (if (cons? W4708) (let W4709 (hd W4708) (let W4710 (shen.lazyderef (tl W4708) V4553) (if (= W4710 ()) (let W4711 (shen.newpv V4553) (shen.gc V4553 (let W4712 (shen.newpv V4553) (shen.gc V4553 (let W4713 (shen.newpv V4553) (shen.gc V4553 (do (shen.incinfs) (shen.system-S-h W4707 W4713 V4552 V4553 V4554 W4557 (freeze (bind W4712 (shen.freshterm (shen.lazyderef W4705 V4553)) V4553 V4554 W4557 (freeze (bind W4711 (shen.beta (shen.lazyderef W4705 V4553) (shen.lazyderef W4712 V4553) (shen.lazyderef W4709 V4553)) V4553 V4554 W4557 (freeze (shen.system-S-h W4711 V4551 (cons (cons W4712 (cons (intern ":") (cons W4713 ()))) V4552) V4553 V4554 W4557 V4556)))))))))))))) false))) false))) false))) false)) false)) false)) false) (if (= W4701 false) (let W4714 (if (shen.unlocked? V4554) (let W4715 (shen.lazyderef V4550 V4553) (if (cons? W4715) (let W4716 (shen.lazyderef (hd W4715) V4553) (if (= W4716 open) (let W4717 (shen.lazyderef (tl W4715) V4553) (if (cons? W4717) (let W4718 (hd W4717) (let W4719 (shen.lazyderef (tl W4717) V4553) (if (cons? W4719) (let W4720 (hd W4719) (let W4721 (shen.lazyderef (tl W4719) V4553) (if (= W4721 ()) (let W4722 (shen.lazyderef V4551 V4553) (let W4723 (lambda Z4724 (do (shen.incinfs) (is! W4720 Z4724 V4553 V4554 W4557 (freeze (when (element? (shen.lazyderef Z4724 V4553) (cons in (cons out ()))) V4553 V4554 W4557 (freeze (shen.system-S-h W4718 string V4552 V4553 V4554 W4557 V4556))))))) (if (cons? W4722) (let W4725 (shen.lazyderef (hd W4722) V4553) (let W4726 (freeze (let W4727 (shen.lazyderef (tl W4722) V4553) (let W4728 (lambda Z4729 (W4723 Z4729)) (if (cons? W4727) (let W4730 (hd W4727) (let W4731 (shen.lazyderef (tl W4727) V4553) (let W4732 (freeze (W4728 W4730)) (if (= W4731 ()) (thaw W4732) (if (shen.pvar? W4731) (shen.bind! W4731 () V4553 W4732) false))))) (if (shen.pvar? W4727) (let W4733 (shen.newpv V4553) (shen.gc V4553 (shen.bind! W4727 (cons W4733 ()) V4553 (freeze (W4728 W4733))))) false))))) (if (= W4725 stream) (thaw W4726) (if (shen.pvar? W4725) (shen.bind! W4725 stream V4553 W4726) false)))) (if (shen.pvar? W4722) (let W4734 (shen.newpv V4553) (shen.gc V4553 (shen.bind! W4722 (cons stream (cons W4734 ())) V4553 (freeze (W4723 W4734))))) false)))) false))) false))) false)) false)) false)) false) (if (= W4714 false) (let W4735 (if (shen.unlocked? V4554) (let W4736 (shen.lazyderef V4550 V4553) (if (cons? W4736) (let W4737 (shen.lazyderef (hd W4736) V4553) (if (= W4737 type) (let W4738 (shen.lazyderef (tl W4736) V4553) (if (cons? W4738) (let W4739 (hd W4738) (let W4740 (shen.lazyderef (tl W4738) V4553) (if (cons? W4740) (let W4741 (hd W4740) (let W4742 (shen.lazyderef (tl W4740) V4553) (if (= W4742 ()) (do (shen.incinfs) (shen.cut V4553 V4554 W4557 (freeze (is! (shen.rectify-type (shen.deref W4741 V4553)) V4551 V4553 V4554 W4557 (freeze (shen.system-S-h W4739 V4551 V4552 V4553 V4554 W4557 V4556)))))) false))) false))) false)) false)) false)) false) (if (= W4735 false) (let W4743 (if (shen.unlocked? V4554) (let W4744 (shen.lazyderef V4550 V4553) (if (cons? W4744) (let W4745 (shen.lazyderef (hd W4744) V4553) (if (= W4745 shen.input-h+) (let W4746 (shen.lazyderef (tl W4744) V4553) (if (cons? W4746) (let W4747 (hd W4746) (let W4748 (shen.lazyderef (tl W4746) V4553) (if (cons? W4748) (let W4749 (hd W4748) (let W4750 (shen.lazyderef (tl W4748) V4553) (if (= W4750 ()) (do (shen.incinfs) (is V4551 (shen.rectify-type (shen.rdecons (shen.deref W4747 V4553))) V4553 V4554 W4557 (freeze (shen.system-S-h W4749 (cons stream (cons in ())) V4552 V4553 V4554 W4557 V4556)))) false))) false))) false)) false)) false)) false) (if (= W4743 false) (let W4751 (if (shen.unlocked? V4554) (let W4752 (shen.lazyderef V4550 V4553) (if (cons? W4752) (let W4753 (shen.lazyderef (hd W4752) V4553) (if (= W4753 set) (let W4754 (shen.lazyderef (tl W4752) V4553) (if (cons? W4754) (let W4755 (hd W4754) (let W4756 (shen.lazyderef (tl W4754) V4553) (if (cons? W4756) (let W4757 (hd W4756) (let W4758 (shen.lazyderef (tl W4756) V4553) (if (= W4758 ()) (do (shen.incinfs) (shen.system-S-h W4755 symbol V4552 V4553 V4554 W4557 (freeze (shen.system-S-h (cons value (cons W4755 ())) V4551 V4552 V4553 V4554 W4557 (freeze (shen.system-S-h W4757 V4551 V4552 V4553 V4554 W4557 V4556)))))) false))) false))) false)) false)) false)) false) (if (= W4751 false) (let W4759 (if (shen.unlocked? V4554) (let W4760 (shen.newpv V4553) (shen.gc V4553 (do (shen.incinfs) (shen.l-rules V4552 W4760 false V4553 V4554 W4557 (freeze (shen.cut V4553 V4554 W4557 (freeze (shen.system-S-h V4550 V4551 W4760 V4553 V4554 W4557 V4556)))))))) false) (if (= W4759 false) (let W4761 (if (shen.unlocked? V4554) (do (shen.incinfs) (shen.search-user-datatypes (cons V4550 (cons (intern ":") (cons V4551 ()))) V4552 (value shen.*datatypes*) V4553 V4554 W4557 V4556)) false) (if (= W4761 false) (shen.unlock V4554 W4557) W4761)) W4759)) W4751)) W4743)) W4735)) W4714)) W4701)) W4671)) W4661)) W4640)) W4612)) W4591)) W4584)) W4577)) W4571)) W4565)) W4561)) W4560)) W4559)) W4558)))) +(defun shen.system-S-h (V5023 V5024 V5025 V5026 V5027 V5028 V5029) (let W5030 (+ V5028 1) (let W5031 (if (shen.unlocked? V5027) (do (shen.incinfs) (when (value shen.*spy*) V5026 V5027 W5030 (freeze (shen.show (cons V5023 (cons (intern ":") (cons V5024 ()))) V5025 V5026 V5027 W5030 V5029)))) false) (if (= W5031 false) (let W5032 (if (shen.unlocked? V5027) (do (shen.incinfs) (when (not (cons? (shen.lazyderef V5023 V5026))) V5026 V5027 W5030 (freeze (shen.primitive V5023 V5024 V5026 V5027 W5030 V5029)))) false) (if (= W5032 false) (let W5033 (if (shen.unlocked? V5027) (do (shen.incinfs) (shen.by-hypothesis V5023 V5024 V5025 V5026 V5027 W5030 V5029)) false) (if (= W5033 false) (let W5034 (if (shen.unlocked? V5027) (let W5035 (shen.lazyderef V5023 V5026) (if (cons? W5035) (let W5036 (hd W5035) (let W5037 (shen.lazyderef (tl W5035) V5026) (if (= W5037 ()) (do (shen.incinfs) (shen.lookupsig W5036 (cons --> (cons V5024 ())) V5026 V5027 W5030 V5029)) false))) false)) false) (if (= W5034 false) (let W5038 (if (shen.unlocked? V5027) (let W5039 (shen.lazyderef V5023 V5026) (if (cons? W5039) (let W5040 (shen.lazyderef (hd W5039) V5026) (if (= W5040 fn) (let W5041 (shen.lazyderef (tl W5039) V5026) (if (cons? W5041) (let W5042 (hd W5041) (let W5043 (shen.lazyderef (tl W5041) V5026) (if (= W5043 ()) (do (shen.incinfs) (when (= (arity (shen.deref W5042 V5026)) 0) V5026 V5027 W5030 (freeze (shen.cut V5026 V5027 W5030 (freeze (shen.system-S-h (cons W5042 ()) V5024 V5025 V5026 V5027 W5030 V5029)))))) false))) false)) false)) false)) false) (if (= W5038 false) (let W5044 (if (shen.unlocked? V5027) (let W5045 (shen.lazyderef V5023 V5026) (if (cons? W5045) (let W5046 (shen.lazyderef (hd W5045) V5026) (if (= W5046 fn) (let W5047 (shen.lazyderef (tl W5045) V5026) (if (cons? W5047) (let W5048 (hd W5047) (let W5049 (shen.lazyderef (tl W5047) V5026) (if (= W5049 ()) (do (shen.incinfs) (shen.lookupsig W5048 V5024 V5026 V5027 W5030 V5029)) false))) false)) false)) false)) false) (if (= W5044 false) (let W5050 (if (shen.unlocked? V5027) (let W5051 (shen.lazyderef V5023 V5026) (if (cons? W5051) (let W5052 (hd W5051) (let W5053 (shen.lazyderef (tl W5051) V5026) (if (cons? W5053) (let W5054 (hd W5053) (let W5055 (shen.lazyderef (tl W5053) V5026) (if (= W5055 ()) (let W5056 (shen.newpv V5026) (shen.gc V5026 (do (shen.incinfs) (when (not (cons? (shen.lazyderef W5052 V5026))) V5026 V5027 W5030 (freeze (shen.lookupsig W5052 (cons W5056 (cons --> (cons V5024 ()))) V5026 V5027 W5030 (freeze (shen.system-S-h W5054 W5056 V5025 V5026 V5027 W5030 V5029)))))))) false))) false))) false)) false) (if (= W5050 false) (let W5057 (if (shen.unlocked? V5027) (let W5058 (shen.lazyderef V5023 V5026) (if (cons? W5058) (let W5059 (hd W5058) (let W5060 (shen.lazyderef (tl W5058) V5026) (if (cons? W5060) (let W5061 (hd W5060) (let W5062 (shen.lazyderef (tl W5060) V5026) (if (= W5062 ()) (let W5063 (shen.newpv V5026) (shen.gc V5026 (do (shen.incinfs) (shen.system-S-h W5059 (cons W5063 (cons --> (cons V5024 ()))) V5025 V5026 V5027 W5030 (freeze (shen.system-S-h W5061 W5063 V5025 V5026 V5027 W5030 V5029)))))) false))) false))) false)) false) (if (= W5057 false) (let W5064 (if (shen.unlocked? V5027) (let W5065 (shen.lazyderef V5023 V5026) (if (cons? W5065) (let W5066 (shen.lazyderef (hd W5065) V5026) (if (= W5066 cons) (let W5067 (shen.lazyderef (tl W5065) V5026) (if (cons? W5067) (let W5068 (hd W5067) (let W5069 (shen.lazyderef (tl W5067) V5026) (if (cons? W5069) (let W5070 (hd W5069) (let W5071 (shen.lazyderef (tl W5069) V5026) (if (= W5071 ()) (let W5072 (shen.lazyderef V5024 V5026) (let W5073 (lambda Z5074 (do (shen.incinfs) (shen.system-S-h W5068 Z5074 V5025 V5026 V5027 W5030 (freeze (shen.system-S-h W5070 (cons list (cons Z5074 ())) V5025 V5026 V5027 W5030 V5029))))) (if (cons? W5072) (let W5075 (shen.lazyderef (hd W5072) V5026) (let W5076 (freeze (let W5077 (shen.lazyderef (tl W5072) V5026) (let W5078 (lambda Z5079 (W5073 Z5079)) (if (cons? W5077) (let W5080 (hd W5077) (let W5081 (shen.lazyderef (tl W5077) V5026) (let W5082 (freeze (W5078 W5080)) (if (= W5081 ()) (thaw W5082) (if (shen.pvar? W5081) (shen.bind! W5081 () V5026 W5082) false))))) (if (shen.pvar? W5077) (let W5083 (shen.newpv V5026) (shen.gc V5026 (shen.bind! W5077 (cons W5083 ()) V5026 (freeze (W5078 W5083))))) false))))) (if (= W5075 list) (thaw W5076) (if (shen.pvar? W5075) (shen.bind! W5075 list V5026 W5076) false)))) (if (shen.pvar? W5072) (let W5084 (shen.newpv V5026) (shen.gc V5026 (shen.bind! W5072 (cons list (cons W5084 ())) V5026 (freeze (W5073 W5084))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5064 false) (let W5085 (if (shen.unlocked? V5027) (let W5086 (shen.lazyderef V5023 V5026) (if (cons? W5086) (let W5087 (shen.lazyderef (hd W5086) V5026) (if (= W5087 @p) (let W5088 (shen.lazyderef (tl W5086) V5026) (if (cons? W5088) (let W5089 (hd W5088) (let W5090 (shen.lazyderef (tl W5088) V5026) (if (cons? W5090) (let W5091 (hd W5090) (let W5092 (shen.lazyderef (tl W5090) V5026) (if (= W5092 ()) (let W5093 (shen.lazyderef V5024 V5026) (let W5094 (lambda Z5095 (lambda Z5096 (do (shen.incinfs) (shen.system-S-h W5089 Z5095 V5025 V5026 V5027 W5030 (freeze (shen.system-S-h W5091 Z5096 V5025 V5026 V5027 W5030 V5029)))))) (if (cons? W5093) (let W5097 (hd W5093) (let W5098 (shen.lazyderef (tl W5093) V5026) (let W5099 (lambda Z5100 ((W5094 W5097) Z5100)) (if (cons? W5098) (let W5101 (shen.lazyderef (hd W5098) V5026) (let W5102 (freeze (let W5103 (shen.lazyderef (tl W5098) V5026) (let W5104 (lambda Z5105 (W5099 Z5105)) (if (cons? W5103) (let W5106 (hd W5103) (let W5107 (shen.lazyderef (tl W5103) V5026) (let W5108 (freeze (W5104 W5106)) (if (= W5107 ()) (thaw W5108) (if (shen.pvar? W5107) (shen.bind! W5107 () V5026 W5108) false))))) (if (shen.pvar? W5103) (let W5109 (shen.newpv V5026) (shen.gc V5026 (shen.bind! W5103 (cons W5109 ()) V5026 (freeze (W5104 W5109))))) false))))) (if (= W5101 *) (thaw W5102) (if (shen.pvar? W5101) (shen.bind! W5101 * V5026 W5102) false)))) (if (shen.pvar? W5098) (let W5110 (shen.newpv V5026) (shen.gc V5026 (shen.bind! W5098 (cons * (cons W5110 ())) V5026 (freeze (W5099 W5110))))) false))))) (if (shen.pvar? W5093) (let W5111 (shen.newpv V5026) (shen.gc V5026 (let W5112 (shen.newpv V5026) (shen.gc V5026 (shen.bind! W5093 (cons W5111 (cons * (cons W5112 ()))) V5026 (freeze ((W5094 W5111) W5112))))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5085 false) (let W5113 (if (shen.unlocked? V5027) (let W5114 (shen.lazyderef V5023 V5026) (if (cons? W5114) (let W5115 (shen.lazyderef (hd W5114) V5026) (if (= W5115 @v) (let W5116 (shen.lazyderef (tl W5114) V5026) (if (cons? W5116) (let W5117 (hd W5116) (let W5118 (shen.lazyderef (tl W5116) V5026) (if (cons? W5118) (let W5119 (hd W5118) (let W5120 (shen.lazyderef (tl W5118) V5026) (if (= W5120 ()) (let W5121 (shen.lazyderef V5024 V5026) (let W5122 (lambda Z5123 (do (shen.incinfs) (shen.system-S-h W5117 Z5123 V5025 V5026 V5027 W5030 (freeze (shen.system-S-h W5119 (cons vector (cons Z5123 ())) V5025 V5026 V5027 W5030 V5029))))) (if (cons? W5121) (let W5124 (shen.lazyderef (hd W5121) V5026) (let W5125 (freeze (let W5126 (shen.lazyderef (tl W5121) V5026) (let W5127 (lambda Z5128 (W5122 Z5128)) (if (cons? W5126) (let W5129 (hd W5126) (let W5130 (shen.lazyderef (tl W5126) V5026) (let W5131 (freeze (W5127 W5129)) (if (= W5130 ()) (thaw W5131) (if (shen.pvar? W5130) (shen.bind! W5130 () V5026 W5131) false))))) (if (shen.pvar? W5126) (let W5132 (shen.newpv V5026) (shen.gc V5026 (shen.bind! W5126 (cons W5132 ()) V5026 (freeze (W5127 W5132))))) false))))) (if (= W5124 vector) (thaw W5125) (if (shen.pvar? W5124) (shen.bind! W5124 vector V5026 W5125) false)))) (if (shen.pvar? W5121) (let W5133 (shen.newpv V5026) (shen.gc V5026 (shen.bind! W5121 (cons vector (cons W5133 ())) V5026 (freeze (W5122 W5133))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5113 false) (let W5134 (if (shen.unlocked? V5027) (let W5135 (shen.lazyderef V5023 V5026) (if (cons? W5135) (let W5136 (shen.lazyderef (hd W5135) V5026) (if (= W5136 @s) (let W5137 (shen.lazyderef (tl W5135) V5026) (if (cons? W5137) (let W5138 (hd W5137) (let W5139 (shen.lazyderef (tl W5137) V5026) (if (cons? W5139) (let W5140 (hd W5139) (let W5141 (shen.lazyderef (tl W5139) V5026) (if (= W5141 ()) (let W5142 (shen.lazyderef V5024 V5026) (let W5143 (freeze (do (shen.incinfs) (shen.system-S-h W5138 string V5025 V5026 V5027 W5030 (freeze (shen.system-S-h W5140 string V5025 V5026 V5027 W5030 V5029))))) (if (= W5142 string) (thaw W5143) (if (shen.pvar? W5142) (shen.bind! W5142 string V5026 W5143) false)))) false))) false))) false)) false)) false)) false) (if (= W5134 false) (let W5144 (if (shen.unlocked? V5027) (let W5145 (shen.lazyderef V5023 V5026) (if (cons? W5145) (let W5146 (shen.lazyderef (hd W5145) V5026) (if (= W5146 lambda) (let W5147 (shen.lazyderef (tl W5145) V5026) (if (cons? W5147) (let W5148 (hd W5147) (let W5149 (shen.lazyderef (tl W5147) V5026) (if (cons? W5149) (let W5150 (hd W5149) (let W5151 (shen.lazyderef (tl W5149) V5026) (if (= W5151 ()) (let W5152 (shen.lazyderef V5024 V5026) (let W5153 (lambda Z5154 (lambda Z5155 (let W5156 (shen.newpv V5026) (shen.gc V5026 (let W5157 (shen.newpv V5026) (shen.gc V5026 (do (shen.incinfs) (bind W5157 (shen.freshterm (shen.lazyderef W5148 V5026)) V5026 V5027 W5030 (freeze (bind W5156 (shen.beta (shen.lazyderef W5148 V5026) (shen.deref W5157 V5026) (shen.deref W5150 V5026)) V5026 V5027 W5030 (freeze (shen.system-S-h W5156 Z5155 (cons (cons W5157 (cons (intern ":") (cons Z5154 ()))) V5025) V5026 V5027 W5030 V5029)))))))))))) (if (cons? W5152) (let W5158 (hd W5152) (let W5159 (shen.lazyderef (tl W5152) V5026) (let W5160 (lambda Z5161 ((W5153 W5158) Z5161)) (if (cons? W5159) (let W5162 (shen.lazyderef (hd W5159) V5026) (let W5163 (freeze (let W5164 (shen.lazyderef (tl W5159) V5026) (let W5165 (lambda Z5166 (W5160 Z5166)) (if (cons? W5164) (let W5167 (hd W5164) (let W5168 (shen.lazyderef (tl W5164) V5026) (let W5169 (freeze (W5165 W5167)) (if (= W5168 ()) (thaw W5169) (if (shen.pvar? W5168) (shen.bind! W5168 () V5026 W5169) false))))) (if (shen.pvar? W5164) (let W5170 (shen.newpv V5026) (shen.gc V5026 (shen.bind! W5164 (cons W5170 ()) V5026 (freeze (W5165 W5170))))) false))))) (if (= W5162 -->) (thaw W5163) (if (shen.pvar? W5162) (shen.bind! W5162 --> V5026 W5163) false)))) (if (shen.pvar? W5159) (let W5171 (shen.newpv V5026) (shen.gc V5026 (shen.bind! W5159 (cons --> (cons W5171 ())) V5026 (freeze (W5160 W5171))))) false))))) (if (shen.pvar? W5152) (let W5172 (shen.newpv V5026) (shen.gc V5026 (let W5173 (shen.newpv V5026) (shen.gc V5026 (shen.bind! W5152 (cons W5172 (cons --> (cons W5173 ()))) V5026 (freeze ((W5153 W5172) W5173))))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5144 false) (let W5174 (if (shen.unlocked? V5027) (let W5175 (shen.lazyderef V5023 V5026) (if (cons? W5175) (let W5176 (shen.lazyderef (hd W5175) V5026) (if (= W5176 let) (let W5177 (shen.lazyderef (tl W5175) V5026) (if (cons? W5177) (let W5178 (hd W5177) (let W5179 (shen.lazyderef (tl W5177) V5026) (if (cons? W5179) (let W5180 (hd W5179) (let W5181 (shen.lazyderef (tl W5179) V5026) (if (cons? W5181) (let W5182 (hd W5181) (let W5183 (shen.lazyderef (tl W5181) V5026) (if (= W5183 ()) (let W5184 (shen.newpv V5026) (shen.gc V5026 (let W5185 (shen.newpv V5026) (shen.gc V5026 (let W5186 (shen.newpv V5026) (shen.gc V5026 (do (shen.incinfs) (shen.system-S-h W5180 W5186 V5025 V5026 V5027 W5030 (freeze (bind W5185 (shen.freshterm (shen.lazyderef W5178 V5026)) V5026 V5027 W5030 (freeze (bind W5184 (shen.beta (shen.lazyderef W5178 V5026) (shen.lazyderef W5185 V5026) (shen.lazyderef W5182 V5026)) V5026 V5027 W5030 (freeze (shen.system-S-h W5184 V5024 (cons (cons W5185 (cons (intern ":") (cons W5186 ()))) V5025) V5026 V5027 W5030 V5029)))))))))))))) false))) false))) false))) false)) false)) false)) false) (if (= W5174 false) (let W5187 (if (shen.unlocked? V5027) (let W5188 (shen.lazyderef V5023 V5026) (if (cons? W5188) (let W5189 (shen.lazyderef (hd W5188) V5026) (if (= W5189 open) (let W5190 (shen.lazyderef (tl W5188) V5026) (if (cons? W5190) (let W5191 (hd W5190) (let W5192 (shen.lazyderef (tl W5190) V5026) (if (cons? W5192) (let W5193 (hd W5192) (let W5194 (shen.lazyderef (tl W5192) V5026) (if (= W5194 ()) (let W5195 (shen.lazyderef V5024 V5026) (let W5196 (lambda Z5197 (do (shen.incinfs) (is! W5193 Z5197 V5026 V5027 W5030 (freeze (when (element? (shen.lazyderef Z5197 V5026) (cons in (cons out ()))) V5026 V5027 W5030 (freeze (shen.system-S-h W5191 string V5025 V5026 V5027 W5030 V5029))))))) (if (cons? W5195) (let W5198 (shen.lazyderef (hd W5195) V5026) (let W5199 (freeze (let W5200 (shen.lazyderef (tl W5195) V5026) (let W5201 (lambda Z5202 (W5196 Z5202)) (if (cons? W5200) (let W5203 (hd W5200) (let W5204 (shen.lazyderef (tl W5200) V5026) (let W5205 (freeze (W5201 W5203)) (if (= W5204 ()) (thaw W5205) (if (shen.pvar? W5204) (shen.bind! W5204 () V5026 W5205) false))))) (if (shen.pvar? W5200) (let W5206 (shen.newpv V5026) (shen.gc V5026 (shen.bind! W5200 (cons W5206 ()) V5026 (freeze (W5201 W5206))))) false))))) (if (= W5198 stream) (thaw W5199) (if (shen.pvar? W5198) (shen.bind! W5198 stream V5026 W5199) false)))) (if (shen.pvar? W5195) (let W5207 (shen.newpv V5026) (shen.gc V5026 (shen.bind! W5195 (cons stream (cons W5207 ())) V5026 (freeze (W5196 W5207))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5187 false) (let W5208 (if (shen.unlocked? V5027) (let W5209 (shen.lazyderef V5023 V5026) (if (cons? W5209) (let W5210 (shen.lazyderef (hd W5209) V5026) (if (= W5210 type) (let W5211 (shen.lazyderef (tl W5209) V5026) (if (cons? W5211) (let W5212 (hd W5211) (let W5213 (shen.lazyderef (tl W5211) V5026) (if (cons? W5213) (let W5214 (hd W5213) (let W5215 (shen.lazyderef (tl W5213) V5026) (if (= W5215 ()) (do (shen.incinfs) (shen.cut V5026 V5027 W5030 (freeze (is! (shen.rectify-type (shen.deref W5214 V5026)) V5024 V5026 V5027 W5030 (freeze (shen.system-S-h W5212 V5024 V5025 V5026 V5027 W5030 V5029)))))) false))) false))) false)) false)) false)) false) (if (= W5208 false) (let W5216 (if (shen.unlocked? V5027) (let W5217 (shen.lazyderef V5023 V5026) (if (cons? W5217) (let W5218 (shen.lazyderef (hd W5217) V5026) (if (= W5218 shen.input-h+) (let W5219 (shen.lazyderef (tl W5217) V5026) (if (cons? W5219) (let W5220 (hd W5219) (let W5221 (shen.lazyderef (tl W5219) V5026) (if (cons? W5221) (let W5222 (hd W5221) (let W5223 (shen.lazyderef (tl W5221) V5026) (if (= W5223 ()) (do (shen.incinfs) (is V5024 (shen.rectify-type (shen.rdecons (shen.deref W5220 V5026))) V5026 V5027 W5030 (freeze (shen.system-S-h W5222 (cons stream (cons in ())) V5025 V5026 V5027 W5030 V5029)))) false))) false))) false)) false)) false)) false) (if (= W5216 false) (let W5224 (if (shen.unlocked? V5027) (let W5225 (shen.lazyderef V5023 V5026) (if (cons? W5225) (let W5226 (shen.lazyderef (hd W5225) V5026) (if (= W5226 set) (let W5227 (shen.lazyderef (tl W5225) V5026) (if (cons? W5227) (let W5228 (hd W5227) (let W5229 (shen.lazyderef (tl W5227) V5026) (if (cons? W5229) (let W5230 (hd W5229) (let W5231 (shen.lazyderef (tl W5229) V5026) (if (= W5231 ()) (do (shen.incinfs) (shen.system-S-h W5228 symbol V5025 V5026 V5027 W5030 (freeze (shen.system-S-h (cons value (cons W5228 ())) V5024 V5025 V5026 V5027 W5030 (freeze (shen.system-S-h W5230 V5024 V5025 V5026 V5027 W5030 V5029)))))) false))) false))) false)) false)) false)) false) (if (= W5224 false) (let W5232 (if (shen.unlocked? V5027) (let W5233 (shen.newpv V5026) (shen.gc V5026 (do (shen.incinfs) (shen.l-rules V5025 W5233 false V5026 V5027 W5030 (freeze (shen.cut V5026 V5027 W5030 (freeze (shen.system-S-h V5023 V5024 W5233 V5026 V5027 W5030 V5029)))))))) false) (if (= W5232 false) (let W5234 (if (shen.unlocked? V5027) (do (shen.incinfs) (shen.search-user-datatypes (cons V5023 (cons (intern ":") (cons V5024 ()))) V5025 (value shen.*datatypes*) V5026 V5027 W5030 V5029)) false) (if (= W5234 false) (shen.unlock V5027 W5030) W5234)) W5232)) W5224)) W5216)) W5208)) W5187)) W5174)) W5144)) W5134)) W5113)) W5085)) W5064)) W5057)) W5050)) W5044)) W5038)) W5034)) W5033)) W5032)) W5031)))) -(defun shen.rdecons (V4762) (cond ((and (cons? V4762) (and (= cons (hd V4762)) (and (cons? (tl V4762)) (and (cons? (tl (tl V4762))) (= () (tl (tl (tl V4762)))))))) (cons (shen.rdecons (hd (tl V4762))) (shen.rdecons (hd (tl (tl V4762)))))) ((cons? V4762) (cons (shen.rdecons (hd V4762)) (shen.rdecons (tl V4762)))) (true V4762))) +(defun shen.rdecons (V5235) (cond ((and (cons? V5235) (and (= cons (hd V5235)) (and (cons? (tl V5235)) (and (cons? (tl (tl V5235))) (= () (tl (tl (tl V5235)))))))) (cons (shen.rdecons (hd (tl V5235))) (shen.rdecons (hd (tl (tl V5235)))))) ((cons? V5235) (cons (shen.rdecons (hd V5235)) (shen.rdecons (tl V5235)))) (true V5235))) -(defun shen.primitive (V4763 V4764 V4765 V4766 V4767 V4768) (let W4769 (if (shen.unlocked? V4766) (let W4770 (shen.lazyderef V4764 V4765) (let W4771 (freeze (do (shen.incinfs) (when (number? (shen.lazyderef V4763 V4765)) V4765 V4766 V4767 V4768))) (if (= W4770 number) (thaw W4771) (if (shen.pvar? W4770) (shen.bind! W4770 number V4765 W4771) false)))) false) (if (= W4769 false) (let W4772 (if (shen.unlocked? V4766) (let W4773 (shen.lazyderef V4764 V4765) (let W4774 (freeze (do (shen.incinfs) (when (boolean? (shen.lazyderef V4763 V4765)) V4765 V4766 V4767 V4768))) (if (= W4773 boolean) (thaw W4774) (if (shen.pvar? W4773) (shen.bind! W4773 boolean V4765 W4774) false)))) false) (if (= W4772 false) (let W4775 (if (shen.unlocked? V4766) (let W4776 (shen.lazyderef V4764 V4765) (let W4777 (freeze (do (shen.incinfs) (when (string? (shen.lazyderef V4763 V4765)) V4765 V4766 V4767 V4768))) (if (= W4776 string) (thaw W4777) (if (shen.pvar? W4776) (shen.bind! W4776 string V4765 W4777) false)))) false) (if (= W4775 false) (let W4778 (if (shen.unlocked? V4766) (let W4779 (shen.lazyderef V4764 V4765) (let W4780 (freeze (do (shen.incinfs) (when (symbol? (shen.lazyderef V4763 V4765)) V4765 V4766 V4767 V4768))) (if (= W4779 symbol) (thaw W4780) (if (shen.pvar? W4779) (shen.bind! W4779 symbol V4765 W4780) false)))) false) (if (= W4778 false) (if (shen.unlocked? V4766) (let W4781 (shen.lazyderef V4763 V4765) (if (= W4781 ()) (let W4782 (shen.lazyderef V4764 V4765) (let W4783 (lambda Z4784 (do (shen.incinfs) (thaw V4768))) (if (cons? W4782) (let W4785 (shen.lazyderef (hd W4782) V4765) (let W4786 (freeze (let W4787 (shen.lazyderef (tl W4782) V4765) (let W4788 (lambda Z4789 (W4783 Z4789)) (if (cons? W4787) (let W4790 (hd W4787) (let W4791 (shen.lazyderef (tl W4787) V4765) (let W4792 (freeze (W4788 W4790)) (if (= W4791 ()) (thaw W4792) (if (shen.pvar? W4791) (shen.bind! W4791 () V4765 W4792) false))))) (if (shen.pvar? W4787) (let W4793 (shen.newpv V4765) (shen.gc V4765 (shen.bind! W4787 (cons W4793 ()) V4765 (freeze (W4788 W4793))))) false))))) (if (= W4785 list) (thaw W4786) (if (shen.pvar? W4785) (shen.bind! W4785 list V4765 W4786) false)))) (if (shen.pvar? W4782) (let W4794 (shen.newpv V4765) (shen.gc V4765 (shen.bind! W4782 (cons list (cons W4794 ())) V4765 (freeze (W4783 W4794))))) false)))) false)) false) W4778)) W4775)) W4772)) W4769))) +(defun shen.primitive (V5236 V5237 V5238 V5239 V5240 V5241) (let W5242 (if (shen.unlocked? V5239) (let W5243 (shen.lazyderef V5237 V5238) (let W5244 (freeze (do (shen.incinfs) (when (number? (shen.lazyderef V5236 V5238)) V5238 V5239 V5240 V5241))) (if (= W5243 number) (thaw W5244) (if (shen.pvar? W5243) (shen.bind! W5243 number V5238 W5244) false)))) false) (if (= W5242 false) (let W5245 (if (shen.unlocked? V5239) (let W5246 (shen.lazyderef V5237 V5238) (let W5247 (freeze (do (shen.incinfs) (when (boolean? (shen.lazyderef V5236 V5238)) V5238 V5239 V5240 V5241))) (if (= W5246 boolean) (thaw W5247) (if (shen.pvar? W5246) (shen.bind! W5246 boolean V5238 W5247) false)))) false) (if (= W5245 false) (let W5248 (if (shen.unlocked? V5239) (let W5249 (shen.lazyderef V5237 V5238) (let W5250 (freeze (do (shen.incinfs) (when (string? (shen.lazyderef V5236 V5238)) V5238 V5239 V5240 V5241))) (if (= W5249 string) (thaw W5250) (if (shen.pvar? W5249) (shen.bind! W5249 string V5238 W5250) false)))) false) (if (= W5248 false) (let W5251 (if (shen.unlocked? V5239) (let W5252 (shen.lazyderef V5237 V5238) (let W5253 (freeze (do (shen.incinfs) (when (symbol? (shen.lazyderef V5236 V5238)) V5238 V5239 V5240 V5241))) (if (= W5252 symbol) (thaw W5253) (if (shen.pvar? W5252) (shen.bind! W5252 symbol V5238 W5253) false)))) false) (if (= W5251 false) (if (shen.unlocked? V5239) (let W5254 (shen.lazyderef V5236 V5238) (if (= W5254 ()) (let W5255 (shen.lazyderef V5237 V5238) (let W5256 (lambda Z5257 (do (shen.incinfs) (thaw V5241))) (if (cons? W5255) (let W5258 (shen.lazyderef (hd W5255) V5238) (let W5259 (freeze (let W5260 (shen.lazyderef (tl W5255) V5238) (let W5261 (lambda Z5262 (W5256 Z5262)) (if (cons? W5260) (let W5263 (hd W5260) (let W5264 (shen.lazyderef (tl W5260) V5238) (let W5265 (freeze (W5261 W5263)) (if (= W5264 ()) (thaw W5265) (if (shen.pvar? W5264) (shen.bind! W5264 () V5238 W5265) false))))) (if (shen.pvar? W5260) (let W5266 (shen.newpv V5238) (shen.gc V5238 (shen.bind! W5260 (cons W5266 ()) V5238 (freeze (W5261 W5266))))) false))))) (if (= W5258 list) (thaw W5259) (if (shen.pvar? W5258) (shen.bind! W5258 list V5238 W5259) false)))) (if (shen.pvar? W5255) (let W5267 (shen.newpv V5238) (shen.gc V5238 (shen.bind! W5255 (cons list (cons W5267 ())) V5238 (freeze (W5256 W5267))))) false)))) false)) false) W5251)) W5248)) W5245)) W5242))) -(defun shen.by-hypothesis (V4795 V4796 V4797 V4798 V4799 V4800 V4801) (let W4802 (if (shen.unlocked? V4799) (let W4803 (shen.lazyderef V4797 V4798) (if (cons? W4803) (let W4804 (shen.lazyderef (hd W4803) V4798) (if (cons? W4804) (let W4805 (hd W4804) (let W4806 (shen.lazyderef (tl W4804) V4798) (if (cons? W4806) (let W4807 (hd W4806) (let W4808 (shen.lazyderef (tl W4806) V4798) (if (cons? W4808) (let W4809 (hd W4808) (let W4810 (shen.lazyderef (tl W4808) V4798) (if (= W4810 ()) (do (shen.incinfs) (when (= (shen.deref W4807 V4798) (intern ":")) V4798 V4799 V4800 (freeze (when (= (shen.deref V4795 V4798) (shen.deref W4805 V4798)) V4798 V4799 V4800 (freeze (is! V4796 W4809 V4798 V4799 V4800 V4801)))))) false))) false))) false))) false)) false)) false) (if (= W4802 false) (if (shen.unlocked? V4799) (let W4811 (shen.lazyderef V4797 V4798) (if (cons? W4811) (let W4812 (tl W4811) (do (shen.incinfs) (shen.by-hypothesis V4795 V4796 W4812 V4798 V4799 V4800 V4801))) false)) false) W4802))) +(defun shen.by-hypothesis (V5268 V5269 V5270 V5271 V5272 V5273 V5274) (let W5275 (if (shen.unlocked? V5272) (let W5276 (shen.lazyderef V5270 V5271) (if (cons? W5276) (let W5277 (shen.lazyderef (hd W5276) V5271) (if (cons? W5277) (let W5278 (hd W5277) (let W5279 (shen.lazyderef (tl W5277) V5271) (if (cons? W5279) (let W5280 (hd W5279) (let W5281 (shen.lazyderef (tl W5279) V5271) (if (cons? W5281) (let W5282 (hd W5281) (let W5283 (shen.lazyderef (tl W5281) V5271) (if (= W5283 ()) (do (shen.incinfs) (when (= (shen.deref W5280 V5271) (intern ":")) V5271 V5272 V5273 (freeze (when (= (shen.deref V5268 V5271) (shen.deref W5278 V5271)) V5271 V5272 V5273 (freeze (is! V5269 W5282 V5271 V5272 V5273 V5274)))))) false))) false))) false))) false)) false)) false) (if (= W5275 false) (if (shen.unlocked? V5272) (let W5284 (shen.lazyderef V5270 V5271) (if (cons? W5284) (let W5285 (tl W5284) (do (shen.incinfs) (shen.by-hypothesis V5268 V5269 W5285 V5271 V5272 V5273 V5274))) false)) false) W5275))) -(defun shen.lookupsig (V4813 V4814 V4815 V4816 V4817 V4818) (if (shen.unlocked? V4816) (do (shen.incinfs) (shen.sigf (assoc V4813 (value shen.*sigf*)) V4814 V4815 V4816 V4817 V4818)) false)) +(defun shen.lookupsig (V5286 V5287 V5288 V5289 V5290 V5291) (if (shen.unlocked? V5289) (do (shen.incinfs) (shen.sigf (assoc V5286 (value shen.*sigf*)) V5287 V5288 V5289 V5290 V5291)) false)) -(defun shen.sigf (V4833 V4834 V4835 V4836 V4837 V4838) (cond ((cons? V4833) ((((((tl V4833) V4834) V4835) V4836) V4837) V4838)) (true false))) +(defun shen.sigf (V5306 V5307 V5308 V5309 V5310 V5311) (cond ((cons? V5306) ((((((tl V5306) V5307) V5308) V5309) V5310) V5311)) (true false))) -(defun shen.freshterm (V4839) (let W4840 (absvector 3) (let W4841 (address-> W4840 0 shen.print-freshterm) (let W4842 (address-> W4841 1 V4839) (let W4843 (address-> W4842 2 (set shen.*gensym* (+ 1 (value shen.*gensym*)))) W4843))))) +(defun shen.freshterm (V5312) (let W5313 (absvector 3) (let W5314 (address-> W5313 0 shen.print-freshterm) (let W5315 (address-> W5314 1 V5312) (let W5316 (address-> W5315 2 (set shen.*gensym* (+ 1 (value shen.*gensym*)))) W5316))))) -(defun shen.print-freshterm (V4844) (cn "&&" (shen.app (<-address V4844 1) "" shen.a))) +(defun shen.print-freshterm (V5317) (cn "&&" (shen.app (<-address V5317 1) "" shen.a))) -(defun shen.search-user-datatypes (V4845 V4846 V4847 V4848 V4849 V4850 V4851) (let W4852 (if (shen.unlocked? V4849) (let W4853 (shen.lazyderef V4847 V4848) (if (cons? W4853) (let W4854 (shen.lazyderef (hd W4853) V4848) (if (cons? W4854) (let W4855 (tl W4854) (do (shen.incinfs) (call (((shen.deref W4855 V4848) (shen.deref V4845 V4848)) (shen.deref V4846 V4848)) V4848 V4849 V4850 V4851))) false)) false)) false) (if (= W4852 false) (if (shen.unlocked? V4849) (let W4856 (shen.lazyderef V4847 V4848) (if (cons? W4856) (let W4857 (tl W4856) (do (shen.incinfs) (shen.search-user-datatypes V4845 V4846 W4857 V4848 V4849 V4850 V4851))) false)) false) W4852))) +(defun shen.search-user-datatypes (V5318 V5319 V5320 V5321 V5322 V5323 V5324) (let W5325 (if (shen.unlocked? V5322) (let W5326 (shen.lazyderef V5320 V5321) (if (cons? W5326) (let W5327 (shen.lazyderef (hd W5326) V5321) (if (cons? W5327) (let W5328 (tl W5327) (do (shen.incinfs) (call (((shen.deref W5328 V5321) (shen.deref V5318 V5321)) (shen.deref V5319 V5321)) V5321 V5322 V5323 V5324))) false)) false)) false) (if (= W5325 false) (if (shen.unlocked? V5322) (let W5329 (shen.lazyderef V5320 V5321) (if (cons? W5329) (let W5330 (tl W5329) (do (shen.incinfs) (shen.search-user-datatypes V5318 V5319 W5330 V5321 V5322 V5323 V5324))) false)) false) W5325))) -(defun shen.l-rules (V4858 V4859 V4860 V4861 V4862 V4863 V4864) (let W4865 (+ V4863 1) (let W4866 (if (shen.unlocked? V4862) (let W4867 (shen.lazyderef V4858 V4861) (if (= W4867 ()) (let W4868 (shen.lazyderef V4860 V4861) (if (= W4868 true) (do (shen.incinfs) (shen.cut V4861 V4862 W4865 (freeze (bind V4859 () V4861 V4862 W4865 V4864)))) false)) false)) false) (if (= W4866 false) (let W4869 (if (shen.unlocked? V4862) (let W4870 (shen.lazyderef V4858 V4861) (if (cons? W4870) (let W4871 (shen.lazyderef (hd W4870) V4861) (if (cons? W4871) (let W4872 (shen.lazyderef (hd W4871) V4861) (if (cons? W4872) (let W4873 (shen.lazyderef (hd W4872) V4861) (if (= W4873 cons) (let W4874 (shen.lazyderef (tl W4872) V4861) (if (cons? W4874) (let W4875 (hd W4874) (let W4876 (shen.lazyderef (tl W4874) V4861) (if (cons? W4876) (let W4877 (hd W4876) (let W4878 (shen.lazyderef (tl W4876) V4861) (if (= W4878 ()) (let W4879 (shen.lazyderef (tl W4871) V4861) (if (cons? W4879) (let W4880 (hd W4879) (let W4881 (shen.lazyderef (tl W4879) V4861) (if (cons? W4881) (let W4882 (shen.lazyderef (hd W4881) V4861) (if (cons? W4882) (let W4883 (shen.lazyderef (hd W4882) V4861) (if (= W4883 list) (let W4884 (shen.lazyderef (tl W4882) V4861) (if (cons? W4884) (let W4885 (hd W4884) (let W4886 (shen.lazyderef (tl W4884) V4861) (if (= W4886 ()) (let W4887 (shen.lazyderef (tl W4881) V4861) (if (= W4887 ()) (let W4888 (tl W4870) (do (shen.incinfs) (when (= (shen.deref W4880 V4861) (intern ":")) V4861 V4862 W4865 (freeze (shen.cut V4861 V4862 W4865 (freeze (shen.l-rules (cons (cons W4875 (cons W4880 (cons W4885 ()))) (cons (cons W4877 (cons W4880 (cons (cons list (cons W4885 ())) ()))) W4888)) V4859 true V4861 V4862 W4865 V4864))))))) false)) false))) false)) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W4869 false) (let W4889 (if (shen.unlocked? V4862) (let W4890 (shen.lazyderef V4858 V4861) (if (cons? W4890) (let W4891 (shen.lazyderef (hd W4890) V4861) (if (cons? W4891) (let W4892 (shen.lazyderef (hd W4891) V4861) (if (cons? W4892) (let W4893 (shen.lazyderef (hd W4892) V4861) (if (= W4893 @p) (let W4894 (shen.lazyderef (tl W4892) V4861) (if (cons? W4894) (let W4895 (hd W4894) (let W4896 (shen.lazyderef (tl W4894) V4861) (if (cons? W4896) (let W4897 (hd W4896) (let W4898 (shen.lazyderef (tl W4896) V4861) (if (= W4898 ()) (let W4899 (shen.lazyderef (tl W4891) V4861) (if (cons? W4899) (let W4900 (hd W4899) (let W4901 (shen.lazyderef (tl W4899) V4861) (if (cons? W4901) (let W4902 (shen.lazyderef (hd W4901) V4861) (if (cons? W4902) (let W4903 (hd W4902) (let W4904 (shen.lazyderef (tl W4902) V4861) (if (cons? W4904) (let W4905 (shen.lazyderef (hd W4904) V4861) (if (= W4905 *) (let W4906 (shen.lazyderef (tl W4904) V4861) (if (cons? W4906) (let W4907 (hd W4906) (let W4908 (shen.lazyderef (tl W4906) V4861) (if (= W4908 ()) (let W4909 (shen.lazyderef (tl W4901) V4861) (if (= W4909 ()) (let W4910 (tl W4890) (do (shen.incinfs) (when (= (shen.deref W4900 V4861) (intern ":")) V4861 V4862 W4865 (freeze (shen.cut V4861 V4862 W4865 (freeze (shen.l-rules (cons (cons W4895 (cons W4900 (cons W4903 ()))) (cons (cons W4897 (cons W4900 (cons W4907 ()))) W4910)) V4859 true V4861 V4862 W4865 V4864))))))) false)) false))) false)) false)) false))) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W4889 false) (let W4911 (if (shen.unlocked? V4862) (let W4912 (shen.lazyderef V4858 V4861) (if (cons? W4912) (let W4913 (shen.lazyderef (hd W4912) V4861) (if (cons? W4913) (let W4914 (shen.lazyderef (hd W4913) V4861) (if (cons? W4914) (let W4915 (shen.lazyderef (hd W4914) V4861) (if (= W4915 @s) (let W4916 (shen.lazyderef (tl W4914) V4861) (if (cons? W4916) (let W4917 (hd W4916) (let W4918 (shen.lazyderef (tl W4916) V4861) (if (cons? W4918) (let W4919 (hd W4918) (let W4920 (shen.lazyderef (tl W4918) V4861) (if (= W4920 ()) (let W4921 (shen.lazyderef (tl W4913) V4861) (if (cons? W4921) (let W4922 (hd W4921) (let W4923 (shen.lazyderef (tl W4921) V4861) (if (cons? W4923) (let W4924 (shen.lazyderef (hd W4923) V4861) (if (= W4924 string) (let W4925 (shen.lazyderef (tl W4923) V4861) (if (= W4925 ()) (let W4926 (tl W4912) (do (shen.incinfs) (when (= (shen.deref W4922 V4861) (intern ":")) V4861 V4862 W4865 (freeze (shen.cut V4861 V4862 W4865 (freeze (shen.l-rules (cons (cons W4917 (cons W4922 (cons string ()))) (cons (cons W4919 (cons W4922 (cons string ()))) W4926)) V4859 true V4861 V4862 W4865 V4864))))))) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W4911 false) (let W4927 (if (shen.unlocked? V4862) (let W4928 (shen.lazyderef V4858 V4861) (if (cons? W4928) (let W4929 (shen.lazyderef (hd W4928) V4861) (if (cons? W4929) (let W4930 (shen.lazyderef (hd W4929) V4861) (if (cons? W4930) (let W4931 (shen.lazyderef (hd W4930) V4861) (if (= W4931 @v) (let W4932 (shen.lazyderef (tl W4930) V4861) (if (cons? W4932) (let W4933 (hd W4932) (let W4934 (shen.lazyderef (tl W4932) V4861) (if (cons? W4934) (let W4935 (hd W4934) (let W4936 (shen.lazyderef (tl W4934) V4861) (if (= W4936 ()) (let W4937 (shen.lazyderef (tl W4929) V4861) (if (cons? W4937) (let W4938 (hd W4937) (let W4939 (shen.lazyderef (tl W4937) V4861) (if (cons? W4939) (let W4940 (shen.lazyderef (hd W4939) V4861) (if (cons? W4940) (let W4941 (shen.lazyderef (hd W4940) V4861) (if (= W4941 vector) (let W4942 (shen.lazyderef (tl W4940) V4861) (if (cons? W4942) (let W4943 (hd W4942) (let W4944 (shen.lazyderef (tl W4942) V4861) (if (= W4944 ()) (let W4945 (shen.lazyderef (tl W4939) V4861) (if (= W4945 ()) (let W4946 (tl W4928) (do (shen.incinfs) (when (= (shen.deref W4938 V4861) (intern ":")) V4861 V4862 W4865 (freeze (shen.cut V4861 V4862 W4865 (freeze (shen.l-rules (cons (cons W4933 (cons W4938 (cons W4943 ()))) (cons (cons W4935 (cons W4938 (cons (cons vector (cons W4943 ())) ()))) W4946)) V4859 true V4861 V4862 W4865 V4864))))))) false)) false))) false)) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W4927 false) (let W4947 (if (shen.unlocked? V4862) (let W4948 (shen.lazyderef V4858 V4861) (if (cons? W4948) (let W4949 (hd W4948) (let W4950 (tl W4948) (let W4951 (shen.lazyderef V4859 V4861) (let W4952 (lambda Z4953 (lambda Z4954 (do (shen.incinfs) (bind Z4953 W4949 V4861 V4862 W4865 (freeze (shen.l-rules W4950 Z4954 V4860 V4861 V4862 W4865 V4864)))))) (if (cons? W4951) (let W4955 (hd W4951) (let W4956 (tl W4951) ((W4952 W4955) W4956))) (if (shen.pvar? W4951) (let W4957 (shen.newpv V4861) (shen.gc V4861 (let W4958 (shen.newpv V4861) (shen.gc V4861 (shen.bind! W4951 (cons W4957 W4958) V4861 (freeze ((W4952 W4957) W4958))))))) false)))))) false)) false) (if (= W4947 false) (shen.unlock V4862 W4865) W4947)) W4927)) W4911)) W4889)) W4869)) W4866)))) +(defun shen.l-rules (V5331 V5332 V5333 V5334 V5335 V5336 V5337) (let W5338 (+ V5336 1) (let W5339 (if (shen.unlocked? V5335) (let W5340 (shen.lazyderef V5331 V5334) (if (= W5340 ()) (let W5341 (shen.lazyderef V5333 V5334) (if (= W5341 true) (do (shen.incinfs) (shen.cut V5334 V5335 W5338 (freeze (bind V5332 () V5334 V5335 W5338 V5337)))) false)) false)) false) (if (= W5339 false) (let W5342 (if (shen.unlocked? V5335) (let W5343 (shen.lazyderef V5331 V5334) (if (cons? W5343) (let W5344 (shen.lazyderef (hd W5343) V5334) (if (cons? W5344) (let W5345 (shen.lazyderef (hd W5344) V5334) (if (cons? W5345) (let W5346 (shen.lazyderef (hd W5345) V5334) (if (= W5346 cons) (let W5347 (shen.lazyderef (tl W5345) V5334) (if (cons? W5347) (let W5348 (hd W5347) (let W5349 (shen.lazyderef (tl W5347) V5334) (if (cons? W5349) (let W5350 (hd W5349) (let W5351 (shen.lazyderef (tl W5349) V5334) (if (= W5351 ()) (let W5352 (shen.lazyderef (tl W5344) V5334) (if (cons? W5352) (let W5353 (hd W5352) (let W5354 (shen.lazyderef (tl W5352) V5334) (if (cons? W5354) (let W5355 (shen.lazyderef (hd W5354) V5334) (if (cons? W5355) (let W5356 (shen.lazyderef (hd W5355) V5334) (if (= W5356 list) (let W5357 (shen.lazyderef (tl W5355) V5334) (if (cons? W5357) (let W5358 (hd W5357) (let W5359 (shen.lazyderef (tl W5357) V5334) (if (= W5359 ()) (let W5360 (shen.lazyderef (tl W5354) V5334) (if (= W5360 ()) (let W5361 (tl W5343) (do (shen.incinfs) (when (= (shen.deref W5353 V5334) (intern ":")) V5334 V5335 W5338 (freeze (shen.cut V5334 V5335 W5338 (freeze (shen.l-rules (cons (cons W5348 (cons W5353 (cons W5358 ()))) (cons (cons W5350 (cons W5353 (cons (cons list (cons W5358 ())) ()))) W5361)) V5332 true V5334 V5335 W5338 V5337))))))) false)) false))) false)) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W5342 false) (let W5362 (if (shen.unlocked? V5335) (let W5363 (shen.lazyderef V5331 V5334) (if (cons? W5363) (let W5364 (shen.lazyderef (hd W5363) V5334) (if (cons? W5364) (let W5365 (shen.lazyderef (hd W5364) V5334) (if (cons? W5365) (let W5366 (shen.lazyderef (hd W5365) V5334) (if (= W5366 @p) (let W5367 (shen.lazyderef (tl W5365) V5334) (if (cons? W5367) (let W5368 (hd W5367) (let W5369 (shen.lazyderef (tl W5367) V5334) (if (cons? W5369) (let W5370 (hd W5369) (let W5371 (shen.lazyderef (tl W5369) V5334) (if (= W5371 ()) (let W5372 (shen.lazyderef (tl W5364) V5334) (if (cons? W5372) (let W5373 (hd W5372) (let W5374 (shen.lazyderef (tl W5372) V5334) (if (cons? W5374) (let W5375 (shen.lazyderef (hd W5374) V5334) (if (cons? W5375) (let W5376 (hd W5375) (let W5377 (shen.lazyderef (tl W5375) V5334) (if (cons? W5377) (let W5378 (shen.lazyderef (hd W5377) V5334) (if (= W5378 *) (let W5379 (shen.lazyderef (tl W5377) V5334) (if (cons? W5379) (let W5380 (hd W5379) (let W5381 (shen.lazyderef (tl W5379) V5334) (if (= W5381 ()) (let W5382 (shen.lazyderef (tl W5374) V5334) (if (= W5382 ()) (let W5383 (tl W5363) (do (shen.incinfs) (when (= (shen.deref W5373 V5334) (intern ":")) V5334 V5335 W5338 (freeze (shen.cut V5334 V5335 W5338 (freeze (shen.l-rules (cons (cons W5368 (cons W5373 (cons W5376 ()))) (cons (cons W5370 (cons W5373 (cons W5380 ()))) W5383)) V5332 true V5334 V5335 W5338 V5337))))))) false)) false))) false)) false)) false))) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W5362 false) (let W5384 (if (shen.unlocked? V5335) (let W5385 (shen.lazyderef V5331 V5334) (if (cons? W5385) (let W5386 (shen.lazyderef (hd W5385) V5334) (if (cons? W5386) (let W5387 (shen.lazyderef (hd W5386) V5334) (if (cons? W5387) (let W5388 (shen.lazyderef (hd W5387) V5334) (if (= W5388 @s) (let W5389 (shen.lazyderef (tl W5387) V5334) (if (cons? W5389) (let W5390 (hd W5389) (let W5391 (shen.lazyderef (tl W5389) V5334) (if (cons? W5391) (let W5392 (hd W5391) (let W5393 (shen.lazyderef (tl W5391) V5334) (if (= W5393 ()) (let W5394 (shen.lazyderef (tl W5386) V5334) (if (cons? W5394) (let W5395 (hd W5394) (let W5396 (shen.lazyderef (tl W5394) V5334) (if (cons? W5396) (let W5397 (shen.lazyderef (hd W5396) V5334) (if (= W5397 string) (let W5398 (shen.lazyderef (tl W5396) V5334) (if (= W5398 ()) (let W5399 (tl W5385) (do (shen.incinfs) (when (= (shen.deref W5395 V5334) (intern ":")) V5334 V5335 W5338 (freeze (shen.cut V5334 V5335 W5338 (freeze (shen.l-rules (cons (cons W5390 (cons W5395 (cons string ()))) (cons (cons W5392 (cons W5395 (cons string ()))) W5399)) V5332 true V5334 V5335 W5338 V5337))))))) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W5384 false) (let W5400 (if (shen.unlocked? V5335) (let W5401 (shen.lazyderef V5331 V5334) (if (cons? W5401) (let W5402 (shen.lazyderef (hd W5401) V5334) (if (cons? W5402) (let W5403 (shen.lazyderef (hd W5402) V5334) (if (cons? W5403) (let W5404 (shen.lazyderef (hd W5403) V5334) (if (= W5404 @v) (let W5405 (shen.lazyderef (tl W5403) V5334) (if (cons? W5405) (let W5406 (hd W5405) (let W5407 (shen.lazyderef (tl W5405) V5334) (if (cons? W5407) (let W5408 (hd W5407) (let W5409 (shen.lazyderef (tl W5407) V5334) (if (= W5409 ()) (let W5410 (shen.lazyderef (tl W5402) V5334) (if (cons? W5410) (let W5411 (hd W5410) (let W5412 (shen.lazyderef (tl W5410) V5334) (if (cons? W5412) (let W5413 (shen.lazyderef (hd W5412) V5334) (if (cons? W5413) (let W5414 (shen.lazyderef (hd W5413) V5334) (if (= W5414 vector) (let W5415 (shen.lazyderef (tl W5413) V5334) (if (cons? W5415) (let W5416 (hd W5415) (let W5417 (shen.lazyderef (tl W5415) V5334) (if (= W5417 ()) (let W5418 (shen.lazyderef (tl W5412) V5334) (if (= W5418 ()) (let W5419 (tl W5401) (do (shen.incinfs) (when (= (shen.deref W5411 V5334) (intern ":")) V5334 V5335 W5338 (freeze (shen.cut V5334 V5335 W5338 (freeze (shen.l-rules (cons (cons W5406 (cons W5411 (cons W5416 ()))) (cons (cons W5408 (cons W5411 (cons (cons vector (cons W5416 ())) ()))) W5419)) V5332 true V5334 V5335 W5338 V5337))))))) false)) false))) false)) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W5400 false) (let W5420 (if (shen.unlocked? V5335) (let W5421 (shen.lazyderef V5331 V5334) (if (cons? W5421) (let W5422 (hd W5421) (let W5423 (tl W5421) (let W5424 (shen.lazyderef V5332 V5334) (let W5425 (lambda Z5426 (lambda Z5427 (do (shen.incinfs) (bind Z5426 W5422 V5334 V5335 W5338 (freeze (shen.l-rules W5423 Z5427 V5333 V5334 V5335 W5338 V5337)))))) (if (cons? W5424) (let W5428 (hd W5424) (let W5429 (tl W5424) ((W5425 W5428) W5429))) (if (shen.pvar? W5424) (let W5430 (shen.newpv V5334) (shen.gc V5334 (let W5431 (shen.newpv V5334) (shen.gc V5334 (shen.bind! W5424 (cons W5430 W5431) V5334 (freeze ((W5425 W5430) W5431))))))) false)))))) false)) false) (if (= W5420 false) (shen.unlock V5335 W5338) W5420)) W5400)) W5384)) W5362)) W5342)) W5339)))) -(defun shen.t* (V4959 V4960 V4961 V4962 V4963 V4964) (let W4965 (+ V4963 1) (let W4966 (if (shen.unlocked? V4962) (let W4967 (shen.lazyderef V4959 V4961) (if (cons? W4967) (let W4968 (shen.lazyderef (hd W4967) V4961) (if (= W4968 define) (let W4969 (shen.lazyderef (tl W4967) V4961) (if (cons? W4969) (let W4970 (hd W4969) (let W4971 (tl W4969) (let W4972 (shen.newpv V4961) (shen.gc V4961 (let W4973 (shen.newpv V4961) (shen.gc V4961 (let W4974 (shen.newpv V4961) (shen.gc V4961 (let W4975 (shen.newpv V4961) (shen.gc V4961 (do (shen.incinfs) (shen.cut V4961 V4962 W4965 (freeze (bind W4972 (shen.sigxrules (cons W4970 W4971)) V4961 V4962 W4965 (freeze (bind W4975 (fst (shen.lazyderef W4972 V4961)) V4961 V4962 W4965 (freeze (bind W4973 (snd (shen.lazyderef W4972 V4961)) V4961 V4962 W4965 (freeze (bind W4974 (shen.freshen-sig (shen.deref W4975 V4961)) V4961 V4962 W4965 (freeze (shen.t*-rules W4970 W4973 W4974 1 V4961 V4962 W4965 (freeze (is W4975 V4960 V4961 V4962 W4965 V4964)))))))))))))))))))))))) false)) false)) false)) false) (if (= W4966 false) (shen.unlock V4962 W4965) W4966)))) +(defun shen.t* (V5432 V5433 V5434 V5435 V5436 V5437) (let W5438 (+ V5436 1) (let W5439 (if (shen.unlocked? V5435) (let W5440 (shen.lazyderef V5432 V5434) (if (cons? W5440) (let W5441 (shen.lazyderef (hd W5440) V5434) (if (= W5441 define) (let W5442 (shen.lazyderef (tl W5440) V5434) (if (cons? W5442) (let W5443 (hd W5442) (let W5444 (tl W5442) (let W5445 (shen.newpv V5434) (shen.gc V5434 (let W5446 (shen.newpv V5434) (shen.gc V5434 (let W5447 (shen.newpv V5434) (shen.gc V5434 (let W5448 (shen.newpv V5434) (shen.gc V5434 (do (shen.incinfs) (shen.cut V5434 V5435 W5438 (freeze (bind W5445 (shen.sigxrules (cons W5443 W5444)) V5434 V5435 W5438 (freeze (bind W5448 (fst (shen.lazyderef W5445 V5434)) V5434 V5435 W5438 (freeze (bind W5446 (snd (shen.lazyderef W5445 V5434)) V5434 V5435 W5438 (freeze (bind W5447 (shen.freshen-sig (shen.deref W5448 V5434)) V5434 V5435 W5438 (freeze (shen.t*-rules W5443 W5446 W5447 1 V5434 V5435 W5438 (freeze (is W5448 V5433 V5434 V5435 W5438 V5437)))))))))))))))))))))))) false)) false)) false)) false) (if (= W5439 false) (shen.unlock V5435 W5438) W5439)))) -(defun shen.sigxrules (V4976) (compile (lambda Z4977 (shen. Z4977)) V4976)) +(defun shen.sigxrules (V5449) (let W5450 (compile (lambda Z5451 (shen. Z5451)) V5449) (@p (fst W5450) (map (lambda Z5452 (shen.unmark-rule-custom-patterns Z5452)) (snd W5450))))) -(defun shen. (V4978) (let W4979 (if (cons? V4978) (let W4980 (tail V4978) (if (shen.hds=? W4980 {) (let W4981 (tail W4980) (let W4982 (shen. W4981) (if (shen.parse-failure? W4982) (shen.parse-failure) (let W4983 (shen.<-out W4982) (let W4984 (shen.in-> W4982) (if (shen.hds=? W4984 }) (let W4985 (tail W4984) (let W4986 (shen. W4985) (if (shen.parse-failure? W4986) (shen.parse-failure) (let W4987 (shen.<-out W4986) (let W4988 (shen.in-> W4986) (shen.comb W4988 (let W4989 (shen.rectify-type W4983) (@p W4989 W4987)))))))) (shen.parse-failure))))))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W4979) (shen.parse-failure) W4979))) +(defun shen.unmark-rule-custom-patterns (V5453) (cond ((tuple? V5453) (@p (map (lambda Z5454 (shen.unmark-custom-pattern Z5454)) (fst V5453)) (snd V5453))) (true (shen.f-error shen.unmark-rule-custom-patterns)))) -(defun shen.freshen-sig (V4990) (let W4991 (shen.extract-vars V4990) (let W4992 (map (lambda Z4993 (cons Z4993 (shen.freshterm (concat & Z4993)))) W4991) (shen.freshen-type W4992 V4990)))) +(defun shen.unmark-custom-pattern (V5455) (cond ((and (cons? V5455) (and (= @p (hd V5455)) (and (cons? (tl V5455)) (and (= shen.custom-pattern (hd (tl V5455))) (and (cons? (tl (tl V5455))) (= () (tl (tl (tl V5455))))))))) (shen.unmark-custom-pattern (shen.curry (hd (tl (tl V5455)))))) ((cons? V5455) (cons (shen.unmark-custom-pattern (hd V5455)) (shen.unmark-custom-pattern (tl V5455)))) (true V5455))) -(defun shen.freshen-type (V4994 V4995) (cond ((= () V4994) V4995) ((and (cons? V4994) (cons? (hd V4994))) (shen.freshen-type (tl V4994) (subst (tl (hd V4994)) (hd (hd V4994)) V4995))) (true (simple-error "partial function shen.freshen-type")))) +(defun shen. (V5456) (let W5457 (if (cons? V5456) (let W5458 (tail V5456) (if (shen.hds=? W5458 {) (let W5459 (tail W5458) (let W5460 (shen. W5459) (if (shen.parse-failure? W5460) (shen.parse-failure) (let W5461 (shen.<-out W5460) (let W5462 (shen.in-> W5460) (if (shen.hds=? W5462 }) (let W5463 (tail W5462) (let W5464 (shen. W5463) (if (shen.parse-failure? W5464) (shen.parse-failure) (let W5465 (shen.<-out W5464) (let W5466 (shen.in-> W5464) (shen.comb W5466 (let W5467 (shen.rectify-type W5461) (@p W5467 W5465)))))))) (shen.parse-failure))))))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W5457) (shen.parse-failure) W5457))) -(defun shen. (V4996) (let W4997 (let W4998 (shen. V4996) (if (shen.parse-failure? W4998) (shen.parse-failure) (let W4999 (shen.<-out W4998) (let W5000 (shen.in-> W4998) (let W5001 (shen. W5000) (if (shen.parse-failure? W5001) (shen.parse-failure) (let W5002 (shen.<-out W5001) (let W5003 (shen.in-> W5001) (shen.comb W5003 (cons W4999 W5002)))))))))) (if (shen.parse-failure? W4997) (let W5004 (let W5005 (shen. V4996) (if (shen.parse-failure? W5005) (shen.parse-failure) (let W5006 (shen.<-out W5005) (let W5007 (shen.in-> W5005) (shen.comb W5007 (cons W5006 ())))))) (if (shen.parse-failure? W5004) (shen.parse-failure) W5004)) W4997))) +(defun shen.freshen-sig (V5468) (let W5469 (shen.extract-vars V5468) (let W5470 (map (lambda Z5471 (cons Z5471 (shen.freshterm (concat & Z5471)))) W5469) (shen.freshen-type W5470 V5468)))) -(defun shen. (V5008) (let W5009 (let W5010 (shen. V5008) (if (shen.parse-failure? W5010) (shen.parse-failure) (let W5011 (shen.<-out W5010) (let W5012 (shen.in-> W5010) (if (shen.hds=? W5012 ->) (let W5013 (tail W5012) (if (cons? W5013) (let W5014 (head W5013) (let W5015 (tail W5013) (if (shen.hds=? W5015 where) (let W5016 (tail W5015) (if (cons? W5016) (let W5017 (head W5016) (let W5018 (tail W5016) (shen.comb W5018 (@p W5011 (cons where (cons W5017 (cons W5014 ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5009) (let W5019 (let W5020 (shen. V5008) (if (shen.parse-failure? W5020) (shen.parse-failure) (let W5021 (shen.<-out W5020) (let W5022 (shen.in-> W5020) (if (shen.hds=? W5022 <-) (let W5023 (tail W5022) (if (cons? W5023) (let W5024 (head W5023) (let W5025 (tail W5023) (if (shen.hds=? W5025 where) (let W5026 (tail W5025) (if (cons? W5026) (let W5027 (head W5026) (let W5028 (tail W5026) (shen.comb W5028 (@p W5021 (shen.correct (cons where (cons W5027 (cons W5024 ())))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5019) (let W5029 (let W5030 (shen. V5008) (if (shen.parse-failure? W5030) (shen.parse-failure) (let W5031 (shen.<-out W5030) (let W5032 (shen.in-> W5030) (if (shen.hds=? W5032 <-) (let W5033 (tail W5032) (if (cons? W5033) (let W5034 (head W5033) (let W5035 (tail W5033) (shen.comb W5035 (@p W5031 (shen.correct W5034))))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5029) (let W5036 (let W5037 (shen. V5008) (if (shen.parse-failure? W5037) (shen.parse-failure) (let W5038 (shen.<-out W5037) (let W5039 (shen.in-> W5037) (if (shen.hds=? W5039 ->) (let W5040 (tail W5039) (if (cons? W5040) (let W5041 (head W5040) (let W5042 (tail W5040) (shen.comb W5042 (@p W5038 W5041)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5036) (shen.parse-failure) W5036)) W5029)) W5019)) W5009))) +(defun shen.freshen-type (V5472 V5473) (cond ((= () V5472) V5473) ((and (cons? V5472) (cons? (hd V5472))) (shen.freshen-type (tl V5472) (subst (tl (hd V5472)) (hd (hd V5472)) V5473))) (true (shen.f-error shen.freshen-type)))) -(defun shen.correct (V5043) (cond ((and (cons? V5043) (and (= where (hd V5043)) (and (cons? (tl V5043)) (and (cons? (tl (tl V5043))) (and (cons? (hd (tl (tl V5043)))) (and (= fail-if (hd (hd (tl (tl V5043))))) (and (cons? (tl (hd (tl (tl V5043))))) (and (cons? (tl (tl (hd (tl (tl V5043)))))) (and (= () (tl (tl (tl (hd (tl (tl V5043))))))) (= () (tl (tl (tl V5043))))))))))))) (cons where (cons (cons and (cons (hd (tl V5043)) (cons (cons not (cons (tl (hd (tl (tl V5043)))) ())) ()))) (tl (tl (hd (tl (tl V5043)))))))) ((and (cons? V5043) (and (= where (hd V5043)) (and (cons? (tl V5043)) (and (cons? (tl (tl V5043))) (= () (tl (tl (tl V5043)))))))) (cons where (cons (cons and (cons (hd (tl V5043)) (cons (cons not (cons (cons == (cons (hd (tl (tl V5043))) (cons (cons fail ()) ()))) ())) ()))) (tl (tl V5043))))) ((and (cons? V5043) (and (= fail-if (hd V5043)) (and (cons? (tl V5043)) (and (cons? (tl (tl V5043))) (= () (tl (tl (tl V5043)))))))) (cons where (cons (cons not (cons (tl V5043) ())) (tl (tl V5043))))) (true (cons where (cons (cons not (cons (cons == (cons V5043 (cons (cons fail ()) ()))) ())) (cons V5043 ())))))) +(defun shen. (V5474) (let W5475 (let W5476 (shen. V5474) (if (shen.parse-failure? W5476) (shen.parse-failure) (let W5477 (shen.<-out W5476) (let W5478 (shen.in-> W5476) (let W5479 (shen. W5478) (if (shen.parse-failure? W5479) (shen.parse-failure) (let W5480 (shen.<-out W5479) (let W5481 (shen.in-> W5479) (shen.comb W5481 (cons W5477 W5480)))))))))) (if (shen.parse-failure? W5475) (let W5482 (let W5483 (shen. V5474) (if (shen.parse-failure? W5483) (shen.parse-failure) (let W5484 (shen.<-out W5483) (let W5485 (shen.in-> W5483) (shen.comb W5485 (cons W5484 ())))))) (if (shen.parse-failure? W5482) (shen.parse-failure) W5482)) W5475))) -(defun shen.t*-rules (V5044 V5045 V5046 V5047 V5048 V5049 V5050 V5051) (let W5052 (+ V5050 1) (let W5053 (if (shen.unlocked? V5049) (let W5054 (shen.lazyderef V5045 V5048) (if (= W5054 ()) (do (shen.incinfs) (thaw V5051)) false)) false) (if (= W5053 false) (let W5055 (if (shen.unlocked? V5049) (let W5056 (shen.lazyderef V5045 V5048) (if (cons? W5056) (let W5057 (hd W5056) (let W5058 (tl W5056) (let W5059 (shen.newpv V5048) (shen.gc V5048 (do (shen.incinfs) (bind W5059 (shen.freshen-rule (shen.deref W5057 V5048)) V5048 V5049 W5052 (freeze (shen.t*-rule V5044 V5047 (fst (shen.lazyderef W5059 V5048)) (snd (shen.lazyderef W5059 V5048)) V5046 V5048 V5049 W5052 (freeze (shen.cut V5048 V5049 W5052 (freeze (shen.t*-rules V5044 W5058 V5046 (+ V5047 1) V5048 V5049 W5052 V5051)))))))))))) false)) false) (if (= W5055 false) (shen.unlock V5049 W5052) W5055)) W5053)))) +(defun shen. (V5486) (let W5487 (let W5488 (shen. V5486) (if (shen.parse-failure? W5488) (shen.parse-failure) (let W5489 (shen.<-out W5488) (let W5490 (shen.in-> W5488) (if (shen.hds=? W5490 ->) (let W5491 (tail W5490) (if (cons? W5491) (let W5492 (head W5491) (let W5493 (tail W5491) (if (shen.hds=? W5493 where) (let W5494 (tail W5493) (if (cons? W5494) (let W5495 (head W5494) (let W5496 (tail W5494) (shen.comb W5496 (@p W5489 (cons where (cons W5495 (cons W5492 ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5487) (let W5497 (let W5498 (shen. V5486) (if (shen.parse-failure? W5498) (shen.parse-failure) (let W5499 (shen.<-out W5498) (let W5500 (shen.in-> W5498) (if (shen.hds=? W5500 <-) (let W5501 (tail W5500) (if (cons? W5501) (let W5502 (head W5501) (let W5503 (tail W5501) (if (shen.hds=? W5503 where) (let W5504 (tail W5503) (if (cons? W5504) (let W5505 (head W5504) (let W5506 (tail W5504) (shen.comb W5506 (@p W5499 (shen.correct (cons where (cons W5505 (cons W5502 ())))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5497) (let W5507 (let W5508 (shen. V5486) (if (shen.parse-failure? W5508) (shen.parse-failure) (let W5509 (shen.<-out W5508) (let W5510 (shen.in-> W5508) (if (shen.hds=? W5510 <-) (let W5511 (tail W5510) (if (cons? W5511) (let W5512 (head W5511) (let W5513 (tail W5511) (shen.comb W5513 (@p W5509 (shen.correct W5512))))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5507) (let W5514 (let W5515 (shen. V5486) (if (shen.parse-failure? W5515) (shen.parse-failure) (let W5516 (shen.<-out W5515) (let W5517 (shen.in-> W5515) (if (shen.hds=? W5517 ->) (let W5518 (tail W5517) (if (cons? W5518) (let W5519 (head W5518) (let W5520 (tail W5518) (shen.comb W5520 (@p W5516 W5519)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5514) (shen.parse-failure) W5514)) W5507)) W5497)) W5487))) -(defun shen.freshen-rule (V5060) (cond ((tuple? V5060) (let W5061 (shen.extract-vars (fst V5060)) (let W5062 (map (lambda Z5063 (cons Z5063 (shen.freshterm Z5063))) W5061) (@p (shen.freshen W5062 (fst V5060)) (shen.freshen W5062 (snd V5060)))))) (true (simple-error "partial function shen.freshen-rule")))) +(defun shen.correct (V5521) (cond ((and (cons? V5521) (and (= where (hd V5521)) (and (cons? (tl V5521)) (and (cons? (tl (tl V5521))) (and (cons? (hd (tl (tl V5521)))) (and (= fail-if (hd (hd (tl (tl V5521))))) (and (cons? (tl (hd (tl (tl V5521))))) (and (cons? (tl (tl (hd (tl (tl V5521)))))) (and (= () (tl (tl (tl (hd (tl (tl V5521))))))) (= () (tl (tl (tl V5521))))))))))))) (cons where (cons (cons and (cons (hd (tl V5521)) (cons (cons not (cons (tl (hd (tl (tl V5521)))) ())) ()))) (tl (tl (hd (tl (tl V5521)))))))) ((and (cons? V5521) (and (= where (hd V5521)) (and (cons? (tl V5521)) (and (cons? (tl (tl V5521))) (= () (tl (tl (tl V5521)))))))) (cons where (cons (cons and (cons (hd (tl V5521)) (cons (cons not (cons (cons == (cons (hd (tl (tl V5521))) (cons (cons fail ()) ()))) ())) ()))) (tl (tl V5521))))) ((and (cons? V5521) (and (= fail-if (hd V5521)) (and (cons? (tl V5521)) (and (cons? (tl (tl V5521))) (= () (tl (tl (tl V5521)))))))) (cons where (cons (cons not (cons (tl V5521) ())) (tl (tl V5521))))) (true (cons where (cons (cons not (cons (cons == (cons V5521 (cons (cons fail ()) ()))) ())) (cons V5521 ())))))) -(defun shen.freshen (V5064 V5065) (cond ((= () V5064) V5065) ((and (cons? V5064) (cons? (hd V5064))) (shen.freshen (tl V5064) (shen.beta (hd (hd V5064)) (tl (hd V5064)) V5065))) (true (simple-error "partial function shen.freshen")))) +(defun shen.t*-rules (V5522 V5523 V5524 V5525 V5526 V5527 V5528 V5529) (let W5530 (+ V5528 1) (let W5531 (if (shen.unlocked? V5527) (let W5532 (shen.lazyderef V5523 V5526) (if (= W5532 ()) (do (shen.incinfs) (thaw V5529)) false)) false) (if (= W5531 false) (let W5533 (if (shen.unlocked? V5527) (let W5534 (shen.lazyderef V5523 V5526) (if (cons? W5534) (let W5535 (hd W5534) (let W5536 (tl W5534) (let W5537 (shen.newpv V5526) (shen.gc V5526 (do (shen.incinfs) (bind W5537 (shen.freshen-rule (shen.deref W5535 V5526)) V5526 V5527 W5530 (freeze (shen.t*-rule V5522 V5525 (fst (shen.lazyderef W5537 V5526)) (snd (shen.lazyderef W5537 V5526)) V5524 V5526 V5527 W5530 (freeze (shen.cut V5526 V5527 W5530 (freeze (shen.t*-rules V5522 W5536 V5524 (+ V5525 1) V5526 V5527 W5530 V5529)))))))))))) false)) false) (if (= W5533 false) (shen.unlock V5527 W5530) W5533)) W5531)))) -(defun shen.t*-rule (V5066 V5067 V5068 V5069 V5070 V5071 V5072 V5073 V5074) (let W5075 (if (shen.unlocked? V5072) (do (shen.incinfs) (shen.t*-rule-h V5068 V5069 V5070 V5071 V5072 V5073 V5074)) false) (if (= W5075 false) (if (shen.unlocked? V5072) (let W5076 (shen.newpv V5071) (shen.gc V5071 (do (shen.incinfs) (bind W5076 (simple-error (cn "type error in rule " (shen.app V5067 (cn " of " (shen.app V5066 " -" shen.a)) shen.a))) V5071 V5072 V5073 V5074)))) false) W5075))) +(defun shen.freshen-rule (V5538) (cond ((tuple? V5538) (let W5539 (shen.extract-vars (fst V5538)) (let W5540 (map (lambda Z5541 (cons Z5541 (shen.freshterm Z5541))) W5539) (@p (shen.freshen W5540 (fst V5538)) (shen.freshen W5540 (snd V5538)))))) (true (shen.f-error shen.freshen-rule)))) -(defun shen.t*-rule-h (V5077 V5078 V5079 V5080 V5081 V5082 V5083) (let W5084 (+ V5082 1) (let W5085 (if (shen.unlocked? V5081) (let W5086 (shen.lazyderef V5077 V5080) (if (= W5086 ()) (let W5087 (shen.lazyderef V5079 V5080) (if (cons? W5087) (let W5088 (shen.lazyderef (hd W5087) V5080) (if (= W5088 -->) (let W5089 (shen.lazyderef (tl W5087) V5080) (if (cons? W5089) (let W5090 (hd W5089) (let W5091 (shen.lazyderef (tl W5089) V5080) (if (= W5091 ()) (do (shen.incinfs) (shen.cut V5080 V5081 W5084 (freeze (shen.t*-correct V5078 W5090 () V5080 V5081 W5084 V5083)))) false))) false)) false)) false)) false)) false) (if (= W5085 false) (let W5092 (if (shen.unlocked? V5081) (let W5093 (shen.newpv V5080) (shen.gc V5080 (let W5094 (shen.newpv V5080) (shen.gc V5080 (let W5095 (shen.newpv V5080) (shen.gc V5080 (do (shen.incinfs) (shen.p-hyps (shen.freshterms V5077) W5093 V5080 V5081 W5084 (freeze (shen.t*-integrity V5077 V5079 W5093 W5094 V5080 V5081 W5084 (freeze (shen.cut V5080 V5081 W5084 (freeze (shen.myassume V5077 V5079 W5095 V5080 V5081 W5084 (freeze (shen.t*-correct V5078 W5094 W5095 V5080 V5081 W5084 V5083)))))))))))))))) false) (if (= W5092 false) (shen.unlock V5081 W5084) W5092)) W5085)))) +(defun shen.freshen (V5542 V5543) (cond ((= () V5542) V5543) ((and (cons? V5542) (cons? (hd V5542))) (shen.freshen (tl V5542) (shen.beta (hd (hd V5542)) (tl (hd V5542)) V5543))) (true (shen.f-error shen.freshen)))) -(defun shen.myassume (V5096 V5097 V5098 V5099 V5100 V5101 V5102) (let W5103 (if (shen.unlocked? V5100) (let W5104 (shen.lazyderef V5096 V5099) (if (= W5104 ()) (let W5105 (shen.lazyderef V5098 V5099) (let W5106 (freeze (do (shen.incinfs) (thaw V5102))) (if (= W5105 ()) (thaw W5106) (if (shen.pvar? W5105) (shen.bind! W5105 () V5099 W5106) false)))) false)) false) (if (= W5103 false) (if (shen.unlocked? V5100) (let W5107 (shen.lazyderef V5096 V5099) (if (cons? W5107) (let W5108 (hd W5107) (let W5109 (tl W5107) (let W5110 (shen.lazyderef V5097 V5099) (if (cons? W5110) (let W5111 (hd W5110) (let W5112 (shen.lazyderef (tl W5110) V5099) (if (cons? W5112) (let W5113 (shen.lazyderef (hd W5112) V5099) (if (= W5113 -->) (let W5114 (shen.lazyderef (tl W5112) V5099) (if (cons? W5114) (let W5115 (hd W5114) (let W5116 (shen.lazyderef (tl W5114) V5099) (if (= W5116 ()) (let W5117 (shen.lazyderef V5098 V5099) (let W5118 (lambda Z5119 (lambda Z5120 (lambda Z5121 (lambda Z5122 (do (shen.incinfs) (is! W5111 Z5121 V5099 V5100 V5101 (freeze (is! W5108 Z5119 V5099 V5100 V5101 (freeze (bind Z5120 (intern ":") V5099 V5100 V5101 (freeze (shen.myassume W5109 W5115 Z5122 V5099 V5100 V5101 V5102)))))))))))) (if (cons? W5117) (let W5123 (shen.lazyderef (hd W5117) V5099) (let W5124 (lambda Z5125 (lambda Z5126 (lambda Z5127 (let W5128 (tl W5117) ((((W5118 Z5125) Z5126) Z5127) W5128))))) (if (cons? W5123) (let W5129 (hd W5123) (let W5130 (shen.lazyderef (tl W5123) V5099) (let W5131 (lambda Z5132 (lambda Z5133 (((W5124 W5129) Z5132) Z5133))) (if (cons? W5130) (let W5134 (hd W5130) (let W5135 (shen.lazyderef (tl W5130) V5099) (let W5136 (lambda Z5137 ((W5131 W5134) Z5137)) (if (cons? W5135) (let W5138 (hd W5135) (let W5139 (shen.lazyderef (tl W5135) V5099) (let W5140 (freeze (W5136 W5138)) (if (= W5139 ()) (thaw W5140) (if (shen.pvar? W5139) (shen.bind! W5139 () V5099 W5140) false))))) (if (shen.pvar? W5135) (let W5141 (shen.newpv V5099) (shen.gc V5099 (shen.bind! W5135 (cons W5141 ()) V5099 (freeze (W5136 W5141))))) false))))) (if (shen.pvar? W5130) (let W5142 (shen.newpv V5099) (shen.gc V5099 (let W5143 (shen.newpv V5099) (shen.gc V5099 (shen.bind! W5130 (cons W5142 (cons W5143 ())) V5099 (freeze ((W5131 W5142) W5143))))))) false))))) (if (shen.pvar? W5123) (let W5144 (shen.newpv V5099) (shen.gc V5099 (let W5145 (shen.newpv V5099) (shen.gc V5099 (let W5146 (shen.newpv V5099) (shen.gc V5099 (shen.bind! W5123 (cons W5144 (cons W5145 (cons W5146 ()))) V5099 (freeze (((W5124 W5144) W5145) W5146))))))))) false)))) (if (shen.pvar? W5117) (let W5147 (shen.newpv V5099) (shen.gc V5099 (let W5148 (shen.newpv V5099) (shen.gc V5099 (let W5149 (shen.newpv V5099) (shen.gc V5099 (let W5150 (shen.newpv V5099) (shen.gc V5099 (shen.bind! W5117 (cons (cons W5147 (cons W5148 (cons W5149 ()))) W5150) V5099 (freeze ((((W5118 W5147) W5148) W5149) W5150))))))))))) false)))) false))) false)) false)) false))) false)))) false)) false) W5103))) +(defun shen.t*-rule (V5544 V5545 V5546 V5547 V5548 V5549 V5550 V5551 V5552) (let W5553 (if (shen.unlocked? V5550) (do (shen.incinfs) (shen.t*-rule-h V5546 V5547 V5548 V5549 V5550 V5551 V5552)) false) (if (= W5553 false) (if (shen.unlocked? V5550) (let W5554 (shen.newpv V5549) (shen.gc V5549 (do (shen.incinfs) (bind W5554 (simple-error (cn "type error in rule " (shen.app V5545 (cn " of " (shen.app V5544 " +" shen.a)) shen.a))) V5549 V5550 V5551 V5552)))) false) W5553))) -(defun shen.freshterms (V5153) (cond ((= () V5153) ()) ((and (cons? V5153) (cons? (hd V5153))) (shen.freshterms (append (hd V5153) (tl V5153)))) ((and (cons? V5153) (shen.freshterm? (hd V5153))) (adjoin (hd V5153) (shen.freshterms (tl V5153)))) ((cons? V5153) (shen.freshterms (tl V5153))) (true (simple-error "partial function shen.freshterms")))) +(defun shen.t*-rule-h (V5555 V5556 V5557 V5558 V5559 V5560 V5561) (let W5562 (+ V5560 1) (let W5563 (if (shen.unlocked? V5559) (let W5564 (shen.lazyderef V5555 V5558) (if (= W5564 ()) (let W5565 (shen.lazyderef V5557 V5558) (if (cons? W5565) (let W5566 (shen.lazyderef (hd W5565) V5558) (if (= W5566 -->) (let W5567 (shen.lazyderef (tl W5565) V5558) (if (cons? W5567) (let W5568 (hd W5567) (let W5569 (shen.lazyderef (tl W5567) V5558) (if (= W5569 ()) (do (shen.incinfs) (shen.cut V5558 V5559 W5562 (freeze (shen.t*-correct V5556 W5568 () V5558 V5559 W5562 V5561)))) false))) false)) false)) false)) false)) false) (if (= W5563 false) (let W5570 (if (shen.unlocked? V5559) (let W5571 (shen.newpv V5558) (shen.gc V5558 (let W5572 (shen.newpv V5558) (shen.gc V5558 (let W5573 (shen.newpv V5558) (shen.gc V5558 (do (shen.incinfs) (shen.p-hyps (shen.freshterms V5555) W5571 V5558 V5559 W5562 (freeze (shen.t*-integrity V5555 V5557 W5571 W5572 V5558 V5559 W5562 (freeze (shen.cut V5558 V5559 W5562 (freeze (shen.myassume V5555 V5557 W5573 V5558 V5559 W5562 (freeze (shen.t*-correct V5556 W5572 W5573 V5558 V5559 W5562 V5561)))))))))))))))) false) (if (= W5570 false) (shen.unlock V5559 W5562) W5570)) W5563)))) -(defun shen.p-hyps (V5154 V5155 V5156 V5157 V5158 V5159) (let W5160 (if (shen.unlocked? V5157) (let W5161 (shen.lazyderef V5154 V5156) (if (= W5161 ()) (let W5162 (shen.lazyderef V5155 V5156) (let W5163 (freeze (do (shen.incinfs) (thaw V5159))) (if (= W5162 ()) (thaw W5163) (if (shen.pvar? W5162) (shen.bind! W5162 () V5156 W5163) false)))) false)) false) (if (= W5160 false) (if (shen.unlocked? V5157) (let W5164 (shen.lazyderef V5154 V5156) (if (cons? W5164) (let W5165 (hd W5164) (let W5166 (tl W5164) (let W5167 (shen.lazyderef V5155 V5156) (let W5168 (lambda Z5169 (lambda Z5170 (lambda Z5171 (lambda Z5172 (do (shen.incinfs) (bind Z5169 W5165 V5156 V5157 V5158 (freeze (bind Z5170 (intern ":") V5156 V5157 V5158 (freeze (shen.p-hyps W5166 Z5172 V5156 V5157 V5158 V5159)))))))))) (if (cons? W5167) (let W5173 (shen.lazyderef (hd W5167) V5156) (let W5174 (lambda Z5175 (lambda Z5176 (lambda Z5177 (let W5178 (tl W5167) ((((W5168 Z5175) Z5176) Z5177) W5178))))) (if (cons? W5173) (let W5179 (hd W5173) (let W5180 (shen.lazyderef (tl W5173) V5156) (let W5181 (lambda Z5182 (lambda Z5183 (((W5174 W5179) Z5182) Z5183))) (if (cons? W5180) (let W5184 (hd W5180) (let W5185 (shen.lazyderef (tl W5180) V5156) (let W5186 (lambda Z5187 ((W5181 W5184) Z5187)) (if (cons? W5185) (let W5188 (hd W5185) (let W5189 (shen.lazyderef (tl W5185) V5156) (let W5190 (freeze (W5186 W5188)) (if (= W5189 ()) (thaw W5190) (if (shen.pvar? W5189) (shen.bind! W5189 () V5156 W5190) false))))) (if (shen.pvar? W5185) (let W5191 (shen.newpv V5156) (shen.gc V5156 (shen.bind! W5185 (cons W5191 ()) V5156 (freeze (W5186 W5191))))) false))))) (if (shen.pvar? W5180) (let W5192 (shen.newpv V5156) (shen.gc V5156 (let W5193 (shen.newpv V5156) (shen.gc V5156 (shen.bind! W5180 (cons W5192 (cons W5193 ())) V5156 (freeze ((W5181 W5192) W5193))))))) false))))) (if (shen.pvar? W5173) (let W5194 (shen.newpv V5156) (shen.gc V5156 (let W5195 (shen.newpv V5156) (shen.gc V5156 (let W5196 (shen.newpv V5156) (shen.gc V5156 (shen.bind! W5173 (cons W5194 (cons W5195 (cons W5196 ()))) V5156 (freeze (((W5174 W5194) W5195) W5196))))))))) false)))) (if (shen.pvar? W5167) (let W5197 (shen.newpv V5156) (shen.gc V5156 (let W5198 (shen.newpv V5156) (shen.gc V5156 (let W5199 (shen.newpv V5156) (shen.gc V5156 (let W5200 (shen.newpv V5156) (shen.gc V5156 (shen.bind! W5167 (cons (cons W5197 (cons W5198 (cons W5199 ()))) W5200) V5156 (freeze ((((W5168 W5197) W5198) W5199) W5200))))))))))) false)))))) false)) false) W5160))) +(defun shen.myassume (V5574 V5575 V5576 V5577 V5578 V5579 V5580) (let W5581 (if (shen.unlocked? V5578) (let W5582 (shen.lazyderef V5574 V5577) (if (= W5582 ()) (let W5583 (shen.lazyderef V5576 V5577) (let W5584 (freeze (do (shen.incinfs) (thaw V5580))) (if (= W5583 ()) (thaw W5584) (if (shen.pvar? W5583) (shen.bind! W5583 () V5577 W5584) false)))) false)) false) (if (= W5581 false) (if (shen.unlocked? V5578) (let W5585 (shen.lazyderef V5574 V5577) (if (cons? W5585) (let W5586 (hd W5585) (let W5587 (tl W5585) (let W5588 (shen.lazyderef V5575 V5577) (if (cons? W5588) (let W5589 (hd W5588) (let W5590 (shen.lazyderef (tl W5588) V5577) (if (cons? W5590) (let W5591 (shen.lazyderef (hd W5590) V5577) (if (= W5591 -->) (let W5592 (shen.lazyderef (tl W5590) V5577) (if (cons? W5592) (let W5593 (hd W5592) (let W5594 (shen.lazyderef (tl W5592) V5577) (if (= W5594 ()) (let W5595 (shen.lazyderef V5576 V5577) (let W5596 (lambda Z5597 (lambda Z5598 (lambda Z5599 (lambda Z5600 (do (shen.incinfs) (is! W5589 Z5599 V5577 V5578 V5579 (freeze (is! W5586 Z5597 V5577 V5578 V5579 (freeze (bind Z5598 (intern ":") V5577 V5578 V5579 (freeze (shen.myassume W5587 W5593 Z5600 V5577 V5578 V5579 V5580)))))))))))) (if (cons? W5595) (let W5601 (shen.lazyderef (hd W5595) V5577) (let W5602 (lambda Z5603 (lambda Z5604 (lambda Z5605 (let W5606 (tl W5595) ((((W5596 Z5603) Z5604) Z5605) W5606))))) (if (cons? W5601) (let W5607 (hd W5601) (let W5608 (shen.lazyderef (tl W5601) V5577) (let W5609 (lambda Z5610 (lambda Z5611 (((W5602 W5607) Z5610) Z5611))) (if (cons? W5608) (let W5612 (hd W5608) (let W5613 (shen.lazyderef (tl W5608) V5577) (let W5614 (lambda Z5615 ((W5609 W5612) Z5615)) (if (cons? W5613) (let W5616 (hd W5613) (let W5617 (shen.lazyderef (tl W5613) V5577) (let W5618 (freeze (W5614 W5616)) (if (= W5617 ()) (thaw W5618) (if (shen.pvar? W5617) (shen.bind! W5617 () V5577 W5618) false))))) (if (shen.pvar? W5613) (let W5619 (shen.newpv V5577) (shen.gc V5577 (shen.bind! W5613 (cons W5619 ()) V5577 (freeze (W5614 W5619))))) false))))) (if (shen.pvar? W5608) (let W5620 (shen.newpv V5577) (shen.gc V5577 (let W5621 (shen.newpv V5577) (shen.gc V5577 (shen.bind! W5608 (cons W5620 (cons W5621 ())) V5577 (freeze ((W5609 W5620) W5621))))))) false))))) (if (shen.pvar? W5601) (let W5622 (shen.newpv V5577) (shen.gc V5577 (let W5623 (shen.newpv V5577) (shen.gc V5577 (let W5624 (shen.newpv V5577) (shen.gc V5577 (shen.bind! W5601 (cons W5622 (cons W5623 (cons W5624 ()))) V5577 (freeze (((W5602 W5622) W5623) W5624))))))))) false)))) (if (shen.pvar? W5595) (let W5625 (shen.newpv V5577) (shen.gc V5577 (let W5626 (shen.newpv V5577) (shen.gc V5577 (let W5627 (shen.newpv V5577) (shen.gc V5577 (let W5628 (shen.newpv V5577) (shen.gc V5577 (shen.bind! W5595 (cons (cons W5625 (cons W5626 (cons W5627 ()))) W5628) V5577 (freeze ((((W5596 W5625) W5626) W5627) W5628))))))))))) false)))) false))) false)) false)) false))) false)))) false)) false) W5581))) -(defun shen.t*-correct (V5201 V5202 V5203 V5204 V5205 V5206 V5207) (let W5208 (+ V5206 1) (let W5209 (if (shen.unlocked? V5205) (let W5210 (shen.lazyderef V5201 V5204) (if (cons? W5210) (let W5211 (shen.lazyderef (hd W5210) V5204) (if (= W5211 where) (let W5212 (shen.lazyderef (tl W5210) V5204) (if (cons? W5212) (let W5213 (hd W5212) (let W5214 (shen.lazyderef (tl W5212) V5204) (if (cons? W5214) (let W5215 (hd W5214) (let W5216 (shen.lazyderef (tl W5214) V5204) (if (= W5216 ()) (let W5217 (shen.newpv V5204) (shen.gc V5204 (do (shen.incinfs) (shen.cut V5204 V5205 W5208 (freeze (bind W5217 (shen.curry W5213) V5204 V5205 W5208 (freeze (shen.system-S-h W5217 boolean V5203 V5204 V5205 W5208 (freeze (shen.cut V5204 V5205 W5208 (freeze (shen.t*-correct W5215 V5202 (cons (cons W5217 (cons (intern ":") (cons verified ()))) V5203) V5204 V5205 W5208 V5207)))))))))))) false))) false))) false)) false)) false)) false) (if (= W5209 false) (let W5218 (if (shen.unlocked? V5205) (do (shen.incinfs) (shen.system-S-h (shen.curry V5201) V5202 V5203 V5204 V5205 W5208 V5207)) false) (if (= W5218 false) (shen.unlock V5205 W5208) W5218)) W5209)))) +(defun shen.freshterms (V5631) (cond ((= () V5631) ()) ((and (cons? V5631) (cons? (hd V5631))) (shen.freshterms (append (hd V5631) (tl V5631)))) ((and (cons? V5631) (shen.freshterm? (hd V5631))) (adjoin (hd V5631) (shen.freshterms (tl V5631)))) ((cons? V5631) (shen.freshterms (tl V5631))) (true (shen.f-error shen.freshterms)))) -(defun shen.t*-integrity (V5219 V5220 V5221 V5222 V5223 V5224 V5225 V5226) (let W5227 (if (shen.unlocked? V5224) (let W5228 (shen.lazyderef V5219 V5223) (if (= W5228 ()) (do (shen.incinfs) (is! V5220 V5222 V5223 V5224 V5225 V5226)) false)) false) (if (= W5227 false) (if (shen.unlocked? V5224) (let W5229 (shen.lazyderef V5219 V5223) (if (cons? W5229) (let W5230 (hd W5229) (let W5231 (tl W5229) (let W5232 (shen.lazyderef V5220 V5223) (if (cons? W5232) (let W5233 (hd W5232) (let W5234 (shen.lazyderef (tl W5232) V5223) (if (cons? W5234) (let W5235 (shen.lazyderef (hd W5234) V5223) (if (= W5235 -->) (let W5236 (shen.lazyderef (tl W5234) V5223) (if (cons? W5236) (let W5237 (hd W5236) (let W5238 (shen.lazyderef (tl W5236) V5223) (if (= W5238 ()) (do (shen.incinfs) (shen.system-S-h W5230 W5233 V5221 V5223 V5224 V5225 (freeze (shen.t*-integrity W5231 W5237 V5221 V5222 V5223 V5224 V5225 V5226)))) false))) false)) false)) false))) false)))) false)) false) W5227))) +(defun shen.p-hyps (V5632 V5633 V5634 V5635 V5636 V5637) (let W5638 (if (shen.unlocked? V5635) (let W5639 (shen.lazyderef V5632 V5634) (if (= W5639 ()) (let W5640 (shen.lazyderef V5633 V5634) (let W5641 (freeze (do (shen.incinfs) (thaw V5637))) (if (= W5640 ()) (thaw W5641) (if (shen.pvar? W5640) (shen.bind! W5640 () V5634 W5641) false)))) false)) false) (if (= W5638 false) (if (shen.unlocked? V5635) (let W5642 (shen.lazyderef V5632 V5634) (if (cons? W5642) (let W5643 (hd W5642) (let W5644 (tl W5642) (let W5645 (shen.lazyderef V5633 V5634) (let W5646 (lambda Z5647 (lambda Z5648 (lambda Z5649 (lambda Z5650 (do (shen.incinfs) (bind Z5647 W5643 V5634 V5635 V5636 (freeze (bind Z5648 (intern ":") V5634 V5635 V5636 (freeze (shen.p-hyps W5644 Z5650 V5634 V5635 V5636 V5637)))))))))) (if (cons? W5645) (let W5651 (shen.lazyderef (hd W5645) V5634) (let W5652 (lambda Z5653 (lambda Z5654 (lambda Z5655 (let W5656 (tl W5645) ((((W5646 Z5653) Z5654) Z5655) W5656))))) (if (cons? W5651) (let W5657 (hd W5651) (let W5658 (shen.lazyderef (tl W5651) V5634) (let W5659 (lambda Z5660 (lambda Z5661 (((W5652 W5657) Z5660) Z5661))) (if (cons? W5658) (let W5662 (hd W5658) (let W5663 (shen.lazyderef (tl W5658) V5634) (let W5664 (lambda Z5665 ((W5659 W5662) Z5665)) (if (cons? W5663) (let W5666 (hd W5663) (let W5667 (shen.lazyderef (tl W5663) V5634) (let W5668 (freeze (W5664 W5666)) (if (= W5667 ()) (thaw W5668) (if (shen.pvar? W5667) (shen.bind! W5667 () V5634 W5668) false))))) (if (shen.pvar? W5663) (let W5669 (shen.newpv V5634) (shen.gc V5634 (shen.bind! W5663 (cons W5669 ()) V5634 (freeze (W5664 W5669))))) false))))) (if (shen.pvar? W5658) (let W5670 (shen.newpv V5634) (shen.gc V5634 (let W5671 (shen.newpv V5634) (shen.gc V5634 (shen.bind! W5658 (cons W5670 (cons W5671 ())) V5634 (freeze ((W5659 W5670) W5671))))))) false))))) (if (shen.pvar? W5651) (let W5672 (shen.newpv V5634) (shen.gc V5634 (let W5673 (shen.newpv V5634) (shen.gc V5634 (let W5674 (shen.newpv V5634) (shen.gc V5634 (shen.bind! W5651 (cons W5672 (cons W5673 (cons W5674 ()))) V5634 (freeze (((W5652 W5672) W5673) W5674))))))))) false)))) (if (shen.pvar? W5645) (let W5675 (shen.newpv V5634) (shen.gc V5634 (let W5676 (shen.newpv V5634) (shen.gc V5634 (let W5677 (shen.newpv V5634) (shen.gc V5634 (let W5678 (shen.newpv V5634) (shen.gc V5634 (shen.bind! W5645 (cons (cons W5675 (cons W5676 (cons W5677 ()))) W5678) V5634 (freeze ((((W5646 W5675) W5676) W5677) W5678))))))))))) false)))))) false)) false) W5638))) -(defun shen.freshterm? (V5239) (and (absvector? V5239) (and (not (string? V5239)) (= (<-address V5239 0) shen.print-freshterm)))) +(defun shen.t*-correct (V5679 V5680 V5681 V5682 V5683 V5684 V5685) (let W5686 (+ V5684 1) (let W5687 (if (shen.unlocked? V5683) (let W5688 (shen.lazyderef V5679 V5682) (if (cons? W5688) (let W5689 (shen.lazyderef (hd W5688) V5682) (if (= W5689 where) (let W5690 (shen.lazyderef (tl W5688) V5682) (if (cons? W5690) (let W5691 (hd W5690) (let W5692 (shen.lazyderef (tl W5690) V5682) (if (cons? W5692) (let W5693 (hd W5692) (let W5694 (shen.lazyderef (tl W5692) V5682) (if (= W5694 ()) (let W5695 (shen.newpv V5682) (shen.gc V5682 (do (shen.incinfs) (shen.cut V5682 V5683 W5686 (freeze (bind W5695 (shen.curry W5691) V5682 V5683 W5686 (freeze (shen.system-S-h W5695 boolean V5681 V5682 V5683 W5686 (freeze (shen.cut V5682 V5683 W5686 (freeze (shen.t*-correct W5693 V5680 (cons (cons W5695 (cons (intern ":") (cons verified ()))) V5681) V5682 V5683 W5686 V5685)))))))))))) false))) false))) false)) false)) false)) false) (if (= W5687 false) (let W5696 (if (shen.unlocked? V5683) (do (shen.incinfs) (shen.system-S-h (shen.curry V5679) V5680 V5681 V5682 V5683 W5686 V5685)) false) (if (= W5696 false) (shen.unlock V5683 W5686) W5696)) W5687)))) + +(defun shen.t*-integrity (V5697 V5698 V5699 V5700 V5701 V5702 V5703 V5704) (let W5705 (if (shen.unlocked? V5702) (let W5706 (shen.lazyderef V5697 V5701) (if (= W5706 ()) (do (shen.incinfs) (is! V5698 V5700 V5701 V5702 V5703 V5704)) false)) false) (if (= W5705 false) (if (shen.unlocked? V5702) (let W5707 (shen.lazyderef V5697 V5701) (if (cons? W5707) (let W5708 (hd W5707) (let W5709 (tl W5707) (let W5710 (shen.lazyderef V5698 V5701) (if (cons? W5710) (let W5711 (hd W5710) (let W5712 (shen.lazyderef (tl W5710) V5701) (if (cons? W5712) (let W5713 (shen.lazyderef (hd W5712) V5701) (if (= W5713 -->) (let W5714 (shen.lazyderef (tl W5712) V5701) (if (cons? W5714) (let W5715 (hd W5714) (let W5716 (shen.lazyderef (tl W5714) V5701) (if (= W5716 ()) (do (shen.incinfs) (shen.system-S-h W5708 W5711 V5699 V5701 V5702 V5703 (freeze (shen.t*-integrity W5709 W5715 V5699 V5700 V5701 V5702 V5703 V5704)))) false))) false)) false)) false))) false)))) false)) false) W5705))) + +(defun shen.freshterm? (V5717) (and (absvector? V5717) (and (not (string? V5717)) (= (<-address V5717 0) shen.print-freshterm)))) diff --git a/klambda/toplevel.kl b/klambda/toplevel.kl index ee72195..f007a74 100644 --- a/klambda/toplevel.kl +++ b/klambda/toplevel.kl @@ -1,6 +1,8 @@ -(defun shen.shen () (do (shen.credits) (shen.loop))) +(defun shen.repl () (do (shen.credits) (shen.loop))) -(defun shen.loop () (do (shen.initialise_environment) (do (shen.prompt) (do (trap-error (shen.read-evaluate-print) (lambda Z5262 (do (pr (error-to-string Z5262) (stoutput)) (nl 0)))) (shen.loop))))) +(defun shen.loop () (do (shen.initialise_environment) (do (shen.prompt) (do (trap-error (shen.read-evaluate-print) (lambda Z5741 (shen.toplevel-display-exception Z5741))) (shen.loop))))) + +(defun shen.toplevel-display-exception (V5742) (do (pr (error-to-string V5742) (stoutput)) (nl 0))) (defun shen.credits () (do (pr " Shen, www.shenlanguage.org, copyright (C) 2010-2024, Mark Tarver @@ -15,32 +17,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 W5263 (value shen.*package*) (let W5264 (shen.package-user-input W5263 (lineread (stinput))) (let W5265 (shen.update-history) (shen.evaluate-lineread W5264 W5265 (value shen.*tc*)))))) +(defun shen.read-evaluate-print () (let W5743 (value shen.*package*) (let W5744 (shen.package-user-input W5743 (lineread (stinput))) (let W5745 (shen.update-history) (shen.evaluate-lineread W5744 W5745 (value shen.*tc*)))))) -(defun shen.package-user-input (V5266 V5267) (cond ((= null V5266) V5267) (true (let W5268 (str V5266) (let W5269 (external V5266) (map (lambda Z5270 (shen.pui-h W5268 W5269 Z5270)) V5267)))))) +(defun shen.package-user-input (V5746 V5747) (cond ((= null V5746) V5747) (true (let W5748 (str V5746) (let W5749 (external V5746) (map (lambda Z5750 (shen.pui-h W5748 W5749 Z5750)) V5747)))))) -(defun shen.pui-h (V5275 V5276 V5277) (cond ((and (cons? V5277) (and (= fn (hd V5277)) (and (cons? (tl V5277)) (= () (tl (tl V5277)))))) (if (shen.internal? (hd (tl V5277)) V5275 V5276) (cons fn (cons (shen.intern-in-package V5275 (hd (tl V5277))) ())) V5277)) ((cons? V5277) (if (shen.internal? (hd V5277) V5275 V5276) (cons (shen.intern-in-package V5275 (hd V5277)) (map (lambda Z5278 (shen.pui-h V5275 V5276 Z5278)) (tl V5277))) (if (cons? (hd V5277)) (map (lambda Z5279 (shen.pui-h V5275 V5276 Z5279)) V5277) (cons (hd V5277) (map (lambda Z5280 (shen.pui-h V5275 V5276 Z5280)) (tl V5277)))))) (true V5277))) +(defun shen.pui-h (V5755 V5756 V5757) (cond ((and (cons? V5757) (and (= fn (hd V5757)) (and (cons? (tl V5757)) (= () (tl (tl V5757)))))) (if (shen.internal? (hd (tl V5757)) V5755 V5756) (cons fn (cons (shen.intern-in-package V5755 (hd (tl V5757))) ())) V5757)) ((cons? V5757) (if (shen.internal? (hd V5757) V5755 V5756) (cons (shen.intern-in-package V5755 (hd V5757)) (map (lambda Z5758 (shen.pui-h V5755 V5756 Z5758)) (tl V5757))) (if (cons? (hd V5757)) (map (lambda Z5759 (shen.pui-h V5755 V5756 Z5759)) V5757) (cons (hd V5757) (map (lambda Z5760 (shen.pui-h V5755 V5756 Z5760)) (tl V5757)))))) (true V5757))) (defun shen.update-history () (set shen.*history* (cons (shen.trim-it (it)) (value shen.*history*)))) -(defun shen.trim-it (V5281) (cond ((and (shen.+string? V5281) (shen.whitespace? (string->n (hdstr V5281)))) (shen.trim-it (tlstr V5281))) (true V5281))) +(defun shen.trim-it (V5761) (cond ((and (shen.+string? V5761) (shen.whitespace? (string->n (hdstr V5761)))) (shen.trim-it (tlstr V5761))) (true V5761))) -(defun shen.evaluate-lineread (V5300 V5301 V5302) (cond ((and (cons? V5300) (and (= () (tl V5300)) (and (cons? V5301) (and (shen.+string? (hd V5301)) (and (= "!" (hdstr (hd V5301))) (and (shen.+string? (tlstr (hd V5301))) (and (= "!" (hdstr (tlstr (hd V5301)))) (cons? (tl V5301))))))))) (let W5303 (read-from-string (hd (tl V5301))) (let W5304 (set shen.*history* (cons (hd (tl V5301)) (tl V5301))) (let W5305 (pr (shen.app (hd (tl V5301)) " -" shen.a) (stoutput)) (shen.evaluate-lineread W5303 W5304 V5302))))) ((and (cons? V5300) (and (= () (tl V5300)) (and (cons? V5301) (and (shen.+string? (hd V5301)) (= "!" (hdstr (hd V5301))))))) (let W5306 (if (= (tlstr (hd V5301)) "") () (hd (read-from-string (tlstr (hd V5301))))) (let W5307 (shen.use-history W5306 (tlstr (hd V5301)) (tl V5301)) (let W5308 (pr (shen.app W5307 " -" shen.a) (stoutput)) (let W5309 (read-from-string W5307) (let W5310 (set shen.*history* (cons W5307 (tl V5301))) (shen.evaluate-lineread W5309 W5310 V5302))))))) ((and (cons? V5300) (and (= () (tl V5300)) (and (cons? V5301) (and (shen.+string? (hd V5301)) (= "%" (hdstr (hd V5301))))))) (let W5311 (if (= (tlstr (hd V5301)) "") () (hd (read-from-string (tlstr (hd V5301))))) (let W5312 (shen.peek-history W5311 (tlstr (hd V5301)) (tl V5301)) (let W5313 (set shen.*history* (tl V5301)) (abort))))) ((= true V5302) (shen.check-eval-and-print V5300)) ((= false V5302) (shen.eval-and-print V5300)) (true (simple-error "implementation error in shen.evaluate-lineread")))) +(defun shen.evaluate-lineread (V5780 V5781 V5782) (cond ((and (cons? V5780) (and (= () (tl V5780)) (and (cons? V5781) (and (shen.+string? (hd V5781)) (and (= "!" (hdstr (hd V5781))) (and (shen.+string? (tlstr (hd V5781))) (and (= "!" (hdstr (tlstr (hd V5781)))) (cons? (tl V5781))))))))) (let W5783 (read-from-string (hd (tl V5781))) (let W5784 (set shen.*history* (cons (hd (tl V5781)) (tl V5781))) (let W5785 (pr (shen.app (hd (tl V5781)) " +" shen.a) (stoutput)) (shen.evaluate-lineread W5783 W5784 V5782))))) ((and (cons? V5780) (and (= () (tl V5780)) (and (cons? V5781) (and (shen.+string? (hd V5781)) (= "!" (hdstr (hd V5781))))))) (let W5786 (if (= (tlstr (hd V5781)) "") () (hd (read-from-string (tlstr (hd V5781))))) (let W5787 (shen.use-history W5786 (tlstr (hd V5781)) (tl V5781)) (let W5788 (pr (shen.app W5787 " +" shen.a) (stoutput)) (let W5789 (read-from-string W5787) (let W5790 (set shen.*history* (cons W5787 (tl V5781))) (shen.evaluate-lineread W5789 W5790 V5782))))))) ((and (cons? V5780) (and (= () (tl V5780)) (and (cons? V5781) (and (shen.+string? (hd V5781)) (= "%" (hdstr (hd V5781))))))) (let W5791 (if (= (tlstr (hd V5781)) "") () (hd (read-from-string (tlstr (hd V5781))))) (let W5792 (shen.peek-history W5791 (tlstr (hd V5781)) (tl V5781)) (let W5793 (set shen.*history* (tl V5781)) (abort))))) ((= true V5782) (shen.check-eval-and-print V5780)) ((= false V5782) (shen.eval-and-print V5780)) (true (simple-error "implementation error in shen.evaluate-lineread")))) -(defun shen.use-history (V5314 V5315 V5316) (if (integer? V5314) (nth (+ 1 V5314) (reverse V5316)) (if (symbol? V5314) (shen.string-match V5315 V5316) (simple-error "! expects a number or a symbol +(defun shen.use-history (V5794 V5795 V5796) (if (integer? V5794) (nth (+ 1 V5794) (reverse V5796)) (if (symbol? V5794) (shen.string-match V5795 V5796) (simple-error "! expects a number or a symbol ")))) -(defun shen.peek-history (V5317 V5318 V5319) (if (integer? V5317) (pr (cn " -" (shen.app (nth (+ 1 V5317) (reverse V5319)) "" shen.a)) (stoutput)) (if (or (= V5318 "") (symbol? V5317)) (shen.recursive-string-match 0 V5318 (reverse V5319)) (simple-error "% expects a number or a symbol +(defun shen.peek-history (V5797 V5798 V5799) (if (integer? V5797) (pr (cn " +" (shen.app (nth (+ 1 V5797) (reverse V5799)) "" shen.a)) (stoutput)) (if (or (= V5798 "") (symbol? V5797)) (shen.recursive-string-match 0 V5798 (reverse V5799)) (simple-error "% expects a number or a symbol ")))) -(defun shen.string-match (V5329 V5330) (cond ((= () V5330) (simple-error " -input not found")) ((and (cons? V5330) (shen.string-prefix? V5329 (hd V5330))) (hd V5330)) ((cons? V5330) (shen.string-match V5329 (tl V5330))) (true (simple-error "implementation error in shen.string-match")))) +(defun shen.string-match (V5809 V5810) (cond ((= () V5810) (simple-error " +input not found")) ((and (cons? V5810) (shen.string-prefix? V5809 (hd V5810))) (hd V5810)) ((cons? V5810) (shen.string-match V5809 (tl V5810))) (true (simple-error "implementation error in shen.string-match")))) -(defun shen.string-prefix? (V5338 V5339) (cond ((= "" V5338) true) ((and (shen.+string? V5338) (shen.whitespace? (string->n (hdstr V5338)))) (shen.string-prefix? (tlstr V5338) V5339)) ((and (shen.+string? V5339) (shen.whitespace? (string->n (hdstr V5339)))) (shen.string-prefix? V5338 (tlstr V5339))) ((and (shen.+string? V5339) (= "(" (hdstr V5339))) (shen.string-prefix? V5338 (tlstr V5339))) ((and (shen.+string? V5338) (and (shen.+string? V5339) (= (hdstr V5338) (hdstr V5339)))) (shen.string-prefix? (tlstr V5338) (tlstr V5339))) (true false))) +(defun shen.string-prefix? (V5818 V5819) (cond ((= "" V5818) true) ((and (shen.+string? V5818) (shen.whitespace? (string->n (hdstr V5818)))) (shen.string-prefix? (tlstr V5818) V5819)) ((and (shen.+string? V5819) (shen.whitespace? (string->n (hdstr V5819)))) (shen.string-prefix? V5818 (tlstr V5819))) ((and (shen.+string? V5819) (= "(" (hdstr V5819))) (shen.string-prefix? V5818 (tlstr V5819))) ((and (shen.+string? V5818) (and (shen.+string? V5819) (= (hdstr V5818) (hdstr V5819)))) (shen.string-prefix? (tlstr V5818) (tlstr V5819))) (true false))) -(defun shen.recursive-string-match (V5350 V5351 V5352) (cond ((= () V5352) shen.skip) ((cons? V5352) (do (if (shen.string-prefix? V5351 (hd V5352)) (pr (shen.app V5350 (cn ". " (shen.app (hd V5352) " -" shen.a)) shen.a) (stoutput)) shen.skip) (shen.recursive-string-match (+ V5350 1) V5351 (tl V5352)))) (true (simple-error "implementation error in shen.recursive-string-match")))) +(defun shen.recursive-string-match (V5830 V5831 V5832) (cond ((= () V5832) shen.skip) ((cons? V5832) (do (if (shen.string-prefix? V5831 (hd V5832)) (pr (shen.app V5830 (cn ". " (shen.app (hd V5832) " +" shen.a)) shen.a) (stoutput)) shen.skip) (shen.recursive-string-match (+ V5830 1) V5831 (tl V5832)))) (true (simple-error "implementation error in shen.recursive-string-match")))) diff --git a/klambda/track.kl b/klambda/track.kl index 000d804..03199d4 100644 --- a/klambda/track.kl +++ b/klambda/track.kl @@ -1,66 +1,66 @@ -(defun shen.f-error (V5384) (do (pr (cn "partial function " (shen.app V5384 "; -" shen.a)) (stoutput)) (do (if (and (not (shen.tracked? V5384)) (y-or-n? (cn "track " (shen.app V5384 "? " shen.a)))) (shen.track-function (ps V5384)) shen.ok) (simple-error "aborted")))) +(defun shen.f-error (V5864) (do (pr (cn "partial function " (shen.app V5864 "; +" shen.a)) (stoutput)) (do (if (and (not (shen.tracked? V5864)) (y-or-n? (cn "track " (shen.app V5864 "? " shen.a)))) (shen.track-function (ps V5864)) shen.ok) (simple-error "aborted")))) -(defun shen.tracked? (V5385) (element? V5385 (value shen.*tracking*))) +(defun shen.tracked? (V5865) (element? V5865 (value shen.*tracking*))) -(defun track (V5386) (let W5387 (ps V5386) (shen.track-function W5387))) +(defun track (V5866) (let W5867 (ps V5866) (shen.track-function W5867))) -(defun shen.track-function (V5390) (cond ((and (cons? V5390) (and (= defun (hd V5390)) (and (cons? (tl V5390)) (and (cons? (tl (tl V5390))) (and (cons? (tl (tl (tl V5390)))) (= () (tl (tl (tl (tl V5390)))))))))) (let W5391 (cons defun (cons (hd (tl V5390)) (cons (hd (tl (tl V5390))) (cons (shen.insert-tracking-code (hd (tl V5390)) (hd (tl (tl V5390))) (hd (tl (tl (tl V5390))))) ())))) (let W5392 (eval-kl W5391) (let W5393 (set shen.*tracking* (adjoin (hd (tl V5390)) (value shen.*tracking*))) (hd (tl V5390)))))) (true (simple-error "implementation error in shen.track-function")))) +(defun shen.track-function (V5870) (cond ((and (cons? V5870) (and (= defun (hd V5870)) (and (cons? (tl V5870)) (and (cons? (tl (tl V5870))) (and (cons? (tl (tl (tl V5870)))) (= () (tl (tl (tl (tl V5870)))))))))) (let W5871 (cons defun (cons (hd (tl V5870)) (cons (hd (tl (tl V5870))) (cons (shen.insert-tracking-code (hd (tl V5870)) (hd (tl (tl V5870))) (hd (tl (tl (tl V5870))))) ())))) (let W5872 (eval-kl W5871) (let W5873 (set shen.*tracking* (adjoin (hd (tl V5870)) (value shen.*tracking*))) (hd (tl V5870)))))) (true (simple-error "implementation error in shen.track-function")))) -(defun shen.insert-tracking-code (V5394 V5395 V5396) (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 V5394 (cons (shen.cons-form (shen.prolog-track V5396 V5395)) ())))) (cons (cons do (cons (cons shen.terpri-or-read-char ()) (cons (cons let (cons Result (cons V5396 (cons (cons do (cons (cons shen.output-track (cons (cons value (cons shen.*call* ())) (cons V5394 (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 (V5874 V5875 V5876) (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 V5874 (cons (shen.cons-form (shen.prolog-track V5876 V5875)) ())))) (cons (cons do (cons (cons shen.terpri-or-read-char ()) (cons (cons let (cons Result (cons V5876 (cons (cons do (cons (cons shen.output-track (cons (cons value (cons shen.*call* ())) (cons V5874 (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 (V5397 V5398) (cond ((= (occurrences shen.incinfs V5397) 0) V5398) (true (shen.vector-dereference V5398 (shen.vector-parameter V5398))))) +(defun shen.prolog-track (V5877 V5878) (cond ((= (occurrences shen.incinfs V5877) 0) V5878) (true (shen.vector-dereference V5878 (shen.vector-parameter V5878))))) -(defun shen.vector-parameter (V5401) (cond ((= () V5401) ()) ((and (cons? V5401) (and (cons? (tl V5401)) (and (cons? (tl (tl V5401))) (and (cons? (tl (tl (tl V5401)))) (= () (tl (tl (tl (tl V5401))))))))) (hd V5401)) ((cons? V5401) (shen.vector-parameter (tl V5401))) (true (simple-error "partial function shen.vector-parameter")))) +(defun shen.vector-parameter (V5881) (cond ((= () V5881) ()) ((and (cons? V5881) (and (cons? (tl V5881)) (and (cons? (tl (tl V5881))) (and (cons? (tl (tl (tl V5881)))) (= () (tl (tl (tl (tl V5881))))))))) (hd V5881)) ((cons? V5881) (shen.vector-parameter (tl V5881))) (true (shen.f-error shen.vector-parameter)))) -(defun shen.vector-dereference (V5404 V5405) (cond ((= () V5405) V5404) ((and (cons? V5404) (and (cons? (tl V5404)) (and (cons? (tl (tl V5404))) (and (cons? (tl (tl (tl V5404)))) (= () (tl (tl (tl (tl V5404))))))))) V5404) ((cons? V5404) (cons (cons shen.deref (cons (hd V5404) (cons V5405 ()))) (shen.vector-dereference (tl V5404) V5405))) (true (simple-error "partial function shen.vector-dereference")))) +(defun shen.vector-dereference (V5884 V5885) (cond ((= () V5885) V5884) ((and (cons? V5884) (and (cons? (tl V5884)) (and (cons? (tl (tl V5884))) (and (cons? (tl (tl (tl V5884)))) (= () (tl (tl (tl (tl V5884))))))))) V5884) ((cons? V5884) (cons (cons shen.deref (cons (hd V5884) (cons V5885 ()))) (shen.vector-dereference (tl V5884) V5885))) (true (shen.f-error shen.vector-dereference)))) -(defun step (V5408) (cond ((= + V5408) (set shen.*step* true)) ((= - V5408) (set shen.*step* false)) (true (simple-error "step expects a + or a -. +(defun step (V5888) (cond ((= + V5888) (set shen.*step* true)) ((= - V5888) (set shen.*step* false)) (true (simple-error "step expects a + or a -. ")))) -(defun step? () (value shen.*step*)) +(defun shen.step? () (value shen.*step*)) -(defun spy (V5411) (cond ((= + V5411) (set shen.*spy* true)) ((= - V5411) (set shen.*spy* false)) (true (simple-error "spy expects a + or a -. +(defun spy (V5891) (cond ((= + V5891) (set shen.*spy* true)) ((= - V5891) (set shen.*spy* false)) (true (simple-error "spy expects a + or a -. ")))) -(defun spy? () (value shen.*spy*)) +(defun shen.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 (V5414) (cond ((= 94 V5414) (simple-error "aborted")) (true true))) +(defun shen.check-byte (V5894) (cond ((= 94 V5894) (simple-error "aborted")) (true true))) -(defun shen.input-track (V5415 V5416 V5417) (do (pr (cn " -" (shen.app (shen.spaces V5415) (cn "<" (shen.app V5415 (cn "> Inputs to " (shen.app V5416 (cn " -" (shen.app (shen.spaces V5415) "" shen.a)) shen.a)) shen.a)) shen.a)) (stoutput)) (shen.recursively-print V5417))) +(defun shen.input-track (V5895 V5896 V5897) (do (pr (cn " +" (shen.app (shen.spaces V5895) (cn "<" (shen.app V5895 (cn "> Inputs to " (shen.app V5896 (cn " +" (shen.app (shen.spaces V5895) "" shen.a)) shen.a)) shen.a)) shen.a)) (stoutput)) (shen.recursively-print V5897))) -(defun shen.recursively-print (V5420) (cond ((= () V5420) (pr " ==>" (stoutput))) ((cons? V5420) (do (print (hd V5420)) (do (pr ", " (stoutput)) (shen.recursively-print (tl V5420))))) (true (simple-error "implementation error in shen.recursively-print")))) +(defun shen.recursively-print (V5900) (cond ((= () V5900) (pr " ==>" (stoutput))) ((cons? V5900) (do (print (hd V5900)) (do (pr ", " (stoutput)) (shen.recursively-print (tl V5900))))) (true (simple-error "implementation error in shen.recursively-print")))) -(defun shen.spaces (V5421) (cond ((= 0 V5421) "") (true (cn " " (shen.spaces (- V5421 1)))))) +(defun shen.spaces (V5901) (cond ((= 0 V5901) "") (true (cn " " (shen.spaces (- V5901 1)))))) -(defun shen.output-track (V5422 V5423 V5424) (pr (cn " -" (shen.app (shen.spaces V5422) (cn "<" (shen.app V5422 (cn "> Output from " (shen.app V5423 (cn " -" (shen.app (shen.spaces V5422) (cn "==> " (shen.app V5424 "" shen.s)) shen.a)) shen.a)) shen.a)) shen.a)) (stoutput))) +(defun shen.output-track (V5902 V5903 V5904) (pr (cn " +" (shen.app (shen.spaces V5902) (cn "<" (shen.app V5902 (cn "> Output from " (shen.app V5903 (cn " +" (shen.app (shen.spaces V5902) (cn "==> " (shen.app V5904 "" shen.s)) shen.a)) shen.a)) shen.a)) shen.a)) (stoutput))) -(defun untrack (V5425) (do (set shen.*tracking* (remove V5425 (value shen.*tracking*))) (do (trap-error (eval (ps V5425)) (lambda Z5426 V5425)) V5425))) +(defun untrack (V5905) (do (set shen.*tracking* (remove V5905 (value shen.*tracking*))) (do (trap-error (eval (ps V5905)) (lambda Z5906 V5905)) V5905))) -(defun remove (V5427 V5428) (shen.remove-h V5427 V5428 ())) +(defun remove (V5907 V5908) (shen.remove-h V5907 V5908 ())) -(defun shen.remove-h (V5438 V5439 V5440) (cond ((= () V5439) (reverse V5440)) ((and (cons? V5439) (= V5438 (hd V5439))) (shen.remove-h (hd V5439) (tl V5439) V5440)) ((cons? V5439) (shen.remove-h V5438 (tl V5439) (cons (hd V5439) V5440))) (true (simple-error "implementation error in shen.remove-h")))) +(defun shen.remove-h (V5918 V5919 V5920) (cond ((= () V5919) (reverse V5920)) ((and (cons? V5919) (= V5918 (hd V5919))) (shen.remove-h (hd V5919) (tl V5919) V5920)) ((cons? V5919) (shen.remove-h V5918 (tl V5919) (cons (hd V5919) V5920))) (true (simple-error "implementation error in shen.remove-h")))) -(defun profile (V5441) (do (set shen.*profiled* (cons V5441 (value shen.*profiled*))) (shen.profile-help (ps V5441)))) +(defun profile (V5921) (do (set shen.*profiled* (cons V5921 (value shen.*profiled*))) (shen.profile-help (ps V5921)))) -(defun shen.profile-help (V5444) (cond ((and (cons? V5444) (and (= defun (hd V5444)) (and (cons? (tl V5444)) (and (cons? (tl (tl V5444))) (and (cons? (tl (tl (tl V5444)))) (= () (tl (tl (tl (tl V5444)))))))))) (let W5445 (gensym shen.f) (let W5446 (cons defun (cons (hd (tl V5444)) (cons (hd (tl (tl V5444))) (cons (shen.profile-func (hd (tl V5444)) (hd (tl (tl V5444))) (cons W5445 (hd (tl (tl V5444))))) ())))) (let W5447 (cons defun (cons W5445 (cons (hd (tl (tl V5444))) (cons (subst W5445 (hd (tl V5444)) (hd (tl (tl (tl V5444))))) ())))) (let W5448 (eval-kl W5446) (let W5449 (eval-kl W5447) (hd (tl V5444)))))))) (true (simple-error "Cannot profile. +(defun shen.profile-help (V5924) (cond ((and (cons? V5924) (and (= defun (hd V5924)) (and (cons? (tl V5924)) (and (cons? (tl (tl V5924))) (and (cons? (tl (tl (tl V5924)))) (= () (tl (tl (tl (tl V5924)))))))))) (let W5925 (gensym shen.f) (let W5926 (cons defun (cons (hd (tl V5924)) (cons (hd (tl (tl V5924))) (cons (shen.profile-func (hd (tl V5924)) (hd (tl (tl V5924))) (cons W5925 (hd (tl (tl V5924))))) ())))) (let W5927 (cons defun (cons W5925 (cons (hd (tl (tl V5924))) (cons (subst W5925 (hd (tl V5924)) (hd (tl (tl (tl V5924))))) ())))) (let W5928 (eval-kl W5926) (let W5929 (eval-kl W5927) (hd (tl V5924)))))))) (true (simple-error "Cannot profile. ")))) -(defun unprofile (V5450) (do (set shen.*profiled* (remove V5450 (value shen.*profiled*))) (trap-error (eval (ps V5450)) (lambda Z5451 V5450)))) +(defun unprofile (V5930) (do (set shen.*profiled* (remove V5930 (value shen.*profiled*))) (trap-error (eval (ps V5930)) (lambda Z5931 V5930)))) -(defun shen.profiled? (V5452) (element? V5452 (value shen.*profiled*))) +(defun shen.profiled? (V5932) (element? V5932 (value shen.*profiled*))) -(defun shen.profile-func (V5453 V5454 V5455) (cons let (cons Start (cons (cons get-time (cons run ())) (cons (cons let (cons Result (cons V5455 (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 V5453 (cons (cons + (cons (cons shen.get-profile (cons V5453 ())) (cons Finish ()))) ()))) (cons Result ())))) ())))) ())))) ()))))) +(defun shen.profile-func (V5933 V5934 V5935) (cons let (cons Start (cons (cons get-time (cons run ())) (cons (cons let (cons Result (cons V5935 (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 V5933 (cons (cons + (cons (cons shen.get-profile (cons V5933 ())) (cons Finish ()))) ()))) (cons Result ())))) ())))) ())))) ()))))) -(defun profile-results (V5456) (let W5457 (shen.get-profile V5456) (let W5458 (shen.put-profile V5456 0) (@p V5456 W5457)))) +(defun profile-results (V5936) (let W5937 (shen.get-profile V5936) (let W5938 (shen.put-profile V5936 0) (@p V5936 W5937)))) -(defun shen.get-profile (V5459) (trap-error (get V5459 profile (value *property-vector*)) (lambda Z5460 0))) +(defun shen.get-profile (V5939) (trap-error (get V5939 profile (value *property-vector*)) (lambda Z5940 0))) -(defun shen.put-profile (V5461 V5462) (put V5461 profile V5462 (value *property-vector*))) +(defun shen.put-profile (V5941 V5942) (put V5941 profile V5942 (value *property-vector*))) diff --git a/klambda/types.kl b/klambda/types.kl index 123bbed..82376f4 100644 --- a/klambda/types.kl +++ b/klambda/types.kl @@ -1,333 +1,13 @@ -(defun declare (V5507 V5508) (let W5509 (shen.rectify-type V5508) (let W5510 (((((lambda Z5511 (lambda Z5512 (lambda Z5513 (lambda Z5514 (do (shen.incinfs) (shen.variancy (receive (shen.deref V5507 Z5511)) (receive (shen.deref W5509 Z5511)) Z5511 Z5512 Z5513 Z5514)))))) (shen.prolog-vector)) (@v true (@v 0 (vector 0)))) 0) (freeze true)) (let W5515 (eval-kl (shen.prolog-abstraction V5508)) (let W5516 (set shen.*sigf* (shen.assoc-> V5507 W5515 (value shen.*sigf*))) V5507))))) +(defun declare (V6003 V6004) (let W6005 (shen.rectify-type V6004) (let W6006 (((((lambda Z6007 (lambda Z6008 (lambda Z6009 (lambda Z6010 (do (shen.incinfs) (shen.variancy (receive (shen.deref V6003 Z6007)) (receive (shen.deref W6005 Z6007)) Z6007 Z6008 Z6009 Z6010)))))) (shen.prolog-vector)) (@v true (@v 0 (vector 0)))) 0) (freeze true)) (let W6011 (eval-kl (shen.prolog-abstraction V6004)) (let W6012 (set shen.*sigf* (shen.assoc-> V6003 W6011 (value shen.*sigf*))) V6003))))) -(defun shen.variancy (V5517 V5518 V5519 V5520 V5521 V5522) (let W5523 (+ V5521 1) (let W5524 (if (shen.unlocked? V5520) (let W5525 (shen.lazyderef V5518 V5519) (let W5526 (lambda Z5527 (let W5528 (shen.newpv V5519) (shen.gc V5519 (do (shen.incinfs) (when (= (arity (shen.deref V5517 V5519)) 0) V5519 V5520 W5523 (freeze (shen.cut V5519 V5520 W5523 (freeze (shen.system-S-h (cons fn (cons V5517 ())) W5528 () V5519 V5520 W5523 (freeze (shen.variants? V5517 Z5527 W5528 V5519 V5520 W5523 V5522))))))))))) (if (cons? W5525) (let W5529 (shen.lazyderef (hd W5525) V5519) (let W5530 (freeze (let W5531 (shen.lazyderef (tl W5525) V5519) (let W5532 (lambda Z5533 (W5526 Z5533)) (if (cons? W5531) (let W5534 (hd W5531) (let W5535 (shen.lazyderef (tl W5531) V5519) (let W5536 (freeze (W5532 W5534)) (if (= W5535 ()) (thaw W5536) (if (shen.pvar? W5535) (shen.bind! W5535 () V5519 W5536) false))))) (if (shen.pvar? W5531) (let W5537 (shen.newpv V5519) (shen.gc V5519 (shen.bind! W5531 (cons W5537 ()) V5519 (freeze (W5532 W5537))))) false))))) (if (= W5529 -->) (thaw W5530) (if (shen.pvar? W5529) (shen.bind! W5529 --> V5519 W5530) false)))) (if (shen.pvar? W5525) (let W5538 (shen.newpv V5519) (shen.gc V5519 (shen.bind! W5525 (cons --> (cons W5538 ())) V5519 (freeze (W5526 W5538))))) false)))) false) (if (= W5524 false) (let W5539 (if (shen.unlocked? V5520) (let W5540 (shen.newpv V5519) (shen.gc V5519 (do (shen.incinfs) (shen.system-S-h (cons fn (cons V5517 ())) W5540 () V5519 V5520 W5523 (freeze (shen.variants? V5517 W5540 V5518 V5519 V5520 W5523 V5522)))))) false) (if (= W5539 false) (shen.unlock V5520 W5523) W5539)) W5524)))) +(defun shen.variancy (V6013 V6014 V6015 V6016 V6017 V6018) (if (shen.unlocked? V6016) (let W6019 (shen.newpv V6015) (shen.gc V6015 (let W6020 (shen.newpv V6015) (shen.gc V6015 (do (shen.incinfs) (shen.system-S-h (cons fn (cons V6013 ())) W6019 () V6015 V6016 V6017 (freeze (shen.variancy-signature V6013 W6019 W6020 V6015 V6016 V6017 (freeze (shen.variants? V6013 W6020 V6014 V6015 V6016 V6017 V6018)))))))))) false)) -(defun shen.variants? (V5541 V5542 V5543 V5544 V5545 V5546 V5547) (let W5548 (if (shen.unlocked? V5545) (do (shen.incinfs) (is! V5542 V5543 V5544 V5545 V5546 V5547)) false) (if (= W5548 false) (if (shen.unlocked? V5545) (let W5549 (shen.newpv V5544) (shen.gc V5544 (do (shen.incinfs) (is W5549 (pr (cn "warning: changing the type of " (shen.app (shen.deref V5541 V5544) " may create errors -" shen.a)) (stoutput)) V5544 V5545 V5546 V5547)))) false) W5548))) +(defun shen.variancy-signature (V6021 V6022 V6023 V6024 V6025 V6026 V6027) (let W6028 (+ V6026 1) (let W6029 (if (shen.unlocked? V6025) (let W6030 (shen.lazyderef V6023 V6024) (let W6031 (lambda Z6032 (do (shen.incinfs) (is! V6022 Z6032 V6024 V6025 W6028 (freeze (when (= (arity (shen.deref V6021 V6024)) 0) V6024 V6025 W6028 (freeze (shen.cut V6024 V6025 W6028 V6027))))))) (if (cons? W6030) (let W6033 (shen.lazyderef (hd W6030) V6024) (let W6034 (freeze (let W6035 (shen.lazyderef (tl W6030) V6024) (let W6036 (lambda Z6037 (W6031 Z6037)) (if (cons? W6035) (let W6038 (hd W6035) (let W6039 (shen.lazyderef (tl W6035) V6024) (let W6040 (freeze (W6036 W6038)) (if (= W6039 ()) (thaw W6040) (if (shen.pvar? W6039) (shen.bind! W6039 () V6024 W6040) false))))) (if (shen.pvar? W6035) (let W6041 (shen.newpv V6024) (shen.gc V6024 (shen.bind! W6035 (cons W6041 ()) V6024 (freeze (W6036 W6041))))) false))))) (if (= W6033 -->) (thaw W6034) (if (shen.pvar? W6033) (shen.bind! W6033 --> V6024 W6034) false)))) (if (shen.pvar? W6030) (let W6042 (shen.newpv V6024) (shen.gc V6024 (shen.bind! W6030 (cons --> (cons W6042 ())) V6024 (freeze (W6031 W6042))))) false)))) false) (if (= W6029 false) (let W6043 (if (shen.unlocked? V6025) (do (shen.incinfs) (is! V6022 V6023 V6024 V6025 W6028 V6027)) false) (if (= W6043 false) (shen.unlock V6025 W6028) W6043)) W6029)))) -(defun shen.prolog-abstraction (V5550) (let W5551 (gensym B) (let W5552 (gensym L) (let W5553 (gensym Key) (let W5554 (gensym C) (let W5555 (gensym V) (let W5556 (shen.extract-vars V5550) (cons lambda (cons W5555 (cons (cons lambda (cons W5551 (cons (cons lambda (cons W5552 (cons (cons lambda (cons W5553 (cons (cons lambda (cons W5554 (cons (shen.stpart W5556 (cons is! (cons W5555 (cons (shen.rcons_form V5550) (cons W5551 (cons W5552 (cons W5553 (cons W5554 ()))))))) W5551) ()))) ()))) ()))) ()))) ())))))))))) +(defun shen.variants? (V6044 V6045 V6046 V6047 V6048 V6049 V6050) (let W6051 (if (shen.unlocked? V6048) (do (shen.incinfs) (is! V6045 V6046 V6047 V6048 V6049 V6050)) false) (if (= W6051 false) (if (shen.unlocked? V6048) (let W6052 (shen.newpv V6047) (shen.gc V6047 (do (shen.incinfs) (is W6052 (pr (cn "warning: changing the type of " (shen.app (shen.deref V6044 V6047) " may create errors +" shen.a)) (stoutput)) V6047 V6048 V6049 V6050)))) false) W6051))) -(defun shen.demod (V5557) V5557) +(defun shen.prolog-abstraction (V6053) (let W6054 (gensym B) (let W6055 (gensym L) (let W6056 (gensym Key) (let W6057 (gensym C) (let W6058 (gensym V) (let W6059 (shen.extract-vars V6053) (cons lambda (cons W6058 (cons (cons lambda (cons W6054 (cons (cons lambda (cons W6055 (cons (cons lambda (cons W6056 (cons (cons lambda (cons W6057 (cons (shen.stpart W6059 (cons is! (cons W6058 (cons (shen.rcons_form V6053) (cons W6054 (cons W6055 (cons W6056 (cons W6057 ()))))))) W6054) ()))) ()))) ()))) ()))) ())))))))))) -(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 ()))) ())))) +(defun shen.demod (V6060) (let W6061 (value shen.*demodulation-function*) (W6061 V6060))) diff --git a/klambda/writer.kl b/klambda/writer.kl index 61f713e..18a0ebb 100644 --- a/klambda/writer.kl +++ b/klambda/writer.kl @@ -1,52 +1,56 @@ -(defun print (V5602) (let W5603 (shen.insert V5602 "~S") (let W5604 (pr W5603 (stoutput)) V5602))) +(defun print (V6928) (let W6929 (shen.insert V6928 "~S") (let W6930 (pr W6929 (stoutput)) V6928))) -(defun pr (V5605 V5606) (if (value *hush*) V5605 (if (shen.char-stoutput? V5606) (shen.write-string V5605 V5606) (shen.write-chars V5605 V5606 (shen.string->byte V5605 0) 1)))) +(defun pr (V6931 V6932) (if (value *hush*) V6931 (if (shen.char-stoutput? V6932) (shen.write-string V6931 V6932) (shen.write-chars V6931 V6932 (shen.string->byte V6931 0) 1)))) -(defun shen.string->byte (V5607 V5608) (trap-error (string->n (pos V5607 V5608)) (lambda Z5609 shen.eos))) +(defun shen.string->byte (V6933 V6934) (trap-error (string->n (pos V6933 V6934)) (lambda Z6935 shen.eos))) -(defun shen.write-chars (V5610 V5611 V5612 V5613) (cond ((= shen.eos V5612) V5610) (true (shen.write-chars V5610 V5611 (do (write-byte V5612 V5611) (shen.string->byte V5610 V5613)) (+ V5613 1))))) +(defun shen.write-chars (V6936 V6937 V6938 V6939) (cond ((= shen.eos V6938) V6936) (true (shen.write-chars V6936 V6937 (do (write-byte V6938 V6937) (shen.string->byte V6936 V6939)) (+ V6939 1))))) -(defun shen.mkstr (V5614 V5615) (cond ((string? V5614) (shen.mkstr-l (shen.proc-nl V5614) V5615)) (true (shen.mkstr-r (cons shen.proc-nl (cons V5614 ())) V5615)))) +(defun shen.mkstr (V6940 V6941) (cond ((string? V6940) (shen.mkstr-l (shen.proc-nl V6940) V6941)) (true (shen.mkstr-r (cons shen.proc-nl (cons V6940 ())) V6941)))) -(defun shen.mkstr-l (V5620 V5621) (cond ((= () V5621) V5620) ((cons? V5621) (shen.mkstr-l (shen.insert-l (hd V5621) V5620) (tl V5621))) (true (simple-error "implementation error in shen.mkstr-l")))) +(defun shen.mkstr-l (V6946 V6947) (cond ((= () V6947) V6946) ((cons? V6947) (shen.mkstr-l (shen.insert-l (hd V6947) V6946) (tl V6947))) (true (simple-error "implementation error in shen.mkstr-l")))) -(defun shen.insert-l (V5628 V5629) (cond ((= "" V5629) "") ((and (shen.+string? V5629) (and (= "~" (hdstr V5629)) (and (shen.+string? (tlstr V5629)) (= "A" (hdstr (tlstr V5629)))))) (cons shen.app (cons V5628 (cons (tlstr (tlstr V5629)) (cons shen.a ()))))) ((and (shen.+string? V5629) (and (= "~" (hdstr V5629)) (and (shen.+string? (tlstr V5629)) (= "R" (hdstr (tlstr V5629)))))) (cons shen.app (cons V5628 (cons (tlstr (tlstr V5629)) (cons shen.r ()))))) ((and (shen.+string? V5629) (and (= "~" (hdstr V5629)) (and (shen.+string? (tlstr V5629)) (= "S" (hdstr (tlstr V5629)))))) (cons shen.app (cons V5628 (cons (tlstr (tlstr V5629)) (cons shen.s ()))))) ((shen.+string? V5629) (shen.factor-cn (cons cn (cons (hdstr V5629) (cons (shen.insert-l V5628 (tlstr V5629)) ()))))) ((and (cons? V5629) (and (= cn (hd V5629)) (and (cons? (tl V5629)) (and (cons? (tl (tl V5629))) (= () (tl (tl (tl V5629)))))))) (cons cn (cons (hd (tl V5629)) (cons (shen.insert-l V5628 (hd (tl (tl V5629)))) ())))) ((and (cons? V5629) (and (= shen.app (hd V5629)) (and (cons? (tl V5629)) (and (cons? (tl (tl V5629))) (and (cons? (tl (tl (tl V5629)))) (= () (tl (tl (tl (tl V5629)))))))))) (cons shen.app (cons (hd (tl V5629)) (cons (shen.insert-l V5628 (hd (tl (tl V5629)))) (tl (tl (tl V5629))))))) (true (simple-error "implementation error in shen.insert-l")))) +(defun shen.insert-l (V6954 V6955) (cond ((= "" V6955) "") ((and (shen.+string? V6955) (and (= "~" (hdstr V6955)) (and (shen.+string? (tlstr V6955)) (= "A" (hdstr (tlstr V6955)))))) (cons shen.app (cons V6954 (cons (tlstr (tlstr V6955)) (cons shen.a ()))))) ((and (shen.+string? V6955) (and (= "~" (hdstr V6955)) (and (shen.+string? (tlstr V6955)) (= "R" (hdstr (tlstr V6955)))))) (cons shen.app (cons V6954 (cons (tlstr (tlstr V6955)) (cons shen.r ()))))) ((and (shen.+string? V6955) (and (= "~" (hdstr V6955)) (and (shen.+string? (tlstr V6955)) (= "S" (hdstr (tlstr V6955)))))) (cons shen.app (cons V6954 (cons (tlstr (tlstr V6955)) (cons shen.s ()))))) ((shen.+string? V6955) (shen.factor-cn (cons cn (cons (hdstr V6955) (cons (shen.insert-l V6954 (tlstr V6955)) ()))))) ((and (cons? V6955) (and (= cn (hd V6955)) (and (cons? (tl V6955)) (and (cons? (tl (tl V6955))) (= () (tl (tl (tl V6955)))))))) (cons cn (cons (hd (tl V6955)) (cons (shen.insert-l V6954 (hd (tl (tl V6955)))) ())))) ((and (cons? V6955) (and (= shen.app (hd V6955)) (and (cons? (tl V6955)) (and (cons? (tl (tl V6955))) (and (cons? (tl (tl (tl V6955)))) (= () (tl (tl (tl (tl V6955)))))))))) (cons shen.app (cons (hd (tl V6955)) (cons (shen.insert-l V6954 (hd (tl (tl V6955)))) (tl (tl (tl V6955))))))) (true (simple-error "implementation error in shen.insert-l")))) -(defun shen.factor-cn (V5630) (cond ((and (cons? V5630) (and (= cn (hd V5630)) (and (cons? (tl V5630)) (and (cons? (tl (tl V5630))) (and (cons? (hd (tl (tl V5630)))) (and (= cn (hd (hd (tl (tl V5630))))) (and (cons? (tl (hd (tl (tl V5630))))) (and (cons? (tl (tl (hd (tl (tl V5630)))))) (and (= () (tl (tl (tl (hd (tl (tl V5630))))))) (and (= () (tl (tl (tl V5630)))) (and (string? (hd (tl V5630))) (string? (hd (tl (hd (tl (tl V5630))))))))))))))))) (cons cn (cons (cn (hd (tl V5630)) (hd (tl (hd (tl (tl V5630)))))) (tl (tl (hd (tl (tl V5630)))))))) (true V5630))) +(defun shen.factor-cn (V6956) (cond ((and (cons? V6956) (and (= cn (hd V6956)) (and (cons? (tl V6956)) (and (cons? (tl (tl V6956))) (and (cons? (hd (tl (tl V6956)))) (and (= cn (hd (hd (tl (tl V6956))))) (and (cons? (tl (hd (tl (tl V6956))))) (and (cons? (tl (tl (hd (tl (tl V6956)))))) (and (= () (tl (tl (tl (hd (tl (tl V6956))))))) (and (= () (tl (tl (tl V6956)))) (and (string? (hd (tl V6956))) (string? (hd (tl (hd (tl (tl V6956))))))))))))))))) (cons cn (cons (cn (hd (tl V6956)) (hd (tl (hd (tl (tl V6956)))))) (tl (tl (hd (tl (tl V6956)))))))) (true V6956))) -(defun shen.proc-nl (V5633) (cond ((= "" V5633) "") ((and (shen.+string? V5633) (and (= "~" (hdstr V5633)) (and (shen.+string? (tlstr V5633)) (= "%" (hdstr (tlstr V5633)))))) (cn (n->string 10) (shen.proc-nl (tlstr (tlstr V5633))))) ((shen.+string? V5633) (cn (hdstr V5633) (shen.proc-nl (tlstr V5633)))) (true (simple-error "implementation error in shen.proc-nl")))) +(defun shen.proc-nl (V6959) (cond ((= "" V6959) "") ((and (shen.+string? V6959) (and (= "~" (hdstr V6959)) (and (shen.+string? (tlstr V6959)) (= "%" (hdstr (tlstr V6959)))))) (cn (n->string 10) (shen.proc-nl (tlstr (tlstr V6959))))) ((shen.+string? V6959) (cn (hdstr V6959) (shen.proc-nl (tlstr V6959)))) (true (simple-error "implementation error in shen.proc-nl")))) -(defun shen.mkstr-r (V5638 V5639) (cond ((= () V5639) V5638) ((cons? V5639) (shen.mkstr-r (cons shen.insert (cons (hd V5639) (cons V5638 ()))) (tl V5639))) (true (simple-error "implementation error in shen.mkstr-r")))) +(defun shen.mkstr-r (V6964 V6965) (cond ((= () V6965) V6964) ((cons? V6965) (shen.mkstr-r (cons shen.insert (cons (hd V6965) (cons V6964 ()))) (tl V6965))) (true (simple-error "implementation error in shen.mkstr-r")))) -(defun shen.insert (V5640 V5641) (shen.insert-h V5640 V5641 "")) +(defun shen.insert (V6966 V6967) (shen.insert-h V6966 V6967 "")) -(defun shen.insert-h (V5650 V5651 V5652) (cond ((= "" V5651) V5652) ((and (shen.+string? V5651) (and (= "~" (hdstr V5651)) (and (shen.+string? (tlstr V5651)) (= "A" (hdstr (tlstr V5651)))))) (cn V5652 (shen.app V5650 (tlstr (tlstr V5651)) shen.a))) ((and (shen.+string? V5651) (and (= "~" (hdstr V5651)) (and (shen.+string? (tlstr V5651)) (= "R" (hdstr (tlstr V5651)))))) (cn V5652 (shen.app V5650 (tlstr (tlstr V5651)) shen.r))) ((and (shen.+string? V5651) (and (= "~" (hdstr V5651)) (and (shen.+string? (tlstr V5651)) (= "S" (hdstr (tlstr V5651)))))) (cn V5652 (shen.app V5650 (tlstr (tlstr V5651)) shen.s))) ((shen.+string? V5651) (shen.insert-h V5650 (tlstr V5651) (cn V5652 (hdstr V5651)))) (true (simple-error "implementation error in shen.insert-h")))) +(defun shen.insert-h (V6976 V6977 V6978) (cond ((= "" V6977) V6978) ((and (shen.+string? V6977) (and (= "~" (hdstr V6977)) (and (shen.+string? (tlstr V6977)) (= "A" (hdstr (tlstr V6977)))))) (cn V6978 (shen.app V6976 (tlstr (tlstr V6977)) shen.a))) ((and (shen.+string? V6977) (and (= "~" (hdstr V6977)) (and (shen.+string? (tlstr V6977)) (= "R" (hdstr (tlstr V6977)))))) (cn V6978 (shen.app V6976 (tlstr (tlstr V6977)) shen.r))) ((and (shen.+string? V6977) (and (= "~" (hdstr V6977)) (and (shen.+string? (tlstr V6977)) (= "S" (hdstr (tlstr V6977)))))) (cn V6978 (shen.app V6976 (tlstr (tlstr V6977)) shen.s))) ((shen.+string? V6977) (shen.insert-h V6976 (tlstr V6977) (cn V6978 (hdstr V6977)))) (true (simple-error "implementation error in shen.insert-h")))) -(defun shen.app (V5653 V5654 V5655) (cn (shen.arg->str V5653 V5655) V5654)) +(defun shen.app (V6979 V6980 V6981) (cn (shen.arg->str V6979 V6981) V6980)) -(defun shen.arg->str (V5659 V5660) (cond ((= V5659 (fail)) "...") ((shen.list? V5659) (shen.list->str V5659 V5660)) ((string? V5659) (shen.str->str V5659 V5660)) ((absvector? V5659) (shen.vector->str V5659 V5660)) (true (shen.atom->str V5659)))) +(defun shen.arg->str (V6985 V6986) (cond ((= V6985 (fail)) "...") ((shen.list? V6985) (shen.list->str V6985 V6986)) ((string? V6985) (shen.str->str V6985 V6986)) ((absvector? V6985) (shen.vector->str V6985 V6986)) (true (shen.atom->str V6985)))) -(defun shen.list->str (V5661 V5662) (cond ((= shen.r V5662) (@s "(" (@s (shen.iter-list V5661 shen.r (shen.maxseq)) ")"))) (true (@s "[" (@s (shen.iter-list V5661 V5662 (shen.maxseq)) "]"))))) +(defun shen.list->str (V6987 V6988) (cond ((= shen.r V6988) (@s "(" (@s (shen.iter-list V6987 shen.r (shen.maxseq)) ")"))) (true (@s "[" (@s (shen.iter-list V6987 V6988 (shen.maxseq)) "]"))))) (defun shen.maxseq () (value *maximum-print-sequence-size*)) -(defun shen.iter-list (V5673 V5674 V5675) (cond ((= () V5673) "") ((= 0 V5675) "... etc") ((and (cons? V5673) (= () (tl V5673))) (shen.arg->str (hd V5673) V5674)) ((cons? V5673) (@s (shen.arg->str (hd V5673) V5674) (@s " " (shen.iter-list (tl V5673) V5674 (- V5675 1))))) (true (@s "|" (@s " " (shen.arg->str V5673 V5674)))))) +(defun shen.iter-list (V6999 V7000 V7001) (cond ((= () V6999) "") ((= 0 V7001) "... etc") ((and (cons? V6999) (= () (tl V6999))) (shen.arg->str (hd V6999) V7000)) ((cons? V6999) (@s (shen.arg->str (hd V6999) V7000) (@s " " (shen.iter-list (tl V6999) V7000 (- V7001 1))))) (true (@s "|" (@s " " (shen.arg->str V6999 V7000)))))) -(defun shen.str->str (V5678 V5679) (cond ((= shen.a V5679) V5678) (true (@s (n->string 34) (@s V5678 (n->string 34)))))) +(defun shen.str->str (V7004 V7005) (cond ((= shen.a V7005) V7004) (true (@s (n->string 34) (@s V7004 (n->string 34)))))) -(defun shen.vector->str (V5680 V5681) (if (shen.print-vector? V5680) ((fn (<-address V5680 0)) V5680) (if (vector? V5680) (@s "<" (@s (shen.iter-vector V5680 1 V5681 (shen.maxseq)) ">")) (@s "<" (@s "<" (@s (shen.iter-vector V5680 0 V5681 (shen.maxseq)) ">>")))))) +(defun shen.vector->str (V7006 V7007) (if (shen.print-vector? V7006) ((fn (<-address V7006 0)) V7006) (if (vector? V7006) (@s "<" (@s (shen.iter-vector V7006 1 V7007 (shen.maxseq)) ">")) (@s "<" (@s "<" (@s (shen.iter-vector V7006 0 V7007 (shen.maxseq)) ">>")))))) -(defun shen.print-vector? (V5682) (let W5683 (<-address V5682 0) (if (= W5683 shen.tuple) true (if (= W5683 shen.pvar) true (if (not (number? W5683)) (shen.fbound? W5683) false))))) +(defun shen.empty-absvector? (V7008) (= V7008 (value shen.*empty-absvector*))) -(defun shen.fbound? (V5684) (not (= (arity V5684) -1))) +(defun shen.print-vector? (V7009) (and (not (shen.empty-absvector? V7009)) (let W7010 (<-address V7009 0) (or (= W7010 shen.tuple) (or (= W7010 shen.pvar) (or (= W7010 shen.dictionary) (and (not (number? W7010)) (shen.fbound? W7010)))))))) -(defun shen.tuple (V5685) (cn "(@p " (shen.app (<-address V5685 1) (cn " " (shen.app (<-address V5685 2) ")" shen.s)) shen.s))) +(defun shen.fbound? (V7011) (not (= (arity V7011) -1))) -(defun shen.iter-vector (V5692 V5693 V5694 V5695) (cond ((= 0 V5695) "... etc") (true (let W5696 (trap-error (<-address V5692 V5693) (lambda Z5697 shen.out-of-bounds)) (let W5698 (trap-error (<-address V5692 (+ V5693 1)) (lambda Z5699 shen.out-of-bounds)) (if (= W5696 shen.out-of-bounds) "" (if (= W5698 shen.out-of-bounds) (shen.arg->str W5696 V5694) (@s (shen.arg->str W5696 V5694) (@s " " (shen.iter-vector V5692 (+ V5693 1) V5694 (- V5695 1))))))))))) +(defun shen.tuple (V7012) (cn "(@p " (shen.app (<-address V7012 1) (cn " " (shen.app (<-address V7012 2) ")" shen.s)) shen.s))) -(defun shen.atom->str (V5700) (trap-error (str V5700) (lambda Z5701 (shen.funexstring)))) +(defun shen.dictionary (V7013) "(dict ...)") + +(defun shen.iter-vector (V7020 V7021 V7022 V7023) (cond ((= 0 V7023) "... etc") (true (let W7024 (trap-error (<-address V7020 V7021) (lambda Z7025 shen.out-of-bounds)) (let W7026 (trap-error (<-address V7020 (+ V7021 1)) (lambda Z7027 shen.out-of-bounds)) (if (= W7024 shen.out-of-bounds) "" (if (= W7026 shen.out-of-bounds) (shen.arg->str W7024 V7022) (@s (shen.arg->str W7024 V7022) (@s " " (shen.iter-vector V7020 (+ V7021 1) V7022 (- V7023 1))))))))))) + +(defun shen.atom->str (V7028) (trap-error (str V7028) (lambda Z7029 (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? (V5702) (or (empty? V5702) (cons? V5702))) +(defun shen.list? (V7030) (or (empty? V7030) (cons? V7030))) diff --git a/klambda/yacc.kl b/klambda/yacc.kl index fc9c6e3..12226dc 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 (simple-error "partial function shen.syntax-error-message")))) +") ((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)))) (defun shen.parse-failure? (V126) (= V126 (fail))) @@ -94,13 +94,13 @@ (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) (hd (tl V390))) +(defun shen.<-out (V392) (cond ((and (cons? V392) (and (cons? (tl V392)) (= () (tl (tl V392))))) (hd (tl V392))) (true (hd (tl V392))))) -(defun shen.in-> (V391) (hd V391)) +(defun shen.in-> (V393) (hd V393)) -(defun (V392) (cons () (cons V392 ()))) +(defun (V394) (cons () (cons V394 ()))) -(defun (V393) (cons V393 (cons () ()))) +(defun (V395) (cons V395 (cons () ()))) -(defun (V396) (cond ((= () V396) (cons () (cons () ()))) (true (shen.parse-failure)))) +(defun (V398) (cond ((= () V398) (cons () (cons () ()))) (true (shen.parse-failure)))) diff --git a/lib/StLib/Calendar/date.shen b/lib/StLib/Calendar/date.shen deleted file mode 100644 index 60c6963..0000000 --- a/lib/StLib/Calendar/date.shen +++ /dev/null @@ -1,160 +0,0 @@ -\\ Copyright (c) 2016, Mark Tarver - -(package calendar [now internal-date unix gmt] - -(datatype globals - - _______________ - (value *gmt*) : (symbol * number * number * number);) - -(define gmt - {symbol --> number --> number --> number --> (symbol * number * number * number)} - Plus/Minus Hours Minutes Seconds - -> (set *gmt* (@p Plus/Minus Hours Minutes Seconds)) - where (validate-gmt? Plus/Minus Hours Minutes Seconds) - _ _ _ _ -> (error "error in GMT setting~%")) - -(define validate-gmt? - {symbol --> number --> number --> number --> boolean} - Plus/Minus Hours Minutes Seconds - -> (cases (not (element? Plus/Minus [+ -])) false - (not (and (integer? Hours) (integer? Minutes) (integer? Seconds))) false - (= Hours 12) (and (= Minutes 0) (= Seconds 0)) - (and (>= Hours 0) - (<= Hours 11) - (>= Minutes 0) - (<= Minutes 59) - (>= Seconds 0) - (<= Seconds 59)) true - true false)) - -(gmt + 0 0 0) - -(define now - {number --> string} - Days -> (internal-date->string (internal-date Days))) - -(define internal-date - {number --> (list number)} - Days -> (let UnixDate (+ (* 24 3600 Days) - (get-time unix) - (gmt-time (value *gmt*))) - (if (> 0 UnixDate) - (error "cannot regress date before 1970~%") - (internal-date-h - UnixDate - (- 0 (* 24 3600)) - 1970 - year - []))) where (integer? Days) - _ -> (error "internal-date requires an integer~%")) - -(define gmt-time - {(symbol * number * number * number) --> number} - (@p - Hours Minutes Seconds) -> (- 0 (+ (* 3600 Hours) (* 60 Minutes) Seconds)) - (@p + Hours Minutes Seconds) -> (+ (* 3600 Hours) (* 60 Minutes) Seconds)) - -(define internal-date-h - {number --> number --> number --> symbol --> (list number) --> (list number)} - Now Now Count _ Date -> [Count | Date] - Now Then Count Interval Date - -> (let Then' (+ (seconds-in Count Interval Date) Then) - (if (> Then' Now) - (let NextInterval (next-interval Interval) - Start (start-interval NextInterval) - (internal-date-h Now Then Start NextInterval [Count | Date])) - (internal-date-h Now Then' (+ Count 1) Interval Date)))) - -(define start-interval - {symbol --> number} - month -> 1 - day -> 0 - hour -> 0 - minute -> 0 - second -> 0) - -(define seconds-in - {number --> symbol --> (list number) --> number} - Count year _ -> (if (leap? Count) - (* 366 24 3600) - (* 365 24 3600)) - 2 month [Year] -> (* 29 24 3600) where (leap? Year) - Count month _ -> (* (days-in-month Count) 24 3600) - _ day _ -> (* 24 3600) - _ hour _ -> 3600 - _ minute _ -> 60 - _ second _ -> 1) - -(define next-interval - {symbol --> symbol} - year -> month - month -> day - day -> hour - hour -> minute - minute -> second) - -(define days-in-month - {number --> number} - 1 -> 31 - 2 -> 28 - 3 -> 31 - 4 -> 30 - 5 -> 31 - 6 -> 30 - 7 -> 31 - 8 -> 31 - 9 -> 30 - 10 -> 31 - 11 -> 30 - 12 -> 31) - -(define leap? - {number --> boolean} - Year -> (cases (integer? (/ Year 400)) true - (integer? (/ Year 100)) false - (integer? (/ Year 4)) true - true false)) - -(define internal-date->string - {(list number) --> string} - [Seconds Minutes Hours Days Months Year] - -> (make-string "~A:~A:~A, ~A~A ~A, ~A ~A" - (pad Hours) (pad Minutes) (pad Seconds) - Days (postfix-day Days) (month Months) Year (gmt-string (value *gmt*)))) - -(define gmt-string - {(symbol * number * number * number) --> string} - (@p Plus/Minus Hours Minutes Seconds) - -> (make-string "~AGMT ~A:~A:~A" Plus/Minus (pad Hours) (pad Minutes) (pad Seconds))) - -(define pad - {number --> string} - N -> (make-string "~A" N) where (> N 9) - N -> (make-string "0~A" N)) - -(define postfix-day - {number --> string} - 1 -> "st" - 21 -> "st" - 31 -> "st" - 2 -> "nd" - 22 -> "nd" - 3 -> "rd" - 23 -> "rd" - _ -> "th") - -(define month - {number --> string} - 1 -> "January" - 2 -> "February" - 3 -> "March" - 4 -> "April" - 5 -> "May" - 6 -> "June" - 7 -> "July" - 8 -> "August" - 9 -> "September" - 10 -> "October" - 11 -> "November" - 12 -> "December")) - diff --git a/lib/StLib/Data/data.shen b/lib/StLib/Data/data.shen deleted file mode 100644 index cfd3fc1..0000000 --- a/lib/StLib/Data/data.shen +++ /dev/null @@ -1,26 +0,0 @@ -(package file [read-data eval-data] - -(declare read-data [string --> [list unit]]) -(declare eval-data [string -->[list unit]]) - -(define read-data - File -> (let In (open File in) - (read-data-loop (trap-read In) In []))) - -(define read-data-loop - eof! In Acc -> (do (close In) (reverse Acc)) - Read In Acc -> (read-data-loop (trap-read In) In [Read | Acc])) - -(define trap-read - In -> (trap-error (read In) (/. E eof!))) - -(define eval-data - File -> (let In (open File in) - (eval-data-loop (trap-eval In) In []))) - -(define eval-data-loop - eof! In Acc -> (do (close In) (reverse Acc)) - Read In Acc -> (eval-data-loop (trap-eval In) In [Read | Acc])) - -(define trap-eval - In -> (trap-error (eval (read In)) (/. E eof!))) ) \ No newline at end of file diff --git a/lib/StLib/IO/delete-file.shen b/lib/StLib/IO/delete-file.shen deleted file mode 100644 index e03b82c..0000000 --- a/lib/StLib/IO/delete-file.shen +++ /dev/null @@ -1,7 +0,0 @@ -(define delete-file - {string --> (list A)} - File -> (cases (= (language) "Common Lisp") (lisp.delete-file File) - true (close (open File out)))) - -(declare delete-file [string --> [list A]]) - \ No newline at end of file diff --git a/lib/StLib/IO/files.shen b/lib/StLib/IO/files.shen deleted file mode 100644 index 0031f43..0000000 --- a/lib/StLib/IO/files.shen +++ /dev/null @@ -1,83 +0,0 @@ -(package file [append-files append-files-with-open-stream mapc - copy-file file-size reopen errout copy-file-with-open-stream - file-exists? newv ascii] - -(defmacro file-macro - [errout X Default ErrFile] -> (let Err (newv) - Open (newv) - Record (newv) - Close (newv) - E (newv) - [trap-error X [/. E [let Err [error-to-string E] - Open [trap-error [reopen ErrFile] [/. E [open ErrFile out]]] - Record [pr Err Open] - Close [close Open] - Default]]])) - -(define append-files - {(list string) --> string --> string} - Files File -> (let Stream (append-files-with-open-stream Files File) - Close (close Stream) - File)) - -(define append-files-with-open-stream - {(list string) --> string --> (stream out)} - Files File -> (error "cannot read and write to ~A at the same time~%" File) where (element? File Files) - Files File -> (let OutStream (open File out) - Write (mapc (/. F (read&write (open F in) OutStream)) Files) - OutStream)) - -(define read&write - {(stream in) --> (stream out) --> number} - In Out -> (read&write-h (read-byte In) In Out)) - -(define read&write-h - {number --> (stream in) --> (stream out) --> number} - -1 In Out -> -1 - Byte In Out -> (read&write-h (read-byte In) In (do (write-byte Byte Out) Out))) - -(define reopen - {string --> (stream out)} - File -> (let ByteList (read-file-as-bytelist File) - Open (open File out) - Write (mapc (/. Byte (write-byte Byte Open)) ByteList) - Open)) - -(define copy-file - {string --> string --> string} - InFile OutFile -> (append-files [InFile] OutFile)) - -(define copy-file-with-open-stream - {string --> string --> (stream out)} - InFile OutFile -> (append-files-with-open-stream [InFile] OutFile)) - -(define file-exists? - {string --> boolean} - File -> (trap-error (do (close (open File in)) true) (/. E false))) - -(define file-size - {string --> number} - File -> (let Stream (open File in) - Size (file-size-loop Stream 0 (read-byte Stream)) - Close (close Stream) - Size)) - -(define file-size-loop - {(stream in) --> number --> number --> number} - _ Size -1 -> Size - Stream Size _ -> (file-size-loop Stream (+ 1 Size) (read-byte Stream))) - -(define ascii - {number --> number --> string --> string} - Min Max File -> (let Bytes (read-file-as-bytelist File) - (scan-bytes Min Max Bytes ""))) - -(define scan-bytes - {number --> number --> (list number) --> string --> string} - Min Max [] S -> S - Min Max [N | Ns] S - -> (scan-bytes Min Max Ns (cn S (n->string N))) - where (and (>= N Min) (<= N Max)) - Min Max [N | _] S -> (error "character has code ~A: parsed to here~%~%~A" N S)) ) - - \ No newline at end of file diff --git a/lib/StLib/IO/prettyprint.shen b/lib/StLib/IO/prettyprint.shen deleted file mode 100644 index df9f6be..0000000 --- a/lib/StLib/IO/prettyprint.shen +++ /dev/null @@ -1,83 +0,0 @@ -(package print (append (external maths) - [pps pprint pretty-string linelength indentation set-linelength set-indentation]) - -(datatype print - - _______________________________ - (value *indentation*) : number; - - _______________________________ - (value *linelength*) : number;) - -(defmacro pprint-macro - [pprint X] -> [pprint X [stoutput]] - [pps F] -> [pps F [stoutput]]) - -(set *indentation* 1) -(set *linelength* 60) - -(define linelength - {--> number} - -> (value *linelength*)) - -(define indentation - {--> number} - -> (value *indentation*)) - -(define set-linelength - {number --> number} - N -> (set *linelength* N) where (and (positive? N) (integer? N)) - N -> (error "line length must be a positive integer~%")) - -(define set-indentation - {number --> number} - N -> (set *indentation* N) where (and (positive? N) (integer? N)) - N -> (error "indentation must be a positive integer~%")) - -(define pps - {symbol --> (stream out) --> symbol} - F Sink -> (let Code (ps F) - Ugly (make-string "~R" Code) - Pretty (pretty-string Ugly) - PrettyPrint (pr Pretty Sink) - NL (nl) - F)) - -(define pprint - {A --> (stream out) --> A} - X Stream -> (let Ugly (make-string "~S" X) - Pretty (pretty-string Ugly) - PrettyPrint (pr Pretty Stream) - NL (nl) - X)) - -(define pretty-string - {string --> string} - S -> (pretty-string-h S 0 0)) - -(define pretty-string-h - {string --> number --> number --> string} - "" _ _ -> "" - (@s "[" Ss) Depth Length -> (@s (indent Depth) "[" (pretty-string-h Ss (+ Depth 1) 0)) - (@s "(" Ss) Depth Length -> (@s (indent Depth) "(" (pretty-string-h Ss (+ Depth 1) 0)) - (@s "]" Ss) Depth Length -> (@s "]" (pretty-string-h Ss (- Depth 1) 0)) - (@s ")" Ss) Depth Length -> (@s ")" (pretty-string-h Ss (- Depth 1) 0)) - (@s " " Ss) Depth Length -> (@s (indent Depth) (pretty-string-h Ss Depth 0)) where (> Length (linelength)) - (@s S Ss) Depth Length -> (@s S (pretty-string-h Ss Depth (+ Length 1)))) - -(define indent - {number --> string} - 0 -> "" - N -> (@s "c#10;" (indent-h N))) - -(define indent-h - {number --> string} - 0 -> "" - N -> (cn (n-space (indentation)) (indent-h (- N 1)))) - - (define n-space - {number --> string} - 0 -> "" - N -> (cn " " (n-space (- N 1)))) - - (preclude [print])) \ No newline at end of file diff --git a/lib/StLib/Lists/lists.shen b/lib/StLib/Lists/lists.shen deleted file mode 100644 index da4020c..0000000 --- a/lib/StLib/Lists/lists.shen +++ /dev/null @@ -1,267 +0,0 @@ -(package list [prefix? suffix? subset? set=? set? permute nthhd - cartprod powerset subbag? bag=? n-times - trim-right trim-left trim trim-right-if trim-left-if - trim-if assoc-if assoc-if-not infix? count-if count - remove-duplicates foldr foldl find mapf remove-if - some? every? mapc filter transitive-closure x->ascii - take take-last drop drop-last index index-last insert - splice sort partition] - -(define assoc-if - {(A --> boolean) --> (list (list A)) --> (list A)} - _ [] -> [] - F [[X | Y] | _] -> [X | Y] where (F X) - F [_ | Y] -> (assoc-if F Y)) - -(define assoc-if-not - {(A --> boolean) --> (list (list A)) --> (list A)} - _ [] -> [] - F [[X | Y] | _] -> [X | Y] where (not (F X)) - F [_ | Y] -> (assoc-if F Y)) - -(define drop - {number --> (list A) --> (list A)} - 0 L -> L - N [_ | Y] -> (drop (- N 1) Y)) - -(define drop-last - {number --> (list A) --> (list A)} - N L -> (reverse (drop N (reverse L)))) - -(define index - {A --> (list A) --> number} - X L -> (index-h X L 1)) - -(define index-h - {A --> (list A) --> number --> number} - _ [] _ -> -1 - X [X | _] N -> N - X [_ | Y] N -> (index-h X Y (+ N 1))) - -(define index-last - {A --> (list A) --> number} - X L -> (let Len (length L) - N (index X (reverse L)) - (if (= N -1) N (+ (- Len N) 1)))) - -(define insert - {number --> A --> (list A) --> (list A)} - _ X [] -> (error "cannot insert ~S into list: index out of range~%" X) - 1 X L -> [X | L] - N X [Y | Z] -> [Y | (insert (- N 1) X Z)]) - -(define remove-duplicates - {(list A) --> (list A)} - [] -> [] - [X | Y] -> (remove-duplicates Y) where (element? X Y) - [X | Y] -> [X | (remove-duplicates Y)]) - -(define trim-left-if - {(A --> boolean) --> (list A) --> (list A)} - _ [] -> [] - P [X | Y] -> (trim-left-if P Y) where (P X) - _ L -> L) - -(define trim-right-if - {(A --> boolean) --> (list A) --> (list A)} - P L -> (reverse (trim-left-if P (reverse L)))) - -(define trim-if - {(A --> boolean) --> (list A) --> (list A)} - P L -> (trim-right-if P (trim-left-if P L))) - -(define trim-left - {(list A) --> (list A) --> (list A)} - _ [] -> [] - Trim [X | Y] -> (trim-left Trim Y) where (element? X Trim) - _ L -> L) - -(define trim-right - {(list A) --> (list A) --> (list A)} - Trim L -> (reverse (trim-left Trim (reverse L)))) - -(define trim - {(list A) --> (list A) --> (list A)} - Trim L -> (trim-right Trim (trim-left Trim L))) - -(define prefix? - {(list A) --> (list A) --> boolean} - [] _ -> true - [X | Y] [X | Z] -> (prefix? Y Z) - _ _ -> false) - -(define infix? - {(list A) --> (list A) --> boolean} - L1 L2 -> true where (prefix? L1 L2) - _ [] -> false - L1 [_ | Y] -> (infix? L1 Y)) - -(define suffix? - {(list A) --> (list A) --> boolean} - L1 L2 -> (prefix? (reverse L1) (reverse L2))) - -(define subset? - {(list A) --> (list A) --> boolean} - [] _ -> true - [X | Y] Z -> (subset? Y Z) where (element? X Z) - _ _ -> false) - -(define set=? - {(list A) --> (list A) --> boolean} - L1 L2 -> (and (subset? L1 L2) (subset? L2 L1))) - -(define set? - {(list A) --> boolean} - [] -> true - [X | Y] -> false where (element? X Y) - [_ | Y] -> (set? Y)) - -(define n-times - {A --> number --> (list A)} - X N -> (n-times-h N X [])) - -(define n-times-h - {number --> A --> (list A) --> (list A)} - 0 X L -> L - N X L -> (n-times-h (- N 1) X [X | L])) - -(define subbag? - {(list A) --> (list A) --> boolean} - L1 L2 -> (every? (/. Z (= (count Z L1) (count Z L2))) L1)) - -(define bag=? - {(list A) --> (list A) --> boolean} - L1 L2 -> (and (subbag? L1 L2) (subbag? L2 L1))) - -(define mapc - {(A --> B) --> (list A) --> (list C)} - _ [] -> [] - F [X | Y] -> (mapc (do (F X) F) Y)) - -(define permute - {(list A) --> (list (list A))} - [] -> [[]] - XS -> (mapcan (/. EL (map (/. P [EL | P]) - (permute (remove EL XS)))) - XS)) - -(define count-if - {(A --> boolean) --> (list A) --> number} - P L -> (length (mapcan (/. Z (if (P Z) [Z] [])) L))) - -(define count - {A --> (list A) --> number} - X L -> (count-if (= X) L)) - -(define some? - {(A --> boolean) --> (list A) --> boolean} - _ [] -> false - P [X | _] -> true where (P X) - P [_ | Y] -> (some? P Y)) - -(define every? - {(A --> boolean) --> (list A) --> boolean} - _ [] -> true - P [X | Y] -> (every? P Y) where (P X) - _ _ -> false) - -(define sort - {(A --> A --> boolean) --> (list A) --> (list A)} - _ [] -> [] - _ [X] -> [X] - R [X | Y] -> (let Less (mapcan (/. Z (if (R Z X) [Z] [])) Y) - More (mapcan (/. Z (if (not (R Z X)) [Z] [])) Y) - (append (sort R Less) [X] (sort R More)))) - -(define find - {(A --> boolean) --> (list A) --> A} - _ [] -> (error "find has found no element~%") - P [X | _] -> X where (P X) - P [_ | Y] -> (find P Y)) - -(define foldr - {(A --> B --> B) --> B --> (list A) --> B} - _ X [] -> X - F X [Y | Z] -> (foldr F (F Y X) Z)) - -(define foldl - {(A --> B --> A) --> A --> (list B) --> A} - _ X [] -> X - F X [Y | Z] -> (foldl F (F X Y) Z)) - -(define mapf - {(A --> B) --> (list A) --> (B --> (list C) --> (list C)) --> (list C)} - _ [] _ -> [] - F [X | Y] C -> (C (F X) (mapf F Y C))) - -(define filter - {(A --> boolean) --> (list A) --> (list A)} - _ [] -> [] - F [X | Y] -> (if (F X) [X | (filter F Y)] (filter F Y))) - -(define remove-if - {(A --> boolean) --> (list A) --> (list A)} - _ [] -> [] - F [X | Y] -> (if (F X) (remove-if F Y) [X | (remove-if F Y)])) - -(define reduce - {(A --> B --> A) --> A --> (list B) --> A} - F Z [] -> Z - F Z [X | Xs] -> (reduce F (F Z X) Xs)) - -(define take - {number --> (list A) --> (list A)} - 0 _ -> [] - _ [] -> [] - N [X | L] -> [X | (take (- N 1) L)]) - -(define take-last - {number --> (list A) --> (list A)} - N L -> (reverse (take N (reverse L)))) - -(define cartprod - {(list A) --> (list A) --> (list (list A))} - [] _ -> [] - [X | Y] Z -> (append (map (/. W [X W]) Z) (cartprod Y Z))) - -(define powerset - {(list A) --> (list (list A))} - [] -> [[]] - [X | Y] -> (let P (powerset Y) - (append P (map (/. Z [X | Z]) P)))) - -(define partition - {(A --> A --> boolean) --> (list A) --> (list (list A))} - _ [] -> [] - R [X | Y] -> (let EQ (mapcan (/. Z (if (R X Z) [Z] [])) [X | Y]) - Remainder (difference [X | Y] EQ) - [EQ | (partition R Remainder)]) - _ _ -> (simple-error "partition equires a list")) - -(define transitive-closure - {(list (A * A)) --> (list (A * A))} - L -> (let T (transitive-pass L L) - (if (= T L) - T - (transitive-pass T T)))) - -(define transitive-pass - {(list (A * A)) --> (list (A * A)) --> (list (A * A))} - [] All -> All - [(@p X Y) | L] All -> (let Trans (find-trans X Y All) - (union Trans (transitive-pass L All)))) - -(define find-trans - {A --> A --> (list (A * A)) --> (list (A * A))} - _ _ [] -> [] - X Y [(@p Y Z) | All] -> [(@p X Z) | (find-trans X Y All)] - X Y [_ | All] -> (find-trans X Y All)) - -(define x->ascii - {A --> (list number)} - X -> (map (fn string->n) (explode X))) - -(define splice - {number --> (list A) --> (list A) --> (list A)} - 1 L1 L2 -> (append L1 L2) - N L [X | Y] -> [X | (splice (- N 1) L Y)]) ) \ No newline at end of file diff --git a/lib/StLib/Lists/lists.shen.kl b/lib/StLib/Lists/lists.shen.kl deleted file mode 100644 index ac35666..0000000 --- a/lib/StLib/Lists/lists.shen.kl +++ /dev/null @@ -1,110 +0,0 @@ -(defun assoc-if (V3391 V3392) (cond ((= () V3392) ()) ((and (and (cons? V3392) (cons? (hd V3392))) (V3391 (hd (hd V3392)))) (hd V3392)) ((cons? V3392) (assoc-if V3391 (tl V3392))) (true (shen.f_error assoc-if)))) - -(defun assoc-if-not (V3402 V3403) (cond ((= () V3403) ()) ((and (and (cons? V3403) (cons? (hd V3403))) (not (V3402 (hd (hd V3403))))) (hd V3403)) ((cons? V3403) (assoc-if V3402 (tl V3403))) (true (shen.f_error assoc-if-not)))) - -(defun drop (V3410 V3411) (cond ((= 0 V3410) V3411) ((cons? V3411) (drop (- V3410 1) (tl V3411))) (true (shen.f_error drop)))) - -(defun drop-last (V3414 V3415) (reverse (drop V3414 (reverse V3415)))) - -(defun index (V3418 V3419) (list.index-h V3418 V3419 1)) - -(defun list.index-h (V3434 V3435 V3436) (cond ((= () V3435) -1) ((and (cons? V3435) (= (hd V3435) V3434)) V3436) ((cons? V3435) (list.index-h V3434 (tl V3435) (+ V3436 1))) (true (shen.f_error list.index-h)))) - -(defun index-last (V3439 V3440) (let Len (length V3440) (let N (index V3439 (reverse V3440)) (if (= N -1) N (+ (- Len N) 1))))) - -(defun insert (V3446 V3447 V3448) (cond ((= () V3448) (simple-error (cn "cannot insert " (shen.app V3447 " into list: index out of range -" shen.s)))) ((= 1 V3446) (cons V3447 V3448)) ((cons? V3448) (cons (hd V3448) (insert (- V3446 1) V3447 (tl V3448)))) (true (shen.f_error insert)))) - -(defun remove-duplicates (V3450) (cond ((= () V3450) ()) ((and (cons? V3450) (element? (hd V3450) (tl V3450))) (remove-duplicates (tl V3450))) ((cons? V3450) (cons (hd V3450) (remove-duplicates (tl V3450)))) (true (shen.f_error remove-duplicates)))) - -(defun trim-left-if (V3459 V3460) (cond ((= () V3460) ()) ((and (cons? V3460) (V3459 (hd V3460))) (trim-left-if V3459 (tl V3460))) (true V3460))) - -(defun trim-right-if (V3463 V3464) (reverse (trim-left-if V3463 (reverse V3464)))) - -(defun trim-if (V3467 V3468) (trim-right-if V3467 (trim-left-if V3467 V3468))) - -(defun trim-left (V3477 V3478) (cond ((= () V3478) ()) ((and (cons? V3478) (element? (hd V3478) V3477)) (trim-left V3477 (tl V3478))) (true V3478))) - -(defun trim-right (V3481 V3482) (reverse (trim-left V3481 (reverse V3482)))) - -(defun trim (V3485 V3486) (trim-right V3485 (trim-left V3485 V3486))) - -(defun prefix? (V3500 V3501) (cond ((= () V3500) true) ((and (and (cons? V3500) (cons? V3501)) (= (hd V3501) (hd V3500))) (prefix? (tl V3500) (tl V3501))) (true false))) - -(defun infix? (V3510 V3511) (cond ((prefix? V3510 V3511) true) ((= () V3511) false) ((cons? V3511) (infix? V3510 (tl V3511))) (true (shen.f_error infix?)))) - -(defun suffix? (V3514 V3515) (prefix? (reverse V3514) (reverse V3515))) - -(defun subset? (V3528 V3529) (cond ((= () V3528) true) ((and (cons? V3528) (element? (hd V3528) V3529)) (subset? (tl V3528) V3529)) (true false))) - -(defun set=? (V3532 V3533) (and (subset? V3532 V3533) (subset? V3533 V3532))) - -(defun set? (V3539) (cond ((= () V3539) true) ((and (cons? V3539) (element? (hd V3539) (tl V3539))) false) ((cons? V3539) (set? (tl V3539))) (true (shen.f_error set?)))) - -(defun n-times (V3542 V3543) (list.n-times-h V3543 V3542 ())) - -(defun list.n-times-h (V3547 V3548 V3549) (cond ((= 0 V3547) V3549) (true (list.n-times-h (- V3547 1) V3548 (cons V3548 V3549))))) - -(defun subbag? (V3552 V3553) (every? (lambda Z (= (count Z V3552) (count Z V3553))) V3552)) - -(defun bag=? (V3556 V3557) (and (subbag? V3556 V3557) (subbag? V3557 V3556))) - -(defun mapc (V3562 V3563) (cond ((= () V3563) ()) ((cons? V3563) (mapc (do (V3562 (hd V3563)) V3562) (tl V3563))) (true (shen.f_error mapc)))) - -(defun permute (V3565) (cond ((= () V3565) (cons () ())) (true (mapcan (lambda EL (map (lambda P (cons EL P)) (permute (remove EL V3565)))) V3565)))) - -(defun partition (V3570 V3571) (cond ((= () V3571) ()) ((cons? V3571) (let EQ (mapcan (lambda Z (if (V3570 (hd V3571) Z) (cons Z ()) ())) V3571) (let Remainder (difference V3571 EQ) (cons EQ (partition V3570 Remainder))))) (true (shen.f_error partition)))) - -(defun count-if (V3574 V3575) (length (mapcan (lambda Z (if (V3574 Z) (cons Z ()) ())) V3575))) - -(defun count (V3578 V3579) (count-if (= V3578) V3579)) - -(defun some? (V3593 V3594) (cond ((= () V3594) false) ((and (cons? V3594) (V3593 (hd V3594))) true) ((cons? V3594) (some? V3593 (tl V3594))) (true (shen.f_error some?)))) - -(defun every? (V3607 V3608) (cond ((= () V3608) true) ((and (cons? V3608) (V3607 (hd V3608))) (every? V3607 (tl V3608))) (true false))) - -(defun sort (V3615 V3616) (cond ((= () V3616) ()) ((and (cons? V3616) (= () (tl V3616))) V3616) ((cons? V3616) (let Less (mapcan (lambda Z (if (V3615 Z (hd V3616)) (cons Z ()) ())) (tl V3616)) (let More (mapcan (lambda Z (if (not (V3615 Z (hd V3616))) (cons Z ()) ())) (tl V3616)) (append (sort V3615 Less) (append (cons (hd V3616) ()) (sort V3615 More)))))) (true (shen.f_error sort)))) - -(defun find (V3626 V3627) (cond ((= () V3627) (simple-error "find has found no element -")) ((and (cons? V3627) (V3626 (hd V3627))) (hd V3627)) ((cons? V3627) (find V3626 (tl V3627))) (true (shen.f_error find)))) - -(defun foldr (V3633 V3634 V3635) (cond ((= () V3635) V3634) ((cons? V3635) (foldr V3633 (V3633 (hd V3635) V3634) (tl V3635))) (true (shen.f_error foldr)))) - -(defun foldl (V3641 V3642 V3643) (cond ((= () V3643) V3642) ((cons? V3643) (foldl V3641 (V3641 V3642 (hd V3643)) (tl V3643))) (true (shen.f_error foldl)))) - -(defun mapf (V3651 V3652 V3653) (cond ((= () V3652) ()) ((cons? V3652) (V3653 (V3651 (hd V3652)) (mapf V3651 (tl V3652) V3653))) (true (shen.f_error mapf)))) - -(defun filter (V3658 V3659) (cond ((= () V3659) ()) ((cons? V3659) (if (V3658 (hd V3659)) (cons (hd V3659) (filter V3658 (tl V3659))) (filter V3658 (tl V3659)))) (true (shen.f_error filter)))) - -(defun remove-if (V3664 V3665) (cond ((= () V3665) ()) ((cons? V3665) (if (V3664 (hd V3665)) (remove-if V3664 (tl V3665)) (cons (hd V3665) (remove-if V3664 (tl V3665))))) (true (shen.f_error remove-if)))) - -(defun list.reduce (V3669 V3670 V3671) (cond ((= () V3671) V3670) ((cons? V3671) (list.reduce V3669 (V3669 V3670 (hd V3671)) (tl V3671))) (true (shen.f_error list.reduce)))) - -(defun take (V3678 V3679) (cond ((= 0 V3678) ()) ((= () V3679) ()) ((cons? V3679) (cons (hd V3679) (take (- V3678 1) (tl V3679)))) (true (shen.f_error take)))) - -(defun take-last (V3682 V3683) (reverse (take V3682 (reverse V3683)))) - -(defun cartprod (V3688 V3689) (cond ((= () V3688) ()) ((cons? V3688) (append (map (lambda W (cons (hd V3688) (cons W ()))) V3689) (cartprod (tl V3688) V3689))) (true (shen.f_error cartprod)))) - -(defun powerset (V3691) (cond ((= () V3691) (cons () ())) ((cons? V3691) (let P (powerset (tl V3691)) (append P (map (lambda Z (cons (hd V3691) Z)) P)))) (true (shen.f_error powerset)))) - -(defun transitive-closure (V3694 V3695) (let Table (list.transitivity-table V3694 V3695) (list.transitive-closure-loop Table))) - -(defun list.transitivity-table (V3698 V3699) (map (lambda X (@p open (cons X (list.xRy V3698 X V3699)))) V3699)) - -(defun list.xRy (V3703 V3704 V3705) (filter (lambda Y (V3703 V3704 Y)) V3705)) - -(defun list.transitive-closure-loop (V3707) (let NewTable (list.compute-closure V3707) (if (every? (function list.closed?) NewTable) (map (lambda V3380 (snd V3380)) NewTable) (list.transitive-closure-loop NewTable)))) - -(defun list.closed? (V3716) (cond ((and (tuple? V3716) (= list.closed (fst V3716))) true) (true false))) - -(defun list.compute-closure (V3718) (map (lambda Row (list.augment-row Row V3718)) V3718)) - -(defun list.augment-row (V3723 V3724) (cond ((and (tuple? V3723) (= list.closed (fst V3723))) V3723) ((and (and (tuple? V3723) (= open (fst V3723))) (cons? (snd V3723))) (let NewEntries (mapcan (lambda Entry (list.lookup Entry V3724)) (tl (snd V3723))) (let NewSet (remove-duplicates NewEntries) (if (empty? (difference NewSet (tl (snd V3723)))) (@p list.closed (snd V3723)) (@p open (cons (hd (snd V3723)) NewSet)))))) (true (shen.f_error list.augment-row)))) - -(defun list.lookup (V3736 V3737) (cond ((= () V3737) (cons V3736 ())) ((and (and (and (cons? V3737) (tuple? (hd V3737))) (cons? (snd (hd V3737)))) (= (hd (snd (hd V3737))) V3736)) (snd (hd V3737))) ((cons? V3737) (list.lookup V3736 (tl V3737))) (true (shen.f_error list.lookup)))) - -(defun x->ascii (V3739) (map (lambda V3381 (string->n V3381)) (explode V3739))) - -(defun splice (V3743 V3744 V3745) (cond ((= 1 V3743) (append V3744 V3745)) ((cons? V3745) (cons (hd V3745) (splice (- V3743 1) V3744 (tl V3745)))) (true (shen.f_error splice)))) - diff --git a/lib/StLib/Maths/complex.dtype b/lib/StLib/Maths/complex.dtype deleted file mode 100644 index d16d3ba..0000000 --- a/lib/StLib/Maths/complex.dtype +++ /dev/null @@ -1,31 +0,0 @@ -(package complex [c# complex? real imaginary complex] - -(define c# - R I -> (let C (absvector 3) - PrintF (address-> C 0 print-complex) - Rumerator (address-> C 1 R) - Ienominator (address-> C 2 I) - C) where (and (number? R) (number? I)) - R I -> (error "real ~A and imaginary ~A must be numbers~%" R I)) - -(define print-complex - C -> (make-string (cn "(c" "# ~A ~A)") (<-address C 1) (<-address C 2))) - -(define complex? - C -> (trap-error (and (absvector? C) - (= (<-address C 0) print-complex) - (number? (<-address C 1)) - (number? (<-address C 2))) (/. E false))) - -(define real - C -> (<-address C 1)) - -(define imaginary - C -> (<-address C 2)) - -(declare c# [number --> [number --> complex]]) -(declare complex? [A --> boolean]) -(declare real [complex --> number]) -(declare imaginary [complex --> number]) ) - - \ No newline at end of file diff --git a/lib/StLib/Maths/complex.shen b/lib/StLib/Maths/complex.shen deleted file mode 100644 index 37726b7..0000000 --- a/lib/StLib/Maths/complex.shen +++ /dev/null @@ -1,38 +0,0 @@ -(package complex (append [c+ c- c* c/] (external complex) (external maths)) - - (define c+ - {complex --> complex --> complex} - C1 C2 -> (let A (real C1) - B (imaginary C1) - C (real C2) - D (imaginary C2) - (c# (+ A C) (+ B D)))) - - (define c- - {complex --> complex --> complex} - C1 C2 -> (let A (real C1) - B (imaginary C1) - C (real C2) - D (imaginary C2) - (c# (- A C) (- B D)))) - - (define c* - {complex --> complex --> complex} - C1 C2 -> (let A (real C1) - B (imaginary C1) - C (real C2) - D (imaginary C2) - (c# (- (* A C) (* B D)) (+ (* B C) (* A D))))) - - (define c/ - {complex --> complex --> complex} - C1 C2 -> (let A (real C1) - B (imaginary C1) - C (real C2) - D (imaginary C2) - (c# (/ (+ (* A C) (* B D)) - (+ (* C C) (* D D))) - (/ (- (* B C) (* A D)) - (+ (* C C) (* D D)))))) - - ) \ No newline at end of file diff --git a/lib/StLib/Maths/macros.shen b/lib/StLib/Maths/macros.shen deleted file mode 100644 index 4cc0e0d..0000000 --- a/lib/StLib/Maths/macros.shen +++ /dev/null @@ -1,55 +0,0 @@ -(package maths [expt =r gcd lcd isqrt sqrt nthrt floor ceiling round mod lcm random min max - reseed ~ positive? negative? natural? converge series odd? even? - cos sin tan radians pi e tan30 cos30 cos45 sin45 sqrt2 tan60 sin120 - tan120 sin135 cos135 cos150 tan150 cos210 tan210 sin225 cos225 sin240 - tan240 sin300 tan300 sin315 cos315 cos330 tan330 sinh cosh tanh sech - csch power factorial prime? unix div modf product summation set-tolerance tolerance - coth for sq cube newv abs approx log log2 loge log10 g to stop done] - -(defmacro maths-macro - [log10 N] -> [log10 N [tolerance]] - [log2 N] -> [log2 N [tolerance]] - [loge N] -> [loge N [tolerance]] - [log M N] -> [log M N [tolerance]] - [sin N] -> [sin N [tolerance]] - [tan N] -> [tan N [tolerance]] - [cos N] -> [cos N [tolerance]] - [tanh N] -> [tanh N [tolerance]] - [cosh N] -> [cosh N [tolerance]] - [sinh N] -> [sinh N [tolerance]] - [sech N] -> [sech N [tolerance]] - [csch N] -> [csch N [tolerance]] - [coth N] -> [coth N [tolerance]] - [nthrt N Root] -> [nthrt N Root [tolerance]] - [sqrt N] -> [sqrt N [tolerance]] - [expt M N] -> [expt M N [tolerance]] - [max W X Y | Z] -> [max W [max X Y | Z]] - [min W X Y | Z] -> [min W [min X Y | Z]] - [tolerance N] -> [tolerance=n N] - [for X = Val stop Stop | Options+Procedure] -> [upto Val Stop | (process-options X Options+Procedure)] - [for X = Val to N | Options+Procedure] -> [upto Val [< N] | (process-options X Options+Procedure)]) - -(define process-options - X O+P -> (append (step-option O+P) - (constructor-option O+P) - (end-option O+P) - (process X O+P))) - -(define step-option - [] -> [[+ 1]] - [step Step | _] -> [Step] - [_ | O+P] -> (step-option O+P)) - -(define constructor-option - [] -> [[fn do]] - [constructor C | _] -> [C] - [_ | O+P] -> (constructor-option O+P)) - -(define end-option - [] -> [done] - [end End | _] -> [End] - [_ | O+P] -> (end-option O+P)) - -(define process - X [Process] -> [[/. X Process]] - X [_ | O+P] -> (process X O+P))) \ No newline at end of file diff --git a/lib/StLib/Maths/maths.shen b/lib/StLib/Maths/maths.shen deleted file mode 100644 index 849a3d1..0000000 --- a/lib/StLib/Maths/maths.shen +++ /dev/null @@ -1,542 +0,0 @@ -(package maths [expt =r gcd lcd isqrt sqrt nthrt floor ceiling round mod lcm random min max - reseed ~ positive? negative? natural? converge series odd? even? - cos sin tan radians pi e tan30 cos30 cos45 sin45 sqrt2 tan60 sin120 - tan120 sin135 cos135 cos150 tan150 cos210 tan210 sin225 cos225 sin240 - tan240 sin300 tan300 sin315 cos315 cos330 tan330 sinh cosh tanh sech - csch power factorial prime? unix div modf product summation set-tolerance tolerance - coth for sq cube newv abs approx log log2 loge log10 g] - - - -(datatype maths - - _________________ - (value *seed*) : number; - - _______________________ - (value *tolerance*) : number;) - -(set *seed* 95795) -(set *tolerance* .0001) - -(define set-tolerance - {number --> number} - N -> (set *tolerance* N)) - -(define tolerance - {--> number} - -> (value *tolerance*)) - -(define sq - {number --> number} - X -> (* X X)) - -(define cube - {number --> number} - X -> (* X X X)) - -(define for - {number --> (number --> boolean) - --> (number --> A) --> (number --> number) - --> (A --> A --> A) --> A} - Count Continue? Loop Inc Acc -> (for-h (Inc Count) Continue? Loop Inc Acc (Loop Count))) - -(define for-h - {number --> (number --> boolean) - --> (number --> A) --> (number --> number) --> (A --> A --> A) --> A --> A} - Count Continue? _ _ _ Result -> Result where (not (Continue? Count)) - Count Continue? Loop Inc Acc Result - -> (for-h (Inc Count) Continue? Loop Inc Acc (Acc Result (Loop Count) ))) - -(define lazyfor-and - {number --> (number --> boolean) - --> (number --> boolean) --> (number --> number) --> boolean} - Count Continue? _ _ -> true where (not (Continue? Count)) - Count Continue? Loop Inc -> (lazyfor-and (Inc Count) Continue? Loop Inc) where (Loop Count) - _ _ _ _ -> false) - -(define lazyfor-or - {number --> (number --> boolean) - --> (number --> boolean) --> (number --> number) --> boolean} - Count Continue? Loop Inc -> false where (not (Continue? Count)) - Count _ Loop _ -> true where (Loop Count) - Count Continue? Loop Inc -> (lazyfor-or (Inc Count) Continue? Loop Inc)) - -(define max - {number --> number --> number} - M N -> N where (> N M) - M _ -> M) - -(define min - {number --> number --> number} - M N -> N where (< N M) - M _ -> M) - -(define expt - {number --> number --> number --> number} - M N Tolerance -> (cases (= N 0) 1 - (positive? N) (expt-h M (n->r N 1) Tolerance) - true (/ 1 (expt-h M (n->r (~ N) 1) Tolerance)))) - -(define n->r - {number --> number --> (number * number)} - N D -> (@p N D) where (integer? N) - N D -> (n->r (* N 10) (* D 10))) - -(define expt-h - {number --> (number * number) --> number --> number} - M (@p N D) Tolerance -> (power (nthrt M D Tolerance) N)) - -(define gcd - {number --> number --> number} - M N -> (if (and (integer? M) (integer? N)) - (let M* (abs M) - N* (abs N) - (if (> M* N*) - (gcd-help (- M* N*) N*) - (gcd-help M* (- N* M*)))) - (error "gcd expects integer inputs"))) - -(define gcd-help - {number --> number --> number} - M N -> (if (> M N) - (gcd-loop M N N) - (gcd-loop M N M))) - -(define gcd-loop - {number --> number --> number --> number} - _ _ 1 -> 1 - M N Divisor -> Divisor where (and (integer? (/ M Divisor)) (integer? (/ N Divisor))) - M N Divisor -> (gcd-loop M N (- Divisor 1))) - -(define lcd - {number --> number --> number} - M N -> 2 where (and (even? M) (even? N)) - M N -> (lcd-loop M N (if (> M N) N M) 3)) - -(define lcd-loop - {number --> number --> number --> number --> number} - _ _ Max Divisor -> 1 where (> Divisor Max) - M N _ Divisor -> Divisor where (and (integer? (/ M Divisor)) (integer? (/ N Divisor))) - M N Max Divisor -> (lcd-loop M N Max (+ 2 Divisor))) - -(define isqrt - {number --> number} - N -> (isqrt-loop N 0)) - -(define isqrt-loop - {number --> number --> number} - N Sqrt -> Sqrt where (= (* Sqrt Sqrt) N) - N Sqrt -> (- Sqrt 1) where (> (* Sqrt Sqrt) N) - N Sqrt -> (isqrt-loop N (+ Sqrt 1))) - -(define div - {number --> number --> number} - N D -> (floor (/ N D))) - -(define modf - {number --> (number * number)} - N -> (let Floor (floor N) (@p Floor (- N Floor)))) - -(define floor - {number --> number} - N -> (~ (ceiling (~ N))) where (negative? N) - N -> (rounding-loop floor N 15 0)) - -(define rounding-loop - {symbol --> number --> number --> number --> number} - _ N 0 N -> N - K N 0 Guess -> (cases (= K floor) (- Guess 1) - (= K ceiling) Guess - (= K round) (let Up (- Guess N) - Down (- N (- Guess 1)) - (if (> Up Down) - (- Guess 1) - Guess))) where (> Guess N) - K N Exponent Guess -> (rounding-loop K N Exponent - (+ Guess (power 10 Exponent))) where (> N Guess) - K N Exponent Guess -> (rounding-loop K N (- Exponent 1) (- Guess (power 10 Exponent)))) - -(define float->pair - {number --> (number * number)} - N -> (let Floor (floor N) (@p Floor (- N Floor)))) - -(define ceiling - {number --> number} - N -> (~ (floor (~ N))) where (negative? N) - N -> (rounding-loop ceiling N 15 0)) - -(define round - {number --> number} - N -> (~ (round (~ N))) where (negative? N) - N -> (rounding-loop round N 15 0)) - -(define mod - {number --> number --> number} - X Y -> (let Div (/ X Y) - FloorDiv (floor Div) - (if (and (integer? X) (integer? Y)) - (round (* Y (- Div FloorDiv))) - (* Y (- Div FloorDiv))))) - -(define lcm - {(list number) --> number} - L -> (let Greatest (greatest L) - (lcm-h Greatest Greatest L))) - -(define greatest - {(list number) --> number} - [N] -> N - [M N | Ns] -> (greatest [M | Ns]) where (> M N) - [_ N | Ns] -> (greatest [N | Ns])) - -(define lcm-h - {number --> number --> (list number) --> number} - LCM Greatest L -> LCM where (lcm? LCM L) - LCM Greatest L -> (lcm-h (+ LCM Greatest) Greatest L)) - -(define lcm? - {number --> (list number) --> boolean} - _ [] -> true - LCM [N | Ns] -> (and (integer? (/ LCM N)) (lcm? LCM Ns))) - -(define random - {number --> number --> number} - Lower Upper -> (let Random (bbs (value *seed*)) - NewSeed (set *seed* Random) - Min (min Lower Upper) - (+ Min (mod NewSeed (abs (+ 1 (- Upper Lower))))))) - -(define min - {number --> number --> number} - X Y -> Y where (> X Y) - X _ -> X) - -(define reseed - {--> number} - -> (set *seed* (get-time unix))) - -(define bbs - {number --> number} - Xn -> (let M (* 1201 1213) - (mod (* Xn Xn) M))) - -(define ~ - {number --> number} - N -> (- 0 N)) - -(define positive? - {number --> boolean} - N -> (> N 0)) - -(define negative? - {number --> boolean} - N -> (< N 0)) - -(define natural? - {number --> boolean} - 0 -> true - N -> (and (integer? N) (positive? N))) - -(define converge - {A --> (A --> A) --> (A --> A --> boolean) --> A} - X F R -> (converge-help F (F X) X R)) - -(define converge-help - {(A --> A) --> A --> A --> (A --> A --> boolean) --> A} - _ New Old R -> New where (R Old New) - F New _ R -> (converge-help F (F New) New R)) - -(define nthrt - {number --> number --> number --> number} - A Root Tolerance -> (converge A (/. Xk (compute-nthrt A Xk Root Tolerance)) (approx Tolerance)) where (positive? A) - A _ _ -> (error "nthrt: negA must be a positive numberneg%" A)) - -(define sqrt - {number --> number --> number} - N Tolerance -> (nthrt N 2 Tolerance)) - -(define compute-nthrt - {number --> number --> number --> number --> number} - A Xk N Tolerance -> (let Reciprocal (/ 1 N) - N-1Xk (* (- N 1) Xk) - Xk (expt Xk (- N 1) Tolerance) - A/Xk (/ A Xk) - Add (+ N-1Xk A/Xk) - (* Reciprocal Add))) - -(define approx - {number --> (number --> number --> boolean)} - N -> (/. X Y (let Z (- X Y) (>= N (abs Z))))) - -(define abs - {number --> number} - N -> (if (>= N 0) N (- 0 N))) - -(define series - {number --> (number --> number) --> number --> (number --> number --> number) --> number} - Start TermF Tolerance Op -> (series-h (+ Start 1) Tolerance TermF (TermF Start) Op)) - -(define series-h - {number --> number --> (number --> number) --> number --> (number --> number --> number) --> number} - Count Tolerance TermF SoFar Op - -> (let Next (Op (TermF Count) SoFar) - (if (<= (abs (- SoFar Next)) Tolerance) - Next - (series-h (+ Count 1) - Tolerance - TermF - Next - Op)))) - -(define product - {number --> (number --> number) --> number --> number} - Start TermF Tolerance -> (series Start TermF Tolerance (fn *))) - -(define summation - {number --> (number --> number) --> number --> number} - Start TermF Tolerance -> (series Start TermF Tolerance (fn +))) - -(define odd? - {number --> boolean} - N -> (and (integer? N) (not (integer? (/ N 2))))) - -(define even? - {number --> boolean} - N -> (and (integer? N) (integer? (/ N 2)))) - -(define compute-sine - {number --> number --> number} - X N -> (let N*2+1 (+ (* 2 N) 1) - Numerator (* (power -1 N) (power X N*2+1)) - Denominator (factorial N*2+1) - (/ Numerator Denominator))) - -(define compute-cos - {number --> number --> number} - X N -> (let N*2 (* 2 N) - Numerator (* (power -1 N) (power X N*2)) - Denominator (factorial N*2) - (/ Numerator Denominator))) - -(define cos - {number --> number --> number} - Degrees Tolerance -> (let Radians (radians Degrees) - (summation 0 (compute-cos Radians) Tolerance))) - -(define sin - {number --> number --> number} - Degrees Tolerance -> (let Radians (radians Degrees) - (summation 0 (compute-sine Radians) Tolerance))) - -(define tan - {number --> number --> number} - Degrees Tolerance -> (/ (sin Degrees Tolerance) (cos Degrees Tolerance))) - -(define radians - {number --> number} - Degrees -> (* (/ Degrees 180) (pi))) - -(define g - {--> number} - -> 1.6180339887498) - -(define pi - {--> number} - -> 3.1415926535897) - -(define e - {--> number} - -> 2.7182818284590) - -(define tan30 - {--> number} - -> 0.5773502691896) - -(define cos30 - {--> number} - -> 0.8660254037844) - -(define cos45 - {--> number} - -> 0.70710678118651) - -(define sin45 - {--> number} - -> 0.7071067811865) - -(define sqrt2 - {--> number} - -> 1.4142135623731) - -(define tan60 - {--> number} - -> 1.7320508075692) - -(define sin60 - {--> number} - -> 0.8660254037844) - -(define sin120 - {--> number} - -> 0.8660254037844) - -(define tan120 -{--> number} - -> -1.7320508075692) - -(define sin135 -{--> number} - -> 0.7071067811865) - -(define cos135 -{--> number} - -> -0.7071067811865) - -(define cos150 -{--> number} - -> -0.8660254037844) - -(define tan150 -{--> number} - -> -0.5773502691905) - -(define cos210 - {--> number} - -> -0.8660254037844) - -(define tan210 -{--> number} - -> 0.5773502691905) - -(define sin225 -{--> number} - -> -0.7071067811865) - -(define cos225 -{--> number} - -> -0.7071067811865) - -(define sin240 -{--> number} - -> -0.8660254037844) - -(define tan240 -{--> number} - -> 1.7320508075692) - -(define sin300 -{--> number} - -> -0.8660254037844) - -(define tan300 -{--> number} - -> -1.7320508075692) - -(define sin315 -{--> number} - -> -0.7071067811865) - -(define cos315 -{--> number} - -> 0.7071067811865) - -(define cos330 -{--> number} - -> 0.8660254037844) - -(define tan330 -{--> number} - -> -0.5773502691905) - -(define coth - {number --> number --> number} - N Tolerance -> (let E (e) - E-2N (expt E (~ (* 2 N)) Tolerance) - (/ (+ 1 E-2N) (- 1 E-2N)))) - -(define sinh - {number --> number --> number} - N Tolerance -> (let E (e) - EN (expt E N Tolerance) - E-N (expt E (~ N) Tolerance) - Diff (- EN E-N) - (/ Diff 2))) - -(define cosh - {number --> number --> number} - N Tolerance -> (let E (e) - EN (expt E N Tolerance) - E-N (expt E (~ N) Tolerance) - Sum (+ EN E-N) - (/ Sum 2))) - -(define tanh - {number --> number --> number} - N Tolerance -> (/ (sinh N Tolerance) (cosh N Tolerance))) - -(define sech - {number --> number --> number} - N Tolerance -> (/ 1 (cosh N Tolerance))) - -(define csch - {number --> number --> number} - N Tolerance -> (/ 1 (sinh N Tolerance))) - -(define power - {number --> number --> number} - _ 0 -> 1 - N M -> (* N (power N (- M 1)))) - -(define factorial - {number --> number} - 0 -> 1 - N -> (* N (factorial (- N 1)))) - -(define prime? - {number --> boolean} - 2 -> true - N -> false where (even? N) - N -> (prime-h N (isqrt N) 3)) - -(define prime-h - {number --> number --> number --> boolean} - _ Sqrt Div -> true where (> Div Sqrt) - N Sqrt Div -> false where (integer? (/ N Div)) - N Sqrt Div -> (prime-h N Sqrt (+ Div 2))) - -(define sign - {number --> number} - 0 -> 0 - N -> 1 where (positive? N) - _ -> -1) - -(define log - {number --> number --> number --> number} - N Base Tolerance -> (/ (log10 N Tolerance) (log10 Base Tolerance))) - -(define loge - {number --> number --> number} - N Tolerance -> (log N (e) Tolerance)) - -(define log2 - {number --> number --> number} - N Tolerance -> (log N 2 Tolerance)) - -(define log10 - {number --> number --> number} - N Tolerance -> (if (>= N 1) - (log10+ N Tolerance) - (~ (log10+ (/ 1 N) Tolerance)))) - -(define log10+ - {number --> number --> number} - Zero Tolerance -> 0 where (<= (abs Zero) Tolerance) - N Tolerance -> (+ 1 (log10+ (/ N 10) Tolerance)) where (>= N 10) - N Tolerance -> (* 0.1 (log10+ (power N 10) (* 10 Tolerance)))) - -(define upto - {A --> (A --> boolean) --> (A --> A) - --> (B --> C --> C) --> C --> (A --> B) --> C} - N Stop? _ _ End _ -> End where (Stop? N) - N Stop? Step Constructor End F -> (Constructor (F N) (upto (Step N) Stop? Step Constructor End F))) ) \ No newline at end of file diff --git a/lib/StLib/Maths/numerals.dtype b/lib/StLib/Maths/numerals.dtype deleted file mode 100644 index 5d8f9dd..0000000 --- a/lib/StLib/Maths/numerals.dtype +++ /dev/null @@ -1,47 +0,0 @@ -(package numerals (append (external maths) [numeral? numeral radix n#->ns n# n#->n]) - - (define n# - N Radix -> (let Vector (absvector 4) - PrintV (address-> Vector 0 print-numeral) - NumbersV (address-> Vector 1 (n->numeral N Radix)) - BaseV (address-> Vector 2 Radix) - NV (address-> Vector 3 N) - Vector) where (and (natural? N) (natural? Radix) (> Radix 0)) - N Radix -> (error "N = ~A, Radix = ~A; N and Radix must be natural numbers where Radix > 0~%" - N Radix)) - - (define radix - Numeral -> (<-address Numeral 2)) - - (define numerals - Numeral -> (<-address Numeral 1)) - - (define n#->n - Numeral -> (<-address Numeral 3)) - - (declare radix [numeral --> number]) - (declare n#->ns [numeral --> [list number]]) - (declare n#->n [numeral --> number]) - (declare n# [number --> [number --> numeral]]) - (declare numeral? [A --> boolean]) - - (define n#->ns - Numeral -> (<-address Numeral 1)) - - (define print-numeral - Numeral -> (let Base (radix Numeral) - Ns (numerals Numeral) - (@s (numeric->string Ns Base) "#" (str Base)))) - - (define numeric->string - {(list number) --> number --> string} - [] _ -> "" - [N | Ns] Base -> (let Char (cases (< N 10) (str N) - (> Base 36) (cn (str N) " ") - true (n->string (+ N 55))) - (cn Char (numeric->string Ns Base)))) - - (define numeral? - Num -> (and (absvector? Num) (= print-numeral (<-address Num 0)))) - - ) \ No newline at end of file diff --git a/lib/StLib/Maths/numerals.shen b/lib/StLib/Maths/numerals.shen deleted file mode 100644 index 92d89cf..0000000 --- a/lib/StLib/Maths/numerals.shen +++ /dev/null @@ -1,91 +0,0 @@ -(package numerals [hex octal duodecimal binary - n-op2 n-op1 n+ n- n* n/ - | (append (external numerals) (external maths))] - -(defmacro numeral-macro - [n-op2 Op M N] -> [n-op2 Op M N [radix M]] - [n-op1 Op M] -> [n-op1 Op M [radix M]] - [n+ M N] -> [n+ M N [radix M]] - [n- M N] -> [n- M N [radix M]] - [n* M N] -> [n* M N [radix M]] - [n/ M N] -> [n/ M N [radix M]]) - -(define n-op2 - {(number --> number --> number) --> numeral --> numeral --> number --> numeral} - Op M N Base -> (n# (Op (n#->n M) (n#->n N)) Base)) - -(define n-op1 - {(number --> number) --> numeral --> number --> numeral} - Op M Base -> (n# (Op (n#->n M)) Base)) - -(define n+ - {numeral --> numeral --> number --> numeral} - M N Base -> (n-op2 (fn +) M N Base)) - -(define n* - {numeral --> numeral --> number --> numeral} - M N Base -> (n-op2 (fn *) M N Base)) - -(define n- - {numeral --> numeral --> number --> numeral} - M N Base -> (n-op2 (fn -) M N Base)) - -(define n/ - {numeral --> numeral --> number --> numeral} - M N Base -> (n-op2 (fn /) M N Base)) - -(define binary - {number --> numeral} - N -> (n# N 2)) - -(define hex - {number --> numeral} - N -> (n# N 16)) - -(define octal - {number --> numeral} - N -> (n# N 8)) - -(define duodecimal - {number --> numeral} - N -> (n# N 12)) - -(define n->numeral - {number --> number --> (list number)} - N Base -> [N] where (> Base N) - N Base -> (let E (largest-expt N Base 0) - Unit (power Base E) - D (div N Unit) - Numeral [D | (n-zeros E)] - Remainder (- N (* D Unit)) - (add Numeral (n->numeral Remainder Base) Base))) - -(define largest-expt - {number --> number --> number --> number} - N Base Expt -> (- Expt 1) where (> (power Base Expt) N) - N Base Expt -> (largest-expt N Base (+ Expt 1))) - -(define n-zeros - {number --> (list number)} - 0 -> [] - N -> [0 | (n-zeros (- N 1))]) - -(define add - {(list number) --> (list number) --> number --> (list number)} - L1 L2 Base -> (reverse (add-h (reverse L1) (reverse L2) Base 0))) - -(define add-h - {(list number) --> (list number) --> number --> number --> (list number)} - [] [] _ 0 -> [] - [] [] _ Carry -> [Carry] - [] L2 Base Carry -> (add-h [0] L2 Base Carry) - L1 [] Base Carry -> (add-h L1 [0] Base Carry) - [N1 | L1] [N2 | L2] Base Carry -> (let M (+ N1 N2 Carry) - (if (< M Base) - [M | (add-h L1 L2 Base 0)] - [(- Base M) | (add-h L1 L2 Base 1)]))) - - ) - - - \ No newline at end of file diff --git a/lib/StLib/Maths/r.shen b/lib/StLib/Maths/r.shen deleted file mode 100644 index 70266a1..0000000 --- a/lib/StLib/Maths/r.shen +++ /dev/null @@ -1,6 +0,0 @@ -(package rational (append [r-reduce r= r< r> r>= r<= r+ r- r* r/ r-expr +-inverse *-inverse - r-expt r->n r->pair n->r maths.n->r r-approx maths.lcd-loop - r-op1 r-op2] - (external maths)) - - a) \ No newline at end of file diff --git a/lib/StLib/Maths/rationals.dtype b/lib/StLib/Maths/rationals.dtype deleted file mode 100644 index 5d81aac..0000000 --- a/lib/StLib/Maths/rationals.dtype +++ /dev/null @@ -1,31 +0,0 @@ -(package rational [r# rational? rational numerator denominator] - -(define r# - N D -> (let V (absvector 3) - PrintF (address-> V 0 print-rational) - Numerator (address-> V 1 N) - Denominator (address-> V 2 D) - V) where (and (integer? N) (integer? D)) - N D -> (error "numerator ~S and divisor ~S must be integers~%" N D)) - -(define print-rational - V -> (make-string "~S/~S" (<-address V 1) (<-address V 2))) - -(define rational? - R -> (trap-error (and (absvector? R) - (= (<-address R 0) print-rational) - (integer? (<-address R 1)) - (integer? (<-address R 2))) (/. E false))) - -(define numerator - V -> (<-address V 1)) - -(define denominator - V -> (<-address V 2)) - -(declare r# [number --> [number --> rational]]) -(declare rational? [A --> boolean]) -(declare numerator [rational --> number]) -(declare denominator [rational --> number]) ) - - \ No newline at end of file diff --git a/lib/StLib/Maths/rationals.shen b/lib/StLib/Maths/rationals.shen deleted file mode 100644 index 7e00b01..0000000 --- a/lib/StLib/Maths/rationals.shen +++ /dev/null @@ -1,126 +0,0 @@ -(package rational (append [r-reduce r= r< r> r>= r<= r+ r- r* r/ r-expr +-inverse *-inverse - r-expt r->n r->pair n->r maths.n->r r-approx maths.lcd-loop - r-op1 r-op2] - (external rational) - (external maths)) - -(define r-op1 - {(number --> number) --> rational --> rational} - F R -> (n->r (F (r->n R)))) - -(define r-op2 - {(number --> number --> number) --> rational --> rational --> rational} - F R1 R2 -> (n->r (F (r->n R1) (r->n R2)))) - -(define r->n - {rational --> number} - R -> (/ (numerator R) (denominator R))) - -(define r->pair - {rational --> (number * number)} - R -> (@p (numerator R) (denominator R))) - -(define n->r - {number --> rational} - N -> (let Pair (maths.n->r N 1) - (r# (fst Pair) (snd Pair)))) - -(define r-reduce - {rational --> rational} - R -> (r-reduce-help (numerator R) (denominator R))) - -(define r-reduce-help - {number --> number --> rational} - N D -> (let LCD (lcd N D) - (if (= LCD 1) - (r# N D) - (r-reduce-help (/ N LCD) (/ D LCD))))) - -(define r= - {rational --> rational --> boolean} - R1 R2 -> (let A (numerator R1) - B (denominator R1) - C (numerator R2) - D (denominator R2) - (= (* A D) (* B C)))) - -(define r< - {rational --> rational --> boolean} - R1 R2 -> (let A (numerator R1) - B (denominator R1) - C (numerator R2) - D (denominator R2) - (< (* A D) (* B C)))) - -(define r> - {rational --> rational --> boolean} - R1 R2 -> (not (or (r= R1 R2) (r< R1 R2)))) - -(define r>= - {rational --> rational --> boolean} - R1 R2 -> (or (r= R1 R2) (r> R1 R2))) - -(define r<= - {rational --> rational --> boolean} - R1 R2 -> (or (r= R1 R2) (r< R1 R2))) - -(define r+ - {rational --> rational --> rational} - R1 R2 -> (let A (numerator R1) - B (denominator R1) - C (numerator R2) - D (denominator R2) - (r# (+ (* A D) (* B C)) (* B D)))) - -(define r- - {rational --> rational --> rational} - R1 R2 -> (let A (numerator R1) - B (denominator R1) - C (numerator R2) - D (denominator R2) - (r# (- (* A D) (* B C)) (* B D)))) - -(define r* - {rational --> rational --> rational} - R1 R2 -> (let A (numerator R1) - B (denominator R1) - C (numerator R2) - D (denominator R2) - (r# (* A C) (* B D)))) - -(define +-inverse - {rational --> rational} - R -> (let A (numerator R) - B (denominator R) - (r# (~ A) B))) - -(define *-inverse - {rational --> rational} - R -> (let A (numerator R) - B (denominator R) - (r# B A))) - -(define r/ - {rational --> rational --> rational} - R1 R2 -> (r* R1 (*-inverse R2))) - -(define r-expt - {rational --> number --> rational} - R N -> (let A (numerator R) - B (denominator R) - (r# (power A N) (power B N))) where (natural? N) - R N -> (let A (numerator R) - B (denominator R) - (r# (power B (~ N)) (power A (~ N)))) where (and (integer? N) (negative? N)) - _ N -> (error "cannot exponentiate a rational by a non-integer ~A~%" N)) - -(define r-approx - {rational --> number --> rational} - R D -> (approx-r-h (r->n R) D 0)) - -(define approx-r-h - {number --> number --> number --> rational} - Value D N -> (r# N D) where (> (/ N D) Value) - Value D N -> (approx-r-h Value D (+ N 1))) - - ) \ No newline at end of file diff --git a/lib/StLib/PROVENANCE.md b/lib/StLib/PROVENANCE.md deleted file mode 100644 index c4814fd..0000000 --- a/lib/StLib/PROVENANCE.md +++ /dev/null @@ -1,54 +0,0 @@ -# Provenance of the vendored standard-library sources (lib/StLib) - -These are the **Shen sources** of the Shen standard library for the S42 -(2026-08-25 refresh) kernel. Tarver's refresh no longer ships the standard -library as a precompiled `stlib.kl`; it ships these sources, which the SBCL -reference distribution loads into the image at install time via `install.shen`. -shen-lua does the equivalent at boot — see `boot.lua` `load_stdlib` and -`klambda/PROVENANCE.md`. - -## Canonical source - -- **Mirror**: `pyrex41/shen-upstream` — the designated mirror of Mark Tarver's - shenlanguage.org uploads (private repo). - - Tag: `s42-pristine-20260825` - - Commit: `pending mirror import` -- **Upstream origin** (what the mirror imported): Mark Tarver's `S42.zip`. - - URL: https://www.shenlanguage.org/Download/S42.zip - - Last-Modified: 2026-08-25 - - Zip SHA-256: `30abdc7e5a1e27b7a20109c1ed141e4712885e31f24d9710d16415fbbd4dfb23` - -Every file here is vendored **byte-identical** to `Lib/StLib/` in the mirror at -that tag (28 files, verified with `cmp`). - -## How shen-lua loads these - -`boot.lua` `load_stdlib()` runs upstream's own `install.shen` — its file order, -its `factorise` toggles, its `(package stlib …)` + `(map (fn systemf) …)` -externals block — with two mechanical rewrites: - -1. The relative `(load "Sub/file.shen")` paths are made absolute against this - directory, so no process `chdir` is needed. -2. The `(tc +)` toggles are neutralised to `(tc -)`: the stdlib is loaded - **without typechecking**. This matches the pre-refresh behaviour (the old - precompiled `stlib.kl` registered no stdlib type signatures either — its - `stlib.initialise` was never called), it is much faster, and it keeps the - native typecheck drivers deferred at boot. Functions are still fully defined - and **arity-registered** (via the kernel's `define`/`update-lambda-table` - path), which is what makes `(fn filter)` and a bare top-level `(filter …)` - resolve — the very thing raw `stlib.kl` defuns did *not* do. - -The load runs at every boot (after kernel init), for the CLI, the port spec -suite, and the kernel certification alike. `SHEN_NO_STDLIB=1` skips it (a -kernel-only embed); `SHEN_STDLIB_DIR` overrides this location. In the -single-file bundle these sources are embedded and materialised to a temp dir at -boot (see `build/make-bundle.lua`). - -## Not typechecked here - -Because the stdlib is loaded with `(tc -)`, stdlib functions carry no -registered type signatures — a `tc +` program that calls, say, `filter` will -not see `filter`'s type. This is unchanged from the pre-refresh port. Loading -the stdlib under `tc +` (upstream's default) would register the signatures but -is markedly slower and eagerly initialises the native typecheck drivers; if a -typed stdlib is wanted, that is a deliberate future option, not the default. diff --git a/lib/StLib/README.txt b/lib/StLib/README.txt deleted file mode 100644 index a133f38..0000000 --- a/lib/StLib/README.txt +++ /dev/null @@ -1 +0,0 @@ -to install the standard library, cd in Shen to this directory and enter install.shen \ No newline at end of file diff --git a/lib/StLib/Strings/macros.shen b/lib/StLib/Strings/macros.shen deleted file mode 100644 index e00e9e7..0000000 --- a/lib/StLib/Strings/macros.shen +++ /dev/null @@ -1,3 +0,0 @@ -(defmacro string-macros - [s-op1 F S] -> [s-op1 F S [/. (protect X) (protect X)]] - [s-op2 F S1 S2] -> [s-op2 F S1 S2 [/. (protect X) (protect X)]]) diff --git a/lib/StLib/Strings/regex.shen b/lib/StLib/Strings/regex.shen deleted file mode 100644 index 375e668..0000000 --- a/lib/StLib/Strings/regex.shen +++ /dev/null @@ -1,286 +0,0 @@ - -(package regexp [] - -(datatype re-state - String : string; - Index : number; - Matches : [number]; - ========================================== - (@p (@p String Index) Matches) : re-state; - - Simple-state : string; - ======================= - Simple-state : re-state; - - _________________ - false : re-state;) - -(datatype re-next - - Re-string : string; - =================== - Re-string : re-next; - - ______________ - eos : re-next;) - -\\ re-state holds the state and match data of regular expressions - -(define new-state - {re-state --> re-state} - (@p (@p String Index) Matches) -> (@p (@p String Index) Matches) - String -> (@p (@p String 0) []) where (string? String)) - -(define state - {re-state --> (string * number)} - (@p (@p String Index) Matches) -> (@p String Index) - String -> (@p String 0) where (string? String)) - -(define index - {re-state --> number} - X -> (snd (state X))) - -(define matches - {re-state --> [number]} - (@p (@p String Index) Matches) -> Matches - String -> [] where (string? String)) - -(define next - {re-state --> re-next} - (@p (@p String Index) Matches) -> (trap-error (pos String Index) (/. X eos)) - String -> (next (new-state String)) where (string? String) - What -> (print (make-string "what the ~S" What))) - -(define increment - {re-state --> re-state} - (@p (@p String Index) Matches) -> (@p (@p String (+ 1 Index)) Matches) - String -> (increment (new-state String)) where (string? String)) - -(define match-strings - {re-state --> [string]} - false -> [] - String -> [] where (string? String) - (@p (@p S I) [A B|MS]) -> [(substr S A B)|(match-strings (@p (@p S I) MS))]) - -(define starting-at - {re-state --> number --> re-state} - (@p (@p String _) Matches) Index -> (@p (@p String Index) Matches) - String Index -> (starting-at (new-state String) Index) where (string? String)) - -(define successful? - {re-state --> boolean} - false -> false - _ -> true) - -\******************************************************************************* - * compilation of a regular expression from a string representation - *\ -(define re-or - \* Create a disjunction of regular expressions *\ - [] -> (lambda _ false) - [R|Rs] -> (lambda State - (let Result ((re R) State) - (if (successful? Result) - Result - ((re-or Rs) State))))) - -(define re-and - \* Create a conjunction of regular expressions *\ - [] -> (lambda X X) - [R|Rs] -> (lambda State - (let Result ((re R) State) - (if (successful? Result) - ((re-and Rs) Result) - false)))) - -(define re-repeat - \* Repeatedly apply a regular expression until it fails *\ - R -> (let RC (re R) - (lambda State - (let Result (RC State) - (if (successful? Result) - ((re-repeat RC) Result) - State))))) - -(define with-match - \* Wrap a regular expression into a match. *\ - E -> (lambda State - (let Beg (index State) - Result ((re E) State) - (if (successful? Result) - (@p (state Result) [(index Result) Beg|(matches Result)]) - false)))) - -(define re-repeat-lazy - R1 [] -> (lambda State State) - R1 R2 -> (let RC1 (re R1) - RC2 (re R2) - (lambda State - (let Result1 (RC2 State) - (if (successful? Result1) - Result1 - (let Result2 (RC1 State) - (if (successful? Result2) - ((re-repeat-lazy R1 R2) Result2) - false))))))) - -(define compile-1 - \* Condense (...|...) and [...] control constructs *\ - [] -> [] - ["("|Rs] -> (let Inside (take-while (complement (= ")")) Rs) - Leftover (tl (drop-while (complement (= ")")) Rs)) - Split (remove ["|"] (partition-with (= "|") Inside)) - (cons (with-match - (re-or (map (/. X (re-and (compile-2 (compile-1 X)))) - Split))) - (compile-1 Leftover))) - ["["|Rs] -> (let Inside (take-while (complement (= "]")) Rs) - Leftover (tl (drop-while (complement (= "]")) Rs)) - (cons (re-or Inside) (compile-1 Leftover))) - [R|Rs] -> (cons R (compile-1 Rs))) - -(define compile-2 - \* Handle + and * control constructs *\ - [] -> [] - [R "+" "?" |Rs] -> (cons R (compile-2 [R "*" "?"|Rs])) - [R "+"|Rs] -> (cons R (compile-2 [R "*"|Rs])) - [R1 "*" "?" R2|Rs] -> (cons (re-repeat-lazy R1 R2) (compile-2 Rs)) - [R1 "*" "?"|Rs] -> (cons (re-repeat-lazy R1 []) (compile-2 Rs)) - [R "*"|Rs] -> (cons (re-repeat R) (compile-2 Rs)) - [R|Rs] -> (cons R (compile-2 Rs))) - -(define parse - \* Convert a string regexp into a list of compiled regular expressions and strings *\ - {string --> (list A)} - "" -> [] - \* Character Classes *\ - (@s "\\d" Str) -> [(to-re re-digit?) |(parse Str)] - (@s "[:digit:]" Str) -> [(to-re re-digit?) |(parse Str)] - (@s "\\D" Str) -> [(to-re (complement re-digit?)) |(parse Str)] - (@s "\\s" Str) -> [(to-re re-space?) |(parse Str)] - (@s "[:space:]" Str) -> [(to-re re-space?) |(parse Str)] - (@s "\\S" Str) -> [(to-re (complement re-space?)) |(parse Str)] - (@s "\\a" Str) -> [(to-re re-alpha?) |(parse Str)] - (@s "[:alpha:]" Str) -> [(to-re re-alpha?) |(parse Str)] - (@s "\\A" Str) -> [(to-re (complement re-alpha?)) |(parse Str)] - (@s "\\w" Str) -> [(to-re re-word?) |(parse Str)] - (@s "[:word:]" Str) -> [(to-re re-word?) |(parse Str)] - (@s "\\W" Str) -> [(to-re (complement re-word?)) |(parse Str)] - \* Beginning and end markers *\ - \** (@s "^" Str) -> [beginning-of-string? | (parse Str)] **\ - (@s "$" Str) -> [end-of-string? | (parse Str)] - \* Control characters *\ - (@s "(" Str) -> ["("|(parse Str)] (@s ")" Str) -> [")"|(parse Str)] - (@s "[" Str) -> ["["|(parse Str)] (@s "]" Str) -> ["]"|(parse Str)] - (@s "+" Str) -> ["+"|(parse Str)] (@s "*" Str) -> ["*"|(parse Str)] - (@s "|" Str) -> ["|"|(parse Str)] (@s "?" Str) -> ["?"|(parse Str)] - \* Escape'd and Regular Characters *\ - (@s "\\" C Str) -> [(to-re (= C))|(parse Str)] - (@s C Str) -> [(to-re (= C))|(parse Str)]) - -(define to-re - \* Convert a boolean string matcher into a regular expression *\ - {(string --> boolean) --> regexp} - X -> (lambda S (let Next (next S) - (if (and (not (= eos Next)) (X Next)) - (increment S) false)))) - -(define beginning-of-string? - {re-state --> re-state} - S -> (if (= 0 (index S)) S false)) - -(define end-of-string? - {re-state --> re-state} - S -> (if (= eos (next S)) S false)) - -(define re-digit? - {string --> boolean} - X -> (element? X ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9"])) - -(define re-alpha? - {string --> boolean} - X -> (element? X ["z" "y" "x" "w" "v" "u" "t" "s" "r" "q" "p" "o" "n" - "m" "l" "k" "j" "i" "h" "g" "f" "e" "d" "c" "b" "a" - "Z" "Y" "X" "W" "V" "U" "T" "S" "R" "Q" "P" "O" "N" - "M" "L" "K" "J" "I" "H" "G" "F" "E" "D" "C" "B" "A"])) - -(define re-word? - {string --> boolean} - X -> (or (re-digit? X) (re-alpha? X))) - -(define re-space? - {string --> boolean} - X -> (element? X [" " " " " -"])) - -\******************************************************************************* - * External functions - *\ -(define re - \* Compile a string or S-expr to a regular expression *\ - Str -> (re-and (compile-2 (compile-1 (parse Str)))) where (string? Str) - digit -> (to-re re-digit?) - space -> (to-re re-space?) - alpha -> (to-re re-alpha?) - word -> (to-re re-word?) - Sym -> (re-and (map (function re) (explode (str Sym)))) where (symbol? Sym) - [- A B] -> (re-range A B) - [| |RS] -> (re-or RS) - [bar! |RS] -> (re-or RS) - [: |RS] -> (re-and RS) - [m |RS] -> (re-match RS) - [+ R] -> (re [: R [* R]]) - [* R] -> (re-repeat R) - [+? A B] -> [: A (re-repeat-lazy A B)] - [+? A] -> [: A (re-repeat-lazy A [])] - [*? A B] -> (re-repeat-lazy A B) - [*? A] -> (re-repeat-lazy A []) - CS -> (re [:|CS]) where (cons? CS) - X -> X) - -(define re-search - \* Parse and search for a regular expression in a string. *\ - {string --> string --> match-data} - Re String -> (re-search-from Re String 0)) - -(define re-search-from - \* Parse and search for a regular expression in a string starting at arg3. *\ - {string --> string --> number --> string} - Re Str Ind -> (re-search- (with-match (re Re)) - (starting-at (new-state Str) Ind))) - -(define re-search- - \* Continue searching forward in for arg1 in arg2 until success or eos *\ - {regex --> re-state --> match-data} - Re State -> (let Try (Re State) - (if (= false Try) - (if (= eos (next State)) - false - (re-search- Re (increment State))) - Try))) - -(define do-matches - \* Call a function on every match of arg2 in arg3 *\ - {(match-data --> A) --> string --> string --> (list A)} - Fn Re Str -> (do-matches- Fn (with-match (re Re)) (new-state Str))) - -(define do-matches- - \* Call arg1 on the match data from every match of arg2 in arg3 *\ - {(match-data --> A) --> regexp --> re-state --> (list A)} - Fn Re State -> (let Try (Re State) - (if (= false Try) - (if (= eos (next State)) - [] - (do-matches- Fn Re (increment State))) - (cons (Fn Try) - (do-matches- Fn Re (@p (state Try) [])))))) - -(define replace-regexp - \* replace all matches of arg1 with arg2 in arg3 *\ - {string --> string --> string --> string} - Regexp Replace String -> - (reduce (/. Match Acc - (@s (substr Acc 0 (nth 2 Match)) - Replace - (substr Acc (nth 1 Match) (length-str Acc)))) - String (reverse (do-matches (function snd) Regexp String)))) ) \ No newline at end of file diff --git a/lib/StLib/Strings/smart.shen b/lib/StLib/Strings/smart.shen deleted file mode 100644 index 30b86f9..0000000 --- a/lib/StLib/Strings/smart.shen +++ /dev/null @@ -1,60 +0,0 @@ -(package string [render-file render string->list file-extension whitespace?] - -(declare render [string --> string]) -(declare render-file [string --> [string --> string]]) - -(define render-file - File Extension -> (let Bytes (read-file-as-bytelist File) - Strings (bytes->strings Bytes []) - Render (compile (fn ) Strings) - Out (file-extension File Extension) - Write (write-to-file Out Render) - Out)) - -(define bytes->strings - [] Strings -> (reverse Strings) - [Byte | Bytes] Strings -> (bytes->strings Bytes [(n->string Byte) | Strings])) - -(define render - String -> (compile (fn ) (string->list String))) - -(define rendered? - "" -> true - (@s "{" _) -> false - (@s _ S) -> (rendered? S)) - -(defcc - "{" "}" := (cn (recapply (fn (intern )) ) ); - "{" "}" := (cn ((intern )) ); - := (cn ); - := "";) - -(defcc - S := S where (and (not (= S "}")) (not (= S "\")));) - -(define recapply - X [] -> X - Fn [X | Y] -> (recapply (Fn X) Y)) - -(defcc - "\" := [ | ]; - := [];) - -(defcc - ;) - -(defcc - Char := Char where (and (not (= Char "}")) - (not (= Char "\")));) - -(defcc - W := skip where (whitespace? W);) - -(defcc - := (cn ); - := "";) - -(defcc - Char := Char where (and (not (= Char "}")) - (not (= Char "\")) - (not (whitespace? Char)));)) \ No newline at end of file diff --git a/lib/StLib/Strings/smartmem.shen b/lib/StLib/Strings/smartmem.shen deleted file mode 100644 index 69d9c9f..0000000 --- a/lib/StLib/Strings/smartmem.shen +++ /dev/null @@ -1,63 +0,0 @@ -(package string [render-file render string->list file-extension whitespace?] - -(declare render [string --> string]) -(declare render-file [string --> [string --> string]]) - -(define render-file - File Extension -> (let Bytes (read-file-as-bytelist File) - Strings (bytes->strings Bytes []) - Render (compile (fn ) Strings) - Out (file-extension File Extension) - Write (write-to-file Out Render) - Out)) - -(define bytes->strings - [] Strings -> (reverse Strings) - [Byte | Bytes] Strings -> (bytes->strings Bytes [(n->string Byte) | Strings])) - -(define render - String -> (let L (string->list String) - (if (element? "{" L) - (compile (fn ) L) - String))) - -(define rendered? - "" -> true - (@s "{" _) -> false - (@s _ S) -> (rendered? S)) - -(defcc - "{" "}" := (cn (render (recapply (fn (intern )) )) ); - "{" "}" := (cn (render ((intern ))) ); - := (cn ); - := "";) - -(defcc - S := S where (and (not (= S "}")) (not (= S "\")));) - -(define recapply - X [] -> X - Fn [X | Y] -> (recapply (Fn X) Y)) - -(defcc - "\" := [ | ]; - := [];) - -(defcc - ;) - -(defcc - Char := Char where (and (not (= Char "}")) - (not (= Char "\")));) - -(defcc - W := skip where (whitespace? W);) - -(defcc - := (cn ); - := "";) - -(defcc - Char := Char where (and (not (= Char "}")) - (not (= Char "\")) - (not (whitespace? Char)));)) \ No newline at end of file diff --git a/lib/StLib/Strings/strings.shen b/lib/StLib/Strings/strings.shen deleted file mode 100644 index 957ede8..0000000 --- a/lib/StLib/Strings/strings.shen +++ /dev/null @@ -1,300 +0,0 @@ -(package string (append [s-op1 s-op2 string.reverse string.element? - string.infix? string.suffix? string.prefix? string.length string.difference - string.intersection string.nth whitespace? - lowercase? uppercase? digit? alpha? alphanum? - string.subset? string.set=? string.set? string.nth - string.trim string.trim-right string.trim-left - tokenise list->string string->list string.trim-left-if - string.trim-right-if string.trim-if uppercase lowercase - string.map file-extension strip-extension string.count - spell-number string>? string=? string<=? - string.some? string.every?] - (external list)) - -(define string->list - {string --> (list string)} - "" -> [] - S -> (s->l-h S 1 (pos S 0) [])) - -(define s->l-h - {string --> number --> string --> (list string) --> (list string)} - S N "" L -> (reverse L) - S N Char L -> (s->l-h S (+ N 1) (trap-error (pos S N) (/. E "")) [Char | L])) - -(define list->string - {(list string) --> string} - [] -> "" - [S | Ss] -> (cn S (list->string Ss))) - -(define s-op1 - {((list string) --> A) --> string --> (A --> B) --> B} - F S C -> (C (F (string->list S)))) - -(define s-op2 - {((list string) --> (list string) --> A) --> string --> string --> (A --> B) --> B} - F S1 S2 C -> (C (F (string->list S1) (string->list S2)))) - -(define string.count - {string --> string --> number} - _ "" -> 0 - S (@s S Ss) -> (+ 1 (string.count S Ss)) - S (@s _ Ss) -> (string.count S Ss)) - -(define string.reverse - {string --> string} - S -> (s-op1 (fn reverse) S (fn list->string))) - -(define string.element? - {string --> string --> boolean} - Char S -> (s-op1 (/. X (element? Char X)) S)) - -(define string.prefix? - {string --> string --> boolean} - S1 S2 -> (s-op2 (fn prefix?) S1 S2)) - -(define string.infix? - {string --> string --> boolean} - S1 S2 -> (s-op2 (fn infix?) S1 S2)) - -(define string.suffix? - {string --> string --> boolean} - S1 S2 -> (s-op2 (fn suffix?) S1 S2)) - -(define string.subset? - {string --> string --> boolean} - S1 S2 -> (s-op2 (fn subset?) S1 S2)) - -(define string.set=? - {string --> string --> boolean} - S1 S2 -> (s-op2 (fn set=?) S1 S2)) - -(define string.set? - {string --> boolean} - S -> (s-op1 (fn set?) S)) - -(define file-extension - {string --> string --> string} - Path Extension -> (cn (strip-extension Path) Extension)) - -(define strip-extension - {string --> string} - "" -> "" - (@s "." _) -> "" - (@s S Ss) -> (@s S (strip-extension Ss))) - -(define string.length - {string --> number} - S -> (s-op1 (fn length) S)) - -(define string.trim - {(list string) --> string --> string} - L S -> (s-op1 (trim L) S (fn list->string))) - -(define string.trim-if - {(string --> boolean) --> string --> string} - P S -> (s-op1 (trim-if P) S (fn list->string))) - -(define string.trim-right-if - {(string --> boolean) --> string --> string} - P S -> (s-op1 (trim-right-if P) S (fn list->string))) - -(define string.trim-left-if - {(string --> boolean) --> string --> string} - P S -> (s-op1 (trim-left-if P) S (fn list->string))) - -(define string.trim-right - {(list string) --> string --> string} - L S -> (s-op1 (trim-right L) S (fn list->string))) - -(define string.trim-left - {(list string) --> string --> string} - L S -> (s-op1 (trim-left L) S (fn list->string))) - -(define string.some? - {(string --> boolean) --> string --> boolean} - _ "" -> false - F (@s S Ss) -> (or (F S) (string.some? F Ss))) - -(define string.every? - {(string --> boolean) --> string --> boolean} - _ "" -> true - F (@s S Ss) -> (and (F S) (string.every? F Ss))) - -(define string.difference - {string --> string --> string} - S1 S2 -> (s-op2 (fn difference) S1 S2 (fn list->string))) - -(define string.intersection - {string --> string --> string} - S1 S2 -> (s-op2 (fn intersection) S1 S2 (fn list->string))) - -(define string.nth - {number --> string --> string} - N S -> (pos S (+ N 1))) - -(define whitespace? - {string --> boolean} - (@s S _) -> (let N (string->n S) - (element? N [9 10 13 32]))) - -(define uppercase? - {string --> boolean} - (@s S _) -> (let N (string->n S) - (and (> N 64) (< N 91)))) - -(define lowercase? - {string --> boolean} - (@s S _) -> (let N (string->n S) - (and (> N 96) (< N 123)))) - -(define digit? - {string --> boolean} - (@s S _) -> (let N (string->n S) - (and (> N 47) (< N 58)))) - -(define alpha? - {string --> boolean} - (@s S _) -> (let N (string->n S) - (or (and (> N 64) (< N 91)) - (and (> N 96) (< N 123)))) - _ -> false) - -(define alphanum? - {string --> boolean} - (@s S _) -> (let N (string->n S) - (or (and (> N 64) (< N 91)) - (and (> N 96) (< N 123)) - (and (> N 47) (< N 58)))) - _ -> false) - -(define tokenise - {(string --> boolean) --> string --> (list string)} - P S -> (tokenise-h P S "")) - -(define tokenise-h - {(string --> boolean) --> string --> string --> (list string)} - _ "" S -> [S] - P (@s S Ss) Token -> [Token | (tokenise-h P Ss "")] where (P S) - P (@s S Ss) Token -> (tokenise-h P Ss (@s Token S))) - -(define uppercase - {string --> string} - (@s S Ss) -> (if (lowercase? S) - (@s (n->string (- (string->n S) 32)) Ss) - (@s S Ss))) - -(define lowercase - {string --> string} - (@s S Ss) -> (if (uppercase? S) - (@s (n->string (+ (string->n S) 32)) Ss) - (@s S Ss))) - -(define string.map - {(string --> string) --> string --> string} - _ "" -> "" - F (@s S Ss) -> (@s (F S) (string.map F Ss))) - -(define spell-number - {number --> string} - 0 -> "zero" - N -> (scale (map (fn digits) (triples (explode N))))) - -(define digit - {string --> string} - "0" -> "" - "1" -> "one" - "2" -> "two" - "3" -> "three" - "4" -> "four" - "5" -> "five" - "6" -> "six" - "7" -> "seven" - "8" -> "eight" - "9" -> "nine") - -(define triples - {(list A) --> (list (list A))} - L -> (triples-h (reverse L) [])) - -(define triples-h - {(list A) --> (list (list A)) --> (list (list A))} - [W X Y | Z] Triples -> (triples-h Z [(reverse [W X Y]) | Triples]) - X Triples -> [(reverse X) | Triples]) - -(define digits - {(list string) --> string} - ["0" "0" "0"] -> "" - [N "0" "0"] -> (@s (digit N) " " "hundred") - ["0" "0" N] -> (@s "and" " " (digit N)) - ["0" N N'] -> (@s "and" " " (tens N N')) - [N "0" N'] -> (@s (digit N) " " "hundred" " " "and" " " (digit N')) - [N N' N''] -> (@s (digit N) " " "hundred" " " "and" " " (tens N' N'')) - [N N'] -> (tens N N') - [N] -> (digit N) - [] -> "") - -(define tens - {string --> string --> string} - "1" N -> (cases (= N "0") "ten" - (= N "1") "eleven" - (= N "2") "twelve" - (= N "3") "thirteen" - (= N "4") "fourteen" - (= N "5") "fifteen" - (= N "6") "sixteen" - (= N "7") "seventeen" - (= N "8") "eighteen" - (= N "9") "nineteen") - "2" N -> (@s "twenty" " " (digit N)) - "3" N -> (@s "thirty" " " (digit N)) - "4" N -> (@s "forty" " " (digit N)) - "5" N -> (@s "fifty" " " (digit N)) - "6" N -> (@s "sixty" " " (digit N)) - "7" N -> (@s "seventy" " " (digit N)) - "8" N -> (@s "eighty" " " (digit N)) - "9" N -> (@s "ninety" " " (digit N))) - -(define scale - {(list string) --> string} - [S] -> S - ["" | Ss] -> (scale Ss) - [S | Ss] -> (@s S (units (length [S | Ss])) (scale Ss))) - -(define units - {number --> string} - 2 -> " thousand " - 3 -> " million " - 4 -> " billion " - 5 -> " trillion " - _ -> (error "this number has a magnitude beyond our text representation")) - -(define string>? - {string --> string --> boolean} - "" _ -> false - _ "" -> true - (@s S Ss) (@s S* S*s) -> (let SN (string->n S) - S*N (string->n S*) - (cases (> SN S*N) true - (< SN S*N) false - true (string>? Ss S*s)))) - -(define string string --> boolean} - _ "" -> false - "" _ -> true - (@s S Ss) (@s S* S*s) -> (let SN (string->n S) - S*N (string->n S*) - (cases (< SN S*N) true - (> SN S*N) false - true (string=? - {string --> string --> boolean} - S S* -> (or (= S S*) (string>? S S*))) - -(define string<=? - {string --> string --> boolean} - S S* -> (or (= S S*) (string (let S1+S2 (concat S1 S2) - (if (symbol? S1+S2) - S1+S2 - (error "'~A' is not a symbol~%" S1+S2)))) - -(declare concat* [A --> [B --> symbol]]) ) - diff --git a/lib/StLib/Symbols/symbols2.shen b/lib/StLib/Symbols/symbols2.shen deleted file mode 100644 index a880070..0000000 --- a/lib/StLib/Symbols/symbols2.shen +++ /dev/null @@ -1,9 +0,0 @@ -(package symbol [newv | (external symbol)] - -(define newv - {--> symbol} - -> (gensym (protect X))) - - - - ) diff --git a/lib/StLib/Tuples/tuples.shen b/lib/StLib/Tuples/tuples.shen deleted file mode 100644 index a9c77e1..0000000 --- a/lib/StLib/Tuples/tuples.shen +++ /dev/null @@ -1,30 +0,0 @@ -(package tuple [pairoff assocp cartprodp assocp-if assocp-if-not] - - (define pairoff - {(list A) --> (list B) --> (list (A * B))} - [] _ -> [] - _ [] -> [] - [X | Y] [W | Z] -> [(@p X W) | (pairoff Y Z)]) - - (define assocp - {A --> (list (A * B)) --> (A * B)} - _ [] -> (error "pair not found~%") - X [(@p X Y) | _] -> (@p X Y) - X [_ | Pairs] -> (assocp X Pairs)) - - (define cartprodp - {(list A) --> (list B) --> (list (A * B))} - [] _ -> [] - [X | Y] Z -> (append (map (/. W (@p X W)) Z) (cartprodp Y Z))) - - (define assocp-if - {(A --> boolean) --> (list (A * B)) --> (A * B)} - _ [] -> (error "pair not found~%") - F? [(@p X Y) | _] -> (@p X Y) where (F? X) - F? [_ | Pairs] -> (assocp-if F? Pairs)) - - (define assocp-if-not - {(A --> boolean) --> (list (A * B)) --> (A * B)} - _ [] -> (error "pair not found~%") - F? [(@p X Y) | _] -> (@p X Y) where (not (F? X)) - F? [_ | Pairs] -> (assocp-if-not F? Pairs)) ) \ No newline at end of file diff --git a/lib/StLib/Vectors/macros.shen b/lib/StLib/Vectors/macros.shen deleted file mode 100644 index f057f0d..0000000 --- a/lib/StLib/Vectors/macros.shen +++ /dev/null @@ -1,26 +0,0 @@ -(package vector [newv array for to] - -(defmacro vector-macros - - \\ read access - [:= V [cons I []]] -> [<-vector V I] - - [:= V [cons I Is]] -> [:= [<-vector V I] Is] - - \\ write access - [V [cons I []] := X] -> [vector-> V I X] - - [V [cons I Is] := X] -> (let V2 (newv) - [let V2 [<-vector V I] - [V2 Is := X]]) - \\ array construction - [array [cons Dim []]] -> [vector Dim] - [array [cons Dim Dims]] - -> (let V (newv) - N (newv) - [let V [vector Dim] - [do [for N = 1 to Dim - [vector-> V N [array Dims]]] - V]]))) - - \ No newline at end of file diff --git a/lib/StLib/install.shen b/lib/StLib/install.shen deleted file mode 100644 index b993cca..0000000 --- a/lib/StLib/install.shen +++ /dev/null @@ -1,51 +0,0 @@ - -(load "Symbols/symbols1.shen") -(tc +) -(load "Symbols/symbols2.shen") -(tc -) -(factorise +) -(load "Maths/macros.shen") -(factorise -) -(tc +) -(load "Maths/maths.shen") -(tc -) -(load "Maths/rationals.dtype") -(tc +) -(load "Maths/rationals.shen") -(tc -) -(load "Maths/complex.dtype") -(tc +) -(load "Maths/complex.shen") -(tc -) -(load "Maths/numerals.dtype") -(tc +) -(load "Maths/numerals.shen") -(load "Lists/lists.shen") -(load "Strings/macros.shen") -(load "Strings/strings.shen") -(tc -) -(load "Strings/smart.shen") -(factorise +) -(load "Vectors/macros.shen") -(factorise -) -(tc +) -(load "IO/prettyprint.shen") -(tc -) -(load "IO/delete-file.shen") -(tc +) -(load "IO/files.shen") -(load "Tuples/tuples.shen") -(tc -) -(load "package-stlib.shen") - -\\ all external functions of the standard library are declared as system functions -(let External (external stlib) - ExternalF (filter (/. X (> (arity X) -1)) External) - Systemf (map (fn systemf) ExternalF) - ok) - -(preclude-all-but []) -(set shen.*userdefs* []) -(cd "") -(tc -) - diff --git a/lib/StLib/package-stlib.shen b/lib/StLib/package-stlib.shen deleted file mode 100644 index 4980a48..0000000 --- a/lib/StLib/package-stlib.shen +++ /dev/null @@ -1,4 +0,0 @@ -(package stlib (mapcan (fn external) - [list string maths vector symbol - tuple file print]) - void) \ No newline at end of file diff --git a/lua_interop.lua b/lua_interop.lua index d415b1c..ad04a1f 100644 --- a/lua_interop.lua +++ b/lua_interop.lua @@ -402,18 +402,16 @@ M.map_new, M.map_find, M.map_put, M.map_remove = -- ---- install: the Shen-side surface ----------------------------------------- -- Shen-LEVEL registration of name/arity: the `arity` property plus the --- shen.*lambdatable* entry that (fn name) and Shen's evaluator consult. +-- callable lambda form that (fn name) and Shen's evaluator consult. -- --- The S42 (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. +-- On ShenOSKernel 42.2 the lambda form is the shen.lambda-form property +-- (sys.kl `fn` reads it); on Tarver's S42 kernel it was an entry in the +-- shen.*lambdatable* assoc list. Either way the kernel's own +-- update-lambda-table does precisely the writes we need — (put name arity …) +-- then the lambda form built by shen.lambda-entry, whose value is the CURRIED +-- FUNCTION (not a cons), so the old "apply a non-function" hazard at tc+ call +-- sites is gone. Route through it. The internal puts go through the LIVE F +-- entry so the fasl "p"/"lf" wrappers still see them when outside a chunk. local function shen_register(nm, arity) F["update-lambda-table"](nm, arity) end diff --git a/prims.lua b/prims.lua index 14d79f0..8fe4111 100644 --- a/prims.lua +++ b/prims.lua @@ -342,7 +342,19 @@ defprim("absvector", 1, function(n) return setmetatable(v, Vmt) end) defprim("absvector?", 1, function(x) return getmetatable(x)==Vmt end) -defprim("<-address", 2, function(v, i) return v[i+2] end) +-- An out-of-range read is an error (every in-range slot holds a value: the +-- fail object until written), so kernel code that probes past the end under +-- trap-error -- the vector printer's shen.iter-vector, shen.dict? -- sees +-- the boundary instead of a Lua nil. +local function addr_oob(v, i) + ERR(R.to_str and (tostring(i) .. " is not a valid index") or "invalid index") +end +P.addr_oob = addr_oob +defprim("<-address", 2, function(v, i) + local w = v[i+2] + if w == nil then addr_oob(v, i) end + return w +end) defprim("address->", 3, function(v, i, x) v[i+2]=x; return v end) -- freeze/thaw : thunks are 0-arity functions (kernel: (defun thaw (V) (V))) @@ -960,7 +972,8 @@ function P.install_native_stdlib() -- fn (reader.kl): the 42 shen->kl translator compiles every call to a -- function whose arity is unknown at translation time (forward references -- within a file, mainly) as ((fn name) args...), and the kernel `fn` pays - -- an arity property get PLUS an assoc over the whole shen.*lambdatable* + -- an arity property get PLUS a shen.lambda-form property get (a + -- trap-error'd dict lookup on 42.2; an assoc over shen.*lambdatable* on S42) -- on EVERY such call — measured at ~35% of urdr's software-SHA-256 suite -- (jit.p F3: is_cons/equal < assoc < fn). Fast path: for a symbol naming -- a live function with known positive arity, verify the lambdatable entry @@ -970,19 +983,25 @@ function P.install_native_stdlib() -- curried lambda. APP dispatches a raw function with recorded arity -- identically to the curried chain (exact call, partial application, -- over-application), but without one MKFUN closure allocation per applied - -- argument. Every (set shen.*lambdatable* ...) builds a fresh cons spine, - -- so table identity is the correct invalidation key; arity-0 and + -- argument. Every write of a shen.lambda-form property (native put/unput, + -- i.e. update-lambda-table / shen.set-lambda-form-entry) bumps + -- P.LAMBDA_FORM_GEN, which is the invalidation key (the 42.0 requirement: + -- a redefinition must drop the cached callable form); arity-0 and -- unknown-arity names always take the original path (kernel `fn` CALLS an -- arity-0 function rather than returning it). local orig_fn = F["fn"] - local fn_seen, fn_seen_lt = {}, nil + local fn_seen, fn_seen_lt, fn_seen_lt2 = {}, nil, nil local function fn_fast(v) if is_symbol(v) then local f = F[v.name] local ar = f ~= nil and FA[f] or nil if ar and ar > 0 then - local lt = GLOBALS["shen.*lambdatable*"] - if lt ~= fn_seen_lt then fn_seen = {}; fn_seen_lt = lt end + -- (an S42-lineage kernel via SHEN_KL_DIR or a Yggdrasil slice keeps + -- its lambda table in shen.*lambdatable*: a fresh spine per update) + local lt, lt2 = P.LAMBDA_FORM_GEN, GLOBALS["shen.*lambdatable*"] + if lt ~= fn_seen_lt or lt2 ~= fn_seen_lt2 then + fn_seen = {}; fn_seen_lt = lt; fn_seen_lt2 = lt2 + end if fn_seen[v.name] then return f end orig_fn(v) -- errors exactly like the kernel on a miss fn_seen[v.name] = true @@ -1376,78 +1395,99 @@ function P.install_native_stdlib() return data end - -- Property store (get/put/unput/arity). Kernel does hash + trap-error - -- <-vector + assoc; empty buckets are the fail object, which <-vector - -- turns into an exception. Same layout, no pcall. + -- Property store (get/put/unput/arity) over the ShenOSKernel 42.2 dict + -- (dict.kl). A dict is an absvector + -- address 0: shen.dictionary 1: capacity 2: entry count + -- address 3+i: bucket i — an assoc list of (Key . Props) + -- where Props is itself an assoc list of (Prop . Value). In the pure-array + -- layout address a lives at v[a + 2]. The kernel's get/put/unput go through + -- trap-error around shen.<-dict plus shen.assoc-set/shen.assoc-rm; these + -- natives build exactly the same bucket and entry lists (assoc-set replaces + -- in place keeping the stored key, else appends; assoc-rm drops the first + -- match) without the pcall. Anything that is not a well-formed dict, and + -- every error path, delegates to the compiled original so messages match. local orig_get = F["get"] local orig_put = F["put"] local orig_unput = F["unput"] local orig_arity = F["arity"] - local orig_change = F["shen.change-pointer-value"] - local orig_remove = F["shen.remove-pointer"] local arity_sym = intern("arity") + local dict_sym = intern("shen.dictionary") + local lambda_form_sym = intern("shen.lambda-form") + -- bucket address of `key` in dict `vec`: returns bucket, slot index (v[]). local function bucket_at(vec, key) - if getmetatable(vec) ~= Vmt then return nil, nil end - local lim = vec[2] - if type(lim) ~= "number" or lim <= 0 then return nil, nil end - local h = hash(key, lim) + if getmetatable(vec) ~= Vmt or vec[2] ~= dict_sym then return nil, nil end + local cap = vec[3] + if type(cap) ~= "number" or cap <= 0 then return nil, nil end + local h = hash(key, cap) if type(h) ~= "number" then return nil, nil end - local slot = vec[h + 2] - if slot == fail_sym or slot == nil then return NIL, h end - return slot, h - end - local function pointer_match(pair, key, prop) - if not is_cons(pair) then return false end - local kp = pair[1] - if not is_cons(kp) then return false end - local rest = kp[2] - return is_cons(rest) and rest[2] == NIL - and equal(kp[1], key) and equal(rest[1], prop) - end - local function change_pointer(key, prop, val, lst) - local orig = lst + local slot = h + 5 + local b = vec[slot] + if b == nil or b == fail_sym then return nil, nil end + return b, slot + end + -- shen.assoc-set, iteratively; nil on an improper list (caller delegates). + local function assoc_set(k, v, l) local head, last while true do - if lst == NIL then - local cell = cons(cons(cons(key, cons(prop, NIL)), val), NIL) - if last then last[2] = cell; return head end - return cell + if l == NIL then + local cell = cons(cons(k, v), NIL) + if last then last[2] = cell; return head, true end + return cell, true end - if not is_cons(lst) then return orig_change(key, prop, val, orig) end - local pair = lst[1] - if pointer_match(pair, key, prop) then - local cell = cons(cons(pair[1], val), lst[2]) - if last then last[2] = cell; return head end - return cell + if not is_cons(l) then return nil end + local pair = l[1] + if is_cons(pair) and equal(k, pair[1]) then + local cell = cons(cons(pair[1], v), l[2]) + if last then last[2] = cell; return head, false end + return cell, false end local cell = cons(pair, NIL) if last then last[2] = cell else head = cell end last = cell - lst = lst[2] + l = l[2] end end - local function remove_pointer(key, prop, lst) - local orig = lst + -- shen.assoc-rm, iteratively; nil on an improper list. + local function assoc_rm(k, l) local head, last while true do - if lst == NIL then - if last then return head else return NIL end + if l == NIL then + if last then return head end + return NIL end - if not is_cons(lst) then return orig_remove(key, prop, orig) end - if pointer_match(lst[1], key, prop) then - if last then last[2] = lst[2]; return head end - return lst[2] + if not is_cons(l) then return nil end + local pair = l[1] + if is_cons(pair) and equal(k, pair[1]) then + if last then last[2] = l[2]; return head end + return l[2] end - local cell = cons(lst[1], NIL) + local cell = cons(pair, NIL) if last then last[2] = cell else head = cell end last = cell - lst = lst[2] + l = l[2] end end + -- (key . props) entry of `key` in a bucket, or nil. + local function find_entry(bucket, key) + while is_cons(bucket) do + local e = bucket[1] + if is_cons(e) and equal(key, e[1]) then return e end + bucket = bucket[2] + end + return nil + end + local function find_prop(props, prop) + while is_cons(props) do + local p = props[1] + if is_cons(p) and equal(prop, p[1]) then return p end + props = props[2] + end + return nil + end -- Sidecar Lua table for *property-vector* (port-performance.md: property -- access). Kernel keys are almost always interned symbols, so identity - -- table lookup beats hash+assoc. The absvector remains the observable - -- store; the cache is a write-through index. + -- table lookup beats hash+assoc. The dict remains the observable store; + -- the cache is a write-through index. local PGET = {} local function cacheable(x) local t = type(x) @@ -1472,32 +1512,61 @@ function P.install_native_stdlib() if t then t[prop] = nil end end local pv_of = function() return GLOBALS["*property-vector*"] end + -- Bumped on every write of a shen.lambda-form property (update-lambda-table, + -- shen.set-lambda-form-entry, unput): fn_fast's invalidation key. 42.0 + -- requires a cached callable form to be dropped when a function is + -- redefined (in particular to zero or unknown arity). + P.LAMBDA_FORM_GEN = 0 + local function lookup(key, prop, vec) + local bucket = bucket_at(vec, key) + if bucket == nil then return nil end + local e = find_entry(bucket, key) + if e == nil then return nil end + local p = find_prop(e[2], prop) + if p == nil then return nil end + return p[2] + end local function get(key, prop, vec) - if vec == pv_of() then + local is_pv = vec == pv_of() + if is_pv then local v, ok = cache_get(key, prop) if ok then return v end end - local bucket, h = bucket_at(vec, key) - if h == nil then return orig_get(key, prop, vec) end - if bucket == NIL then return orig_get(key, prop, vec) end - local pair = assoc(cons(key, cons(prop, NIL)), bucket) - if pair == NIL or not is_cons(pair) then return orig_get(key, prop, vec) end - local val = pair[2] - if vec == pv_of() then cache_put(key, prop, val) end + local val = lookup(key, prop, vec) + if val == nil then return orig_get(key, prop, vec) end + if is_pv then cache_put(key, prop, val) end return val end local function put(key, prop, val, vec) - local bucket, h = bucket_at(vec, key) - if h == nil then return orig_put(key, prop, val, vec) end - vec[h + 2] = change_pointer(key, prop, val, bucket) - if vec == pv_of() then cache_put(key, prop, val) end + local bucket, slot = bucket_at(vec, key) + if slot == nil then return orig_put(key, prop, val, vec) end + local e = find_entry(bucket, key) + local props, _ = assoc_set(prop, val, e and e[2] or NIL) + if props == nil then return orig_put(key, prop, val, vec) end + local nb, added = assoc_set(key, props, bucket) + if nb == nil then return orig_put(key, prop, val, vec) end + vec[slot] = nb + if added then vec[4] = vec[4] + 1 end + if vec == pv_of() then + cache_put(key, prop, val) + if prop == lambda_form_sym then P.LAMBDA_FORM_GEN = P.LAMBDA_FORM_GEN + 1 end + end return val end local function unput(key, prop, vec) - local bucket, h = bucket_at(vec, key) - if h == nil then return orig_unput(key, prop, vec) end - vec[h + 2] = remove_pointer(key, prop, bucket) - if vec == pv_of() then cache_rm(key, prop) end + local bucket, slot = bucket_at(vec, key) + if slot == nil then return orig_unput(key, prop, vec) end + local e = find_entry(bucket, key) + local props = assoc_rm(prop, e and e[2] or NIL) + if props == nil then return orig_unput(key, prop, vec) end + local nb, added = assoc_set(key, props, bucket) + if nb == nil then return orig_unput(key, prop, vec) end + vec[slot] = nb + if added then vec[4] = vec[4] + 1 end + if vec == pv_of() then + cache_rm(key, prop) + if prop == lambda_form_sym then P.LAMBDA_FORM_GEN = P.LAMBDA_FORM_GEN + 1 end + end return key end local function arity(name) @@ -1505,30 +1574,30 @@ function P.install_native_stdlib() if ok then return v end local pv = pv_of() if pv == nil then return -1 end - local bucket, h = bucket_at(pv, name) - if h == nil or bucket == NIL then return -1 end - local pair = assoc(cons(name, cons(arity_sym, NIL)), bucket) - if pair == NIL or not is_cons(pair) then return -1 end - cache_put(name, arity_sym, pair[2]) - return pair[2] + if bucket_at(pv, name) == nil then return orig_arity(name) end + local val = lookup(name, arity_sym, pv) + if val == nil then return -1 end + cache_put(name, arity_sym, val) + return val end local function get_or(key, prop, vec, default) - if vec == pv_of() then + local is_pv = vec == pv_of() + if is_pv then local v, ok = cache_get(key, prop) if ok then return v end end - local bucket, h = bucket_at(vec, key) - if h == nil or bucket == NIL then - if type(default) == "function" then return default() end - return default + local val + if bucket_at(vec, key) == nil then + local ok, v = pcall(orig_get, key, prop, vec) + if ok then val = v end + else + val = lookup(key, prop, vec) end - local pair = assoc(cons(key, cons(prop, NIL)), bucket) - if pair == NIL or not is_cons(pair) then + if val == nil then if type(default) == "function" then return default() end return default end - local val = pair[2] - if vec == pv_of() then cache_put(key, prop, val) end + if is_pv then cache_put(key, prop, val) end return val end P.ENV.GET_OR = get_or @@ -1741,8 +1810,6 @@ function P.install_native_stdlib() install("put", put, 4) install("unput", unput, 3) install("arity", arity, 1) - install("shen.change-pointer-value", change_pointer, 4) - install("shen.remove-pointer", remove_pointer, 3) install("vector?", vector_q, 1) install("<-vector", vref, 2) install("vector->", vset, 3) @@ -1975,11 +2042,12 @@ local ENV = { return w end, ADDR_OR = function(v, n, default) - if type(v) ~= "table" or type(n) ~= "number" then + local w = (type(v) == "table" and type(n) == "number") and v[n + 2] or nil + if w == nil then if type(default) == "function" then return default() end return default end - return v[n + 2] + return w end, -- Placeholder: trap-error (get ...) during kernel load, before native get. -- install_native_stdlib replaces this with a pcall-free lookup. @@ -2014,7 +2082,11 @@ local ENV = { end return F["n->string"](n) end, - ADDR = function(v, i) return v[i + 2] end, + ADDR = function(v, i) + local w = v[i + 2] + if w == nil then return F["<-address"](v, i) end + return w + end, ADSET = function(v, i, x) v[i + 2] = x; return v end, VMT = Vmt, -- allow compiled code to reach a few Lua builtins safely diff --git a/repl.lua b/repl.lua index df70889..80388c5 100644 --- a/repl.lua +++ b/repl.lua @@ -289,9 +289,9 @@ function M.run(opts) opts = opts or {} local P = opts.P or require("boot") -- "kernel loaded?" probe: `version` is a stable public kernel function - -- present in every Shen version. (Do NOT probe shen.initialise — the S42 - -- 2026-07-11 refresh removed it, folding initialisation into declarations.kl - -- load-time forms; probing it would reload the kernel on every call.) + -- present in every Shen version. (Do NOT probe shen.initialise — Tarver's + -- S41.2/S42 kernels had none, folding initialisation into load-time forms; + -- probing it would reload the kernel on every call on such a tree.) if P.F["version"] == nil then P.load_kernel(opts.verbose) end if P.GLOBALS["*property-vector*"] == nil then P.initialise() end diff --git a/shen-scm-1.rockspec b/shen-scm-1.rockspec index 7fa7387..ce0bed4 100644 --- a/shen-scm-1.rockspec +++ b/shen-scm-1.rockspec @@ -8,14 +8,15 @@ source = { } description = { - summary = "A speed-focused LuaJIT port of the Shen language (kernel 42)", + summary = "A speed-focused LuaJIT port of the Shen language (kernel 42.2)", detailed = [[ shen-lua runs the Shen language on LuaJIT 2.1 by compiling KLambda to Lua source. Embed with `local shen = require("shen")` (boot/eval/call/fn plus list/symbol marshaling), or use the `shen` launcher for a REPL, running .shen files, and -e one-liners. Requires LuaJIT (Lua 5.1 semantics + FFI); -the Shen 42 KLambda sources are bundled and compiled on first boot, then -served from a bytecode cache. +the ShenOSKernel 42.2 KLambda sources (kernel, extensions and precompiled +standard library) are bundled and compiled on first boot, then served from a +bytecode cache. ]], homepage = "https://github.com/pyrex41/shen-lua", license = "BSD-3-Clause (Shen kernel: BSD)", @@ -46,9 +47,9 @@ build = { install = { bin = { shen = "bin/shen" }, }, - -- The vendored Shen 42 KLambda kernel sources, compiled on boot. + -- The vendored ShenOSKernel 42.2 KLambda sources, compiled on boot. -- They land in the rock directory -- (/lib/luarocks/rocks-5.1/shen/scm-1/klambda); boot.lua's -- find_kldir() derives that path from its own install location. - copy_directories = { "klambda", "lib" }, + copy_directories = { "klambda" }, } diff --git a/test/boot_cache_spec.lua b/test/boot_cache_spec.lua index 3718bcb..a877ad0 100644 --- a/test/boot_cache_spec.lua +++ b/test/boot_cache_spec.lua @@ -1,16 +1,15 @@ -- test/boot_cache_spec.lua — PORT-AUTHORED coverage for the boot caches -- (pyrex41/shen-lua#46). -- --- Three layers of the boot are cached, and each replaces work that used to be +-- Two layers of the boot are cached, and each replaces work that used to be -- redone on every single start: -- --- * the kernel bytecode cache (.shen-kernel-cache..bin, SHENKC3) now --- also carries klambda/types.kl's 161 hoisted type signatures as dumped --- prolog abstractions, plus the gensym / inference counters `declare` --- advances; --- * the standard-library boot image (/stdlib-.img) records the --- WHOLE stdlib phase — install.shen's own forms and the ~20 nested loads --- alike — as one record stream; +-- * the kernel bytecode cache (.shen-kernel-cache..bin) holds the +-- compiled ShenOSKernel 42.2 modules, including the precompiled stdlib +-- (klambda/stlib.kl); +-- * its sidecar (.stlib) holds the 290 standard-library type +-- signatures that (stlib.initialise-types) declares, as dumped prolog +-- abstractions, plus the gensym / inference counters `declare` advances; -- * two kernel functions that used to run the compiler at boot, -- shen.lambda-entry and shen.assoc->, are native. -- @@ -72,7 +71,8 @@ local function names(l) end local sig = names(P.GLOBALS["shen.*sigf*"]) print("sigf " .. #sig .. " " .. table.concat(sig, ",")) -print("lambdatable " .. #names(P.GLOBALS["shen.*lambdatable*"])) +print("userdefs " .. #names(P.GLOBALS["shen.*userdefs*"])) +print("arity " .. tostring(P.F["arity"](R.intern("filter")))) print("alldatatypes " .. table.concat(names(P.GLOBALS["shen.*alldatatypes*"]), ",")) print("datatypes " .. table.concat(names(P.GLOBALS["shen.*datatypes*"]), ",")) print("gensym " .. tostring(P.GLOBALS["shen.*gensym*"])) @@ -99,67 +99,45 @@ do return run("env " .. env .. " luajit " .. sh_quote(script)) end - local d1, d2, d3, d4 = fresh(), fresh(), fresh(), fresh() + local d1, d2 = fresh(), fresh() -- (a) nothing cached at all: the reference local ref = boot("SHEN_KERNEL_CACHE=off SHEN_FASL=off") - -- (b) kernel bytecode cache cold, then warm (exercises SHENKC3 write + read) + -- (b) kernel bytecode cache + stdlib signature sidecar cold, then warm local kc = "SHEN_KERNEL_CACHE=" .. sh_quote(kcache) local kcold = boot(kc .. " SHEN_FASL_DIR=" .. sh_quote(d1)) + local sidecar = io.open(kcache .. ".stlib", "rb") + local sidecar_data = sidecar and sidecar:read("*a") + if sidecar then sidecar:close() end local kwarm = boot(kc .. " SHEN_FASL_DIR=" .. sh_quote(d1)) - -- (c) stdlib boot image cold, then warm - local icold = boot(kc .. " SHEN_FASL_DIR=" .. sh_quote(d2)) - local iwarm = boot(kc .. " SHEN_FASL_DIR=" .. sh_quote(d2)) - -- (d) image explicitly disabled: the per-file fasl path must still agree - local noimg = boot(kc .. " SHEN_STDLIB_IMAGE=off SHEN_FASL_DIR=" .. sh_quote(d3)) + local kwarm2 = boot(kc .. " SHEN_FASL_DIR=" .. sh_quote(d2)) - check(ref:find("sigf 182 ", 1, true) ~= nil, - "#46: uncached boot registers kernel, stdlib, and checked-integer signatures") + -- 163 kernel + 3 features + 2 pattern-matching + 4 checked-integer + 290 + -- stdlib (shen-scheme 0.50 reports 458: the same minus checked-integer) + check(ref:find("sigf 462 ", 1, true) ~= nil, + "#46: uncached boot registers kernel, extension, checked-integer and stdlib signatures") check(ref:find("typecheck 49", 1, true) ~= nil, "#46: uncached boot typechecks a user definition") + check(ref:find("arity 2", 1, true) ~= nil, + "#46: stdlib functions are registered (arity filter = 2)") check(kcold == ref, "#46: cold kernel-bytecode-cache boot == uncached boot") - check(kwarm == ref, "#46: WARM kernel-bytecode-cache boot == uncached boot") - check(icold == ref, "#46: stdlib image miss == uncached boot") - check(iwarm == ref, "#46: stdlib image HIT == uncached boot") - check(noimg == ref, "#46: SHEN_STDLIB_IMAGE=off == uncached boot") + check(sidecar_data ~= nil and sidecar_data:sub(1, 8) == "SHENSIG1", + "#46: a cold boot writes the stdlib signature sidecar") + check(kwarm == ref, "#46: WARM kernel-bytecode-cache + signature sidecar boot == uncached boot") + check(kwarm2 == ref, "#46: warm boot with a fresh fasl dir == uncached boot") - -- The image must actually have been exercised — otherwise the checks above - -- would pass vacuously if it silently never engaged. - local dbg = run("env " .. kc .. " SHEN_FASL_DIR=" .. sh_quote(d2) - .. " SHEN_FASL_DEBUG=1 luajit " .. sh_quote(script)) - check(dbg:find("image hit", 1, true) ~= nil, - "#46: the third run really is a stdlib image HIT") - local dbg4 = run("env " .. kc .. " SHEN_FASL_DIR=" .. sh_quote(d4) - .. " SHEN_FASL_DEBUG=1 luajit " .. sh_quote(script)) - check(dbg4:find("image miss", 1, true) ~= nil, - "#46: a fresh fasl dir is a stdlib image MISS") - - -- Invalidation: the image carries the path and content hash of every file the - -- recorded span loaded, so editing one must miss even though install.shen and - -- the kernel are untouched. Done against a COPY of the tree (SHEN_STDLIB_DIR) - -- so the checkout is never mutated, not even transiently. + -- A damaged sidecar must be a miss (the real declares run), never an error + -- or a half-applied replay. do - local tree = os.tmpname(); os.remove(tree) - os.execute("mkdir -p " .. sh_quote(tree)) - os.execute("cp -R " .. sh_quote(here .. "lib/StLib") .. "/. " .. sh_quote(tree)) - local d5 = fresh() - local cp = kc .. " SHEN_STDLIB_DIR=" .. sh_quote(tree) - .. " SHEN_FASL_DIR=" .. sh_quote(d5) .. " SHEN_FASL_DEBUG=1 " - local first = run("env " .. cp .. "luajit " .. sh_quote(script)) - local second = run("env " .. cp .. "luajit " .. sh_quote(script)) - check(first:find("image miss", 1, true) ~= nil, - "#46: first boot against a copied stdlib tree records an image") - check(second:find("image hit", 1, true) ~= nil, - "#46: second boot against the copied tree hits it") - local w = io.open(tree .. "/Lists/lists.shen", "ab") - w:write("\n\\\\ boot_cache_spec probe\n"); w:close() - local edited = run("env " .. cp .. "luajit " .. sh_quote(script)) - check(edited:find("image miss", 1, true) ~= nil, - "#46: editing a standard-library file invalidates the boot image") - os.execute("rm -rf " .. sh_quote(tree) .. " " .. sh_quote(d5)) + local w = io.open(kcache .. ".stlib", "wb") + w:write((sidecar_data or "SHENSIG1\n"):sub(1, 4000)); w:close() + local damaged = boot(kc .. " SHEN_FASL_DIR=" .. sh_quote(d1)) + check(damaged == ref, "#46: a truncated signature sidecar falls back to the real declares") + local again = boot(kc .. " SHEN_FASL_DIR=" .. sh_quote(d1)) + check(again == ref, "#46: the sidecar is rewritten after a miss") end - os.remove(script); os.remove(kcache) - for _, d in ipairs({ d1, d2, d3, d4 }) do os.execute("rm -rf " .. sh_quote(d)) end + os.remove(script); os.remove(kcache); os.remove(kcache .. ".stlib") + for _, d in ipairs({ d1, d2 }) do os.execute("rm -rf " .. sh_quote(d)) end end -- --------------------------------------------------------------------------- diff --git a/test/library_spec.lua b/test/library_spec.lua index 9c1cc87..77cdfc6 100644 --- a/test/library_spec.lua +++ b/test/library_spec.lua @@ -3,13 +3,12 @@ -- -- This is NOT the canonical kernel certification suite (run-kernel-tests.lua). -- --- NB on scope: the standard library is loaded at boot from the S-lineage --- lib/StLib Shen sources (see boot.lua load_stdlib), so list functions like +-- NB on scope: the standard library (precompiled klambda/stlib.kl, registered +-- by (stlib.initialise) — see boot.lua load_stdlib) is present, so list functions like -- filter / take / drop are present and covered here alongside the kernel-core -- functions (map / reverse / append / element? / length / head / tail / sum / -- remove / occurrences / cons? / empty?). See also test/stdlib_spec.lua for --- the (fn filter) / bare-(filter …) regression that motivated loading stdlib --- from source. +-- the (fn filter) / bare-(filter …) regression. -- -- luajit test/library_spec.lua local shen = require("shen") @@ -106,11 +105,10 @@ checkeq("(lib-spec-sumlist [1 2 3 4 5])", "15") checkeq("(lib-spec-sumlist [])", "0") -- --------------------------------------------------------------------------- --- stdlib higher-order + list functions. These come from the S-lineage --- lib/StLib sources (Lists/lists.shen etc.), loaded through the kernel's own --- define pipeline at boot (see boot.lua load_stdlib). Before the stdlib was --- loaded from source, filter/take/drop were absent and this block asserted a --- clean "undefined" error; now they are present and we assert behaviour. +-- stdlib higher-order + list functions, from klambda/stlib.kl registered by +-- (stlib.initialise) at boot (see boot.lua load_stdlib). Before the stdlib was +-- registered, filter/take/drop were absent and this block asserted a clean +-- "undefined" error; now they are present and we assert behaviour. -- --------------------------------------------------------------------------- shen.eval("(define lib-spec-gt1 X -> (> X 1))") checkeq("(filter lib-spec-gt1 [1 2 3])", "(2 3)") diff --git a/test/primitives_spec.lua b/test/primitives_spec.lua index 57c58d7..45e7558 100644 --- a/test/primitives_spec.lua +++ b/test/primitives_spec.lua @@ -12,7 +12,9 @@ -- * floats render bare ("3.5"), not C-printf "%f" ("3.500000"); -- * an uninitialized absvector slot reads back as the `shen.fail!` symbol -- (shen-go returns a distinguished `undefined` object); --- * an out-of-range <-address reads back as nil rather than raising. +-- * (an out-of-range <-address used to read back as nil; it now raises, as +-- on shen-scheme, so the kernel vector printer's trap-error'd probe past +-- the end works: (vector 3) prints <... ... ...>.) -- -- luajit test/primitives_spec.lua local shen = require("shen") @@ -145,11 +147,13 @@ checkeq("(<-address (address-> (absvector 3) 1 7) 1)", "7") -- Uninitialized slot: this port reads back the `shen.fail!` symbol (shen-go -- returns a distinguished `undefined` object). Lock in the port's behavior. checkeq("(<-address (absvector 3) 0)", "shen.fail!") --- Out-of-range read does not raise here — it returns nil (Lua nil -> renders --- as the empty string via to_str). We assert the no-raise contract directly. +-- Out-of-range read raises (shen-scheme: "99 is not a valid index for ..."); +-- the kernel's vector printer (shen.iter-vector) relies on it to find the end. do local ok = pcall(function() return shen.eval("(<-address (absvector 3) 99)") end) - check(ok, "out-of-range <-address does not raise (returns nil)") + check(not ok, "out-of-range <-address raises") + checkeq("(trap-error (<-address (absvector 3) 99) (/. E out))", "out") + checkeq("(make-string \"~A\" (vector 3))", "\"<... ... ...>\"") end -- --------------------------------------------------------------------------- diff --git a/test/prolog_semantics_spec.lua b/test/prolog_semantics_spec.lua index d9e0c2b..b0089b6 100644 --- a/test/prolog_semantics_spec.lua +++ b/test/prolog_semantics_spec.lua @@ -171,15 +171,21 @@ check("var? failure backtracks into the next clause", -- shen.*prolog-memory* is the size of the bindings vector the kernel's -- call-prolog allocates per query (macros.shen shen.prolog-vector), so it is -- a hard ceiling on how many Prolog variables one query may allocate. --- declarations.kl — byte-identical in all four ports' checkouts — sets it to --- 1000, of which slots 0 and 1 hold the printer and the next-index counter. --- shen-lua's native engine grew its variable arena without bound, so queries --- that raise on the other three ports returned a value here. +-- ShenOSKernel 42.2's shen.initialise-environment (init.kl) ends with +-- (prolog-memory 10000); slots 0 and 1 hold the printer and the next-index +-- counter. shen-lua's native engine grew its variable arena without bound, so +-- queries that raise on the other ports returned a value here. +-- +-- The ceiling checks below lower the budget to 1000 with (prolog-memory 1000) +-- (the S42 default): a 10000-deep tdown would overflow the LuaJIT stack before +-- it reached the variable ceiling, which is a different error. -- --------------------------------------------------------------------------- check("shen.*prolog-memory* is the kernel default", - shen.eval("(value shen.*prolog-memory*)"), 1000) + shen.eval("(value shen.*prolog-memory*)"), 10000) +check("prolog-memory sets and reads back the budget", + shen.eval("(prolog-memory 1000)"), 1000) check("prolog-memory reads the current value back", - shen.eval("(prolog-memory -1)"), 1000) + shen.eval("(value shen.*prolog-memory*)"), 1000) check("query under the ceiling succeeds", q("(prolog? (tdown 900 R) (return R))"), "done") @@ -208,6 +214,7 @@ do local root = arg[0]:gsub("test/[^/]*$", "") if root == "" then root = "./" end local prog = [[ +(prolog-memory 1000) (defprolog ldown 0 done <-- !; N R <-- (when (> N 0)) (is M (- N 1)) (ldown M R);) diff --git a/test/stdlib_spec.lua b/test/stdlib_spec.lua index 368f89b..1c5b2f1 100644 --- a/test/stdlib_spec.lua +++ b/test/stdlib_spec.lua @@ -1,14 +1,13 @@ --- test/stdlib_spec.lua — regression for loading the standard library from its --- S-lineage Shen sources (lib/StLib) instead of a precompiled stlib.kl. +-- test/stdlib_spec.lua — regression for standard-library registration. -- --- The motivating bug: the pre-refresh port booted klambda/stlib.kl as raw KL +-- The motivating bug: an earlier port booted klambda/stlib.kl as raw KL -- defuns, which put functions in F but NEVER registered their `arity` property --- or shen.*lambdatable* entry (stlib.initialise was never called). So a bare --- top-level `(filter ...)` or a first-class `(fn filter)` — both of which --- resolve through the lambda table — died with "fn: filter is undefined", --- even though the function existed. Loading the stdlib through the kernel's own --- (load)/define pipeline (boot.lua load_stdlib) registers the arity + lambda --- entry, so these now work. This spec locks that behaviour in. +-- or lambda form (stlib.initialise was never called). So a bare top-level +-- `(filter ...)` or a first-class `(fn filter)` — both of which resolve +-- through the lambda form — died with "fn: filter is undefined", even though +-- the function existed. On ShenOSKernel 42.2 boot.lua load_stdlib runs +-- (stlib.initialise) after the kernel is initialised (port-upgrades.md 41.1), +-- which registers every arity + lambda form. This spec locks that in. -- -- luajit test/stdlib_spec.lua local shen = require("shen") diff --git a/tests/README b/tests/README index 8f2f751..a0bc6a3 100644 --- a/tests/README +++ b/tests/README @@ -1,4 +1,4 @@ -This directory contains test programs for testing the Shen kernel. -To run it; cd to this directory within Shen and enter - +This directory contains test programs for testing the Shen kernel. +To run it; cd to this directory within Shen and enter + (load "runme.shen") \ No newline at end of file diff --git a/tests/binary.shen b/tests/binary.shen index 63fe906..e6a5cd3 100644 --- a/tests/binary.shen +++ b/tests/binary.shen @@ -1,24 +1,24 @@ -(datatype binary - -if (element? X [0 1]) -_____________ -X : zero-or-one; - -X : zero-or-one; -________________ -[X] : binary; - -X : zero-or-one; Y : binary; -____________________________ -[X | Y] : binary; - -X : zero-or-one, [Y | Z] : binary >> P; -________________________________________ -[X Y | Z] : binary >> P;) - -(define complement - {binary --> binary} - [0] -> [1] - [1] -> [0] - [1 N | X] -> [0 | (complement [N | X])] - [0 N | X] -> [1 | (complement [N | X])]) +(datatype binary + +if (element? X [0 1]) +_____________ +X : zero-or-one; + +X : zero-or-one; +________________ +[X] : binary; + +X : zero-or-one; Y : binary; +____________________________ +[X | Y] : binary; + +X : zero-or-one, [Y | Z] : binary >> P; +________________________________________ +[X Y | Z] : binary >> P;) + +(define complement + {binary --> binary} + [0] -> [1] + [1] -> [0] + [1 N | X] -> [0 | (complement [N | X])] + [0 N | X] -> [1 | (complement [N | X])]) diff --git a/tests/bubble version 1.shen b/tests/bubble version 1.shen index 0a6737a..e822130 100644 --- a/tests/bubble version 1.shen +++ b/tests/bubble version 1.shen @@ -1,28 +1,28 @@ -(define bubble-sort - \* bubble again if you need to *\ - X -> (bubble-again-perhaps (bubble X) X)) - -(define bubble - [] -> [] - [X] -> [X] - [X Y | Z] -> [Y | (bubble [X | Z])] where (> Y X) - [X Y | Z] -> [X | (bubble [Y | Z])]) - -(define bubble-again-perhaps - \* no change as a result of bubbling - then the job is done *\ - X X -> X - \* else bubble again *\ - X _ -> (bubble-sort X)) - - - - - - - - - - - - - +(define bubble-sort + \* bubble again if you need to *\ + X -> (bubble-again-perhaps (bubble X) X)) + +(define bubble + [] -> [] + [X] -> [X] + [X Y | Z] -> [Y | (bubble [X | Z])] where (> Y X) + [X Y | Z] -> [X | (bubble [Y | Z])]) + +(define bubble-again-perhaps + \* no change as a result of bubbling - then the job is done *\ + X X -> X + \* else bubble again *\ + X _ -> (bubble-sort X)) + + + + + + + + + + + + + diff --git a/tests/bubble version 2.shen b/tests/bubble version 2.shen index 4435083..5290336 100644 --- a/tests/bubble version 2.shen +++ b/tests/bubble version 2.shen @@ -1,22 +1,22 @@ -(define bubble-sort - X -> (fix (fn bubble) X)) - -(define bubble - [] -> [] - [X] -> [X] - [X Y | Z] -> [Y | (bubble [X | Z])] where (> Y X) - [X Y | Z] -> [X | (bubble [Y | Z])]) - - - - - - - - - - - - - - +(define bubble-sort + X -> (fix (fn bubble) X)) + +(define bubble + [] -> [] + [X] -> [X] + [X Y | Z] -> [Y | (bubble [X | Z])] where (> Y X) + [X Y | Z] -> [X | (bubble [Y | Z])]) + + + + + + + + + + + + + + diff --git a/tests/c-minus.shen b/tests/c-minus.shen index f1409d1..868d269 100644 --- a/tests/c-minus.shen +++ b/tests/c-minus.shen @@ -1,516 +1,516 @@ -\\(package c- [] - -(synonyms preamble (list statement)) - -(datatype program - - Preamble : preamble; Main : main; - ========================================= - [Preamble Main] : program;) - -(datatype preamble - - ______________ - [] : preamble; - - [declare | Declaration] : declaration; Preamble : preamble; - =========================================================== - [[declare | Declaration] | Preamble] : preamble; - - [procedure | Proc] : procedure; Preamble : preamble; - ==================================================== - [[procedure | Proc] | Preamble] : preamble; - - [assign | Assignment] : assignment; Preamble : preamble; - ==================================================== - [[assign | Assignment] | Preamble] : preamble;) - -(datatype main - - Statement : statement; - ========================== - [main [] Statement] : main;) - -(datatype statement - - Statements : (list statement); - ================================== - [compound | Statements] : statement; - - [printf | Rest] : print; - =========================== - [printf | Rest] : statement; - - [assign | Rest] : assignment; - ============================= - [assign | Rest] : statement; - - [assignref | Rest] : assignment; - ============================= - [assignref | Rest] : statement; - - [if | Rest] : conditional; - ========================== - [if | Rest] : statement; - - [while | Rest] : while; - =========================== - [while | Rest] : statement; - - [declare | Rest] : declaration; - =============================== - [declare | Rest] : statement; - - E : expr; - ====================== - [return E] : statement;) - -(datatype assignment - - VectorRef : expr; Expr : expr; - ===================================== - [assignref VectorRef Expr] : assignment; - - Variable : symbol; Expr : expr; - ===================================== - [assign Variable Expr] : assignment;) - -(datatype expr - - X : symbol; - _______________ - X : expr; - - X : constant; - _______________ - X : expr; - - Prefix : op; Exprs : (list expr); - ================================= - [Prefix | Exprs] : expr;) - -(datatype op - - Op : symbol; - __________________ - Op : op; - - Op : infix; - __________ - Op : op; - - if (element? Op [and or > < >= <= equals * + - /]) - ____________________________________________________ - Op : infix;) - -(datatype conditional - - Test : expr; Statement1 : statement; Statement2 : statement; - ============================================================ - [if Test then Statement1 else Statement2] : conditional; - - Test : expr; Statement : statement; - ====================================== - [if Test then Statement] : conditional;) - -(datatype constant - - C : string; - ___________ - C : constant; - - C : number; - _______________ - C : constant;) - -(datatype integer - - if (integer? N) - ____________ - N : integer; - - if (element? Op [+ - *]) - M : integer; N : integer; - ___________________________ - (Op M N) : integer; - - N : integer; - _____________________ - N : number;) - -(datatype print - - String : string; Exprs : (list expr); - ===================================== - [printf String | Exprs] : print;) - -(datatype while - - Condition : expr; Do : statement; - ================================= - [while Condition Do] : while;) - -(datatype parameters - - __________________ - [] : parameters; - - Type : type; Variable : symbol; Parameters : parameters; - ============================================================== - [Type Variable | Parameters] : parameters;) - -(datatype declaration - - Type : type; Variables : (list symbol); - ============================================= - [declare Type Variables] : declaration; - - Type : type; Variable : symbol; Dim : integer; - =================================================== - [declare [vector Type] Variable Dim] : declaration;) - -(datatype type - - if (element? T [int char float]) - ________________________ - T : type;) - -(datatype procedure - - Type : type; Name : symbol; Parameters : parameters; Body : statement; - ====================================================================== - [procedure Type Name Parameters Body] : procedure;) - -(datatype parameters - - __________________ - [] : parameters; - - Type : type; Variable : symbol; Parameters : parameters; - ======================================================== - [Type Variable | Parameters] : parameters;) - -\\(spy +) - -\\(define c-minus - \\{string --> program} - \\File -> (compile (fn ) (read-file-as-unit-strings File))) - -(define read-file-as-unit-strings - {string --> (list string)} - File -> (map (fn n->string) (read-file-as-bytelist File))) - -(defcc - {(list string) ==> program} -
:= [
];) - -(defcc - {(list string) ==> preamble} - ; - := [];) - -(defcc
- {(list string) ==> main} - ($ main) "(" ")" ";" := [main [] ];) - -(defcc - {(list string) ==> statement} - ; - ;) - -(defcc - {(list string) ==> statement} - "{" "}" := [compound | ];) - -(defcc - {(list string) ==> (list statement)} - ";" := [ | ]; - ";" := [];) - -(defcc - {(list string) ==> statement} - \\ ; - ; - ; - ; - ; - ; - ;) - -(defcc - {(list string) ==> statement} - "=" := [assignref ]; - "=" := [assign ];) - -(defcc - {(list string) ==> statement} - ($ return) := [return ];) - -(defcc - {(list string) ==> statement} - ($ if) - ($ then) - ($ else) - := [if then else ]; - ($ if) ($ then) - := [if then ];) - -(defcc - {(list string) ==> statement} - ;) - -(defcc - {(list string) ==> statement} - ;) - -(defcc - {(list string) ==> (list expr)} - "," := [ | ]; - := []; - := [];) - -(defcc - {(list string) ==> expr} - ; ; ; ;) - -(defcc - {(list string) ==> expr} - := [ref ];) - -(defcc - {(list string) ==> expr} - "[" "]" := ;) - -(defcc - {(list string) ==> expr} - "(" ")" - := [ ]; - "(" ")" - := [ | ];) - -(defcc - {(list string) ==> expr} - ;) - -(defcc - {(list string) ==> expr} - ;) - -(defcc - {(list string) ==> symbol} - := (string->symbol );) - -(defcc - {(list string) ==> infix} - "&" "&" := and; - "|" "|" := or; - ">" := >; - "<" := <; - ">" "=" := >=; - "<" "=" := <=; - "=" "=" := equals; - "*" := *; - "+" := +; - "-" := -; - "/" := /;) - -(defcc - {(list string) ==> constant} - := ; - := ; - := ;) - -(defcc - {(list string) ==> number} - 
 "."  := (compute-float 
 );)
-
-(defcc 
-  {(list string) ==> (list integer)}
-    := ;)
-
-(defcc 
-  {(list string) ==> (list integer)}
-   := ;)  
-
-(define compute-float
-  {(list integer) --> (list integer) --> number}
-   Pre Post -> (+ (compute-int Pre) (compute-fractional Post)))
-   
-(define compute-int
-  {(list integer) --> integer}
-  [] -> 0
-  [N | Ns] -> (+ (* N (exptint 10 (intlength Ns))) (compute-int Ns)))   
-
-(define compute-fractional
-  {(list integer) --> number}
-   Post -> (compute-fractional-h Post 1))
-
-(define compute-fractional-h
-  {(list integer) --> integer --> number}
-  [] _ -> 0
-  [N | Ns] Expt -> (+ (/ N (exptint 10 Expt)) (compute-fractional-h Ns (+ Expt 1))))
-  
-(define exptint
-  {integer --> integer --> integer}
-   _ 0 -> 1
-   M N -> (* M (exptint M (- N 1))))  
-  
-(defcc 
-  {(list string) ==> string}
-   "'" C "'" := C;)
-
-(defcc 
-  {(list string) ==> integer}
-   := (compute-int );)
-
-(defcc  
-  {(list string) ==> (list integer)}
-    := [(digit ) | ];
-   := [(digit )];)
-
-(defcc  
-  {(list string) ==> string}
-  X := X        where (element? X ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9"]);)
-   
-(define digit
-  {string --> integer}
-  "0" -> 0
-  "1" -> 1
-  "2" -> 2
-  "3" -> 3
-  "4" -> 4
-  "5" -> 5
-  "6" -> 6
-  "7" -> 7
-  "8" -> 8
-  "9" -> 9)
-
-(define intlength
-  {(list A) --> integer}
-  [] -> 0
-  [_ | Y] -> (+ 1 (intlength Y)))
-  
-(defcc 
-  {(list string) ==> statement}  
-   ($ printf)  "("      ")" 
-      := [printf  | ];)                 
-
-(defcc 
-  {(list string) ==> string}
-  "c#34;"  "c#34;" := ;)
-
-(defcc 
-  {(list string) ==> string}
-   "/" "n"  := (@s "c#13;" );
-   "/" "i"  := (@s "~A" );
-     := (@s  );
-    := "";) 
-   
-(defcc  
-   {(list string) ==> string}
-    X := X  	where (not (= "c#34;" X));)
-
-(defcc  
-   {(list string) ==> statement}
-    ($ while)     
-   := [while  ];)
-   
-(defcc 
-  {(list string) ==> statement} 
-       := [declare  ];
-         
-  := [declare [vector ]  ];)            
-  
-(defcc 
- {(list string) ==> integer}
-"["    "]" := ;)
- 
-(defcc 
- {(list string) ==> type}
-  ($ int) := int;
-  ($ char) := char;
-  ($ float) := float;) 
-
-(defcc 
- {(list string) ==> (list symbol)}
-   ","   := [ | ];
-  := [];)
- 
-(defcc 
- {(list string) ==> symbol}
-  := (string->symbol );)
-
-(defcc 
-  {(list string) ==> string}
-    := (@s  );)
-
-(defcc 
-  {(list string) ==> string}
-    := (@s  );
-    := (@s  );
-   := "";)
-
-(defcc 
-  {(list string) ==> string}
-  S := S where (or (alpha*? S) (= "_" S));)
-  
-(define alpha*?
-  {string --> boolean}
-   S -> (let N (string->n S)
-             (or (and (> N 96) (< N 123))
-                 (and (> N 64) (< N 91))))) 
-
-(defcc  
-  {(list string) ==> string}
-  X := X          where (element? X ["0" "1" "2""3""4""5""6""7""8""9"]);)
-  
-(defcc 
-  {(list string) ==> procedure}
-       "("  ")"    := 
-    [procedure    ];)
-    
-(defcc 
-  {(list string) ==> parameters}
-      ","   := [  | ];  
-       := [ ]; 
-   := [];)
-      
-(defcc 
-  {(list string) ==> symbol} 
-   := a \\(string->symbol )   where (not (==  main));)    
-    ;)
-\\(defcc 
- \\ {(list string) ==> parameters}
- \\     ","   := [  | ];  
- \\      := [ ]; 
- \\  := [];)  
-
-(defcc 
-  {(list string) ==> symbol}
-    := skip;
-    := skip;
-    := skip;
-    := skip;
-   := skip;) 
-
-(defcc 
-  {(list string) ==> symbol}
-  X := skip      where (= (string->n X) 32);)
-
-(defcc 
-  {(list string) ==> symbol}
-  X := skip      where (= (string->n X) 9);)
-
-(defcc 
-  {(list string) ==> symbol}
-  X := skip      where (element? (string->n X) [10 13]);)
-
-(defcc 
-  {(list string) ==> symbol}
-  "/" "*"  := skip;)
-
-(defcc 
-  {(list string) ==> symbol}
-  "/" "*" := skip!;
-  _  := skip;)
-  \\)
+\\(package c- []
+
+(synonyms preamble (list statement))
+
+(datatype program
+
+  Preamble : preamble; Main : main;
+  =========================================
+  [Preamble Main] : program;)
+
+(datatype preamble
+
+  ______________
+  [] : preamble;
+
+  [declare | Declaration] : declaration; Preamble : preamble;
+  ===========================================================
+  [[declare | Declaration] | Preamble] : preamble;
+
+  [procedure | Proc] : procedure; Preamble : preamble;
+  ====================================================
+  [[procedure | Proc] | Preamble] : preamble;
+
+  [assign | Assignment] : assignment; Preamble : preamble;
+  ====================================================
+  [[assign | Assignment] | Preamble] : preamble;)
+
+(datatype main
+
+  Statement : statement;
+  ==========================
+  [main [] Statement] : main;)
+
+(datatype statement
+
+     Statements : (list statement);
+     ==================================
+     [compound | Statements] : statement;
+
+     [printf | Rest] : print;
+     ===========================
+     [printf | Rest] : statement;
+
+     [assign | Rest] : assignment;
+     =============================
+     [assign | Rest] : statement;
+
+     [assignref | Rest] : assignment;
+     =============================
+     [assignref | Rest] : statement;
+
+     [if | Rest] : conditional;
+     ==========================
+     [if | Rest] : statement;
+
+     [while | Rest] : while;
+     ===========================
+     [while | Rest] : statement;
+
+     [declare | Rest] : declaration;
+     ===============================
+     [declare | Rest] : statement;
+
+     E : expr;
+     ======================
+     [return E] : statement;)
+
+(datatype assignment
+
+  VectorRef : expr; Expr : expr;
+  =====================================
+  [assignref VectorRef Expr] : assignment;
+
+  Variable : symbol; Expr : expr;
+  =====================================
+  [assign Variable Expr] : assignment;)
+
+(datatype expr
+
+   X : symbol;
+   _______________
+   X : expr;
+
+  X : constant;
+  _______________
+  X : expr;
+
+  Prefix : op; Exprs : (list expr);
+  =================================
+  [Prefix | Exprs] : expr;)
+
+(datatype op
+
+  Op : symbol;
+  __________________
+  Op : op;
+
+  Op : infix;
+  __________
+  Op : op;
+
+  if (element? Op [and or > < >= <= equals * + - /])
+  ____________________________________________________
+  Op : infix;)
+
+(datatype conditional
+
+  Test : expr; Statement1 : statement; Statement2 : statement;
+  ============================================================
+  [if Test then Statement1 else Statement2] : conditional;
+
+  Test : expr; Statement : statement;
+  ======================================
+  [if Test then Statement] : conditional;)
+
+(datatype constant
+
+   C : string;
+   ___________
+   C : constant;
+
+   C : number;
+   _______________
+   C : constant;)
+
+(datatype integer
+
+  if (integer? N)
+   ____________
+  N : integer;
+
+  if (element? Op [+ - *])
+  M : integer; N : integer;
+  ___________________________
+  (Op M N) : integer;
+
+  N : integer;
+  _____________________
+  N : number;)
+
+(datatype print
+
+  String : string; Exprs : (list expr);
+  =====================================
+  [printf String | Exprs] : print;)
+
+(datatype while
+
+   Condition : expr; Do : statement;
+   =================================
+   [while Condition Do] : while;)
+
+(datatype parameters
+
+  __________________
+  [] : parameters;
+
+  Type : type; Variable : symbol; Parameters : parameters;
+  ==============================================================
+  [Type Variable | Parameters] : parameters;)
+
+(datatype declaration
+
+  Type : type; Variables : (list symbol);
+  =============================================
+  [declare Type Variables] : declaration;
+
+  Type : type; Variable : symbol; Dim : integer;
+  ===================================================
+  [declare [vector Type] Variable Dim] : declaration;)
+
+(datatype type
+
+ if (element? T [int char float])
+ ________________________
+ T : type;)
+
+(datatype procedure
+
+  Type : type; Name : symbol; Parameters : parameters; Body : statement;
+  ======================================================================
+  [procedure Type Name Parameters Body] : procedure;)
+
+(datatype parameters
+
+  __________________
+  [] : parameters;
+
+  Type : type; Variable : symbol; Parameters : parameters;
+  ========================================================
+  [Type Variable | Parameters] : parameters;)
+
+\\(spy +)
+
+\\(define c-minus
+ \\{string --> program}
+  \\File -> (compile (fn ) (read-file-as-unit-strings File)))
+
+(define read-file-as-unit-strings
+  {string --> (list string)}
+   File -> (map (fn n->string) (read-file-as-bytelist File)))
+
+(defcc 
+  {(list string) ==> program}
+      
  := [ 
];)
+
+(defcc 
+  {(list string) ==> preamble}
+   ;
+    := [];)
+
+(defcc 

+  {(list string) ==> main}
+  ($ main)  "("  ")"    ";"  := [main [] ];)
+
+(defcc 
+  {(list string) ==> statement}
+  ;
+  ;)
+
+(defcc 
+  {(list string) ==> statement}
+   "{"    "}"  := [compound | ];)
+
+(defcc 
+  {(list string) ==> (list statement)}
+    ";"   := [ | ];
+    ";" := [];)
+
+(defcc 
+  {(list string) ==> statement}
+ \\ ;
+  ;
+  ;
+  ;
+  ;
+  ;
+  ;)
+
+(defcc 
+  {(list string) ==> statement}
+     "="   := [assignref  ];
+     "="   := [assign  ];)
+
+(defcc 
+  {(list string) ==> statement}
+    ($ return)    := [return ];)
+
+(defcc 
+   {(list string) ==> statement}
+    ($ if)  
+           ($ then)  
+           ($ else)   
+         := [if  then  else ];
+    ($ if)    ($ then)   
+    := [if  then ];)
+
+(defcc 
+   {(list string) ==> statement}
+   ;)
+
+(defcc 
+  {(list string) ==> statement}
+   ;)
+
+(defcc 
+    {(list string) ==> (list expr)}
+      ","   := [ | ];
+     := [];
+     := [];)
+
+(defcc 
+   {(list string) ==> expr}
+    ; ; ;  ;)
+
+(defcc 
+   {(list string) ==> expr}
+      := [ref  ];)
+
+(defcc 
+   {(list string) ==> expr}
+   "["    "]" := ;)
+
+(defcc 
+  {(list string) ==> expr}
+    "("       ")" 
+     := [  ];
+     "("    ")" 
+     := [ | ];)
+
+(defcc 
+    {(list string) ==> expr}
+   ;)
+
+(defcc 
+    {(list string) ==> expr}
+    ;)
+
+(defcc 
+  {(list string) ==> symbol}
+   := (string->symbol );)
+
+(defcc 
+  {(list string) ==> infix}
+  "&" "&" := and;
+  "|" "|" := or;
+  ">" := >;
+  "<" := <;
+  ">" "=" := >=;
+  "<" "=" := <=;
+  "=" "=" := equals;
+   "*" := *;
+   "+" := +;
+   "-" := -;
+   "/" := /;)
+
+(defcc 
+   {(list string) ==> constant}
+    := ;
+    := ;
+    := ;)
+
+(defcc 
+  {(list string) ==> number}
+  
 "."  := (compute-float 
 );)
+
+(defcc 
+  {(list string) ==> (list integer)}
+    := ;)
+
+(defcc 
+  {(list string) ==> (list integer)}
+   := ;)
+
+(define compute-float
+  {(list integer) --> (list integer) --> number}
+   Pre Post -> (+ (compute-int Pre) (compute-fractional Post)))
+
+(define compute-int
+  {(list integer) --> integer}
+  [] -> 0
+  [N | Ns] -> (+ (* N (exptint 10 (intlength Ns))) (compute-int Ns)))
+
+(define compute-fractional
+  {(list integer) --> number}
+   Post -> (compute-fractional-h Post 1))
+
+(define compute-fractional-h
+  {(list integer) --> integer --> number}
+  [] _ -> 0
+  [N | Ns] Expt -> (+ (/ N (exptint 10 Expt)) (compute-fractional-h Ns (+ Expt 1))))
+
+(define exptint
+  {integer --> integer --> integer}
+   _ 0 -> 1
+   M N -> (* M (exptint M (- N 1))))
+
+(defcc 
+  {(list string) ==> string}
+   "'" C "'" := C;)
+
+(defcc 
+  {(list string) ==> integer}
+   := (compute-int );)
+
+(defcc 
+  {(list string) ==> (list integer)}
+    := [(digit ) | ];
+   := [(digit )];)
+
+(defcc 
+  {(list string) ==> string}
+  X := X        where (element? X ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9"]);)
+
+(define digit
+  {string --> integer}
+  "0" -> 0
+  "1" -> 1
+  "2" -> 2
+  "3" -> 3
+  "4" -> 4
+  "5" -> 5
+  "6" -> 6
+  "7" -> 7
+  "8" -> 8
+  "9" -> 9)
+
+(define intlength
+  {(list A) --> integer}
+  [] -> 0
+  [_ | Y] -> (+ 1 (intlength Y)))
+
+(defcc 
+  {(list string) ==> statement}
+   ($ printf)  "("      ")" 
+      := [printf  | ];)
+
+(defcc 
+  {(list string) ==> string}
+  "c#34;"  "c#34;" := ;)
+
+(defcc 
+  {(list string) ==> string}
+   "/" "n"  := (@s "c#13;" );
+   "/" "i"  := (@s "~A" );
+     := (@s  );
+    := "";)
+
+(defcc 
+   {(list string) ==> string}
+    X := X  	where (not (= "c#34;" X));)
+
+(defcc 
+   {(list string) ==> statement}
+    ($ while)     
+   := [while  ];)
+
+(defcc 
+  {(list string) ==> statement}
+       := [declare  ];
+        
+  := [declare [vector ]  ];)
+
+(defcc 
+ {(list string) ==> integer}
+"["    "]" := ;)
+
+(defcc 
+ {(list string) ==> type}
+  ($ int) := int;
+  ($ char) := char;
+  ($ float) := float;)
+
+(defcc 
+ {(list string) ==> (list symbol)}
+   ","   := [ | ];
+  := [];)
+
+(defcc 
+ {(list string) ==> symbol}
+  := (string->symbol );)
+
+(defcc 
+  {(list string) ==> string}
+    := (@s  );)
+
+(defcc 
+  {(list string) ==> string}
+    := (@s  );
+    := (@s  );
+   := "";)
+
+(defcc 
+  {(list string) ==> string}
+  S := S where (or (alpha*? S) (= "_" S));)
+
+(define alpha*?
+  {string --> boolean}
+   S -> (let N (string->n S)
+             (or (and (> N 96) (< N 123))
+                 (and (> N 64) (< N 91)))))
+
+(defcc 
+  {(list string) ==> string}
+  X := X          where (element? X ["0" "1" "2""3""4""5""6""7""8""9"]);)
+
+(defcc 
+  {(list string) ==> procedure}
+       "("  ")"    :=
+    [procedure    ];)
+
+(defcc 
+  {(list string) ==> parameters}
+      ","   := [  | ];
+       := [ ];
+   := [];)
+
+(defcc 
+  {(list string) ==> symbol}
+   := a \\(string->symbol )   where (not (==  main));)
+    ;)
+\\(defcc 
+ \\ {(list string) ==> parameters}
+ \\     ","   := [  | ];
+ \\      := [ ];
+ \\  := [];)
+
+(defcc 
+  {(list string) ==> symbol}
+    := skip;
+    := skip;
+    := skip;
+    := skip;
+   := skip;)
+
+(defcc 
+  {(list string) ==> symbol}
+  X := skip      where (= (string->n X) 32);)
+
+(defcc 
+  {(list string) ==> symbol}
+  X := skip      where (= (string->n X) 9);)
+
+(defcc 
+  {(list string) ==> symbol}
+  X := skip      where (element? (string->n X) [10 13]);)
+
+(defcc 
+  {(list string) ==> symbol}
+  "/" "*"  := skip;)
+
+(defcc 
+  {(list string) ==> symbol}
+  "/" "*" := skip!;
+  _  := skip;)
+  \\)
diff --git a/tests/calculator.shen b/tests/calculator.shen
index 8eca70e..b3bb02f 100644
--- a/tests/calculator.shen
+++ b/tests/calculator.shen
@@ -1,21 +1,21 @@
-(datatype arith-expr
-
-    X : number;
-    ====================
-    [num X] : arith-expr; 
-
-    if (element? Op [+ - * /])
-    X : arith-expr; Y : arith-expr;
-    ===============================
-    [X Op Y] : arith-expr;)
-
-(define do-calculation
-  {arith-expr --> number}
-  [X + Y] -> (+ (do-calculation X) (do-calculation Y))
-  [X - Y] -> (- (do-calculation X) (do-calculation Y))
-  [X * Y] -> (* (do-calculation X) (do-calculation Y))
-  [X / Y] -> (/ (do-calculation X) (do-calculation Y))
-  [num X] -> X)
-
-
-
+(datatype arith-expr
+
+    X : number;
+    ====================
+    [num X] : arith-expr;
+
+    if (element? Op [+ - * /])
+    X : arith-expr; Y : arith-expr;
+    ===============================
+    [X Op Y] : arith-expr;)
+
+(define do-calculation
+  {arith-expr --> number}
+  [X + Y] -> (+ (do-calculation X) (do-calculation Y))
+  [X - Y] -> (- (do-calculation X) (do-calculation Y))
+  [X * Y] -> (* (do-calculation X) (do-calculation Y))
+  [X / Y] -> (/ (do-calculation X) (do-calculation Y))
+  [num X] -> X)
+
+
+
diff --git a/tests/call.shen b/tests/call.shen
index 1311d66..61ddc98 100644
--- a/tests/call.shen
+++ b/tests/call.shen
@@ -1,15 +1,14 @@
-(defprolog mapit
-  _  [] [] <--;
-  Pred [X | Y] [W | Z] <-- (call (Pred X W)) (mapit Pred Y Z);) 
-
-(defprolog consit
-  X [1 X] <--;) 
-
-(defprolog different
-  X Y <--  (not! (is X Y));) 
-
-(defprolog not!
-  P <-- (call P) ! (when false);
-  _ <--;) 
-
-     
\ No newline at end of file
+(defprolog mapit
+  _  [] [] <--;
+  Pred [X | Y] [W | Z] <-- (call (Pred X W)) (mapit Pred Y Z);)
+
+(defprolog consit
+  X [1 X] <--;)
+
+(defprolog different
+  X Y <--  (not! (is X Y));)
+
+(defprolog not!
+  P <-- (call P) ! (when false);
+  _ <--;)
+
diff --git a/tests/cartprod.shen b/tests/cartprod.shen
index 7fb0983..56e36e4 100644
--- a/tests/cartprod.shen
+++ b/tests/cartprod.shen
@@ -1,23 +1,23 @@
-(define cartesian-product 
-   [ ] _ -> [ ]  
-   [X | Y] Z -> (append (all-pairs-using-X X Z) (cartesian-product Y Z)))
-
-(define all-pairs-using-X 
-   _ [ ] -> [ ] 
-   X [Y | Z] -> [[X Y] | (all-pairs-using-X X Z)]) 
-   
-
-   
-    
-      
-    
-      
-
-
-
-
-
-
-
- 
-
+(define cartesian-product
+   [ ] _ -> [ ]
+   [X | Y] Z -> (append (all-pairs-using-X X Z) (cartesian-product Y Z)))
+
+(define all-pairs-using-X
+   _ [ ] -> [ ]
+   X [Y | Z] -> [[X Y] | (all-pairs-using-X X Z)])
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/change.shen b/tests/change.shen
index 2d2e323..0e62859 100644
--- a/tests/change.shen
+++ b/tests/change.shen
@@ -1,25 +1,25 @@
-(define count-change 
-    Amount -> (count-change* Amount 200))
-
-(define count-change* 
-    0 _ -> 1  
-    _ 0 -> 0  
-    Amount _ -> 0  	where (> 0 Amount)
-    Amount Fst_Denom  
-    -> (+ (count-change* (- Amount Fst_Denom) Fst_Denom) 
-          (count-change* Amount (next-denom Fst_Denom))))
-
-(define next-denom
-   200 -> 100  
-   100 -> 50  
-   50 -> 20  
-   20 -> 10  
-   10 -> 5  
-   5 -> 2  
-   2 -> 1  
-   1 -> 0)
-
-
-
- 
-
+(define count-change
+    Amount -> (count-change* Amount 200))
+
+(define count-change*
+    0 _ -> 1
+    _ 0 -> 0
+    Amount _ -> 0  	where (> 0 Amount)
+    Amount Fst_Denom
+    -> (+ (count-change* (- Amount Fst_Denom) Fst_Denom)
+          (count-change* Amount (next-denom Fst_Denom))))
+
+(define next-denom
+   200 -> 100
+   100 -> 50
+   50 -> 20
+   20 -> 10
+   10 -> 5
+   5 -> 2
+   2 -> 1
+   1 -> 0)
+
+
+
+
+
diff --git a/tests/classes-defaults.shen b/tests/classes-defaults.shen
index 7a9c2b8..9b7e314 100644
--- a/tests/classes-defaults.shen
+++ b/tests/classes-defaults.shen
@@ -1,94 +1,94 @@
-(datatype class
-
-      Slots : [slot];
-      _______________________________________
-      (defclass Class Slots) : (class Class);
-
-      Attribute : symbol; Type : symbol;
-      ===================================
-      (@p Attribute Type) : slot;
-
-      Default : Type; Attribute : symbol; Type : symbol;
-      ==================================================
-      (@p Attribute Type Default) : slot;)
-
-(define defclass
-   Class ClassDef -> (let Attributes (map fst ClassDef)
-                          Types (record-attribute-types Class ClassDef)
-                          Assoc (map assign-values ClassDef)
-                          NewClassDef [[class | Class] | Assoc]
-                          Store (put-prop Class classdef NewClassDef)
-                          RecordClass (axiom Class Class [class Class])
-                          Class))
-
-(define assign-values
-  (@p Attribute _ Value) -> [Attribute | Value]
-  (@p Attribute _) -> [Attribute | fail!])                                
-
-(define axiom
-  DataType X A -> (eval [datatype DataType
-                                  ________
-                                   X : A;]))
-
-(define record-attribute-types
-  _ [] -> []
-  Class [(@p Attribute Type _) | ClassDef]
-   -> (let DataTypeName (concat Class Attribute)
-           DataType (axiom DataTypeName Attribute [attribute Class Type])
-           (record-attribute-types Class ClassDef))
-  Class [(@p Attribute Type) | ClassDef] 
-   -> (let DataTypeName (concat Class Attribute)
-           DataType (axiom DataTypeName Attribute [attribute Class Type])
-           (record-attribute-types Class ClassDef)))         
-                                            
-(declare make-instance [[class Class] --> [instance Class]])
-
-(define make-instance
-   Class -> (let ClassDef (get-prop Class classdef [])
-                 (if (empty? ClassDef)
-                     (error "class ~A does not exist~%" Class)
-                     ClassDef))) 
-
-(declare get-value [[attribute Class A] --> [instance Class] --> A])
-
-(define get-value
-   Attribute Instance -> (let LookUp (assoc Attribute Instance)
-                              (get-value-test LookUp)))
-
-(define get-value-test
-  [ ] -> (error "no such attribute!~%")
-  [_ | fail!] -> (error "no such value!~%")
-  [_ | Value] -> Value) 
-
-(declare has-value? [[attribute Class A] --> [instance Class] --> boolean])
-
-(define has-value?
-  Attribute Instance -> (let LookUp (assoc Attribute Instance)
-                             (has-value-test LookUp)))
-
-(define has-value-test
-  [ ] -> (error "no such attribute!~%")
-  [_ | fail!] -> false
-  _ -> true) 
-
-(declare has-attribute? [symbol --> [instance Class] --> boolean])
-
-(define has-attribute?
-  Attribute Instance -> (let LookUp (assoc Attribute Instance)
-                             (not (empty? LookUp))))
-
-(declare change-value [[instance Class] --> [attribute Class A] --> A --> [instance Class]])
-
-(define change-value
-    _ class _ -> (error "cannot change the class of an instance!~%")
-    [ ] _ _ -> (error "no such attribute!~%")
-    [[Attribute | _] | Instance] Attribute Value 
-     -> [[Attribute | Value] | Instance]
-    [Slot | Instance] Attribute Value 
-    -> [Slot | (change-value Instance Attribute Value)])
-
-(declare instance-of [[instance Class] --> [class Class]])
-
-(define instance-of
-    [[class | Class] | _] -> Class
-    _ -> (error "not a class instance!"))
+(datatype class
+
+      Slots : [slot];
+      _______________________________________
+      (defclass Class Slots) : (class Class);
+
+      Attribute : symbol; Type : symbol;
+      ===================================
+      (@p Attribute Type) : slot;
+
+      Default : Type; Attribute : symbol; Type : symbol;
+      ==================================================
+      (@p Attribute Type Default) : slot;)
+
+(define defclass
+   Class ClassDef -> (let Attributes (map fst ClassDef)
+                          Types (record-attribute-types Class ClassDef)
+                          Assoc (map assign-values ClassDef)
+                          NewClassDef [[class | Class] | Assoc]
+                          Store (put-prop Class classdef NewClassDef)
+                          RecordClass (axiom Class Class [class Class])
+                          Class))
+
+(define assign-values
+  (@p Attribute _ Value) -> [Attribute | Value]
+  (@p Attribute _) -> [Attribute | fail!])
+
+(define axiom
+  DataType X A -> (eval [datatype DataType
+                                  ________
+                                   X : A;]))
+
+(define record-attribute-types
+  _ [] -> []
+  Class [(@p Attribute Type _) | ClassDef]
+   -> (let DataTypeName (concat Class Attribute)
+           DataType (axiom DataTypeName Attribute [attribute Class Type])
+           (record-attribute-types Class ClassDef))
+  Class [(@p Attribute Type) | ClassDef]
+   -> (let DataTypeName (concat Class Attribute)
+           DataType (axiom DataTypeName Attribute [attribute Class Type])
+           (record-attribute-types Class ClassDef)))
+
+(declare make-instance [[class Class] --> [instance Class]])
+
+(define make-instance
+   Class -> (let ClassDef (get-prop Class classdef [])
+                 (if (empty? ClassDef)
+                     (error "class ~A does not exist~%" Class)
+                     ClassDef)))
+
+(declare get-value [[attribute Class A] --> [instance Class] --> A])
+
+(define get-value
+   Attribute Instance -> (let LookUp (assoc Attribute Instance)
+                              (get-value-test LookUp)))
+
+(define get-value-test
+  [ ] -> (error "no such attribute!~%")
+  [_ | fail!] -> (error "no such value!~%")
+  [_ | Value] -> Value)
+
+(declare has-value? [[attribute Class A] --> [instance Class] --> boolean])
+
+(define has-value?
+  Attribute Instance -> (let LookUp (assoc Attribute Instance)
+                             (has-value-test LookUp)))
+
+(define has-value-test
+  [ ] -> (error "no such attribute!~%")
+  [_ | fail!] -> false
+  _ -> true)
+
+(declare has-attribute? [symbol --> [instance Class] --> boolean])
+
+(define has-attribute?
+  Attribute Instance -> (let LookUp (assoc Attribute Instance)
+                             (not (empty? LookUp))))
+
+(declare change-value [[instance Class] --> [attribute Class A] --> A --> [instance Class]])
+
+(define change-value
+    _ class _ -> (error "cannot change the class of an instance!~%")
+    [ ] _ _ -> (error "no such attribute!~%")
+    [[Attribute | _] | Instance] Attribute Value
+     -> [[Attribute | Value] | Instance]
+    [Slot | Instance] Attribute Value
+    -> [Slot | (change-value Instance Attribute Value)])
+
+(declare instance-of [[instance Class] --> [class Class]])
+
+(define instance-of
+    [[class | Class] | _] -> Class
+    _ -> (error "not a class instance!"))
diff --git a/tests/classes-inheritance.shen b/tests/classes-inheritance.shen
index 29ddcb7..4598a21 100644
--- a/tests/classes-inheritance.shen
+++ b/tests/classes-inheritance.shen
@@ -1,100 +1,100 @@
-(declare defclass [symbol --> [list [class A]] --> [list [symbol * symbol]] --> symbol])
-
-(datatype subtype
-
-  (subtype B A); X : B;
-  _____________________
-  X : A;)
-
-(define defclass
-   Class SuperClasses ClassDef 
-    -> (let Attributes (map fst ClassDef)
-            Inherited (put-prop Class attributes 
-                        (append Attributes (collect-attributes SuperClasses)))
-            Types (record-attribute-types Class ClassDef)
-            Assoc (map (/. Attribute [Attribute | fail!]) Inherited)
-            ClassDef [[class | Class] | Assoc]
-            Store (put-prop Class classdef ClassDef)
-            RecordClass (axiom Class Class [class Class])
-            SubTypes (record-subtypes Class SuperClasses)
-            Class))
-
-(define record-subtypes
-  _ [] -> _
-  Class SuperClasses -> (eval [datatype (concat Class superclasses)
-                                 | (record-subtypes-help Class SuperClasses)]))
-
-(define record-subtypes-help
-  _ [] -> []
-  Class [SuperClass | SuperClasses] -> [_______________________
-                                        [subtype SuperClass Class]; | 
-                                          (record-subtypes-help Class SuperClasses)])
-                              
-(define collect-attributes
-  [] -> []
-  [SuperClass | SuperClasses] -> (append (get-prop SuperClass attributes [])
-                                         (collect-attributes SuperClasses)))
-
-(define axiom
-  DataType X A -> (eval [datatype DataType
-                                  ________
-                                   X : A;]))
-
-(define record-attribute-types
-  _ [] -> []
-  Class [(@p Attribute Type) | ClassDef] 
-   -> (let DataTypeName (concat Class Attribute)
-           DataType (axiom DataTypeName Attribute [attribute Class Type])
-           (record-attribute-types Class ClassDef)))         
-                                        
-(declare make-instance [[class Class] --> [instance Class]])
-
-(define make-instance
-   Class -> (let ClassDef (get-prop Class classdef [])
-                 (if (empty? ClassDef)
-                     (error "class ~A does not exist~%" Class)
-                     ClassDef))) 
-
-(declare get-value [[attribute Class A] --> [instance Class] --> A])
-
-(define get-value
-   Attribute Instance -> (let LookUp (assoc Attribute Instance)
-                              (get-value-test LookUp)))
-
-(define get-value-test
-  [ ] -> (error "no such attribute!~%")
-  [_ | fail!] -> (error "no such value!~%")
-  [_ | Value] -> Value) 
-
-(declare has-value? [[attribute Class A] --> [instance Class] --> boolean])
-
-(define has-value?
-  Attribute Instance -> (let LookUp (assoc Attribute Instance)
-                             (has-value-test LookUp)))
-
-(define has-value-test
-  [ ] -> (error "no such attribute!~%")
-  [_ | fail!] -> false
-  _ -> true) 
-
-(declare has-attribute? [symbol --> [instance Class] --> boolean])
-
-(define has-attribute?
-  Attribute Instance -> (let LookUp (assoc Attribute Instance)
-                             (not (empty? LookUp))))
-
-(declare change-value [[instance Class] --> [attribute Class A] --> A --> [instance Class]])
-
-(define change-value
-    _ class _ -> (error "cannot change the class of an instance!~%")
-    [ ] _ _ -> (error "no such attribute!~%")
-    [[Attribute | _] | Instance] Attribute Value 
-     -> [[Attribute | Value] | Instance]
-    [Slot | Instance] Attribute Value 
-    -> [Slot | (change-value Instance Attribute Value)])
-
-(declare instance-of [[instance Class] --> [class Class]])
-
-(define instance-of
-    [[class | Class] | _] -> Class
-    _ -> (error "not a class instance!"))
+(declare defclass [symbol --> [list [class A]] --> [list [symbol * symbol]] --> symbol])
+
+(datatype subtype
+
+  (subtype B A); X : B;
+  _____________________
+  X : A;)
+
+(define defclass
+   Class SuperClasses ClassDef
+    -> (let Attributes (map fst ClassDef)
+            Inherited (put-prop Class attributes
+                        (append Attributes (collect-attributes SuperClasses)))
+            Types (record-attribute-types Class ClassDef)
+            Assoc (map (/. Attribute [Attribute | fail!]) Inherited)
+            ClassDef [[class | Class] | Assoc]
+            Store (put-prop Class classdef ClassDef)
+            RecordClass (axiom Class Class [class Class])
+            SubTypes (record-subtypes Class SuperClasses)
+            Class))
+
+(define record-subtypes
+  _ [] -> _
+  Class SuperClasses -> (eval [datatype (concat Class superclasses)
+                                 | (record-subtypes-help Class SuperClasses)]))
+
+(define record-subtypes-help
+  _ [] -> []
+  Class [SuperClass | SuperClasses] -> [_______________________
+                                        [subtype SuperClass Class]; |
+                                          (record-subtypes-help Class SuperClasses)])
+
+(define collect-attributes
+  [] -> []
+  [SuperClass | SuperClasses] -> (append (get-prop SuperClass attributes [])
+                                         (collect-attributes SuperClasses)))
+
+(define axiom
+  DataType X A -> (eval [datatype DataType
+                                  ________
+                                   X : A;]))
+
+(define record-attribute-types
+  _ [] -> []
+  Class [(@p Attribute Type) | ClassDef]
+   -> (let DataTypeName (concat Class Attribute)
+           DataType (axiom DataTypeName Attribute [attribute Class Type])
+           (record-attribute-types Class ClassDef)))
+
+(declare make-instance [[class Class] --> [instance Class]])
+
+(define make-instance
+   Class -> (let ClassDef (get-prop Class classdef [])
+                 (if (empty? ClassDef)
+                     (error "class ~A does not exist~%" Class)
+                     ClassDef)))
+
+(declare get-value [[attribute Class A] --> [instance Class] --> A])
+
+(define get-value
+   Attribute Instance -> (let LookUp (assoc Attribute Instance)
+                              (get-value-test LookUp)))
+
+(define get-value-test
+  [ ] -> (error "no such attribute!~%")
+  [_ | fail!] -> (error "no such value!~%")
+  [_ | Value] -> Value)
+
+(declare has-value? [[attribute Class A] --> [instance Class] --> boolean])
+
+(define has-value?
+  Attribute Instance -> (let LookUp (assoc Attribute Instance)
+                             (has-value-test LookUp)))
+
+(define has-value-test
+  [ ] -> (error "no such attribute!~%")
+  [_ | fail!] -> false
+  _ -> true)
+
+(declare has-attribute? [symbol --> [instance Class] --> boolean])
+
+(define has-attribute?
+  Attribute Instance -> (let LookUp (assoc Attribute Instance)
+                             (not (empty? LookUp))))
+
+(declare change-value [[instance Class] --> [attribute Class A] --> A --> [instance Class]])
+
+(define change-value
+    _ class _ -> (error "cannot change the class of an instance!~%")
+    [ ] _ _ -> (error "no such attribute!~%")
+    [[Attribute | _] | Instance] Attribute Value
+     -> [[Attribute | Value] | Instance]
+    [Slot | Instance] Attribute Value
+    -> [Slot | (change-value Instance Attribute Value)])
+
+(declare instance-of [[instance Class] --> [class Class]])
+
+(define instance-of
+    [[class | Class] | _] -> Class
+    _ -> (error "not a class instance!"))
diff --git a/tests/classes-typed.shen b/tests/classes-typed.shen
index 8a5eed2..708491d 100644
--- a/tests/classes-typed.shen
+++ b/tests/classes-typed.shen
@@ -1,74 +1,74 @@
-(declare defclass [symbol --> [list [symbol * symbol]] --> symbol])
-
-(define defclass
-   Class ClassDef -> (let Attributes (map (fn fst) ClassDef)
-                          Types (record-attribute-types Class ClassDef)
-                          Assoc (map (/. Attribute [Attribute | fail]) Attributes)
-                          ClassDef [[class | Class] | Assoc]
-                          Store (put Class classdef ClassDef)
-                          RecordClass (axiom Class Class [class Class])
-                          Class))
-
-(define axiom
-  DataType X A -> (eval [datatype DataType
-                                  ________
-                                   X : A;]))
-
-(define record-attribute-types
-  _ [] -> []
-  Class [(@p Attribute Type) | ClassDef] 
-   -> (let DataTypeName (concat Class Attribute)
-           DataType (axiom DataTypeName Attribute [attribute Class Type])
-           (record-attribute-types Class ClassDef)))         
-                                        
-(declare make-instance [[class Class] --> [instance Class]])
-
-(define make-instance
-   Class -> (let ClassDef (trap-error (get Class classdef) (/. E []))
-                 (if (empty? ClassDef)
-                     (error "class ~A does not exist~%" Class)
-                     ClassDef))) 
-
-(declare get-value [[attribute Class A] --> [instance Class] --> A])
-
-(define get-value
-   Attribute Instance -> (let LookUp (assoc Attribute Instance)
-                              (get-value-test LookUp)))
-
-(define get-value-test
-  [ ] -> (error "no such attribute!~%")
-  [_ | fail!] -> (error "no such value!~%")
-  [_ | Value] -> Value) 
-
-(declare has-value? [[attribute Class A] --> [instance Class] --> boolean])
-
-(define has-value?
-  Attribute Instance -> (let LookUp (assoc Attribute Instance)
-                             (has-value-test LookUp)))
-
-(define has-value-test
-  [ ] -> (error "no such attribute!~%")
-  [_ | fail] -> false
-  _ -> true) 
-
-(declare has-attribute? [symbol --> [instance Class] --> boolean])
-
-(define has-attribute?
-  Attribute Instance -> (let LookUp (assoc Attribute Instance)
-                             (not (empty? LookUp))))
-
-(declare change-value [[instance Class] --> [attribute Class A] --> A --> [instance Class]])
-
-(define change-value
-    _ class _ -> (error "cannot change the class of an instance!~%")
-    [ ] _ _ -> (error "no such attribute!~%")
-    [[Attribute | _] | Instance] Attribute Value 
-     -> [[Attribute | Value] | Instance]
-    [Slot | Instance] Attribute Value 
-    -> [Slot | (change-value Instance Attribute Value)])
-
-(declare instance-of [[instance Class] --> [class Class]])
-
-(define instance-of
-    [[class | Class] | _] -> Class
-    _ -> (error "not a class instance!"))
+(declare defclass [symbol --> [list [symbol * symbol]] --> symbol])
+
+(define defclass
+   Class ClassDef -> (let Attributes (map (fn fst) ClassDef)
+                          Types (record-attribute-types Class ClassDef)
+                          Assoc (map (/. Attribute [Attribute | fail]) Attributes)
+                          ClassDef [[class | Class] | Assoc]
+                          Store (put Class classdef ClassDef)
+                          RecordClass (axiom Class Class [class Class])
+                          Class))
+
+(define axiom
+  DataType X A -> (eval [datatype DataType
+                                  ________
+                                   X : A;]))
+
+(define record-attribute-types
+  _ [] -> []
+  Class [(@p Attribute Type) | ClassDef]
+   -> (let DataTypeName (concat Class Attribute)
+           DataType (axiom DataTypeName Attribute [attribute Class Type])
+           (record-attribute-types Class ClassDef)))
+
+(declare make-instance [[class Class] --> [instance Class]])
+
+(define make-instance
+   Class -> (let ClassDef (trap-error (get Class classdef) (/. E []))
+                 (if (empty? ClassDef)
+                     (error "class ~A does not exist~%" Class)
+                     ClassDef)))
+
+(declare get-value [[attribute Class A] --> [instance Class] --> A])
+
+(define get-value
+   Attribute Instance -> (let LookUp (assoc Attribute Instance)
+                              (get-value-test LookUp)))
+
+(define get-value-test
+  [ ] -> (error "no such attribute!~%")
+  [_ | fail!] -> (error "no such value!~%")
+  [_ | Value] -> Value)
+
+(declare has-value? [[attribute Class A] --> [instance Class] --> boolean])
+
+(define has-value?
+  Attribute Instance -> (let LookUp (assoc Attribute Instance)
+                             (has-value-test LookUp)))
+
+(define has-value-test
+  [ ] -> (error "no such attribute!~%")
+  [_ | fail] -> false
+  _ -> true)
+
+(declare has-attribute? [symbol --> [instance Class] --> boolean])
+
+(define has-attribute?
+  Attribute Instance -> (let LookUp (assoc Attribute Instance)
+                             (not (empty? LookUp))))
+
+(declare change-value [[instance Class] --> [attribute Class A] --> A --> [instance Class]])
+
+(define change-value
+    _ class _ -> (error "cannot change the class of an instance!~%")
+    [ ] _ _ -> (error "no such attribute!~%")
+    [[Attribute | _] | Instance] Attribute Value
+     -> [[Attribute | Value] | Instance]
+    [Slot | Instance] Attribute Value
+    -> [Slot | (change-value Instance Attribute Value)])
+
+(declare instance-of [[instance Class] --> [class Class]])
+
+(define instance-of
+    [[class | Class] | _] -> Class
+    _ -> (error "not a class instance!"))
diff --git a/tests/classes-untyped.shen b/tests/classes-untyped.shen
index 2b3e1b5..39f92df 100644
--- a/tests/classes-untyped.shen
+++ b/tests/classes-untyped.shen
@@ -1,46 +1,46 @@
-(define defclass
-   Class Attributes 
-   -> (let Assoc (map (/. Attribute [Attribute | fail]) Attributes)
-           ClassDef [[class | Class] | Assoc]
-           Store (put Class classdef ClassDef)
-           Class))             
-
-(define make-instance
-   Class -> (let ClassDef (trap-error (get Class classdef) (/. E []))
-                 (if (empty? ClassDef)
-                     (error "class ~A does not exist~%" Class)
-                     ClassDef))) 
-
-(define get-value
-   Attribute Instance -> (let LookUp (assoc Attribute Instance)
-                              (get-value-test LookUp)))
-
-(define get-value-test
-  [ ] -> (error "no such attribute!~%")
-  [_ | fail] -> (error "no such value!~%")
-  [_ | Value] -> Value) 
-
-(define has-value?
-  Attribute Instance -> (let LookUp (assoc Attribute Instance)
-                             (has-value-test LookUp)))
-
-(define has-value-test
-  [ ] -> (error "no such attribute!~%")
-  [_ | fail] -> false
-  _ -> true) 
-
-(define has-attribute?
-  Attribute Instance -> (let LookUp (assoc Attribute Instance)
-                             (not (empty? LookUp))))
-
-(define change-value
-    _ class _ -> (error "cannot change the class of an instance!~%")
-    [ ] _ _ -> (error "no such attribute!~%")
-    [[Attribute | _] | Instance] Attribute Value 
-     -> [[Attribute | Value] | Instance]
-    [Slot | Instance] Attribute Value 
-    -> [Slot | (change-value Instance Attribute Value)])
-
-(define instance-of
-    [[class | Class] | _] -> Class
-    _ -> (error "not a class instance!"))  
+(define defclass
+   Class Attributes
+   -> (let Assoc (map (/. Attribute [Attribute | fail]) Attributes)
+           ClassDef [[class | Class] | Assoc]
+           Store (put Class classdef ClassDef)
+           Class))
+
+(define make-instance
+   Class -> (let ClassDef (trap-error (get Class classdef) (/. E []))
+                 (if (empty? ClassDef)
+                     (error "class ~A does not exist~%" Class)
+                     ClassDef)))
+
+(define get-value
+   Attribute Instance -> (let LookUp (assoc Attribute Instance)
+                              (get-value-test LookUp)))
+
+(define get-value-test
+  [ ] -> (error "no such attribute!~%")
+  [_ | fail] -> (error "no such value!~%")
+  [_ | Value] -> Value)
+
+(define has-value?
+  Attribute Instance -> (let LookUp (assoc Attribute Instance)
+                             (has-value-test LookUp)))
+
+(define has-value-test
+  [ ] -> (error "no such attribute!~%")
+  [_ | fail] -> false
+  _ -> true)
+
+(define has-attribute?
+  Attribute Instance -> (let LookUp (assoc Attribute Instance)
+                             (not (empty? LookUp))))
+
+(define change-value
+    _ class _ -> (error "cannot change the class of an instance!~%")
+    [ ] _ _ -> (error "no such attribute!~%")
+    [[Attribute | _] | Instance] Attribute Value
+     -> [[Attribute | Value] | Instance]
+    [Slot | Instance] Attribute Value
+    -> [Slot | (change-value Instance Attribute Value)])
+
+(define instance-of
+    [[class | Class] | _] -> Class
+    _ -> (error "not a class instance!"))
diff --git a/tests/cut.shen b/tests/cut.shen
index 3d3ce17..3711d16 100644
--- a/tests/cut.shen
+++ b/tests/cut.shen
@@ -1,26 +1,26 @@
-(defprolog a 
-  X <-- (b X) (c X);)
-  
-(defprolog b
-  1 <--;
-  4 <--;)    
-
-(defprolog c   
-  X <-- (d X) ! (e* X);
-  X <-- (f X);)
-  
-(defprolog d
-  X <-- (g* X);
-  X <-- (h X);)
-  
-(defprolog e*
-  3 <--;)
-  
-(defprolog f
-  4 <--;)
-  
-(defprolog g*
- 2 <--;)
- 
-(defprolog h
+(defprolog a
+  X <-- (b X) (c X);)
+
+(defprolog b
+  1 <--;
+  4 <--;)
+
+(defprolog c
+  X <-- (d X) ! (e* X);
+  X <-- (f X);)
+
+(defprolog d
+  X <-- (g* X);
+  X <-- (h X);)
+
+(defprolog e*
+  3 <--;)
+
+(defprolog f
+  4 <--;)
+
+(defprolog g*
+ 2 <--;)
+
+(defprolog h
  1 <--;)
\ No newline at end of file
diff --git a/tests/depth.shen b/tests/depth.shen
index 479b22e..61a0a53 100644
--- a/tests/depth.shen
+++ b/tests/depth.shen
@@ -1,14 +1,14 @@
-(define depth
-  {A --> (A --> (list A)) --> (A --> boolean) --> (A --> boolean) --> (list A)}
-  State Successors Goal? Fail? -> (depth-help [State] Successors Goal? Fail? []))
-
-(define depth-help
-  {(list A) --> (A --> (list A)) --> (A --> boolean) --> (A --> boolean) --> (list A) --> (list A)}
-  [State | _] _ Goal? _ Path -> (reverse [State | Path]) 	where (Goal? State)
-  [State | _] _ _ Fail? _ -> [] 				where (Fail? State)
-  [State | _] Successors Goal? Fail? Path <- (fail-if (fn empty?) 
-                                                      (depth-help (Successors State) 
-                                                                   Successors Goal? Fail? [State | Path]))
-  [_ | States] Successors Goal? Fail? Path -> (depth-help States Successors Goal? Fail? Path)
-  _ _ _ _ _ -> []) 
-
+(define depth
+  {A --> (A --> (list A)) --> (A --> boolean) --> (A --> boolean) --> (list A)}
+  State Successors Goal? Fail? -> (depth-help [State] Successors Goal? Fail? []))
+
+(define depth-help
+  {(list A) --> (A --> (list A)) --> (A --> boolean) --> (A --> boolean) --> (list A) --> (list A)}
+  [State | _] _ Goal? _ Path -> (reverse [State | Path]) 	where (Goal? State)
+  [State | _] _ _ Fail? _ -> [] 				where (Fail? State)
+  [State | _] Successors Goal? Fail? Path <- (fail-if (fn empty?)
+                                                      (depth-help (Successors State)
+                                                                   Successors Goal? Fail? [State | Path]))
+  [_ | States] Successors Goal? Fail? Path -> (depth-help States Successors Goal? Fail? Path)
+  _ _ _ _ _ -> [])
+
diff --git a/tests/einsteins-riddle.shen b/tests/einsteins-riddle.shen
index 90e700e..d91ebf2 100644
--- a/tests/einsteins-riddle.shen
+++ b/tests/einsteins-riddle.shen
@@ -1,38 +1,38 @@
-(defprolog riddle
-  <-- (house A) (house B) (house C) (house D) (house E) (is Houses [A B C D E])
-       (member [brit _ _ _ red] Houses)
-       (member [swede dog _ _ _] Houses)
-       (member [dane _ _ tea _] Houses)
-       (left [_ _ _ _ green] [_ _ _ _ white] Houses)
-       (member [_ _ _ coffee green] Houses)
-       (member [_ bird pallmall _ _] Houses)
-       (member [_ _ dunhill _ yellow] Houses)
-       (is C [_ _ _ milk _])
-       (is A [norwegian _ _ _ _])
-       (next [_ _ blends _ _] [_ cat _ _ _] Houses)
-       (next [_ horse _ _ _] [_ _ dunhill _ _] Houses)
-       (member [_ _ bluemaster beer _] Houses)
-       (member [german _ prince _ _] Houses)
-       (next [norwegian _ _ _ _] [_ _ _ _ blue] Houses)
-       (next [_ _ blends _ _] [_ _ _ water _] Houses)
-       (who-owns-the-fish? Nationality Houses);)
-
-(defprolog member
-   X (- [X | _]) <--;
-   X (- [_ | Z]) <-- (member X Z);) 
-
-(defprolog house
-   [Nationality Pet Cigarette Drink Colour] <--;)
-  
-(defprolog next
-  X Y List <-- (left X Y List);
-  X Y List <-- (left Y X List);)
-
- 
-(defprolog left
-  L R (- [L R | _]) <--;
-  L R (- [_ | Houses]) <-- (left L R Houses);)        
-      
-(defprolog who-owns-the-fish?
-  Nationality Houses <-- (member [Nationality fish _ _ _] Houses)
+(defprolog riddle
+  <-- (house A) (house B) (house C) (house D) (house E) (is Houses [A B C D E])
+       (member [brit _ _ _ red] Houses)
+       (member [swede dog _ _ _] Houses)
+       (member [dane _ _ tea _] Houses)
+       (left [_ _ _ _ green] [_ _ _ _ white] Houses)
+       (member [_ _ _ coffee green] Houses)
+       (member [_ bird pallmall _ _] Houses)
+       (member [_ _ dunhill _ yellow] Houses)
+       (is C [_ _ _ milk _])
+       (is A [norwegian _ _ _ _])
+       (next [_ _ blends _ _] [_ cat _ _ _] Houses)
+       (next [_ horse _ _ _] [_ _ dunhill _ _] Houses)
+       (member [_ _ bluemaster beer _] Houses)
+       (member [german _ prince _ _] Houses)
+       (next [norwegian _ _ _ _] [_ _ _ _ blue] Houses)
+       (next [_ _ blends _ _] [_ _ _ water _] Houses)
+       (who-owns-the-fish? Nationality Houses);)
+
+(defprolog member
+   X (- [X | _]) <--;
+   X (- [_ | Z]) <-- (member X Z);)
+
+(defprolog house
+   [Nationality Pet Cigarette Drink Colour] <--;)
+
+(defprolog next
+  X Y List <-- (left X Y List);
+  X Y List <-- (left Y X List);)
+
+
+(defprolog left
+  L R (- [L R | _]) <--;
+  L R (- [_ | Houses]) <-- (left L R Houses);)
+
+(defprolog who-owns-the-fish?
+  Nationality Houses <-- (member [Nationality fish _ _ _] Houses)
                          (return Nationality);)
\ No newline at end of file
diff --git a/tests/extensions/features/tests.shen b/tests/extensions/features/tests.shen
new file mode 100644
index 0000000..337f4b7
--- /dev/null
+++ b/tests/extensions/features/tests.shen
@@ -0,0 +1,42 @@
+(load "extensions/features.shen")
+
+(destroy shen.x.features.initialise)
+(destroy shen.x.features.current)
+(destroy shen.x.features.add)
+(shen.x.features.initialise [feature-a])
+
+(extension-tests.assert-equal
+  "features initialise has a type"
+  (shen.typecheck
+    [shen.x.features.initialise [cons feature-a []]]
+    [list symbol])
+  [list symbol])
+
+(extension-tests.assert-equal
+  "features current has a type"
+  (shen.typecheck
+    [shen.x.features.current]
+    [list symbol])
+  [list symbol])
+
+(extension-tests.assert-equal
+  "features add has a type"
+  (shen.typecheck
+    [shen.x.features.add feature-b]
+    [list symbol])
+  [list symbol])
+
+(extension-tests.assert-equal
+  "features initialise updates the feature list"
+  (shen.x.features.current)
+  [feature-a])
+
+(extension-tests.assert-equal
+  "features add returns the previous feature list"
+  (shen.x.features.add feature-b)
+  [feature-a])
+
+(extension-tests.assert-equal
+  "features add updates the feature list"
+  (shen.x.features.current)
+  [feature-b feature-a])
diff --git a/tests/extensions/namespaces/code.shen b/tests/extensions/namespaces/code.shen
new file mode 100644
index 0000000..6ab4188
--- /dev/null
+++ b/tests/extensions/namespaces/code.shen
@@ -0,0 +1,40 @@
+(shen.x.namespace namespace-tests.model
+  (externals [boxed])
+  (with-externals [defrecord] (defrecord box))
+  (define make X -> (box.new X))
+  (define tag -> boxed))
+
+(shen.x.namespace namespace-tests.client
+  (use namespace-tests.model)
+  (use namespace-tests.model => model)
+  (externals (append (namespace-tests.vocabulary) [namespace-tests-global-twice]))
+
+  (define compute-value X ->
+    (with-externals (append [asm mov] [return])
+      (asm (mov R (model.box.value (model.make X))) (return R))))
+  (define full-reference X ->
+    (namespace-tests.model.box.value (namespace-tests.model.make X)))
+  (define reference -> model.box.value)
+  (define local.field X -> X)
+  (define arithmetic X -> (/ X 2))
+  (define namespace-tests-global-twice X -> (+ X X))
+
+  (define mov X -> (+ X 1))
+  (define call-local X -> (mov X))
+  (define qualified-from-scope X ->
+    (with-externals [asm mov return]
+      (asm (mov R (namespace-tests.client.mov X)) (return R))))
+  (define scoped-label -> (with-externals [local.label] local.label))
+  (define outside-label -> local.label)
+  (define preserved-reference -> (with-externals [model.box.value] model.box.value))
+  (define inherited-external -> (with-externals [local.label] shared))
+  (define nested-scopes ->
+    (with-externals [outer.token]
+      (cons outer.token
+        (cons (with-externals [inner.token] [outer.token inner.token])
+              [inner.token])))))
+
+(shen.x.namespace namespace-tests.client
+  (define second X -> (local.field X)))
+
+(namespace-tests.generated)
diff --git a/tests/extensions/namespaces/macros.shen b/tests/extensions/namespaces/macros.shen
new file mode 100644
index 0000000..5086e5c
--- /dev/null
+++ b/tests/extensions/namespaces/macros.shen
@@ -0,0 +1,23 @@
+\\ Deliberately small consumers of qualification-before-expansion.
+(set namespace-tests.*record-names* [])
+
+(define namespace-tests.vocabulary -> [plain shared])
+
+(package namespace-tests [defrecord asm mov return]
+
+(defmacro record
+  [defrecord Name] ->
+    (do (set namespace-tests.*record-names*
+             [Name | (value namespace-tests.*record-names*)])
+      [package null [] [define (intern (@s (str Name) ".new")) (protect X) -> [cons (protect X) []]]
+        [define (intern (@s (str Name) ".value")) (protect R) -> [hd (protect R)]]]))
+
+(defmacro assembly
+  [asm [mov Name Value] [return Name]] -> [let Name Value Name])
+
+)
+
+(defmacro namespace-tests.generated
+  [namespace-tests.generated] ->
+    [shen.x.namespace namespace-tests.generated-owner
+      [with-externals [cons defrecord []] [defrecord box]]])
diff --git a/tests/extensions/namespaces/tests.shen b/tests/extensions/namespaces/tests.shen
new file mode 100644
index 0000000..0835c34
--- /dev/null
+++ b/tests/extensions/namespaces/tests.shen
@@ -0,0 +1,178 @@
+(load "extensions/namespaces.shen")
+(shen.x.namespaces.initialise)
+(load "tests/extensions/namespaces/macros.shen")
+(load "tests/extensions/namespaces/code.shen")
+
+(define namespace-tests.record-vocabulary
+  Name ->
+    (do (set namespace-tests.*vocabulary-order*
+             [Name | (value namespace-tests.*vocabulary-order*)])
+        [Name]))
+
+\\ Generated extensions need not retain their own source package metadata.
+(extension-tests.assert-equal "namespace is not an extension external"
+  (element? namespace (trap-error (external shen.x.namespaces) (/. E []))) false)
+(extension-tests.assert-equal "unqualified namespace has no source handler"
+  (shen.source-form-handler [namespace] (value shen.*source-form-handlers*)) [])
+(extension-tests.assert-equal "namespace remains an ordinary package-local name"
+  (read-from-string "(package namespace-tests.naming [] namespace)")
+  [namespace-tests.naming.namespace])
+(extension-tests.assert-equal "qualified namespace syntax survives package processing"
+  (read-from-string "(package namespace-tests.naming [] shen.x.namespace)")
+  [shen.x.namespace])
+
+(extension-tests.assert-equal "record macros see qualified names even in macro-generated containers"
+  (reverse (value namespace-tests.*record-names*))
+  [namespace-tests.model.box namespace-tests.generated-owner.box])
+(extension-tests.assert-equal "scoped assembly vocabulary preserves embedded alias resolution"
+  (namespace-tests.client.compute-value 42) 42)
+(extension-tests.assert-equal "use without renaming preserves full owner references"
+  (namespace-tests.client.full-reference 37) 37)
+(extension-tests.assert-equal "generated accessor need not exist in the owner's internal list"
+  (element? namespace-tests.model.box.value (internal namespace-tests.model)) false)
+(extension-tests.assert-equal "aliased symbol has the same identity as data"
+  (namespace-tests.client.reference) namespace-tests.model.box.value)
+(extension-tests.assert-equal "namespace externals preserve data symbols"
+  (namespace-tests.model.tag) boxed)
+(extension-tests.assert-equal "namespace externals permit global definitions"
+  (namespace-tests-global-twice 7) 14)
+(extension-tests.assert-equal "multiple files or blocks share local ownership"
+  (namespace-tests.client.second 7) 7)
+(extension-tests.assert-equal "division keeps its ordinary meaning"
+  (namespace-tests.client.arithmetic 8) 4)
+(extension-tests.assert-equal "ordinary macro can produce a namespace containing a local scope"
+  (namespace-tests.generated-owner.box.value (namespace-tests.generated-owner.box.new 9)) 9)
+
+(extension-tests.assert-equal "scoped vocabulary does not affect a same-named local function"
+  (namespace-tests.client.call-local 7) 8)
+(extension-tests.assert-equal "fully qualified locals remain callable within a vocabulary scope"
+  (namespace-tests.client.qualified-from-scope 7) 8)
+(extension-tests.assert-equal "scoped externals preserve dotted data symbols"
+  (namespace-tests.client.scoped-label) local.label)
+(extension-tests.assert-equal "scoped externals do not escape into sibling definitions"
+  (namespace-tests.client.outside-label) namespace-tests.client.local.label)
+(extension-tests.assert-equal "scoped externals take precedence over aliases"
+  (namespace-tests.client.preserved-reference) model.box.value)
+(extension-tests.assert-equal "scopes inherit namespace externals"
+  (namespace-tests.client.inherited-external) shared)
+(extension-tests.assert-equal "nested scopes extend and then restore the outer vocabulary"
+  (namespace-tests.client.nested-scopes)
+  [outer.token [outer.token inner.token] namespace-tests.client.inner.token])
+
+(extension-tests.assert-equal "local names use existing package metadata"
+  (element? namespace-tests.client.mov (internal namespace-tests.client)) true)
+(extension-tests.assert-equal "namespace externals are recorded"
+  (element? namespace-tests-global-twice (external namespace-tests.client)) true)
+(extension-tests.assert-equal "scoped externals are not published as namespace externals"
+  (element? mov (external namespace-tests.client)) false)
+(extension-tests.assert-equal "scoped syntax does not create spurious internal names"
+  (element? namespace-tests.client.asm (internal namespace-tests.client)) false)
+(extension-tests.assert-equal "foreign references are not recorded as local names"
+  (element? namespace-tests.client.model.box.value (internal namespace-tests.client)) false)
+(extension-tests.assert-equal "normalization agrees with equivalent package source"
+  (read-from-string "(shen.x.namespace namespace-tests.compare (use namespace-tests.model => model) (externals [boxed]) (define f X -> (model.box.value X)) (define tag -> boxed))")
+  (read-from-string "(package namespace-tests.compare [namespace-tests.model.box.value boxed] (define f X -> (namespace-tests.model.box.value X)) (define tag -> boxed))"))
+(extension-tests.assert-equal "explicit members do not require existing owner metadata"
+  (read-from-string "(shen.x.namespace namespace-tests.compare (use namespace-tests.future => future) (define ref -> future.record.field))")
+  [[define namespace-tests.compare.ref -> namespace-tests.future.record.field]])
+(extension-tests.assert-equal "undeclared dotted prefixes remain local"
+  (read-from-string "(shen.x.namespace namespace-tests.compare (define ref -> missing.value))")
+  [[define namespace-tests.compare.ref -> namespace-tests.compare.missing.value]])
+(extension-tests.assert-equal "prefix matches require a dot and a member"
+  (read-from-string "(shen.x.namespace namespace-tests.compare (use foreign => model) (define ref -> [model modelx.value model.]))")
+  [[define namespace-tests.compare.ref ->
+    [cons namespace-tests.compare.model
+      [cons namespace-tests.compare.modelx.value [cons namespace-tests.compare.model. []]]]]])
+(extension-tests.assert-equal "the most specific use wins in either declaration order"
+  (read-from-string "(shen.x.namespace namespace-tests.compare (use outer => model) (use inner => model.part) (define ref -> model.part.value))")
+  (read-from-string "(shen.x.namespace namespace-tests.compare (use inner => model.part) (use outer => model) (define ref -> model.part.value))"))
+(extension-tests.assert-equal "the most specific use selects the nested owner"
+  (read-from-string "(shen.x.namespace namespace-tests.compare (use outer => model) (use inner => model.part) (define ref -> model.part.value))")
+  [[define namespace-tests.compare.ref -> inner.value]])
+(extension-tests.assert-equal "namespace externals take precedence over aliases"
+  (read-from-string "(shen.x.namespace namespace-tests.compare (use foreign => model) (externals [model.value]) (define ref -> model.value))")
+  [[define namespace-tests.compare.ref -> model.value]])
+(extension-tests.assert-equal "scope removal preserves the surrounding expression"
+  (read-from-string "(shen.x.namespace namespace-tests.compare (define ref -> (cons (with-externals [plain] plain) [plain])))")
+  [[define namespace-tests.compare.ref -> [cons plain [cons namespace-tests.compare.plain []]]]])
+(extension-tests.assert-equal "a scope keyword in argument position is ordinary data"
+  (read-from-string "(shen.x.namespace namespace-tests.compare (define ref -> (f with-externals [] x)))")
+  (read-from-string "(package namespace-tests.compare [] (define ref -> (f with-externals [] x)))"))
+(extension-tests.assert-equal "an empty scope leaves qualification unchanged"
+  (read-from-string "(shen.x.namespace namespace-tests.compare (define ref -> (with-externals [] item)))")
+  [[define namespace-tests.compare.ref -> namespace-tests.compare.item]])
+(extension-tests.assert-equal "literal cons notation is accepted for externals"
+  (read-from-string "(shen.x.namespace namespace-tests.compare (externals (cons plain ())) (define ref -> plain))")
+  [[define namespace-tests.compare.ref -> plain]])
+
+(extension-tests.assert-equal "external expressions compose shared vocabularies like package"
+  (read-from-string "(shen.x.namespace namespace-tests.compare (externals (append (namespace-tests.vocabulary) [extra])) (define names -> [plain shared extra local]))")
+  (read-from-string "(package namespace-tests.compare (append (namespace-tests.vocabulary) [extra]) (define names -> [plain shared extra local]))"))
+(extension-tests.assert-equal "scoped expressions compose vocabulary without escaping"
+  (read-from-string "(shen.x.namespace namespace-tests.compare (define names -> (cons (with-externals (append (namespace-tests.vocabulary) [extra]) extra) [extra])))")
+  [[define namespace-tests.compare.names -> [cons extra [cons namespace-tests.compare.extra []]]]])
+(extension-tests.assert-equal "existing package metadata can supply external symbols"
+  (read-from-string "(shen.x.namespace namespace-tests.compare (externals (external namespace-tests.model)) (define tag -> boxed))")
+  [[define namespace-tests.compare.tag -> boxed]])
+(extension-tests.assert-equal "external expressions run before use aliases rewrite their names"
+  (read-from-string "(shen.x.namespace namespace-tests.compare (use missing => namespace-tests) (externals (namespace-tests.vocabulary)) (define item -> plain))")
+  [[define namespace-tests.compare.item -> plain]])
+(extension-tests.assert-equal "scoped expressions run before use aliases rewrite their names"
+  (read-from-string "(shen.x.namespace namespace-tests.compare (use missing => namespace-tests) (define item -> (with-externals (namespace-tests.vocabulary) shared)))")
+  [[define namespace-tests.compare.item -> shared]])
+
+(set namespace-tests.*vocabulary-order* [])
+(extension-tests.assert-equal "evaluated scopes inherit their enclosing vocabularies"
+  (read-from-string "(shen.x.namespace namespace-tests.evaluation (externals (namespace-tests.record-vocabulary first)) (externals (namespace-tests.record-vocabulary second)) (define item -> (with-externals (namespace-tests.record-vocabulary outer) (with-externals (namespace-tests.record-vocabulary inner) [first second outer inner]))))")
+  [[define namespace-tests.evaluation.item ->
+    [cons first [cons second [cons outer [cons inner []]]]]]])
+(extension-tests.assert-equal "vocabulary expressions evaluate once in source order"
+  (reverse (value namespace-tests.*vocabulary-order*)) [first second outer inner])
+(extension-tests.assert-equal "evaluated namespace vocabulary is recorded"
+  (element? first (external namespace-tests.evaluation)) true)
+(extension-tests.assert-equal "evaluated scoped vocabulary stays out of namespace metadata"
+  (element? outer (external namespace-tests.evaluation)) false)
+
+(extension-tests.assert-error "external expressions must produce lists"
+  (freeze (read-from-string "(shen.x.namespace a (externals (hd [42])))")))
+(extension-tests.assert-error "external expressions must produce proper lists"
+  (freeze (read-from-string "(shen.x.namespace a (externals (cons plain tail)))")))
+(extension-tests.assert-error "external expressions must produce symbols"
+  (freeze (read-from-string "(shen.x.namespace a (externals (append [plain] [42])))")))
+(extension-tests.assert-error "computed variables cannot be external symbols"
+  (freeze (read-from-string "(shen.x.namespace a (externals [(intern c#34;Variablec#34;)]))")))
+(extension-tests.assert-error "scoped expressions must produce symbol lists"
+  (freeze (read-from-string "(shen.x.namespace a (with-externals (append [plain] [42]) plain))")))
+(extension-tests.assert-equal "external expression errors propagate unchanged"
+  (trap-error (read-from-string "(shen.x.namespace a (externals (simple-error c#34;vocabulary failedc#34;)))")
+              (/. E (error-to-string E)))
+  "vocabulary failed")
+(extension-tests.assert-equal "scoped expression errors propagate unchanged"
+  (trap-error (read-from-string "(shen.x.namespace a (with-externals (simple-error c#34;vocabulary failedc#34;) plain))")
+              (/. E (error-to-string E)))
+  "vocabulary failed")
+
+(extension-tests.assert-error "duplicate aliases are rejected"
+  (freeze (read-from-string "(shen.x.namespace a (use b => x) (use c => x))")))
+(extension-tests.assert-error "unrenamed and renamed uses cannot claim the same prefix"
+  (freeze (read-from-string "(shen.x.namespace a (use b) (use c => b))")))
+(extension-tests.assert-error "owners must be non-variable symbols"
+  (freeze (read-from-string "(shen.x.namespace a (use Owner))")))
+(extension-tests.assert-error "aliases must be non-variable symbols"
+  (freeze (read-from-string "(shen.x.namespace a (use b => Alias))")))
+(extension-tests.assert-error "malformed use headers are rejected"
+  (freeze (read-from-string "(shen.x.namespace a (use b x))")))
+(extension-tests.assert-error "directives must precede the body"
+  (freeze (read-from-string "(shen.x.namespace a (define f -> 1) (use b))")))
+(extension-tests.assert-error "externals must precede the body"
+  (freeze (read-from-string "(shen.x.namespace a (define f -> 1) (externals [plain]))")))
+(extension-tests.assert-error "variables cannot be external symbols"
+  (freeze (read-from-string "(shen.x.namespace a (externals [X]))")))
+(extension-tests.assert-error "variables cannot be scoped external symbols"
+  (freeze (read-from-string "(shen.x.namespace a (with-externals [X] X))")))
+(extension-tests.assert-error "with-externals requires an enclosed form"
+  (freeze (read-from-string "(shen.x.namespace a (with-externals [foo]))")))
+(extension-tests.assert-error "with-externals accepts exactly one enclosed form"
+  (freeze (read-from-string "(shen.x.namespace a (with-externals [foo] foo bar))")))
+
+(shen.unregister-source-form shen.x.namespace)
diff --git a/tests/extensions/programmable-pattern-matching/code.shen b/tests/extensions/programmable-pattern-matching/code.shen
index a033db3..103d43f 100644
--- a/tests/extensions/programmable-pattern-matching/code.shen
+++ b/tests/extensions/programmable-pattern-matching/code.shen
@@ -1,13 +1,13 @@
 (define ppm.match-simple
-  [two A B] -> [A B]
+  (two A B) -> [A B]
   _ -> no)
 
 (define ppm.match-repeat
-  [two X X] -> same
-  [two _ _] -> different)
+  (two X X) -> same
+  (two _ _) -> different)
 
 (define ppm.match-nested
-  [two [two A B] C] -> [A B C]
+  (two (two A B) C) -> [A B C]
   _ -> no)
 
 (define ppm.match-cons
diff --git a/tests/extensions/programmable-pattern-matching/setup.shen b/tests/extensions/programmable-pattern-matching/setup.shen
index e968921..8ee2719 100644
--- a/tests/extensions/programmable-pattern-matching/setup.shen
+++ b/tests/extensions/programmable-pattern-matching/setup.shen
@@ -10,5 +10,31 @@
          (Bind B [snd Self]))
   _ _ _ _ -> (fail))
 
+(define ppm.nothing-handler
+  Self AddTest _ [nothing]
+  -> (do (AddTest [= Self nothing])
+         handled)
+  _ _ _ _ -> (fail))
+
+(define ppm.first-handler
+  Self AddTest Bind [first X]
+  -> (do (AddTest [tuple? Self])
+         (Bind X [fst Self])
+         handled)
+  _ _ _ _ -> (fail))
+
 (shen.x.programmable-pattern-matching.initialise)
 (shen.x.programmable-pattern-matching.register-handler ppm.two-handler)
+(shen.x.programmable-pattern-matching.register-handler ppm.nothing-handler)
+(shen.x.programmable-pattern-matching.register-handler ppm.first-handler)
+
+(datatype ppm.pattern-types
+  X : A;
+  ======================
+  (first X) : (A * B);
+
+  __________________
+  (two X Y) : ppm-pair;
+
+  __________________
+  (nothing) : symbol;)
diff --git a/tests/extensions/programmable-pattern-matching/tests.shen b/tests/extensions/programmable-pattern-matching/tests.shen
index 8dd4703..33c5299 100644
--- a/tests/extensions/programmable-pattern-matching/tests.shen
+++ b/tests/extensions/programmable-pattern-matching/tests.shen
@@ -1,5 +1,31 @@
 (load "tests/extensions/programmable-pattern-matching/setup.shen")
 (load "tests/extensions/programmable-pattern-matching/code.shen")
+(tc +)
+(load "tests/extensions/programmable-pattern-matching/typed-code.shen")
+(tc -)
+
+(extension-tests.assert-equal
+  "register-handler has a type"
+  (shen.typecheck
+    [shen.x.programmable-pattern-matching.register-handler ppm.two-handler]
+    symbol)
+  symbol)
+
+(extension-tests.assert-equal
+  "unregister-handler has a type"
+  (shen.typecheck
+    [shen.x.programmable-pattern-matching.unregister-handler ppm.two-handler]
+    symbol)
+  symbol)
+
+(extension-tests.assert-equal
+  "registration can be sequenced with do"
+  (shen.typecheck
+    [do
+      [shen.x.programmable-pattern-matching.register-handler ppm.two-handler]
+      ppm.two-handler]
+    symbol)
+  symbol)
 
 (extension-tests.assert-equal
   "simple custom pattern"
@@ -21,6 +47,42 @@
   (ppm.match-nested (@p (@p 1 2) 3))
   [1 2 3])
 
+(extension-tests.assert-equal
+  "typed custom pattern uses its surface form"
+  (ppm.match-typed-surface (@p 1 "x"))
+  true)
+
+(extension-tests.assert-equal
+  "typed custom pattern binds its component type"
+  (ppm.match-typed-binding (@p 1 "x"))
+  1)
+
+(extension-tests.assert-equal
+  "nested typed custom pattern"
+  (ppm.match-typed-nested (@p (@p 1 "x") true))
+  1)
+
+(extension-tests.assert-equal
+  "typed binary custom pattern"
+  (ppm.match-typed-binary (@p 1 2))
+  true)
+
+(extension-tests.assert-equal
+  "typed nullary custom pattern"
+  (ppm.match-typed-nullary nothing)
+  true)
+
+(extension-tests.assert-equal
+  "typed nullary custom pattern fallback"
+  (ppm.match-typed-nullary something-else)
+  false)
+
+(let Invalid (hd (read-file
+                   "tests/extensions/programmable-pattern-matching/typed-invalid.shen"))
+  (extension-tests.assert-error
+    "typed custom pattern rejects an incompatible binding type"
+    (freeze (shen.typecheck Invalid (protect A)))))
+
 (extension-tests.assert-equal
   "built-in cons pattern still works"
   (ppm.match-cons [1 2 3])
@@ -36,6 +98,16 @@
   (shen.x.programmable-pattern-matching.unregister-handler ppm.two-handler)
   ppm.two-handler)
 
+(extension-tests.assert-equal
+  "unregister nullary handler"
+  (shen.x.programmable-pattern-matching.unregister-handler ppm.nothing-handler)
+  ppm.nothing-handler)
+
+(extension-tests.assert-equal
+  "unregister typed handler"
+  (shen.x.programmable-pattern-matching.unregister-handler ppm.first-handler)
+  ppm.first-handler)
+
 (extension-tests.assert-error
   "custom pattern definition fails after unregister"
   (freeze
diff --git a/tests/extensions/programmable-pattern-matching/typed-code.shen b/tests/extensions/programmable-pattern-matching/typed-code.shen
new file mode 100644
index 0000000..796292f
--- /dev/null
+++ b/tests/extensions/programmable-pattern-matching/typed-code.shen
@@ -0,0 +1,20 @@
+(define ppm.match-typed-surface
+  { (number * string) --> boolean }
+  (first X) -> true)
+
+(define ppm.match-typed-binding
+  { (number * string) --> number }
+  (first X) -> X)
+
+(define ppm.match-typed-nested
+  { ((number * string) * boolean) --> number }
+  (first (first X)) -> X)
+
+(define ppm.match-typed-binary
+  { ppm-pair --> boolean }
+  (two X Y) -> true)
+
+(define ppm.match-typed-nullary
+  { symbol --> boolean }
+  (nothing) -> true
+  _ -> false)
diff --git a/tests/extensions/programmable-pattern-matching/typed-invalid.shen b/tests/extensions/programmable-pattern-matching/typed-invalid.shen
new file mode 100644
index 0000000..05f4afd
--- /dev/null
+++ b/tests/extensions/programmable-pattern-matching/typed-invalid.shen
@@ -0,0 +1,3 @@
+(define ppm.match-typed-invalid
+  { (number * string) --> string }
+  (first X) -> X)
diff --git a/tests/extensions/runme.shen b/tests/extensions/runme.shen
index 3b5526a..9dbabd2 100644
--- a/tests/extensions/runme.shen
+++ b/tests/extensions/runme.shen
@@ -2,6 +2,11 @@
 
 (extension-tests.reset)
 
+(load "tests/extensions/features/tests.shen")
 (load "tests/extensions/programmable-pattern-matching/tests.shen")
+(load "tests/extensions/type-annotations/tests.shen")
+
+(load "tests/extensions/source-forms/tests.shen")
+(load "tests/extensions/namespaces/tests.shen")
 
 (extension-tests.finish)
diff --git a/tests/extensions/source-forms/fixtures/empty.shen b/tests/extensions/source-forms/fixtures/empty.shen
new file mode 100644
index 0000000..a3ac952
--- /dev/null
+++ b/tests/extensions/source-forms/fixtures/empty.shen
@@ -0,0 +1,2 @@
+(source-tests.empty)
+42
diff --git a/tests/extensions/source-forms/fixtures/error.shen b/tests/extensions/source-forms/fixtures/error.shen
new file mode 100644
index 0000000..7036afe
--- /dev/null
+++ b/tests/extensions/source-forms/fixtures/error.shen
@@ -0,0 +1 @@
+(source-tests.failure)
diff --git a/tests/extensions/source-forms/fixtures/input.shen b/tests/extensions/source-forms/fixtures/input.shen
new file mode 100644
index 0000000..24061d4
--- /dev/null
+++ b/tests/extensions/source-forms/fixtures/input.shen
@@ -0,0 +1 @@
+(source-tests.sequence (+ 20 22))
\ No newline at end of file
diff --git a/tests/extensions/source-forms/tests.shen b/tests/extensions/source-forms/tests.shen
new file mode 100644
index 0000000..86cd452
--- /dev/null
+++ b/tests/extensions/source-forms/tests.shen
@@ -0,0 +1,119 @@
+\\ Source-form hooks are kernel APIs; no namespace extension is needed here.
+
+(set source-tests.*initial-handlers* (value shen.*source-form-handlers*))
+
+(define source-tests.sequence
+  [_ | Forms] -> Forms)
+
+(define source-tests.callable
+  F -> (fn F))
+
+(define source-tests.message
+  Thunk -> (trap-error (do (thaw Thunk) no-error) (/. E (error-to-string E))))
+
+(extension-tests.assert-equal "hooks do not belong to the system-function external list"
+  (map (/. F (element? F (external shen)))
+    [shen.register-source-form shen.unregister-source-form])
+  [false false])
+(extension-tests.assert-equal "qualified hooks are preserved by normal package processing"
+  (read-from-string "(package source-tests.naming [] shen.register-source-form shen.unregister-source-form)")
+  [shen.register-source-form shen.unregister-source-form])
+
+(extension-tests.assert-equal "registration hook has callable arity metadata"
+  (arity shen.register-source-form) 2)
+(extension-tests.assert-equal "registration hook has a type"
+  (not (= [] (assoc shen.register-source-form (value shen.*sigf*)))) true)
+(extension-tests.assert-equal "removal hook has a type"
+  (not (= [] (assoc shen.unregister-source-form (value shen.*sigf*)))) true)
+
+((source-tests.callable shen.register-source-form)
+  source-tests.sequence (fn source-tests.sequence))
+
+(extension-tests.assert-equal "source sequence preserves order"
+  (read-from-string "(source-tests.sequence (+ 1 2) (- 8 3))")
+  [[+ 1 2] [- 8 3]])
+
+(extension-tests.assert-equal "empty expansion is allowed"
+  (read-from-string "(source-tests.sequence)") [])
+
+(extension-tests.assert-equal "raw reader does not expand source forms"
+  (read-from-string-unprocessed "(source-tests.sequence (+ 1 2))")
+  [[source-tests.sequence [+ 1 2]]])
+
+(extension-tests.assert-equal "file reading uses the hook"
+  (read-file "tests/extensions/source-forms/fixtures/input.shen") [[+ 20 22]])
+
+(let Stream (open "tests/extensions/source-forms/fixtures/input.shen" in)
+     Forms (lineread Stream)
+     Closed (close Stream)
+  (extension-tests.assert-equal "line reading at EOF uses the hook" Forms [[+ 20 22]]))
+
+(let Stream (open "tests/extensions/source-forms/fixtures/input.shen" in)
+     Form (read Stream)
+     Closed (close Stream)
+  (extension-tests.assert-equal "single-form reading uses the hook" Form [+ 20 22]))
+
+(extension-tests.assert-equal "arity discovery sees all expanded definitions"
+  (read-from-string "(source-tests.sequence (define source-tests.caller X -> (source-tests.later X 2)) (define source-tests.later X Y -> (+ X Y)))")
+  [[define source-tests.caller X -> [source-tests.later X 2]]
+   [define source-tests.later X Y -> [+ X Y]]])
+
+(shen.register-source-form source-tests.package
+  (/. Form [[package source-tests.owner [] [define f X -> X]]]))
+(extension-tests.assert-equal "handler results may contain packages"
+  (read-from-string "(source-tests.package)") [[define source-tests.owner.f X -> X]])
+
+(shen.register-source-form source-tests.failure (/. Form (simple-error "source handler failed")))
+(extension-tests.assert-equal "handler error propagates from string reader"
+  (source-tests.message (freeze (read-from-string "(source-tests.failure)")))
+  "source handler failed")
+(extension-tests.assert-equal "handler error propagates from file reader"
+  (source-tests.message (freeze (read-file "tests/extensions/source-forms/fixtures/error.shen")))
+  "source handler failed")
+(let Stream (open "tests/extensions/source-forms/fixtures/error.shen" in)
+     Message (source-tests.message (freeze (lineread Stream)))
+     Closed (close Stream)
+  (extension-tests.assert-equal "handler error is not incomplete interactive input"
+    Message "source handler failed"))
+
+(set source-tests.*empty-calls* 0)
+(shen.register-source-form source-tests.empty
+  (/. Form (do (set source-tests.*empty-calls* (+ 1 (value source-tests.*empty-calls*))) [])))
+(let Stream (open "tests/extensions/source-forms/fixtures/empty.shen" in)
+     Empty (lineread Stream)
+     Next (lineread Stream)
+     Closed (close Stream)
+  (do (extension-tests.assert-equal "empty expansion consumes exactly its own line" Empty [])
+      (extension-tests.assert-equal "following line remains unread" Next [42])
+      (extension-tests.assert-equal "empty handler is not retried" (value source-tests.*empty-calls*) 1)))
+
+(shen.register-source-form source-tests.sequence (/. Form [42]))
+(extension-tests.assert-equal "register replaces the existing exact head"
+  (read-from-string "(source-tests.sequence)") [42])
+(extension-tests.assert-equal "qualified head is not confused with an unqualified one"
+  (shen.source-form-handler [sequence] (value shen.*source-form-handlers*)) [])
+
+(shen.register-source-form source-tests.invalid (/. Form [1 | 2]))
+(extension-tests.assert-error "improper handler output is rejected"
+  (freeze (read-from-string "(source-tests.invalid)")))
+(extension-tests.assert-error "package cannot be replaced"
+  (freeze (shen.register-source-form package (fn source-tests.sequence))))
+(extension-tests.assert-error "variable heads are rejected"
+  (freeze (shen.register-source-form (protect X) (fn source-tests.sequence))))
+
+(map (fn shen.unregister-source-form)
+  [source-tests.sequence source-tests.package source-tests.failure source-tests.invalid source-tests.empty])
+(shen.unregister-source-form source-tests.sequence)
+(extension-tests.assert-equal "unregister is idempotent and restores the initial registry"
+  (value shen.*source-form-handlers*) (value source-tests.*initial-handlers*))
+
+\\ Exercise source initialisation separately from generated KLambda metadata.
+(unput shen.register-source-form shen.lambda-form)
+(unput shen.unregister-source-form shen.lambda-form)
+(shen.build-lambda-table [])
+(extension-tests.assert-equal "source initialisation installs the registration callable without externals"
+  ((source-tests.callable shen.register-source-form) source-tests.sequence (fn source-tests.sequence))
+  source-tests.sequence)
+(extension-tests.assert-equal "source initialisation installs the removal callable without externals"
+  ((source-tests.callable shen.unregister-source-form) source-tests.sequence)
+  source-tests.sequence)
diff --git a/tests/extensions/type-annotations/code.shen b/tests/extensions/type-annotations/code.shen
new file mode 100644
index 0000000..f52002b
--- /dev/null
+++ b/tests/extensions/type-annotations/code.shen
@@ -0,0 +1,12 @@
+(define type-annotations-tests.string=
+  {string --> string --> boolean}
+  X X -> true
+  _ _ -> false)
+
+(define type-annotations-tests.identity
+  {A --> A}
+  X -> X)
+
+(define type-annotations-tests.list-head
+  {(list A) --> A}
+  [X | _] -> X)
diff --git a/tests/extensions/type-annotations/tests.shen b/tests/extensions/type-annotations/tests.shen
new file mode 100644
index 0000000..9074ae4
--- /dev/null
+++ b/tests/extensions/type-annotations/tests.shen
@@ -0,0 +1,52 @@
+(load "extensions/type-annotations.shen")
+
+(tc +)
+(load "tests/extensions/type-annotations/code.shen")
+(tc -)
+
+(define type-annotations-tests.compound-annotation?
+  [defun type-annotations-tests.list-head [X]
+    [cond
+      [[cons? [type X [list A]]] _]
+      [_ _]]]
+  -> (variable? A)
+  _ -> false)
+
+(extension-tests.assert-equal
+  "concrete parameter types are added"
+  (shen.x.type-annotations.annotate-kl
+    [defun type-annotations-tests.string= [x y] [= x y]])
+  [defun type-annotations-tests.string=
+    [x y]
+    [= [type x string] [type y string]]])
+
+(extension-tests.assert-equal
+  "polymorphic parameters remain unannotated"
+  (shen.x.type-annotations.annotate-kl
+    [defun type-annotations-tests.identity [x] x])
+  [defun type-annotations-tests.identity [x] x])
+
+(extension-tests.assert-equal
+  "known applications annotate literals"
+  (shen.x.type-annotations.annotate-kl [+ 1 2])
+  [+ [type 1 number] [type 2 number]])
+
+(extension-tests.assert-equal
+  "unknown signatures are left alone"
+  (shen.x.type-annotations.annotate-kl
+    [defun type-annotations-tests.unknown [x] [unknown x]])
+  [defun type-annotations-tests.unknown [x] [unknown x]])
+
+(let Once (shen.x.type-annotations.annotate-kl
+            [defun type-annotations-tests.string= [x y] [= x y]])
+  (extension-tests.assert-equal
+    "existing annotations are preserved"
+    (shen.x.type-annotations.annotate-kl Once)
+    Once))
+
+(extension-tests.assert-equal
+  "compound polymorphic types use Shen variables"
+  (type-annotations-tests.compound-annotation?
+    (shen.x.type-annotations.annotate-kl
+      (ps type-annotations-tests.list-head)))
+  true)
diff --git a/tests/findall.shen b/tests/findall.shen
index 45f2c18..53f1e9a 100644
--- a/tests/findall.shen
+++ b/tests/findall.shen
@@ -1,6 +1,6 @@
-(defprolog enjoys
-  mark chocolate <--;
-  mark tea <--;) 
-   
-(defprolog fads
-  X <-- (findall Y (enjoys X Y) Likes) (return Likes);) 
\ No newline at end of file
+(defprolog enjoys
+  mark chocolate <--;
+  mark tea <--;)
+
+(defprolog fads
+  X <-- (findall Y (enjoys X Y) Likes) (return Likes);)
\ No newline at end of file
diff --git a/tests/fork.shen b/tests/fork.shen
index 34edffd..3079a5d 100644
--- a/tests/fork.shen
+++ b/tests/fork.shen
@@ -1,16 +1,16 @@
-  
-(defprolog g1
-  a <--;)
-  
-(defprolog h
-   b <--;)
-   
-(defprolog i
-   a <--;
-   b <--;)
-   
-(defprolog j
-   b <--;)    
-
-(defprolog f
+
+(defprolog g1
+  a <--;)
+
+(defprolog h
+   b <--;)
+
+(defprolog i
+   a <--;
+   b <--;)
+
+(defprolog j
+   b <--;)
+
+(defprolog f
    X <-- (g1 X) (fork [(h X) (i X) (j X)]);)
\ No newline at end of file
diff --git a/tests/harness.shen b/tests/harness.shen
index 256b0b4..00a51b6 100644
--- a/tests/harness.shen
+++ b/tests/harness.shen
@@ -1,43 +1,43 @@
-(package test-harness [report reset ok passed failed]
-
-(define reset
-  -> (set *passed* (set *failed* 0)))
-
-(defmacro exec-macro
-  [exec Name Expr Prediction] -> [trap-error [let (protect Output) [output "~%~A: ~R = ~S~%" Name (rcons Expr) Prediction]
-                                                  (protect Result) [time Expr]
-                                                  [if [= (protect Result) Prediction] [passed] [failed (protect Result)]]] 
-                                                      [/. (protect E) [err (protect E)]]])
-                                              
-(define rcons
-  [X | Y] -> [cons (rcons X) (rcons Y)] 
-  X -> X)                                             
-                                              
-(define passed
-  -> (do (trap-error (set *passed* (+ 1 (value *passed*))) (/. E (set *passed* 1)))
-          (print passed)))
-          
-(define failed
-  Result -> (let Fail+ (trap-error (set *failed* (+ 1 (value *failed*))) (/. E (set *failed* 1)))
-                 ShowResult (output "~S returned~%" Result)
-                 (if (y-or-n? "failed; continue?") ok (error "kill"))))  
-
-(define err
-  E -> (error "")  where (= (error-to-string E) "kill")
-  E -> (do (trap-error (set *failed* (+ 1 (value *failed*))) (/. E (set *failed* 1)))
-           (output "~%failed with error ~A~%" (error-to-string E))
-           (if (y-or-n? "failed; continue?") ok (error "kill"))))
-
-(defmacro report-results-macro
-  [report Name | Tests] -> (let NewTests (create-tests Name Tests)
-                                         [do | NewTests]))
-                                         
-(define create-tests
-  Name [] -> [[results] ok]  
-  Name [Test Prediction | Tests] -> [[exec Name Test Prediction] | (create-tests Name Tests)])                 
-                                         
-(define results
-  -> (let Passed (trap-error (value *passed*) (/. E 0))
-          Failed (trap-error (value *failed*) (/. E 0))
-          Percent (* (/ Passed (+ Passed Failed)) 100)
+(package test-harness [report reset ok passed failed]
+
+(define reset
+  -> (set *passed* (set *failed* 0)))
+
+(defmacro exec-macro
+  [exec Name Expr Prediction] -> [trap-error [let (protect Output) [output "~%~A: ~R = ~S~%" Name (rcons Expr) Prediction]
+                                                  (protect Result) [time Expr]
+                                                  [if [= (protect Result) Prediction] [passed] [failed (protect Result)]]]
+                                                      [/. (protect E) [err (protect E)]]])
+
+(define rcons
+  [X | Y] -> [cons (rcons X) (rcons Y)]
+  X -> X)
+
+(define passed
+  -> (do (trap-error (set *passed* (+ 1 (value *passed*))) (/. E (set *passed* 1)))
+          (print passed)))
+
+(define failed
+  Result -> (let Fail+ (trap-error (set *failed* (+ 1 (value *failed*))) (/. E (set *failed* 1)))
+                 ShowResult (output "~S returned~%" Result)
+                 (if (y-or-n? "failed; continue?") ok (error "kill"))))
+
+(define err
+  E -> (error "")  where (= (error-to-string E) "kill")
+  E -> (do (trap-error (set *failed* (+ 1 (value *failed*))) (/. E (set *failed* 1)))
+           (output "~%failed with error ~A~%" (error-to-string E))
+           (if (y-or-n? "failed; continue?") ok (error "kill"))))
+
+(defmacro report-results-macro
+  [report Name | Tests] -> (let NewTests (create-tests Name Tests)
+                                         [do | NewTests]))
+
+(define create-tests
+  Name [] -> [[results] ok]
+  Name [Test Prediction | Tests] -> [[exec Name Test Prediction] | (create-tests Name Tests)])
+
+(define results
+  -> (let Passed (trap-error (value *passed*) (/. E 0))
+          Failed (trap-error (value *failed*) (/. E 0))
+          Percent (* (/ Passed (+ Passed Failed)) 100)
           (output "~%passed ... ~A~%failed ... ~A~%pass rate ... ~A%~%~%" Passed Failed Percent)))     )
\ No newline at end of file
diff --git a/tests/interpreter.shen b/tests/interpreter.shen
index e850223..a14add0 100644
--- a/tests/interpreter.shen
+++ b/tests/interpreter.shen
@@ -1,206 +1,206 @@
-(datatype num
-
- ____________________________________
- (number? X) : verified >> X : number;)
-
-(datatype primitive-object
-
-      if (variable? X)
-      _______________
-      X : variable;
-
-      X : variable;
-      _____________________
-      X : primitive-object;
-     
-      X : symbol;
-      _____________________
-      X : primitive-object;
-
-      X : string;
-      _____________________
-      X : primitive-object;
-
-      X : boolean;
-      _____________________
-      X : primitive-object;
-
-      X : number;
-      _____________________
-      X : primitive-object;
-
-      _____________________
-      [] : primitive-object;)
-
-(datatype pattern
-
-   X : primitive-object;
-   _____________________
-   X : pattern;
-      
-   P1 : pattern; P2 : pattern;
-   ===========================
-   [cons P1 P2] : pattern;
-    
-   P1 : pattern; P2 : pattern;
-   ===========================
-   [@p P1 P2] : pattern;)
-
-  (datatype l-formula
-
-   X : pattern;
-   _____________
-   X : l-formula;
-      
-   X : l-formula; Y : l-formula; Z : l-formula;
-   ============================================
-   [if X Y Z] : l-formula;
-
-   X : variable; Y : l-formula; Z : l-formula;
-   ===========================================
-   [let X Y Z] : l-formula;
-      
-   X : l-formula; Y : l-formula;
-   =============================
-   [cons X Y] : l-formula;
-      
-   X : l-formula; Y : l-formula;
-   =============================
-   [@p X Y] : l-formula;
-   
-   X : l-formula; Y : l-formula;
-   =============================
-   [where X Y] : l-formula;
-      
-   X : l-formula; Y : l-formula;
-   =============================
-   [= X Y] : l-formula;
-      
-   X : l-formula; Y : l-formula;
-   =============================
-   [X Y] : l-formula;
-      
-   Xn : (list l-formula);
-   =========================
-   [cases | Xn] : l-formula;
-      
-   P : pattern; X : l-formula;
-   ===========================
-   [/. P X] : l-formula;)
-
-(define normal-form
-  {l-formula --> l-formula}
-   X -> (fix (fn ==>>) X))
-   
-(define ==>>
-   {l-formula --> l-formula}
-   [= X Y] -> (let X* (normal-form X) 
-                   (let Y* (normal-form Y) 
-                        (if (or (eval-error? X*) (eval-error? Y*))
-                            "error!"
-                            (if (= X* Y*) true false))))
-   [[/. P X] Y] -> (let Match (match P (normal-form Y))
-                        (if (no-match? Match) 
-                            "no match"
-                            (sub Match X))) 
-   [if X Y Z] -> (let X* (normal-form X)
-                      (if (= X* true)
-                          Y
-                          (if (= X* false)
-                              Z
-                              "error!")))
-   [let X Y Z] -> [[/. X Z] Y]
-   [@p X Y] -> (let X* (normal-form X)
-                    (let Y* (normal-form Y)
-                         (if (or (eval-error? X*) (eval-error? Y*))
-                             "error!"
-                             [@p X* Y*])))
-   [cons X Y] -> (let X* (normal-form X)
-                      (let Y* (normal-form Y)
-                           (if (or (eval-error? X*) (eval-error? Y*))
-                               "error!"
-                               [cons X* Y*])))
-   [++ X] -> (successor (normal-form X))
-   [-- X] -> (predecessor (normal-form X))
-   [cases X1 | Xn] -> (let Case1 (normal-form X1)
-                           (if (= Case1 "no match")
-                               [cases | Xn]
-                               Case1))
-   [cases] -> "error!"            
-   [where X Y] -> [if X Y "no match"]
-   [y-combinator [/. X Y]] -> (replace X [y-combinator [/. X Y]] Y)
-   [X Y] -> (let X* (normal-form X)
-               (let Y* (normal-form Y)
-                  (if (or (eval-error? X*) (eval-error? Y*))
-                      "error!"
-                      [X* Y*])))
-    X -> X)
-
-(define eval-error?
-  {l-formula --> boolean}
-   "error!" -> true
-   "no match" -> true
-   _ -> false)  
-
-(define successor
-  {A --> l-formula}
-  X -> (+ 1 X) where (number? X)
-  _ -> "error!")
-
-(define predecessor
-  {A --> l-formula}
-  X -> (- X 1) where (number? X)
-  _ -> "error!")
-
-(define sub
-  {(list (pattern * l-formula)) --> l-formula --> l-formula}
-   [] X -> X
-   [(@p Var Val) | Assoc] X -> (sub Assoc (replace Var Val X)))
-
-(define match
-   {pattern --> l-formula --> (list (pattern * l-formula))}
-    P X -> [] where (== P X)
-    P X -> [(@p P X)]      where (variable? P)
-    [cons P1 P2] [cons X Y] -> (let Match1 (match P1 X)
-                                    (if (no-match? Match1)
-                                        Match1
-                                        (let Match2 (match P2 Y)
-                                            (if (no-match? Match2)
-                                                Match2
-						(append Match1 Match2)))))
-    [@p P1 P2] [@p X Y] -> (let Match1 (match P1 X)
-                                    (if (no-match? Match1)
-                                        Match1
-                                        (let Match2 (match P2 Y)
-                                            (if (no-match? Match2)
-                                                Match2
-						(append Match1 Match2)))))
-
-    _ _ -> [(@p no matching)])
-      
-(define no-match?
-  {(list (pattern * l-formula)) --> boolean}
-   [(@p no matching)] -> true
-   _ -> false)
-
-(define replace
-   {pattern --> l-formula --> l-formula --> l-formula}
-    V W [let V* X Y] -> [let V* X Y]  where (== V V*)
-    X Y X -> Y
-    V W [= X Y] -> [= (replace V W X) (replace V W Y)]
-    V W [/. P X] -> [/. P (replace V W X)] 		where (free? V P)
-    V W [if X Y Z] -> [if (replace V W X) (replace V W Y) (replace V W Z)]
-    V W [let X Y Z] -> [let X (replace V W Y) (replace V W Z)]
-    V W [@p X Y] -> [@p (replace V W X) (replace V W Y)]
-    V W [cons X Y] -> [cons (replace V W X) (replace V W Y)]
-    V W [cases | Xn] -> [cases | (map (/. Xi (replace V W Xi)) Xn)]
-    V W [where X Y] -> [where (replace V W X) (replace V W Y)]
-    V W [X Y] -> [(replace V W X) (replace V W Y)] 
-    _ _ X -> X) 	
-
-(define free?
-  {pattern --> pattern --> boolean}
-   P P -> false 
-   P [cons P1 P2] -> (and (free? P P1) (free? P P2))
-   P [@p P1 P2] -> (and (free? P P1) (free? P P2))
+(datatype num
+
+ ____________________________________
+ (number? X) : verified >> X : number;)
+
+(datatype primitive-object
+
+      if (variable? X)
+      _______________
+      X : variable;
+
+      X : variable;
+      _____________________
+      X : primitive-object;
+
+      X : symbol;
+      _____________________
+      X : primitive-object;
+
+      X : string;
+      _____________________
+      X : primitive-object;
+
+      X : boolean;
+      _____________________
+      X : primitive-object;
+
+      X : number;
+      _____________________
+      X : primitive-object;
+
+      _____________________
+      [] : primitive-object;)
+
+(datatype pattern
+
+   X : primitive-object;
+   _____________________
+   X : pattern;
+
+   P1 : pattern; P2 : pattern;
+   ===========================
+   [cons P1 P2] : pattern;
+
+   P1 : pattern; P2 : pattern;
+   ===========================
+   [@p P1 P2] : pattern;)
+
+  (datatype l-formula
+
+   X : pattern;
+   _____________
+   X : l-formula;
+
+   X : l-formula; Y : l-formula; Z : l-formula;
+   ============================================
+   [if X Y Z] : l-formula;
+
+   X : variable; Y : l-formula; Z : l-formula;
+   ===========================================
+   [let X Y Z] : l-formula;
+
+   X : l-formula; Y : l-formula;
+   =============================
+   [cons X Y] : l-formula;
+
+   X : l-formula; Y : l-formula;
+   =============================
+   [@p X Y] : l-formula;
+
+   X : l-formula; Y : l-formula;
+   =============================
+   [where X Y] : l-formula;
+
+   X : l-formula; Y : l-formula;
+   =============================
+   [= X Y] : l-formula;
+
+   X : l-formula; Y : l-formula;
+   =============================
+   [X Y] : l-formula;
+
+   Xn : (list l-formula);
+   =========================
+   [cases | Xn] : l-formula;
+
+   P : pattern; X : l-formula;
+   ===========================
+   [/. P X] : l-formula;)
+
+(define normal-form
+  {l-formula --> l-formula}
+   X -> (fix (fn ==>>) X))
+
+(define ==>>
+   {l-formula --> l-formula}
+   [= X Y] -> (let X* (normal-form X)
+                   (let Y* (normal-form Y)
+                        (if (or (eval-error? X*) (eval-error? Y*))
+                            "error!"
+                            (if (= X* Y*) true false))))
+   [[/. P X] Y] -> (let Match (match P (normal-form Y))
+                        (if (no-match? Match)
+                            "no match"
+                            (sub Match X)))
+   [if X Y Z] -> (let X* (normal-form X)
+                      (if (= X* true)
+                          Y
+                          (if (= X* false)
+                              Z
+                              "error!")))
+   [let X Y Z] -> [[/. X Z] Y]
+   [@p X Y] -> (let X* (normal-form X)
+                    (let Y* (normal-form Y)
+                         (if (or (eval-error? X*) (eval-error? Y*))
+                             "error!"
+                             [@p X* Y*])))
+   [cons X Y] -> (let X* (normal-form X)
+                      (let Y* (normal-form Y)
+                           (if (or (eval-error? X*) (eval-error? Y*))
+                               "error!"
+                               [cons X* Y*])))
+   [++ X] -> (successor (normal-form X))
+   [-- X] -> (predecessor (normal-form X))
+   [cases X1 | Xn] -> (let Case1 (normal-form X1)
+                           (if (= Case1 "no match")
+                               [cases | Xn]
+                               Case1))
+   [cases] -> "error!"
+   [where X Y] -> [if X Y "no match"]
+   [y-combinator [/. X Y]] -> (replace X [y-combinator [/. X Y]] Y)
+   [X Y] -> (let X* (normal-form X)
+               (let Y* (normal-form Y)
+                  (if (or (eval-error? X*) (eval-error? Y*))
+                      "error!"
+                      [X* Y*])))
+    X -> X)
+
+(define eval-error?
+  {l-formula --> boolean}
+   "error!" -> true
+   "no match" -> true
+   _ -> false)
+
+(define successor
+  {A --> l-formula}
+  X -> (+ 1 X) where (number? X)
+  _ -> "error!")
+
+(define predecessor
+  {A --> l-formula}
+  X -> (- X 1) where (number? X)
+  _ -> "error!")
+
+(define sub
+  {(list (pattern * l-formula)) --> l-formula --> l-formula}
+   [] X -> X
+   [(@p Var Val) | Assoc] X -> (sub Assoc (replace Var Val X)))
+
+(define match
+   {pattern --> l-formula --> (list (pattern * l-formula))}
+    P X -> [] where (== P X)
+    P X -> [(@p P X)]      where (variable? P)
+    [cons P1 P2] [cons X Y] -> (let Match1 (match P1 X)
+                                    (if (no-match? Match1)
+                                        Match1
+                                        (let Match2 (match P2 Y)
+                                            (if (no-match? Match2)
+                                                Match2
+						(append Match1 Match2)))))
+    [@p P1 P2] [@p X Y] -> (let Match1 (match P1 X)
+                                    (if (no-match? Match1)
+                                        Match1
+                                        (let Match2 (match P2 Y)
+                                            (if (no-match? Match2)
+                                                Match2
+						(append Match1 Match2)))))
+
+    _ _ -> [(@p no matching)])
+
+(define no-match?
+  {(list (pattern * l-formula)) --> boolean}
+   [(@p no matching)] -> true
+   _ -> false)
+
+(define replace
+   {pattern --> l-formula --> l-formula --> l-formula}
+    V W [let V* X Y] -> [let V* X Y]  where (== V V*)
+    X Y X -> Y
+    V W [= X Y] -> [= (replace V W X) (replace V W Y)]
+    V W [/. P X] -> [/. P (replace V W X)] 		where (free? V P)
+    V W [if X Y Z] -> [if (replace V W X) (replace V W Y) (replace V W Z)]
+    V W [let X Y Z] -> [let X (replace V W Y) (replace V W Z)]
+    V W [@p X Y] -> [@p (replace V W X) (replace V W Y)]
+    V W [cons X Y] -> [cons (replace V W X) (replace V W Y)]
+    V W [cases | Xn] -> [cases | (map (/. Xi (replace V W Xi)) Xn)]
+    V W [where X Y] -> [where (replace V W X) (replace V W Y)]
+    V W [X Y] -> [(replace V W X) (replace V W Y)]
+    _ _ X -> X)
+
+(define free?
+  {pattern --> pattern --> boolean}
+   P P -> false
+   P [cons P1 P2] -> (and (free? P P1) (free? P P2))
+   P [@p P1 P2] -> (and (free? P P1) (free? P P2))
    _ _ -> true)
\ No newline at end of file
diff --git a/tests/kerneltests.shen b/tests/kerneltests.shen
index 2561c9b..e44c758 100644
--- a/tests/kerneltests.shen
+++ b/tests/kerneltests.shen
@@ -1,255 +1,300 @@
-(maxinferences 1e7)
-                        
-(report "cartesian product"
-
-    (load "cartprod.shen") loaded
-    (cartesian-product [1 2 3] [1 2 3]) 
-                          [[1 1] [1 2] [1 3] [2 1] [2 2] [2 3] [3 1] [3 2] [3 3]])
-                          
-(report "powerset" 
-                         
-    (load "powerset.shen") loaded
-    (powerset* [1 2 3]) [[1 2 3] [1 2] [1 3] [1] [2 3] [2] [3] []])
- 
-(report "bubble sort"
-
-  (load "bubble version 1.shen") loaded
-  (bubble-sort [1 2 3])  [3 2 1]
-  (load "bubble version 2.shen") loaded 
-  (bubble-sort [1 2 3]) [3 2 1])
-  
-(report "spreadsheet"  
-
-  (load "spreadsheet.shen") loaded 
-  (assess-spreadsheet [[jim [wages (/. Spreadsheet (get' frank wages Spreadsheet))]
-                             [tax (/. Spreadsheet (* (get' frank tax Spreadsheet) .8))]]
-                        [frank [wages 20000]
-                               [tax (/. Spreadsheet (* .25 (get' frank wages Spreadsheet)))]]])
-              
-              [[jim [wages 20000] [tax 4000.0]] [frank [wages 20000] [tax 5000.0]]]   ) 
-
-(report "primes"
-    
-      (load "prime.shen") loaded
-      (prime*? 1000003) true
-      (load "mutual.shen") loaded
-      (even*? 56) true
-      (odd*? 77)  true 
-      (load "change.shen") loaded
-      (count-change 100) 4563)
-    
-(report "semantic nets"
-
-    (load "semantic net.shen") loaded
-    (clear Mark_Tarver) []
-    (clear man) []
-    (assert [Mark_Tarver is_a man]) [man] 
-    (assert [man type_of human]) [human]
-    (query [is Mark_Tarver human]) yes) 
-
-\\ Prolog
-    
-(report "einsteins riddle" 
-   
-   (load "einsteins-riddle.shen") loaded
-   (prolog? (riddle)) german)
-   
-(report "Prolog call"
-
-  (load "call.shen") loaded
-  (prolog? (mapit (fn consit) [1 2 3] X) (return X))  [[1 1] [1 2] [1 3]]
-  (prolog? (different 1 2)) true
-  (prolog? (different 1 1)) false)
-  
-(report "Prolog cut"
-
-  (load "cut.shen") loaded
-  (prolog? (a X) (return X)) 4)
-  
-(report "Prolog naive reverse"
-
-  (load  "nreverseprolog.shen") loaded
-  (prolog? (nreverse [1 2 3 4] X) (return X))  [4 3 2 1])
-  
-(report "findall in Prolog"
-
-  (load "findall.shen") loaded
-  (prolog? (fads mark)) [tea chocolate])
-  
-(report "Prolog tableau"
-
-  (load  "tableauprolog.shen") loaded
-  (prolog? (prop [] [[p <=> q] <=> [q <=> p]]))  true
-  (prolog? (prop [] [[p <=> q] <=> [q <=> r]]))  false)
-   
-(report "proplog"
-   
-     (load "proplog version 1.shen") loaded 
-     (backchain q [[q <= p] [q <= r] [r <=]]) proved 
-     (backchain q [[q <= p] [q <= r]]) (fail)
-     (load "proplog version 2.shen") loaded 
-     (backchain q [[q <= p] [q <= r] r]) true 
-     (backchain q [[q <= p] [q <= r]]) false)  
-           
-(report "metaprogramming"   
-    
-    (load "metaprog.shen") loaded 
-    (do (generate_parser [sent --> np vp  np --> name  np  --> det n 
-              name --> "John"  name --> "Bill"  
-              name --> "Tom" det  --> "the"  det  --> "a"
-              det  --> "that" det  --> "this"  
-              n --> "girl"  n --> "ball" 
-              vp --> vtrans np  vp --> vintrans  
-              vtrans --> "kicks" vtrans --> "likes"
-              vintrans --> "jumps" vintrans --> "flies"]) ok) ok) 
-     
-(report "binary number datatype"
-     (load "binary.shen") loaded
-     (complement [1 0]) [0 1]
-     (load "streams.shen") loaded
-     (fst (delay (@p 0 (+ 1) (/. X false)))) 1)
-
- (report "calculator"
-     (load "calculator.shen") loaded
-     (do-calculation [[num 12] + [[num 7] * [num 4]]]) 40 )      
-     
-(report "structures 1"
-    (load "structures-untyped.shen") loaded
-    (defstruct ship [length name]) ship
-    (make-ship 200 "Mary Rose")  [[structure | ship] [length | 200] [name | "Mary Rose"]]
-    (ship-length (make-ship 200 "Mary Rose")) 200
-    (ship-name (make-ship 200 "Mary Rose"))  "Mary Rose") 
-
-(report "structures 2"
-  (load "structures-typed.shen") loaded
-  (defstruct ship [(@p length number) (@p name string)]) ship
-  (make-ship 200 "Mary Rose")  [[structure | ship] [length | 200] [name | "Mary Rose"]]
-  (ship-length (make-ship 200 "Mary Rose")) 200
-  (ship-name (make-ship 200 "Mary Rose"))  "Mary Rose") 
-    
-(report "classes 1"
-   (load "classes-untyped.shen") loaded
-   (defclass ship [length name]) ship
-   (set s (make-instance ship)) [[class | ship] [length | fail] [name | fail]]
-   (has-value? length (value s)) false
-   (set s (change-value (value s) length 100)) [[class | ship] [length | 100] [name | fail]]
-   (get-value length (value s)) 100)       
-     
-(report "classes 2"
-   (load "classes-typed.shen") loaded
-   (defclass ship [(@p length number) (@p name string)]) ship
-   (has-value? length (make-instance ship)) false
-   (change-value (make-instance ship) length 100) [[class | ship] [length | 100] [name | fail]]
-   (get-value length (change-value (make-instance ship) length 100)) 100)       
-     
- (report "abstract datatypes"
-   (load "stack.shen") loaded
-   (top (push 0 (empty-stack _))) 0) 
-    
- (report "yacc"
-   (load "yacc.shen") loaded
-   (compile (fn ) [the cat likes the dog]) [the cat likes the dog]
-   (trap-error (compile (fn ) [the cat likes the canary]) (/. E (fail))) (fail)
-   (compile (fn ) [a a a b b c])  [a a a b b c]
-   (compile (fn ) [a v f g 6 y u]) [6]
-   (compile (fn ) [chases the cat]) [chases the cat]
-   (compile (fn ) [[d] [e e]]) [d e e]
-   (compile (fn ) [the cat likes the dog]) [is it true that your father likes the dog ?]
-   (compile (fn ) [a a a]) [a a a]
-   (compile (fn ) [a v f g 6 y u]) [6 y u]
-   (trap-error (compile (fn ) [a v f g 6 y u]) (/. E (fail))) (fail)
-   (compile (fn ) [a v f g 6 y u]) 6
-   (compile (fn ) [a a a b b b c c c]) [a a a b b b c c c])
-      
-(preclude-all-but [])    
-(tc +)       
-
-(report "N Queens"
-     (preclude-all-but [])  []
-     (tc +) true
-     (load "n queens.shen") loaded
-     (n-queens 5) [[4 2 5 3 1] [3 5 2 4 1] [5 3 1 4 2] [4 1 3 5 2] [5 2 4 1 3] [1 4 2 5 3] 
-                    [2 5 3 1 4] [1 3 5 2 4] [3 1 4 2 5] [2 4 1 3 5]]
-     (tc -) false) 
-        
-(report "search"
-     (tc +) true
-     (load "search.shen") loaded
-     (tc -) false) 
-
-(report "montague"
-     (tc +) true
-     (load "montague.shen")  loaded
-     (compile (fn ) [Mary likes John]) [likes Mary John])
-     
-(report "c-"
-     (tc +)  true
-     (load "c-minus.shen")  loaded)       
-      
-(report "L interpreter"
-     (tc +) true
-     (load "interpreter.shen") loaded
-     (normal-form [[[y-combinator [/. ADD [/. X [/. Y [if [= X 0] Y [[ADD [-- X]] [++ Y]]]]]]] 3] 4])  7
-     (normal-form [[[y-combinator [/. APPEND [/. X [/. Y
-                  [if [= X [ ]] Y  [cons [[/. [cons A B] A] X] 
-                     	[[APPEND [[/. [cons A B] B] X]] Y]]]]]]] [cons 1 [ ]]] [cons 2 [ ]]])
-      [cons 1 [cons 2 []]]               	
-     (tc -) false)           
- 
-(report "proof assistant"
-
-   (tc +) true
-   (load "proof assistant.shen") loaded
-   (tc -) false)
-
-(report "quantifier machine"
-
-  (tc +) true
-   (load "qmachine.shen") loaded
-   (exists [1 (+ 1) (= 100)] (> 50)) true
-   (tc -) false) 
- 
-(report "depth first search"
-
-   (tc +) true
-   (load "depth.shen") loaded
-   (depth 4 (/. X [(+ X 3) (+ X 4) (+ X 5)]) (/. X (= X 27)) (/. X (> X 27))) [4 7 10 13 16 19 22 27]
-   (depth 4 (/. X [(+ X 3)]) (/. X (= X 27)) (/. X (> X 27))) []
-   (tc -) false) 
-
-(report "secd"
-
-   (tc +) true
-   (load "secd1.shen") loaded
-   (evaluate [[lambda x x] b]) b   
-   (evaluate [lambda x x]) [closure [] x x]
-   (let If [lambda z [lambda x [lambda y [[z x] y]]]]
-        True [lambda x [lambda y x]]
-        (evaluate [[[If True] a] b]))  a)
-        
-(report "unification"
-
-   (tc -)  false
-   (load "unification.shen") loaded
-   (unify [f a] X) [[X f a]]
-   (unify [f Y] [f b]) [[Y | b]])
-   
-(report "total in Prolog"
-
- (load "totalprolog.shen")  loaded
- (prolog? (findall Age (lived Person Age) Ages) 
-          (total Ages Total) 
-          (return Total))   7625)
-          
-(report "Prolog fork"
- 
-   (load "fork.shen") loaded
-   (prolog? (g1 a))    true) 
-   
-(report "Prolog interpreter"
-
-   (tc +) true
-   (load "prologinterp.shen") loaded 
-   (tc -) false)                      
-   
-(reset)
\ No newline at end of file
+(maxinferences 1e7)
+
+(report "lambda table updates"
+
+  (update-lambda-table append 2)
+  append
+
+  (let F append
+       Lambda (fn F)
+    (Lambda [1] [2]))
+  [1 2]
+
+  (put version shen.lambda-form stale)
+  stale
+
+  (update-lambda-table version 0)
+  version
+
+  (trap-error
+    (get version shen.lambda-form)
+    (/. X undefined))
+  undefined
+
+  (do (put lambda-table-missing shen.lambda-form stale)
+      (update-lambda-table lambda-table-missing -1)
+      (let Result (trap-error
+                    (let F lambda-table-missing
+                      (fn F))
+                    (/. X undefined))
+           Clear (unput lambda-table-missing arity)
+        Result))
+  undefined)
+
+(report "type declaration variancy"
+
+  (prolog? (shen.variancy-signature (receive version) (receive string) Signature)
+           (return Signature))
+  [--> string]
+
+  (prolog? (shen.variancy-signature (receive version) (receive string)
+                                     (receive [--> number])))
+  false
+
+  (prolog? (shen.variancy-signature (receive append) (receive [number --> number]) Signature)
+           (return Signature))
+  [number --> number])
+
+(report "cartesian product"
+
+    (load "cartprod.shen") loaded
+    (cartesian-product [1 2 3] [1 2 3])
+                          [[1 1] [1 2] [1 3] [2 1] [2 2] [2 3] [3 1] [3 2] [3 3]])
+
+(report "powerset"
+
+    (load "powerset.shen") loaded
+    (powerset* [1 2 3]) [[1 2 3] [1 2] [1 3] [1] [2 3] [2] [3] []])
+
+(report "bubble sort"
+
+  (load "bubble version 1.shen") loaded
+  (bubble-sort [1 2 3])  [3 2 1]
+  (load "bubble version 2.shen") loaded
+  (bubble-sort [1 2 3]) [3 2 1])
+
+(report "spreadsheet"
+
+  (load "spreadsheet.shen") loaded
+  (assess-spreadsheet [[jim [wages (/. Spreadsheet (get' frank wages Spreadsheet))]
+                             [tax (/. Spreadsheet (* (get' frank tax Spreadsheet) .8))]]
+                        [frank [wages 20000]
+                               [tax (/. Spreadsheet (* .25 (get' frank wages Spreadsheet)))]]])
+
+              [[jim [wages 20000] [tax 4000.0]] [frank [wages 20000] [tax 5000.0]]]   )
+
+(report "primes"
+
+      (load "prime.shen") loaded
+      (prime*? 1000003) true
+      (load "mutual.shen") loaded
+      (even*? 56) true
+      (odd*? 77)  true
+      (load "change.shen") loaded
+      (count-change 100) 4563)
+
+(report "semantic nets"
+
+    (load "semantic net.shen") loaded
+    (clear Mark_Tarver) []
+    (clear man) []
+    (assert [Mark_Tarver is_a man]) [man]
+    (assert [man type_of human]) [human]
+    (query [is Mark_Tarver human]) yes)
+
+\\ Prolog
+
+(report "einsteins riddle"
+
+   (load "einsteins-riddle.shen") loaded
+   (prolog? (riddle)) german)
+
+(report "Prolog call"
+
+  (load "call.shen") loaded
+  (prolog? (mapit (fn consit) [1 2 3] X) (return X))  [[1 1] [1 2] [1 3]]
+  (prolog? (different 1 2)) true
+  (prolog? (different 1 1)) false)
+
+(report "Prolog cut"
+
+  (load "cut.shen") loaded
+  (prolog? (a X) (return X)) 4)
+
+(report "Prolog naive reverse"
+
+  (load  "nreverseprolog.shen") loaded
+  (prolog? (nreverse [1 2 3 4] X) (return X))  [4 3 2 1])
+
+(report "findall in Prolog"
+
+  (load "findall.shen") loaded
+  (prolog? (fads mark)) [tea chocolate])
+
+(report "Prolog tableau"
+
+  (load  "tableauprolog.shen") loaded
+  (prolog? (prop [] [[p <=> q] <=> [q <=> p]]))  true
+  (prolog? (prop [] [[p <=> q] <=> [q <=> r]]))  false)
+
+(report "proplog"
+
+     (load "proplog version 1.shen") loaded
+     (backchain q [[q <= p] [q <= r] [r <=]]) proved
+     (backchain q [[q <= p] [q <= r]]) (fail)
+     (load "proplog version 2.shen") loaded
+     (backchain q [[q <= p] [q <= r] r]) true
+     (backchain q [[q <= p] [q <= r]]) false)
+
+(report "metaprogramming"
+
+    (load "metaprog.shen") loaded
+    (do (generate_parser [sent --> np vp  np --> name  np  --> det n
+              name --> "John"  name --> "Bill"
+              name --> "Tom" det  --> "the"  det  --> "a"
+              det  --> "that" det  --> "this"
+              n --> "girl"  n --> "ball"
+              vp --> vtrans np  vp --> vintrans
+              vtrans --> "kicks" vtrans --> "likes"
+              vintrans --> "jumps" vintrans --> "flies"]) ok) ok)
+
+(report "binary number datatype"
+     (load "binary.shen") loaded
+     (complement [1 0]) [0 1]
+     (load "streams.shen") loaded
+     (fst (delay (@p 0 (+ 1) (/. X false)))) 1)
+
+ (report "calculator"
+     (load "calculator.shen") loaded
+     (do-calculation [[num 12] + [[num 7] * [num 4]]]) 40 )
+
+(report "structures 1"
+    (load "structures-untyped.shen") loaded
+    (defstruct ship [length name]) ship
+    (make-ship 200 "Mary Rose")  [[structure | ship] [length | 200] [name | "Mary Rose"]]
+    (ship-length (make-ship 200 "Mary Rose")) 200
+    (ship-name (make-ship 200 "Mary Rose"))  "Mary Rose")
+
+(report "structures 2"
+  (load "structures-typed.shen") loaded
+  (defstruct ship [(@p length number) (@p name string)]) ship
+  (make-ship 200 "Mary Rose")  [[structure | ship] [length | 200] [name | "Mary Rose"]]
+  (ship-length (make-ship 200 "Mary Rose")) 200
+  (ship-name (make-ship 200 "Mary Rose"))  "Mary Rose")
+
+(report "classes 1"
+   (load "classes-untyped.shen") loaded
+   (defclass ship [length name]) ship
+   (set s (make-instance ship)) [[class | ship] [length | fail] [name | fail]]
+   (has-value? length (value s)) false
+   (set s (change-value (value s) length 100)) [[class | ship] [length | 100] [name | fail]]
+   (get-value length (value s)) 100)
+
+(report "classes 2"
+   (load "classes-typed.shen") loaded
+   (defclass ship [(@p length number) (@p name string)]) ship
+   (has-value? length (make-instance ship)) false
+   (change-value (make-instance ship) length 100) [[class | ship] [length | 100] [name | fail]]
+   (get-value length (change-value (make-instance ship) length 100)) 100)
+
+ (report "abstract datatypes"
+   (load "stack.shen") loaded
+   (top (push 0 (empty-stack _))) 0)
+
+ (report "yacc"
+   (load "yacc.shen") loaded
+   (compile (fn ) [the cat likes the dog]) [the cat likes the dog]
+   (trap-error (compile (fn ) [the cat likes the canary]) (/. E (fail))) (fail)
+   (compile (fn ) [a a a b b c])  [a a a b b c]
+   (compile (fn ) [a v f g 6 y u]) [6]
+   (compile (fn ) [chases the cat]) [chases the cat]
+   (compile (fn ) [[d] [e e]]) [d e e]
+   (compile (fn ) [the cat likes the dog]) [is it true that your father likes the dog ?]
+   (compile (fn ) [a a a]) [a a a]
+   (compile (fn ) [a v f g 6 y u]) [6 y u]
+   (trap-error (compile (fn ) [a v f g 6 y u]) (/. E (fail))) (fail)
+   (compile (fn ) [a v f g 6 y u]) 6
+   (compile (fn ) [a a a b b b c c c]) [a a a b b b c c c])
+
+(preclude-all-but [])
+(tc +)
+
+(report "N Queens"
+     (preclude-all-but [])  []
+     (tc +) true
+     (load "n queens.shen") loaded
+     (n-queens 5) [[4 2 5 3 1] [3 5 2 4 1] [5 3 1 4 2] [4 1 3 5 2] [5 2 4 1 3] [1 4 2 5 3]
+                    [2 5 3 1 4] [1 3 5 2 4] [3 1 4 2 5] [2 4 1 3 5]]
+     (tc -) false)
+
+(report "search"
+     (tc +) true
+     (load "search.shen") loaded
+     (tc -) false)
+
+(report "montague"
+     (tc +) true
+     (load "montague.shen")  loaded
+     (compile (fn ) [Mary likes John]) [likes Mary John])
+
+(report "c-"
+     (tc +)  true
+     (load "c-minus.shen")  loaded)
+
+(report "L interpreter"
+     (tc +) true
+     (load "interpreter.shen") loaded
+     (normal-form [[[y-combinator [/. ADD [/. X [/. Y [if [= X 0] Y [[ADD [-- X]] [++ Y]]]]]]] 3] 4])  7
+     (normal-form [[[y-combinator [/. APPEND [/. X [/. Y
+                  [if [= X [ ]] Y  [cons [[/. [cons A B] A] X]
+                     	[[APPEND [[/. [cons A B] B] X]] Y]]]]]]] [cons 1 [ ]]] [cons 2 [ ]]])
+      [cons 1 [cons 2 []]]
+     (tc -) false)
+
+(report "proof assistant"
+
+   (tc +) true
+   (load "proof assistant.shen") loaded
+   (tc -) false)
+
+(report "quantifier machine"
+
+  (tc +) true
+   (load "qmachine.shen") loaded
+   (exists [1 (+ 1) (= 100)] (> 50)) true
+   (tc -) false)
+
+(report "depth first search"
+
+   (tc +) true
+   (load "depth.shen") loaded
+   (depth 4 (/. X [(+ X 3) (+ X 4) (+ X 5)]) (/. X (= X 27)) (/. X (> X 27))) [4 7 10 13 16 19 22 27]
+   (depth 4 (/. X [(+ X 3)]) (/. X (= X 27)) (/. X (> X 27))) []
+   (tc -) false)
+
+(report "secd"
+
+   (tc +) true
+   (load "secd1.shen") loaded
+   (evaluate [[lambda x x] b]) b
+   (evaluate [lambda x x]) [closure [] x x]
+   (let If [lambda z [lambda x [lambda y [[z x] y]]]]
+        True [lambda x [lambda y x]]
+        (evaluate [[[If True] a] b]))  a)
+
+(report "unification"
+
+   (tc -)  false
+   (load "unification.shen") loaded
+   (unify [f a] X) [[X f a]]
+   (unify [f Y] [f b]) [[Y | b]])
+
+(report "total in Prolog"
+
+ (load "totalprolog.shen")  loaded
+ (prolog? (findall Age (lived Person Age) Ages)
+          (total Ages Total)
+          (return Total))   7625)
+
+(report "Prolog fork"
+
+   (load "fork.shen") loaded
+   (prolog? (g1 a))    true)
+
+(report "Prolog interpreter"
+
+   (tc +) true
+   (load "prologinterp.shen") loaded
+   (tc -) false)
+
+(reset)
diff --git a/tests/lisp.shen b/tests/lisp.shen
index 95329ea..0ab4dda 100644
--- a/tests/lisp.shen
+++ b/tests/lisp.shen
@@ -1,66 +1,68 @@
-(defcc 
-  {(list number) ==> (list sexpr)}
-      := [ | ];
-    := [];)
-   
-(defcc 
-  {(list number) ==> sexpr}
-      := ;
-   ;)
-   
-(defcc 
-  {(list number) ==> symbol}
-  40 := skip;)
-  
-(defcc 
-  {(list number) ==> symbol}
-  41 := skip;)
-  
-(defcc        
-  {(list number) ==> symbol}
-    := skip;
-   := skip;)
-  
-(defcc 
-  {(list number) ==> symbol}
-   9 := skip;
-   10 := skip;
-   13 := skip;
-   32 := skip;)  
-   
-(defcc 
-  {(list number) ==> atom}
-  ; ; ;)
-  
-(defcc 
-  {(list number) ==> string}  
-     := ;)
-  
-(defcc 
-  {(list number) ==> string}  
-    := (cn  );
-   := "";)
-  
-(defcc 
-  {(list number) ==> string}  
-  Byte := (n->string Byte)   where (not (= Byte 34));)
-  
-(defcc 
-  {(list number) ==> string}  
-  Byte := (n->string Byte)   where (not (= Byte 34));)   
-       
-  
-(datatype sexpr
-
- S : string;
- ____________
- S : sexpr;
- 
- S : symbol;
- ___________
- S : sexpr;
- 
- 
-     
-   
-      
\ No newline at end of file
+(defcc 
+  {(list number) ==> (list sexpr)}
+      := [ | ];
+    := [];)
+
+(defcc 
+  {(list number) ==> sexpr}
+      := ;
+   ;)
+
+(defcc 
+  {(list number) ==> symbol}
+  40 := skip;)
+
+(defcc 
+  {(list number) ==> symbol}
+  41 := skip;)
+
+(defcc 
+  {(list number) ==> symbol}
+    := skip;
+   := skip;)
+
+(defcc 
+  {(list number) ==> symbol}
+   9 := skip;
+   10 := skip;
+   13 := skip;
+   32 := skip;)
+
+(defcc 
+  {(list number) ==> atom}
+  ; ; ;)
+
+(defcc 
+  {(list number) ==> string}
+     := ;)
+
+(defcc 
+  {(list number) ==> string}
+    := (cn  );
+   := "";)
+
+(defcc 
+  {(list number) ==> string}
+  Byte := (n->string Byte)   where (not (= Byte 34));)
+
+(defcc 
+  {(list number) ==> string}
+  Byte := (n->string Byte)   where (not (= Byte 34));)
+
+(datatype sexpr
+
+ S : string;
+ ____________
+ S : sexpr;
+
+ S : symbol;
+ ___________
+ S : sexpr;
+
+ N : number;
+ ___________
+ N : sexpr;
+
+ Xs : (list sexpr);
+ __________________
+ Xs : sexpr;)
diff --git a/tests/metaprog.shen b/tests/metaprog.shen
index 9427f39..6976d99 100644
--- a/tests/metaprog.shen
+++ b/tests/metaprog.shen
@@ -1,85 +1,85 @@
-(define parse
-  D Sentence -> (let Parse (D [Sentence []])
-                   (if (parsed? Parse) (output_parse Parse) ungrammatical)))
-
-(define parsed?
-  [[] Output] -> true
-  _ -> false)
-
-(define output_parse
-  [_ Output] -> Output)
-
-(define generate_parser
-  Grammar -> (map (/. X (compile_rules X)) (group_rules (parenthesise_rules Grammar))))
-
-(define parenthesise_rules
-  [S --> | Rest] -> (parenthesise_rules1 [S -->] Rest))
-
-(define parenthesise_rules1
-  Rule [] -> [Rule]
-  Rule [S --> | Rest] -> [Rule | (parenthesise_rules1 [S -->] Rest)]
-  Rule [X | Y] -> (parenthesise_rules1 (append Rule [X]) Y))
-
-(define group_rules
-  Rules -> (group_rules1 Rules []))
-
-(define group_rules1
-  [] Groups -> Groups
-  [Rule | Rules] Groups -> (group_rules1 Rules (place_in_group Rule Groups)))
-
-(define place_in_group
-  Rule [] -> [[Rule]]
-  Rule [Group | Groups] -> [[Rule | Group] | Groups]
-        where (belongs-in? Rule Group)
-  Rule [Group | Groups] -> [Group | (place_in_group Rule Groups)])
-
-(define belongs-in?
-  [S | _] [[S | _] | _] -> true
-  _ _ -> false)
-
-(define compile_rules
-  Rules -> (if (lex? Rules)
-               (generate_code_for_lex Rules)
-               (generate_code_for_nonlex Rules)))
-
-(define lex?
-  [[S --> Terminal] | _] -> (string? Terminal)
-  _ -> false)
-
-(define generate_code_for_nonlex
-  Rules -> (eval (append [define (get_characteristic_non_terminal Rules) 
-                                   | (mapapp (fn gcfn_help) Rules)] 
-                         [(protect X) -> [fail]])))
-
-(define mapapp
-  _ [] -> []
-  F [X | Y] -> (append (F X) (mapapp F Y)))
-
-(define get_characteristic_non_terminal
-  [[CNT | _] | _] -> CNT)
-
-(define gcfn_help
-   Rule -> [(protect Parameter)
-            <-
-            (apply_expansion Rule
-                             [listit [head (protect Parameter)]
-                                   [cons [listit | Rule]
-                                         [head [tail (protect Parameter)]]]])])
- 
-(define apply_expansion
-   [CNT --> | Expansion] Parameter -> (ae_help Expansion Parameter))
-
-(define ae_help
-   [] Code -> Code
-   [NT | Expansion] Code -> (ae_help Expansion [NT Code]))
-
-(define generate_code_for_lex
-  Rules -> (eval (append [define (get_characteristic_non_terminal Rules)
-                                   (protect X) -> [fail]  where [= (protect X) [fail]]
-                                   | (mapapp (fn gcfl_help) Rules)]
-                                   [(protect X) -> [fail]])))
-
-(define gcfl_help
-  [CNT --> Terminal] -> [[cons [cons Terminal (protect P)] [cons (protect Parse) []]]
-                          -> [listit (protect P) [cons [listit CNT --> Terminal] (protect Parse)]]])
-
+(define parse
+  D Sentence -> (let Parse (D [Sentence []])
+                   (if (parsed? Parse) (output_parse Parse) ungrammatical)))
+
+(define parsed?
+  [[] Output] -> true
+  _ -> false)
+
+(define output_parse
+  [_ Output] -> Output)
+
+(define generate_parser
+  Grammar -> (map (/. X (compile_rules X)) (group_rules (parenthesise_rules Grammar))))
+
+(define parenthesise_rules
+  [S --> | Rest] -> (parenthesise_rules1 [S -->] Rest))
+
+(define parenthesise_rules1
+  Rule [] -> [Rule]
+  Rule [S --> | Rest] -> [Rule | (parenthesise_rules1 [S -->] Rest)]
+  Rule [X | Y] -> (parenthesise_rules1 (append Rule [X]) Y))
+
+(define group_rules
+  Rules -> (group_rules1 Rules []))
+
+(define group_rules1
+  [] Groups -> Groups
+  [Rule | Rules] Groups -> (group_rules1 Rules (place_in_group Rule Groups)))
+
+(define place_in_group
+  Rule [] -> [[Rule]]
+  Rule [Group | Groups] -> [[Rule | Group] | Groups]
+        where (belongs-in? Rule Group)
+  Rule [Group | Groups] -> [Group | (place_in_group Rule Groups)])
+
+(define belongs-in?
+  [S | _] [[S | _] | _] -> true
+  _ _ -> false)
+
+(define compile_rules
+  Rules -> (if (lex? Rules)
+               (generate_code_for_lex Rules)
+               (generate_code_for_nonlex Rules)))
+
+(define lex?
+  [[S --> Terminal] | _] -> (string? Terminal)
+  _ -> false)
+
+(define generate_code_for_nonlex
+  Rules -> (eval (append [define (get_characteristic_non_terminal Rules)
+                                   | (mapapp (fn gcfn_help) Rules)]
+                         [(protect X) -> [fail]])))
+
+(define mapapp
+  _ [] -> []
+  F [X | Y] -> (append (F X) (mapapp F Y)))
+
+(define get_characteristic_non_terminal
+  [[CNT | _] | _] -> CNT)
+
+(define gcfn_help
+   Rule -> [(protect Parameter)
+            <-
+            (apply_expansion Rule
+                             [listit [head (protect Parameter)]
+                                   [cons [listit | Rule]
+                                         [head [tail (protect Parameter)]]]])])
+
+(define apply_expansion
+   [CNT --> | Expansion] Parameter -> (ae_help Expansion Parameter))
+
+(define ae_help
+   [] Code -> Code
+   [NT | Expansion] Code -> (ae_help Expansion [NT Code]))
+
+(define generate_code_for_lex
+  Rules -> (eval (append [define (get_characteristic_non_terminal Rules)
+                                   (protect X) -> [fail]  where [= (protect X) [fail]]
+                                   | (mapapp (fn gcfl_help) Rules)]
+                                   [(protect X) -> [fail]])))
+
+(define gcfl_help
+  [CNT --> Terminal] -> [[cons [cons Terminal (protect P)] [cons (protect Parse) []]]
+                          -> [listit (protect P) [cons [listit CNT --> Terminal] (protect Parse)]]])
+
diff --git a/tests/minim.shen b/tests/minim.shen
index 2700b37..b8588ad 100644
--- a/tests/minim.shen
+++ b/tests/minim.shen
@@ -1,180 +1,180 @@
-\*  @=   | ;
- @=  |  |  | ;
- @= ( @= ) | (++ ); (-- );
- @= any symbol;
- @= any number 
- @= (if   );
- @= (   and ); 
-          ( or ) | (not );
- @= > | < | =; *\
-
-(synonyms program (list statement) 
-          env     (list (symbol * number))) 
-
-(datatype statement 
-
-   Var : symbol; Val : val; 
-   ========================= 
-   [Var @= Val] : statement; 
-
-   if (element? Op [++ --]) 
-   Var : symbol; 
-   ===================== 
-   [Op Var] : statement; 
-
-   Test : test; DoThis : statement; DoThat : statement; 
-   ==================================================== 
-   [if Test then DoThis else DoThat] : statement; 
-
-   Tag : symbol; 
-   ====================== 
-   [goto Tag] : statement; 
-
-   Message : string-or-val; 
-   ============================ 
-   [print Message] : statement; 
-
-   Message : string; 
-   _________________ 
-   Message : string-or-val; 
-
-   Message : val; 
-   _________________ 
-   Message : string-or-val; 
-
-   Var : symbol; 
-   ========================= 
-   [input Var] : statement; 
-
-   Tag : symbol; 
-   _____________ 
-   Tag : statement;) 
-
-(datatype test 
-
-   if (element? Comp [= > <]) 
-   Val1 : val; Val2: val; 
-   ====================== 
-   [Val1 Comp Val2] : test; 
-
-
-   if (element? LogOp [and or]) 
-   Test1 : test; 
-   Test2 : test; 
-   ============= 
-   [Test1 LogOp Test2] : test; 
-
-
-   Test : test; 
-   ================== 
-   [not Test] : test;) 
-
-
-(datatype val 
-
-
-   ______________________________________ 
-   (number? N) : verified >> N : number; 
-
-
-   _______________________________________ 
-   (symbol? S) : verified >> S : symbol; 
-
-
-   Val : symbol; 
-   _______________ 
-   Val : val; 
-
-
-   Val : number; 
-   _____________ 
-   Val : val;) 
-
-
-\\ The program that runs Minim programs is 56 lines and is given here. 
-
-
-(define run-it 
-   {program --> env} 
-    Program -> (run-loop Program Program [])) 
-
-(define run-loop 
-   {program --> program --> env --> env} 
-    [] _ Env -> Env 
-   \\ [nl | Ss] Program Env -> (do (output "~%") (run-loop Ss Program Env)) 
-    [Tag | Ss] Program Env -> (run-loop Ss Program Env)      where (symbol? Tag) 
-    [[goto Tag] | _] Program Env -> (run-loop (go Tag Program) Program Env) 
-    [[Var @= Val] | Ss] Program Env 
-    -> (run-loop Ss Program (change-env Var (compute-val Val Env) Env)) 
-    [[++ Var] | Ss] Program Env 
-    -> (run-loop Ss Program (change-env Var (+ 1 (look-up Var Env)) Env)) 
-    [[-- Var] | Ss] Program Env 
-    -> (run-loop Ss Program (change-env Var (- (look-up Var Env) 1) Env)) 
-    [[if Test then DoThis else DoThat] | Ss] Program Env 
-     -> (if (perform-test? Test Env) 
-            (run-loop [DoThis | Ss] Program Env) 
-            (run-loop [DoThat | Ss] Program Env)) 
-     [[print M] | Ss] Program Env -> (do (output "~A" (look-up M Env)) 
-                                        (run-loop Ss Program Env)) 
-                                                                                where (symbol? M) 
-    [[print M] | Ss] Program Env -> (do (output "~A" M) 
-                                        (run-loop Ss Program Env)) 
-    [[input Var] | Ss] Program Env 
-       -> (run-loop Ss Program (change-env Var (input+ number) Env)) ) 
-
-(define compute-val 
-  {val --> env --> number} 
-   N _ -> N  where (number? N) 
-   Var Env -> (look-up Var Env)      where (symbol? Var)) 
-
-(define go 
-  {symbol --> program --> program} 
-   Tag [Tag | Program] -> Program 
-   Tag [_ | Program] -> (go Tag Program) 
-   Tag _ -> (error "cannot go to tag ~A~%" Tag)) 
-
-(define perform-test? 
-  {test --> env --> boolean} 
-   [Test1 and Test2] Env -> (and (perform-test? Test1 Env) 
-                                 (perform-test? Test2 Env)) 
-   [Test1 or Test2] Env -> (or (perform-test? Test1 Env) 
-                               (perform-test? Test2 Env)) 
-   [not Test] Env -> (not (perform-test? Test Env)) 
-   [V1 = V2] Env -> (= (compute-val V1 Env) (compute-val V2 Env)) 
-   [V1 > V2] Env -> (> (compute-val V1 Env) (compute-val V2 Env)) 
-   [V1 < V2] Env -> (< (compute-val V1 Env) (compute-val V2 Env))) 
-
-(define change-env 
-   {symbol --> number --> env --> env} 
-    Var Val [] -> [(@p Var Val)] 
-    Var Val [(@p Var _) | Env] -> [(@p Var Val) | Env] 
-    Var Val [Binding | Env] -> [Binding | (change-env Var Val Env)]) 
-
-(define look-up 
-  {symbol --> env --> number} 
-   Var [] -> (error "~A is unbound.~%" Var) 
-   Var [(@p Var Val) | _] -> Val 
-   Var [_ | Env] -> (look-up Var Env)) 
-
-\* (run-it [      [print "Add x and y"] 
-               nl 
-               [print "Input x: "] 
-               [input x] 
-               nl 
-               [print "Input y: "] 
-               [input y] 
-               main 
-               [if [x = 0] then [goto end] else [goto sub1x]] 
-
-
-      		 sub1x 
-       		[-- x] 
-       		[++ y] 
-       		[goto main] 
-
-
-       end 
-       nl 
-       [print "The total of x and y is "] 
-       [print y] 
+\*  @=   | ;
+ @=  |  |  | ;
+ @= ( @= ) | (++ ); (-- );
+ @= any symbol;
+ @= any number
+ @= (if   );
+ @= (   and );
+          ( or ) | (not );
+ @= > | < | =; *\
+
+(synonyms program (list statement)
+          env     (list (symbol * number)))
+
+(datatype statement
+
+   Var : symbol; Val : val;
+   =========================
+   [Var @= Val] : statement;
+
+   if (element? Op [++ --])
+   Var : symbol;
+   =====================
+   [Op Var] : statement;
+
+   Test : test; DoThis : statement; DoThat : statement;
+   ====================================================
+   [if Test then DoThis else DoThat] : statement;
+
+   Tag : symbol;
+   ======================
+   [goto Tag] : statement;
+
+   Message : string-or-val;
+   ============================
+   [print Message] : statement;
+
+   Message : string;
+   _________________
+   Message : string-or-val;
+
+   Message : val;
+   _________________
+   Message : string-or-val;
+
+   Var : symbol;
+   =========================
+   [input Var] : statement;
+
+   Tag : symbol;
+   _____________
+   Tag : statement;)
+
+(datatype test
+
+   if (element? Comp [= > <])
+   Val1 : val; Val2: val;
+   ======================
+   [Val1 Comp Val2] : test;
+
+
+   if (element? LogOp [and or])
+   Test1 : test;
+   Test2 : test;
+   =============
+   [Test1 LogOp Test2] : test;
+
+
+   Test : test;
+   ==================
+   [not Test] : test;)
+
+
+(datatype val
+
+
+   ______________________________________
+   (number? N) : verified >> N : number;
+
+
+   _______________________________________
+   (symbol? S) : verified >> S : symbol;
+
+
+   Val : symbol;
+   _______________
+   Val : val;
+
+
+   Val : number;
+   _____________
+   Val : val;)
+
+
+\\ The program that runs Minim programs is 56 lines and is given here.
+
+
+(define run-it
+   {program --> env}
+    Program -> (run-loop Program Program []))
+
+(define run-loop
+   {program --> program --> env --> env}
+    [] _ Env -> Env
+   \\ [nl | Ss] Program Env -> (do (output "~%") (run-loop Ss Program Env))
+    [Tag | Ss] Program Env -> (run-loop Ss Program Env)      where (symbol? Tag)
+    [[goto Tag] | _] Program Env -> (run-loop (go Tag Program) Program Env)
+    [[Var @= Val] | Ss] Program Env
+    -> (run-loop Ss Program (change-env Var (compute-val Val Env) Env))
+    [[++ Var] | Ss] Program Env
+    -> (run-loop Ss Program (change-env Var (+ 1 (look-up Var Env)) Env))
+    [[-- Var] | Ss] Program Env
+    -> (run-loop Ss Program (change-env Var (- (look-up Var Env) 1) Env))
+    [[if Test then DoThis else DoThat] | Ss] Program Env
+     -> (if (perform-test? Test Env)
+            (run-loop [DoThis | Ss] Program Env)
+            (run-loop [DoThat | Ss] Program Env))
+     [[print M] | Ss] Program Env -> (do (output "~A" (look-up M Env))
+                                        (run-loop Ss Program Env))
+                                                                                where (symbol? M)
+    [[print M] | Ss] Program Env -> (do (output "~A" M)
+                                        (run-loop Ss Program Env))
+    [[input Var] | Ss] Program Env
+       -> (run-loop Ss Program (change-env Var (input+ number) Env)) )
+
+(define compute-val
+  {val --> env --> number}
+   N _ -> N  where (number? N)
+   Var Env -> (look-up Var Env)      where (symbol? Var))
+
+(define go
+  {symbol --> program --> program}
+   Tag [Tag | Program] -> Program
+   Tag [_ | Program] -> (go Tag Program)
+   Tag _ -> (error "cannot go to tag ~A~%" Tag))
+
+(define perform-test?
+  {test --> env --> boolean}
+   [Test1 and Test2] Env -> (and (perform-test? Test1 Env)
+                                 (perform-test? Test2 Env))
+   [Test1 or Test2] Env -> (or (perform-test? Test1 Env)
+                               (perform-test? Test2 Env))
+   [not Test] Env -> (not (perform-test? Test Env))
+   [V1 = V2] Env -> (= (compute-val V1 Env) (compute-val V2 Env))
+   [V1 > V2] Env -> (> (compute-val V1 Env) (compute-val V2 Env))
+   [V1 < V2] Env -> (< (compute-val V1 Env) (compute-val V2 Env)))
+
+(define change-env
+   {symbol --> number --> env --> env}
+    Var Val [] -> [(@p Var Val)]
+    Var Val [(@p Var _) | Env] -> [(@p Var Val) | Env]
+    Var Val [Binding | Env] -> [Binding | (change-env Var Val Env)])
+
+(define look-up
+  {symbol --> env --> number}
+   Var [] -> (error "~A is unbound.~%" Var)
+   Var [(@p Var Val) | _] -> Val
+   Var [_ | Env] -> (look-up Var Env))
+
+\* (run-it [      [print "Add x and y"]
+               nl
+               [print "Input x: "]
+               [input x]
+               nl
+               [print "Input y: "]
+               [input y]
+               main
+               [if [x = 0] then [goto end] else [goto sub1x]]
+
+
+      		 sub1x
+       		[-- x]
+       		[++ y]
+       		[goto main]
+
+
+       end
+       nl
+       [print "The total of x and y is "]
+       [print y]
        nl] ) *\
\ No newline at end of file
diff --git a/tests/montague.shen b/tests/montague.shen
index c0ea4c0..fa6d578 100644
--- a/tests/montague.shen
+++ b/tests/montague.shen
@@ -1,96 +1,96 @@
-(datatype t
-
-   if (not (element? t [~ v & => <=> e! a!]))
-   T : symbol;
-   ________
-   T : t;
-   _______________
-   (gensym v) : t;)
-
-(datatype f
-
-  F : t; T : (list t);
-  ____________________
-  [F | T] : f;
-
- (not (= F ~)) : verified;
-  F : t, T : t >> P;
- ___________________
- [F T] : f >> P;
-
- (not (element? C [v & => <=>])) : verified;
- (not (element? F [e! a!])) : verified;
-  F : t, T1 : t, T2 : t >> P;
- ____________________________
- [F T1 T2] : f >> P;
-
- P : f;
- ==========
- [~ P] : f;
-
-  if (element? C [v & => <=>])
-  P : f; Q : f;
-  =============
-  [P C Q] : f;
-
-  X : t; P : f;
-  =============
-  [e! X P] : f;
-
-  X : t; P : f;
-  =============
-  [a! X P] : f;)
-
-(defcc 
-  {(list t) ==> f} 
-    := ( );)
-  
-(defcc 
-  {(list t) ==> ((t --> f) --> f)}
-  Name := (/. P (P Name))   where (name? Name);
-    := ( ); 
-    := ( );)
-  
-(define name?
-  {t --> boolean}
-   Name -> (variable? Name)) 
-  
-(defcc 
-   {(list t) ==> (t --> f)}
-   CN := (/. X [CN X])     where (common-noun? CN);)
-
-(define common-noun?
-   {t --> boolean}
-    CN -> (element? CN [girl boy dog cat]))
-
-(defcc 
-   {(list t) ==> (t --> f)}
-    that  := (/. X [( X) & ( X)]);
-    that   := (/. X [( X) & ( (/. Y ( Y X)))]);)
-
-(defcc 
-   {(list t) ==> (t --> f)}
-   ;
-     := (/. X ( (/. Y ( X Y))));)
-
-(defcc 
-  {(list t) ==> (t --> f)}
-    Intrans := (/. X [Intrans X])   where (intrans? Intrans);)
-
-(define intrans?
-   {t --> boolean}
-    Intrans -> (element? Intrans [runs jumps walks]))
-
-(defcc 
-   {(list t) ==> (t --> t --> f)}
-    Trans := (/. X Y [Trans X Y])   where (trans? Trans);)
-
-(define trans?
-   {t --> boolean}
-   Trans -> (element? Trans [likes greets admires]))
-   
-(defcc 
-  {(list t) ==> ((t --> f) --> ((t --> f) --> f))}
-   some := (let V (type (gensym v) t) (/. P Q [e! V [(P V) & (Q V)]]));
-   every := (let V (type (gensym v) t) (/. P Q [a! V [(P V) => (Q V)]]));
-   no      := (let V (type (gensym v) t) (/. P Q [a! V [(P V) => [~ (Q V)]]]));)   
\ No newline at end of file
+(datatype t
+
+   if (not (element? t [~ v & => <=> e! a!]))
+   T : symbol;
+   ________
+   T : t;
+   _______________
+   (gensym v) : t;)
+
+(datatype f
+
+  F : t; T : (list t);
+  ____________________
+  [F | T] : f;
+
+ (not (= F ~)) : verified;
+  F : t, T : t >> P;
+ ___________________
+ [F T] : f >> P;
+
+ (not (element? C [v & => <=>])) : verified;
+ (not (element? F [e! a!])) : verified;
+  F : t, T1 : t, T2 : t >> P;
+ ____________________________
+ [F T1 T2] : f >> P;
+
+ P : f;
+ ==========
+ [~ P] : f;
+
+  if (element? C [v & => <=>])
+  P : f; Q : f;
+  =============
+  [P C Q] : f;
+
+  X : t; P : f;
+  =============
+  [e! X P] : f;
+
+  X : t; P : f;
+  =============
+  [a! X P] : f;)
+
+(defcc 
+  {(list t) ==> f}
+    := ( );)
+
+(defcc 
+  {(list t) ==> ((t --> f) --> f)}
+  Name := (/. P (P Name))   where (name? Name);
+    := ( );
+    := ( );)
+
+(define name?
+  {t --> boolean}
+   Name -> (variable? Name))
+
+(defcc 
+   {(list t) ==> (t --> f)}
+   CN := (/. X [CN X])     where (common-noun? CN);)
+
+(define common-noun?
+   {t --> boolean}
+    CN -> (element? CN [girl boy dog cat]))
+
+(defcc 
+   {(list t) ==> (t --> f)}
+    that  := (/. X [( X) & ( X)]);
+    that   := (/. X [( X) & ( (/. Y ( Y X)))]);)
+
+(defcc 
+   {(list t) ==> (t --> f)}
+   ;
+     := (/. X ( (/. Y ( X Y))));)
+
+(defcc 
+  {(list t) ==> (t --> f)}
+    Intrans := (/. X [Intrans X])   where (intrans? Intrans);)
+
+(define intrans?
+   {t --> boolean}
+    Intrans -> (element? Intrans [runs jumps walks]))
+
+(defcc 
+   {(list t) ==> (t --> t --> f)}
+    Trans := (/. X Y [Trans X Y])   where (trans? Trans);)
+
+(define trans?
+   {t --> boolean}
+   Trans -> (element? Trans [likes greets admires]))
+
+(defcc 
+  {(list t) ==> ((t --> f) --> ((t --> f) --> f))}
+   some := (let V (type (gensym v) t) (/. P Q [e! V [(P V) & (Q V)]]));
+   every := (let V (type (gensym v) t) (/. P Q [a! V [(P V) => (Q V)]]));
+   no      := (let V (type (gensym v) t) (/. P Q [a! V [(P V) => [~ (Q V)]]]));)
\ No newline at end of file
diff --git a/tests/mutual.shen b/tests/mutual.shen
index a273b3a..386ff46 100644
--- a/tests/mutual.shen
+++ b/tests/mutual.shen
@@ -1,11 +1,11 @@
-(define even*? 
-   1 -> false  
-   X -> (odd*? (- X 1)))
-
-(define odd*?  
-   1 -> true  
-   X -> (even*? (- X 1)))
-
-
- 
-
+(define even*?
+   1 -> false
+   X -> (odd*? (- X 1)))
+
+(define odd*?
+   1 -> true
+   X -> (even*? (- X 1)))
+
+
+
+
diff --git a/tests/n queens-axioms.shen b/tests/n queens-axioms.shen
index ce688ab..933739d 100644
--- a/tests/n queens-axioms.shen	
+++ b/tests/n queens-axioms.shen	
@@ -1,344 +1,344 @@
-(all V13514 : number 
+(all V13514 : number
  (
-  (n-queens V13514) = 
-  (n-queens.n-queens-loop V13514 
+  (n-queens V13514) =
+  (n-queens.n-queens-loop V13514
    (n-queens.initialise V13514))))
 
 (
- (n-queens.initialise 0) = 
+ (n-queens.initialise 0) =
  ())
 
-(all V13516 : number 
+(all V13516 : number
  (
-  (~ 
-   (0 = V13516)) => 
+  (~
+   (0 = V13516)) =>
   (
-   (n-queens.initialise V13516) = 
-   (cons 1 
-    (n-queens.initialise 
+   (n-queens.initialise V13516) =
+   (cons 1
+    (n-queens.initialise
      (- V13516 1))))))
 
-(all V13523 : number 
- (all V13524 : 
-  (list number) 
+(all V13523 : number
+ (all V13524 :
+  (list number)
   (
-   (n-queens.all_Ns? V13523 V13524) => 
+   (n-queens.all_Ns? V13523 V13524) =>
    (
-    (n-queens.n-queens-loop V13523 V13524) = 
+    (n-queens.n-queens-loop V13523 V13524) =
     ()))))
 
-(all V13523 : number 
- (all V13524 : 
-  (list number) 
+(all V13523 : number
+ (all V13524 :
+  (list number)
   (
    (
-    (~ 
-     (n-queens.all_Ns? V13523 V13524)) & 
+    (~
+     (n-queens.all_Ns? V13523 V13524)) &
     (
-     (n-queens.ok_row? V13524) & 
-     (n-queens.ok_diag? V13524))) => 
+     (n-queens.ok_row? V13524) &
+     (n-queens.ok_diag? V13524))) =>
    (
-    (n-queens.n-queens-loop V13523 V13524) = 
-    (cons V13524 
-     (n-queens.n-queens-loop V13523 
+    (n-queens.n-queens-loop V13523 V13524) =
+    (cons V13524
+     (n-queens.n-queens-loop V13523
       (n-queens.next_n V13523 V13524)))))))
 
-(all V13523 : number 
- (all V13524 : 
-  (list number) 
+(all V13523 : number
+ (all V13524 :
+  (list number)
   (
    (
-    (~ 
-     (n-queens.all_Ns? V13523 V13524)) & 
+    (~
+     (n-queens.all_Ns? V13523 V13524)) &
     (
-     (~ 
-      (n-queens.ok_row? V13524)) v 
-     (~ 
-      (n-queens.ok_diag? V13524)))) => 
+     (~
+      (n-queens.ok_row? V13524)) v
+     (~
+      (n-queens.ok_diag? V13524)))) =>
    (
-    (n-queens.n-queens-loop V13523 V13524) = 
-    (n-queens.n-queens-loop V13523 
+    (n-queens.n-queens-loop V13523 V13524) =
+    (n-queens.n-queens-loop V13523
      (n-queens.next_n V13523 V13524))))))
 
-(all V13559 : number 
+(all V13559 : number
  (
-  (n-queens.all_Ns? V13559 
+  (n-queens.all_Ns? V13559
    ()) = true))
 
-(all V13560 : 
- (list number) 
+(all V13560 :
+ (list number)
  (
   (
-   (~ 
+   (~
     (
-     () = V13560)) & 
-   (cons? V13560)) => 
+     () = V13560)) &
+   (cons? V13560)) =>
   (
-   (n-queens.all_Ns? 
-    (hd V13560) V13560) = 
-   (n-queens.all_Ns? 
-    (hd V13560) 
+   (n-queens.all_Ns?
+    (hd V13560) V13560) =
+   (n-queens.all_Ns?
+    (hd V13560)
     (tl V13560)))))
 
-(all V13559 : number 
- (all V13560 : 
-  (list number) 
+(all V13559 : number
+ (all V13560 :
+  (list number)
   (
    (
-    (~ 
+    (~
      (
-      () = V13560)) & 
+      () = V13560)) &
     (
-     (~ 
-      (cons? V13560)) v 
-     (~ 
-      (V13559 = 
-       (hd V13560))))) => 
+     (~
+      (cons? V13560)) v
+     (~
+      (V13559 =
+       (hd V13560))))) =>
    (
     (n-queens.all_Ns? V13559 V13560) = false))))
 
-(all V13580 : 
- (list number) 
+(all V13580 :
+ (list number)
  (
-  (cons? V13580) => 
+  (cons? V13580) =>
   (
-   (n-queens.next_n 
-    (hd V13580) V13580) = 
-   (cons 1 
-    (n-queens.next_n 
-     (hd V13580) 
+   (n-queens.next_n
+    (hd V13580) V13580) =
+   (cons 1
+    (n-queens.next_n
+     (hd V13580)
      (tl V13580))))))
 
-(all V13579 : number 
- (all V13580 : 
-  (list number) 
+(all V13579 : number
+ (all V13580 :
+  (list number)
   (
    (
     (
-     (~ 
-      (cons? V13580)) v 
-     (~ 
-      (V13579 = 
-       (hd V13580)))) & 
-    (cons? V13580)) => 
+     (~
+      (cons? V13580)) v
+     (~
+      (V13579 =
+       (hd V13580)))) &
+    (cons? V13580)) =>
    (
-    (n-queens.next_n V13579 V13580) = 
-    (cons 
-     (+ 1 
-      (hd V13580)) 
+    (n-queens.next_n V13579 V13580) =
+    (cons
+     (+ 1
+      (hd V13580))
      (tl V13580))))))
 
-(all V13579 : number 
- (all V13580 : 
-  (list number) 
+(all V13579 : number
+ (all V13580 :
+  (list number)
   (
    (
     (
-     (~ 
-      (cons? V13580)) v 
-     (~ 
-      (V13579 = 
-       (hd V13580)))) & 
-    (~ 
-     (cons? V13580))) => 
+     (~
+      (cons? V13580)) v
+     (~
+      (V13579 =
+       (hd V13580)))) &
+    (~
+     (cons? V13580))) =>
    (
-    (n-queens.next_n V13579 V13580) = 
+    (n-queens.next_n V13579 V13580) =
     (shen.f-error n-queens.next_n)))))
 
 (
- (n-queens.ok_row? 
+ (n-queens.ok_row?
   ()) = true)
 
-(all V13595 : 
- (list number) 
+(all V13595 :
+ (list number)
  (
   (
-   (~ 
+   (~
     (
-     () = V13595)) & 
+     () = V13595)) &
    (
-    (cons? V13595) & 
-    (element? 
-     (hd V13595) 
-     (tl V13595)))) => 
+    (cons? V13595) &
+    (element?
+     (hd V13595)
+     (tl V13595)))) =>
   (
    (n-queens.ok_row? V13595) = false)))
 
-(all V13595 : 
- (list number) 
+(all V13595 :
+ (list number)
  (
   (
-   (~ 
+   (~
     (
-     () = V13595)) & 
+     () = V13595)) &
    (
     (
-     (~ 
-      (cons? V13595)) v 
-     (~ 
-      (element? 
-       (hd V13595) 
-       (tl V13595)))) & 
-    (cons? V13595))) => 
+     (~
+      (cons? V13595)) v
+     (~
+      (element?
+       (hd V13595)
+       (tl V13595)))) &
+    (cons? V13595))) =>
   (
-   (n-queens.ok_row? V13595) = 
-   (n-queens.ok_row? 
+   (n-queens.ok_row? V13595) =
+   (n-queens.ok_row?
     (tl V13595)))))
 
-(all V13595 : 
- (list number) 
+(all V13595 :
+ (list number)
  (
   (
-   (~ 
+   (~
     (
-     () = V13595)) & 
+     () = V13595)) &
    (
     (
-     (~ 
-      (cons? V13595)) v 
-     (~ 
-      (element? 
-       (hd V13595) 
-       (tl V13595)))) & 
-    (~ 
-     (cons? V13595)))) => 
+     (~
+      (cons? V13595)) v
+     (~
+      (element?
+       (hd V13595)
+       (tl V13595)))) &
+    (~
+     (cons? V13595)))) =>
   (
-   (n-queens.ok_row? V13595) = 
+   (n-queens.ok_row? V13595) =
    (shen.f-error n-queens.ok_row?))))
 
 (
- (n-queens.ok_diag? 
+ (n-queens.ok_diag?
   ()) = true)
 
-(all V13598 : 
- (list number) 
+(all V13598 :
+ (list number)
  (
   (
-   (~ 
+   (~
     (
-     () = V13598)) & 
-   (cons? V13598)) => 
+     () = V13598)) &
+   (cons? V13598)) =>
   (
-   (n-queens.ok_diag? V13598) = 
-   (and 
-    (n-queens.ok_diag_N? 
-     (+ 
-      (hd V13598) 1) 
-     (- 
-      (hd V13598) 1) 
-     (tl V13598)) 
-    (n-queens.ok_diag? 
+   (n-queens.ok_diag? V13598) =
+   (and
+    (n-queens.ok_diag_N?
+     (+
+      (hd V13598) 1)
+     (-
+      (hd V13598) 1)
+     (tl V13598))
+    (n-queens.ok_diag?
      (tl V13598))))))
 
-(all V13598 : 
- (list number) 
+(all V13598 :
+ (list number)
  (
   (
-   (~ 
+   (~
     (
-     () = V13598)) & 
-   (~ 
-    (cons? V13598))) => 
+     () = V13598)) &
+   (~
+    (cons? V13598))) =>
   (
-   (n-queens.ok_diag? V13598) = 
+   (n-queens.ok_diag? V13598) =
    (shen.f-error n-queens.ok_diag?))))
 
-(all V13651 : number 
- (all V13652 : number 
+(all V13651 : number
+ (all V13652 : number
   (
-   (n-queens.ok_diag_N? V13651 V13652 
+   (n-queens.ok_diag_N? V13651 V13652
     ()) = true)))
 
-(all V13652 : number 
- (all V13653 : 
-  (list number) 
+(all V13652 : number
+ (all V13653 :
+  (list number)
   (
    (
-    (~ 
+    (~
      (
-      () = V13653)) & 
-    (cons? V13653)) => 
+      () = V13653)) &
+    (cons? V13653)) =>
    (
-    (n-queens.ok_diag_N? 
+    (n-queens.ok_diag_N?
      (hd V13653) V13652 V13653) = false))))
 
-(all V13651 : number 
- (all V13653 : 
-  (list number) 
+(all V13651 : number
+ (all V13653 :
+  (list number)
   (
    (
-    (~ 
+    (~
      (
-      () = V13653)) & 
+      () = V13653)) &
     (
      (
-      (~ 
-       (cons? V13653)) v 
-      (~ 
-       (V13651 = 
-        (hd V13653)))) & 
-     (cons? V13653))) => 
+      (~
+       (cons? V13653)) v
+      (~
+       (V13651 =
+        (hd V13653)))) &
+     (cons? V13653))) =>
    (
-    (n-queens.ok_diag_N? V13651 
+    (n-queens.ok_diag_N? V13651
      (hd V13653) V13653) = false))))
 
-(all V13651 : number 
- (all V13652 : number 
-  (all V13653 : 
-   (list number) 
+(all V13651 : number
+ (all V13652 : number
+  (all V13653 :
+   (list number)
    (
     (
-     (~ 
+     (~
       (
-       () = V13653)) & 
+       () = V13653)) &
      (
       (
-       (~ 
-        (cons? V13653)) v 
-       (~ 
-        (V13651 = 
-         (hd V13653)))) & 
+       (~
+        (cons? V13653)) v
+       (~
+        (V13651 =
+         (hd V13653)))) &
       (
        (
-        (~ 
-         (cons? V13653)) v 
-        (~ 
-         (V13652 = 
-          (hd V13653)))) & 
-       (cons? V13653)))) => 
+        (~
+         (cons? V13653)) v
+        (~
+         (V13652 =
+          (hd V13653)))) &
+       (cons? V13653)))) =>
     (
-     (n-queens.ok_diag_N? V13651 V13652 V13653) = 
-     (n-queens.ok_diag_N? 
-      (+ 1 V13651) 
-      (- V13652 1) 
+     (n-queens.ok_diag_N? V13651 V13652 V13653) =
+     (n-queens.ok_diag_N?
+      (+ 1 V13651)
+      (- V13652 1)
       (tl V13653)))))))
 
-(all V13651 : number 
- (all V13652 : number 
-  (all V13653 : 
-   (list number) 
+(all V13651 : number
+ (all V13652 : number
+  (all V13653 :
+   (list number)
    (
     (
-     (~ 
+     (~
       (
-       () = V13653)) & 
+       () = V13653)) &
      (
       (
-       (~ 
-        (cons? V13653)) v 
-       (~ 
-        (V13651 = 
-         (hd V13653)))) & 
+       (~
+        (cons? V13653)) v
+       (~
+        (V13651 =
+         (hd V13653)))) &
       (
        (
-        (~ 
-         (cons? V13653)) v 
-        (~ 
-         (V13652 = 
-          (hd V13653)))) & 
-       (~ 
-        (cons? V13653))))) => 
+        (~
+         (cons? V13653)) v
+        (~
+         (V13652 =
+          (hd V13653)))) &
+       (~
+        (cons? V13653))))) =>
     (
-     (n-queens.ok_diag_N? V13651 V13652 V13653) = 
+     (n-queens.ok_diag_N? V13651 V13652 V13653) =
      (shen.f-error n-queens.ok_diag_N?))))))
 
diff --git a/tests/n queens-r.shen b/tests/n queens-r.shen
index d26b1a3..65381ec 100644
--- a/tests/n queens-r.shen	
+++ b/tests/n queens-r.shen	
@@ -1,49 +1,49 @@
-(package n-queens [n-queens]
-
-(define n-queens
-  {number --> (list (list number))}
-  N -> (n-queens-loop N (initialise N)))
-
-(define initialise
-   {number --> (list number)}
-   0 -> []
-   N -> [1 | (initialise (- N 1))])
- 
-(define n-queens-loop
-  {number --> (list number) --> (list (list number))}
-  N Config -> []    where (all_Ns? N Config)
-  N Config -> [Config | (n-queens-loop N (next_n N Config))] 
-                                       where (and (ok_row? Config) (ok_diag? Config))
-  N Config -> (n-queens-loop N (next_n N Config)))
- 
-(define all_Ns?
-  {number --> (list number) --> boolean}
-   _ [] -> true
-  N [N | Ns] -> (all_Ns? N Ns)
-  _ _ -> false)
- 
-(define next_n
-  {number --> (list number) --> (list number)}
-  N [N | Ns] -> [1 | (next_n N Ns)]
-  _ [N | Ns] -> [(+ 1 N) | Ns])
- 
-(define ok_row?
-  {(list number) --> boolean}
-  [] -> true
-  [N | Ns] -> false     where (element? N Ns)
-  [_ | Ns] -> (ok_row? Ns))
- 
-(define ok_diag?
-  {(list number) --> boolean} 
-  [] -> true
-  [N | Ns] -> (and (ok_diag_N? (+ N 1) (- N 1) Ns) 
-                                (ok_diag? Ns)))
- 
-(define ok_diag_N?
-  {number --> number --> (list number) --> boolean}
-  _ _ [] -> true
-  Up Down [Up | _] -> false
-  Up Down [Down | _] -> false
-  Up Down [_ | Ns] -> (ok_diag_N? (+ 1 Up) (- Down 1) Ns))
-  
-  ) 
+(package n-queens [n-queens]
+
+(define n-queens
+  {number --> (list (list number))}
+  N -> (n-queens-loop N (initialise N)))
+
+(define initialise
+   {number --> (list number)}
+   0 -> []
+   N -> [1 | (initialise (- N 1))])
+
+(define n-queens-loop
+  {number --> (list number) --> (list (list number))}
+  N Config -> []    where (all_Ns? N Config)
+  N Config -> [Config | (n-queens-loop N (next_n N Config))]
+                                       where (and (ok_row? Config) (ok_diag? Config))
+  N Config -> (n-queens-loop N (next_n N Config)))
+
+(define all_Ns?
+  {number --> (list number) --> boolean}
+   _ [] -> true
+  N [N | Ns] -> (all_Ns? N Ns)
+  _ _ -> false)
+
+(define next_n
+  {number --> (list number) --> (list number)}
+  N [N | Ns] -> [1 | (next_n N Ns)]
+  _ [N | Ns] -> [(+ 1 N) | Ns])
+
+(define ok_row?
+  {(list number) --> boolean}
+  [] -> true
+  [N | Ns] -> false     where (element? N Ns)
+  [_ | Ns] -> (ok_row? Ns))
+
+(define ok_diag?
+  {(list number) --> boolean}
+  [] -> true
+  [N | Ns] -> (and (ok_diag_N? (+ N 1) (- N 1) Ns)
+                                (ok_diag? Ns)))
+
+(define ok_diag_N?
+  {number --> number --> (list number) --> boolean}
+  _ _ [] -> true
+  Up Down [Up | _] -> false
+  Up Down [Down | _] -> false
+  Up Down [_ | Ns] -> (ok_diag_N? (+ 1 Up) (- Down 1) Ns))
+
+  )
diff --git a/tests/n queens.axioms b/tests/n queens.axioms
index 44f5a29..8e3d567 100644
--- a/tests/n queens.axioms	
+++ b/tests/n queens.axioms	
@@ -1,620 +1,620 @@
-(all x 
+(all x
  (
-  (x : number) => 
+  (x : number) =>
   (
-   (n-queens x) : 
-   (list 
+   (n-queens x) :
+   (list
     (list number)))))
 
-(all x 
+(all x
  (
-  (x : number) => 
+  (x : number) =>
   (
-   (n-queens x) = 
-   (n-queens.n-queens-loop x 
+   (n-queens x) =
+   (n-queens.n-queens-loop x
     (n-queens.initialise x)))))
 
-(all x 
+(all x
  (
-  (x : number) => 
+  (x : number) =>
   (
-   (n-queens.initialise x) : 
+   (n-queens.initialise x) :
    (list number))))
 
-(all x 
+(all x
  (
   (
-   (x : number) & 
-   (0 = x)) => 
+   (x : number) &
+   (0 = x)) =>
   (
-   (n-queens.initialise x) = 
+   (n-queens.initialise x) =
    ())))
 
-(all x 
+(all x
  (
   (
-   (x : number) & 
-   (~ 
-    (0 = x))) => 
+   (x : number) &
+   (~
+    (0 = x))) =>
   (
-   (n-queens.initialise x) = 
-   (cons 1 
-    (n-queens.initialise 
+   (n-queens.initialise x) =
+   (cons 1
+    (n-queens.initialise
      (- x 1))))))
 
-(all x 
+(all x
  (
-  (x : number) => 
-  (all y 
+  (x : number) =>
+  (all y
    (
-    (y : 
-     (list number)) => 
+    (y :
+     (list number)) =>
     (
-     (n-queens.n-queens-loop x y) : 
-     (list 
+     (n-queens.n-queens-loop x y) :
+     (list
       (list number)))))))
 
-(all x 
+(all x
  (
-  (x : number) => 
-  (all y 
+  (x : number) =>
+  (all y
    (
     (
-     (y : 
-      (list number)) & 
-     (n-queens.all_Ns? x y)) => 
+     (y :
+      (list number)) &
+     (n-queens.all_Ns? x y)) =>
     (
-     (n-queens.n-queens-loop x y) = 
+     (n-queens.n-queens-loop x y) =
      ())))))
 
-(all x 
+(all x
  (
-  (x : number) => 
-  (all y 
+  (x : number) =>
+  (all y
    (
     (
-     (y : 
-      (list number)) & 
+     (y :
+      (list number)) &
      (
-      (~ 
-       (n-queens.all_Ns? x y)) & 
+      (~
+       (n-queens.all_Ns? x y)) &
       (
-       (n-queens.ok_row? y) & 
-       (n-queens.ok_diag? y)))) => 
+       (n-queens.ok_row? y) &
+       (n-queens.ok_diag? y)))) =>
     (
-     (n-queens.n-queens-loop x y) = 
-     (cons y 
-      (n-queens.n-queens-loop x 
+     (n-queens.n-queens-loop x y) =
+     (cons y
+      (n-queens.n-queens-loop x
        (n-queens.next_n x y))))))))
 
-(all x 
+(all x
  (
-  (x : number) => 
-  (all y 
+  (x : number) =>
+  (all y
    (
     (
-     (y : 
-      (list number)) & 
+     (y :
+      (list number)) &
      (
-      (~ 
-       (n-queens.all_Ns? x y)) & 
+      (~
+       (n-queens.all_Ns? x y)) &
       (
-       (~ 
-        (n-queens.ok_row? y)) v 
-       (~ 
-        (n-queens.ok_diag? y))))) => 
+       (~
+        (n-queens.ok_row? y)) v
+       (~
+        (n-queens.ok_diag? y))))) =>
     (
-     (n-queens.n-queens-loop x y) = 
-     (n-queens.n-queens-loop x 
+     (n-queens.n-queens-loop x y) =
+     (n-queens.n-queens-loop x
       (n-queens.next_n x y)))))))
 
-(all x 
+(all x
  (
-  (x : number) => 
-  (all y 
+  (x : number) =>
+  (all y
    (
-    (y : 
-     (list number)) => 
+    (y :
+     (list number)) =>
     (
      (n-queens.all_Ns? x y) : boolean)))))
 
-(all x 
+(all x
  (
-  (x : number) => 
-  (all y 
+  (x : number) =>
+  (all y
    (
     (
-     (y : 
-      (list number)) & 
+     (y :
+      (list number)) &
      (
-      () = y)) => 
+      () = y)) =>
     (
      (n-queens.all_Ns? x y) = true)))))
 
-(all x 
+(all x
  (
-  (x : number) => 
-  (all y 
+  (x : number) =>
+  (all y
    (
     (
-     (y : 
-      (list number)) & 
+     (y :
+      (list number)) &
      (
-      (~ 
+      (~
        (
-        () = y)) & 
+        () = y)) &
       (
-       (exists z 
-        (exists x1 
+       (exists z
+        (exists x1
          (
-          (cons z x1) = y))) & 
-       (x = 
-        (hd y))))) => 
+          (cons z x1) = y))) &
+       (x =
+        (hd y))))) =>
     (
-     (n-queens.all_Ns? x y) = 
-     (n-queens.all_Ns? 
-      (hd y) 
+     (n-queens.all_Ns? x y) =
+     (n-queens.all_Ns?
+      (hd y)
       (tl y)))))))
 
-(all x 
+(all x
  (
-  (x : number) => 
-  (all y 
+  (x : number) =>
+  (all y
    (
     (
-     (y : 
-      (list number)) & 
+     (y :
+      (list number)) &
      (
-      (~ 
+      (~
        (
-        () = y)) & 
+        () = y)) &
       (
-       (all z 
-        (all x1 
-         (~ 
+       (all z
+        (all x1
+         (~
           (
-           (cons z x1) = y)))) v 
-       (~ 
-        (x = 
-         (hd y)))))) => 
+           (cons z x1) = y)))) v
+       (~
+        (x =
+         (hd y)))))) =>
     (
      (n-queens.all_Ns? x y) = false)))))
 
-(all x 
+(all x
  (
-  (x : number) => 
-  (all y 
+  (x : number) =>
+  (all y
    (
-    (y : 
-     (list number)) => 
+    (y :
+     (list number)) =>
     (
-     (n-queens.next_n x y) : 
+     (n-queens.next_n x y) :
      (list number))))))
 
-(all x 
+(all x
  (
-  (x : number) => 
-  (all y 
+  (x : number) =>
+  (all y
    (
     (
-     (y : 
-      (list number)) & 
+     (y :
+      (list number)) &
      (
-      (exists z 
-       (exists x1 
+      (exists z
+       (exists x1
         (
-         (cons z x1) = y))) & 
-      (x = 
-       (hd y)))) => 
+         (cons z x1) = y))) &
+      (x =
+       (hd y)))) =>
     (
-     (n-queens.next_n x y) = 
-     (cons 1 
-      (n-queens.next_n 
-       (hd y) 
+     (n-queens.next_n x y) =
+     (cons 1
+      (n-queens.next_n
+       (hd y)
        (tl y))))))))
 
-(all x 
+(all x
  (
-  (x : number) => 
-  (all y 
+  (x : number) =>
+  (all y
    (
     (
-     (y : 
-      (list number)) & 
+     (y :
+      (list number)) &
      (
       (
-       (all z 
-        (all x1 
-         (~ 
+       (all z
+        (all x1
+         (~
           (
-           (cons z x1) = y)))) v 
-       (~ 
-        (x = 
-         (hd y)))) & 
-      (exists z 
-       (exists x1 
+           (cons z x1) = y)))) v
+       (~
+        (x =
+         (hd y)))) &
+      (exists z
+       (exists x1
         (
-         (cons z x1) = y))))) => 
+         (cons z x1) = y))))) =>
     (
-     (n-queens.next_n x y) = 
-     (cons 
-      (+ 1 
-       (hd y)) 
+     (n-queens.next_n x y) =
+     (cons
+      (+ 1
+       (hd y))
       (tl y)))))))
 
-(all x 
+(all x
  (
-  (x : number) => 
-  (all y 
+  (x : number) =>
+  (all y
    (
     (
-     (y : 
-      (list number)) & 
+     (y :
+      (list number)) &
      (
       (
-       (all z 
-        (all x1 
-         (~ 
+       (all z
+        (all x1
+         (~
           (
-           (cons z x1) = y)))) v 
-       (~ 
-        (x = 
-         (hd y)))) & 
-      (all z 
-       (all x1 
-        (~ 
+           (cons z x1) = y)))) v
+       (~
+        (x =
+         (hd y)))) &
+      (all z
+       (all x1
+        (~
          (
-          (cons z x1) = y)))))) => 
+          (cons z x1) = y)))))) =>
     (
-     (n-queens.next_n x y) = 
+     (n-queens.next_n x y) =
      (shen.f-error n-queens.next_n))))))
 
-(all x 
+(all x
  (
-  (x : 
-   (list number)) => 
+  (x :
+   (list number)) =>
   (
    (n-queens.ok_row? x) : boolean)))
 
-(all x 
+(all x
  (
   (
-   (x : 
-    (list number)) & 
+   (x :
+    (list number)) &
    (
-    () = x)) => 
+    () = x)) =>
   (
    (n-queens.ok_row? x) = true)))
 
-(all x 
+(all x
  (
   (
-   (x : 
-    (list number)) & 
+   (x :
+    (list number)) &
    (
-    (~ 
+    (~
      (
-      () = x)) & 
+      () = x)) &
     (
-     (exists y 
-      (exists z 
+     (exists y
+      (exists z
        (
-        (cons y z) = x))) & 
-     (element? 
-      (hd x) 
-      (tl x))))) => 
+        (cons y z) = x))) &
+     (element?
+      (hd x)
+      (tl x))))) =>
   (
    (n-queens.ok_row? x) = false)))
 
-(all x 
+(all x
  (
   (
-   (x : 
-    (list number)) & 
+   (x :
+    (list number)) &
    (
-    (~ 
+    (~
      (
-      () = x)) & 
+      () = x)) &
     (
      (
-      (all y 
-       (all z 
-        (~ 
+      (all y
+       (all z
+        (~
          (
-          (cons y z) = x)))) v 
-      (~ 
-       (element? 
-        (hd x) 
-        (tl x)))) & 
-     (exists y 
-      (exists z 
+          (cons y z) = x)))) v
+      (~
+       (element?
+        (hd x)
+        (tl x)))) &
+     (exists y
+      (exists z
        (
-        (cons y z) = x)))))) => 
+        (cons y z) = x)))))) =>
   (
-   (n-queens.ok_row? x) = 
-   (n-queens.ok_row? 
+   (n-queens.ok_row? x) =
+   (n-queens.ok_row?
     (tl x)))))
 
-(all x 
+(all x
  (
   (
-   (x : 
-    (list number)) & 
+   (x :
+    (list number)) &
    (
-    (~ 
+    (~
      (
-      () = x)) & 
+      () = x)) &
     (
      (
-      (all y 
-       (all z 
-        (~ 
+      (all y
+       (all z
+        (~
          (
-          (cons y z) = x)))) v 
-      (~ 
-       (element? 
-        (hd x) 
-        (tl x)))) & 
-     (all y 
-      (all z 
-       (~ 
+          (cons y z) = x)))) v
+      (~
+       (element?
+        (hd x)
+        (tl x)))) &
+     (all y
+      (all z
+       (~
         (
-         (cons y z) = x))))))) => 
+         (cons y z) = x))))))) =>
   (
-   (n-queens.ok_row? x) = 
+   (n-queens.ok_row? x) =
    (shen.f-error n-queens.ok_row?))))
 
-(all x 
+(all x
  (
-  (x : 
-   (list number)) => 
+  (x :
+   (list number)) =>
   (
    (n-queens.ok_diag? x) : boolean)))
 
-(all x 
+(all x
  (
   (
-   (x : 
-    (list number)) & 
+   (x :
+    (list number)) &
    (
-    () = x)) => 
+    () = x)) =>
   (
    (n-queens.ok_diag? x) = true)))
 
-(all x 
+(all x
  (
   (
-   (x : 
-    (list number)) & 
+   (x :
+    (list number)) &
    (
-    (~ 
+    (~
      (
-      () = x)) & 
-    (exists y 
-     (exists z 
+      () = x)) &
+    (exists y
+     (exists z
       (
-       (cons y z) = x))))) => 
+       (cons y z) = x))))) =>
   (
-   (n-queens.ok_diag? x) = 
-   (n-queens.ok_diag_N? 
-    (+ 
-     (hd x) 1) 
-    (- 
-     (hd x) 1) 
+   (n-queens.ok_diag? x) =
+   (n-queens.ok_diag_N?
+    (+
+     (hd x) 1)
+    (-
+     (hd x) 1)
     (tl x)))))
 
-(all x 
+(all x
  (
   (
-   (x : 
-    (list number)) & 
+   (x :
+    (list number)) &
    (
-    (~ 
+    (~
      (
-      () = x)) & 
-    (exists y 
-     (exists z 
+      () = x)) &
+    (exists y
+     (exists z
       (
-       (cons y z) = x))))) => 
+       (cons y z) = x))))) =>
   (
-   (n-queens.ok_diag? x) = 
-   (n-queens.ok_diag? 
+   (n-queens.ok_diag? x) =
+   (n-queens.ok_diag?
     (tl x)))))
 
-(all x 
+(all x
  (
   (
-   (x : 
-    (list number)) & 
+   (x :
+    (list number)) &
    (
-    (~ 
+    (~
      (
-      () = x)) & 
-    (all y 
-     (all z 
-      (~ 
+      () = x)) &
+    (all y
+     (all z
+      (~
        (
-        (cons y z) = x)))))) => 
+        (cons y z) = x)))))) =>
   (
-   (n-queens.ok_diag? x) = 
+   (n-queens.ok_diag? x) =
    (shen.f-error n-queens.ok_diag?))))
 
-(all x 
+(all x
  (
-  (x : number) => 
-  (all y 
+  (x : number) =>
+  (all y
    (
-    (y : number) => 
-    (all z 
+    (y : number) =>
+    (all z
      (
-      (z : 
-       (list number)) => 
+      (z :
+       (list number)) =>
       (
        (n-queens.ok_diag_N? x y z) : boolean)))))))
 
-(all x 
+(all x
  (
-  (x : number) => 
-  (all y 
+  (x : number) =>
+  (all y
    (
-    (y : number) => 
-    (all z 
+    (y : number) =>
+    (all z
      (
       (
-       (z : 
-        (list number)) & 
+       (z :
+        (list number)) &
        (
-        () = z)) => 
+        () = z)) =>
       (
        (n-queens.ok_diag_N? x y z) = true)))))))
 
-(all x 
+(all x
  (
-  (x : number) => 
-  (all y 
+  (x : number) =>
+  (all y
    (
-    (y : number) => 
-    (all z 
+    (y : number) =>
+    (all z
      (
       (
-       (z : 
-        (list number)) & 
+       (z :
+        (list number)) &
        (
-        (~ 
+        (~
          (
-          () = z)) & 
+          () = z)) &
         (
-         (exists x1 
-          (exists y1 
+         (exists x1
+          (exists y1
            (
-            (cons x1 y1) = z))) & 
-         (x = 
-          (hd z))))) => 
+            (cons x1 y1) = z))) &
+         (x =
+          (hd z))))) =>
       (
        (n-queens.ok_diag_N? x y z) = false)))))))
 
-(all x 
+(all x
  (
-  (x : number) => 
-  (all y 
+  (x : number) =>
+  (all y
    (
-    (y : number) => 
-    (all z 
+    (y : number) =>
+    (all z
      (
       (
-       (z : 
-        (list number)) & 
+       (z :
+        (list number)) &
        (
-        (~ 
+        (~
          (
-          () = z)) & 
+          () = z)) &
         (
          (
-          (all x1 
-           (all y1 
-            (~ 
+          (all x1
+           (all y1
+            (~
              (
-              (cons x1 y1) = z)))) v 
-          (~ 
-           (x = 
-            (hd z)))) & 
+              (cons x1 y1) = z)))) v
+          (~
+           (x =
+            (hd z)))) &
          (
-          (exists x1 
-           (exists y1 
+          (exists x1
+           (exists y1
             (
-             (cons x1 y1) = z))) & 
-          (y = 
-           (hd z)))))) => 
+             (cons x1 y1) = z))) &
+          (y =
+           (hd z)))))) =>
       (
        (n-queens.ok_diag_N? x y z) = false)))))))
 
-(all x 
+(all x
  (
-  (x : number) => 
-  (all y 
+  (x : number) =>
+  (all y
    (
-    (y : number) => 
-    (all z 
+    (y : number) =>
+    (all z
      (
       (
-       (z : 
-        (list number)) & 
+       (z :
+        (list number)) &
        (
-        (~ 
+        (~
          (
-          () = z)) & 
+          () = z)) &
         (
          (
-          (all x1 
-           (all y1 
-            (~ 
+          (all x1
+           (all y1
+            (~
              (
-              (cons x1 y1) = z)))) v 
-          (~ 
-           (x = 
-            (hd z)))) & 
+              (cons x1 y1) = z)))) v
+          (~
+           (x =
+            (hd z)))) &
          (
           (
-           (all x1 
-            (all y1 
-             (~ 
+           (all x1
+            (all y1
+             (~
               (
-               (cons x1 y1) = z)))) v 
-           (~ 
-            (y = 
-             (hd z)))) & 
-          (exists x1 
-           (exists y1 
+               (cons x1 y1) = z)))) v
+           (~
+            (y =
+             (hd z)))) &
+          (exists x1
+           (exists y1
             (
-             (cons x1 y1) = z))))))) => 
+             (cons x1 y1) = z))))))) =>
       (
-       (n-queens.ok_diag_N? x y z) = 
-       (n-queens.ok_diag_N? 
-        (+ 1 x) 
-        (- y 1) 
+       (n-queens.ok_diag_N? x y z) =
+       (n-queens.ok_diag_N?
+        (+ 1 x)
+        (- y 1)
         (tl z)))))))))
 
-(all x 
+(all x
  (
-  (x : number) => 
-  (all y 
+  (x : number) =>
+  (all y
    (
-    (y : number) => 
-    (all z 
+    (y : number) =>
+    (all z
      (
       (
-       (z : 
-        (list number)) & 
+       (z :
+        (list number)) &
        (
-        (~ 
+        (~
          (
-          () = z)) & 
+          () = z)) &
         (
          (
-          (all x1 
-           (all y1 
-            (~ 
+          (all x1
+           (all y1
+            (~
              (
-              (cons x1 y1) = z)))) v 
-          (~ 
-           (x = 
-            (hd z)))) & 
+              (cons x1 y1) = z)))) v
+          (~
+           (x =
+            (hd z)))) &
          (
           (
-           (all x1 
-            (all y1 
-             (~ 
+           (all x1
+            (all y1
+             (~
               (
-               (cons x1 y1) = z)))) v 
-           (~ 
-            (y = 
-             (hd z)))) & 
-          (all x1 
-           (all y1 
-            (~ 
+               (cons x1 y1) = z)))) v
+           (~
+            (y =
+             (hd z)))) &
+          (all x1
+           (all y1
+            (~
              (
-              (cons x1 y1) = z)))))))) => 
+              (cons x1 y1) = z)))))))) =>
       (
-       (n-queens.ok_diag_N? x y z) = 
+       (n-queens.ok_diag_N? x y z) =
        (shen.f-error n-queens.ok_diag_N?))))))))
 
diff --git a/tests/n queens.kl b/tests/n queens.kl
deleted file mode 100644
index 0527c21..0000000
--- a/tests/n queens.kl	
+++ /dev/null
@@ -1,16 +0,0 @@
-(defun n-queens (V18756) (n-queens.n-queens-loop V18756 (n-queens.initialise V18756)))
-
-(defun n-queens.initialise (V18757) (cond ((= 0 V18757) ()) (true (cons 1 (n-queens.initialise (- V18757 1))))))
-
-(defun n-queens.n-queens-loop (V18758 V18759) (cond ((n-queens.all_Ns? V18758 V18759) ()) ((and (n-queens.ok_row? V18759) (n-queens.ok_diag? V18759)) (cons V18759 (n-queens.n-queens-loop V18758 (n-queens.next_n V18758 V18759)))) (true (n-queens.n-queens-loop V18758 (n-queens.next_n V18758 V18759)))))
-
-(defun n-queens.all_Ns? (V18767 V18768) (cond ((= () V18768) true) ((and (cons? V18768) (= V18767 (hd V18768))) (n-queens.all_Ns? (hd V18768) (tl V18768))) (true false)))
-
-(defun n-queens.next_n (V18772 V18773) (cond ((and (cons? V18773) (= V18772 (hd V18773))) (cons 1 (n-queens.next_n (hd V18773) (tl V18773)))) ((cons? V18773) (cons (+ 1 (hd V18773)) (tl V18773))) (true (simple-error "partial function n-queens.next_n"))))
-
-(defun n-queens.ok_row? (V18776) (cond ((= () V18776) true) ((and (cons? V18776) (element? (hd V18776) (tl V18776))) false) ((cons? V18776) (n-queens.ok_row? (tl V18776))) (true (simple-error "partial function n-queens.ok_row?"))))
-
-(defun n-queens.ok_diag? (V18777) (cond ((= () V18777) true) ((cons? V18777) (and (n-queens.ok_diag_N? (+ (hd V18777) 1) (- (hd V18777) 1) (tl V18777)) (n-queens.ok_diag? (tl V18777)))) (true (simple-error "partial function n-queens.ok_diag?"))))
-
-(defun n-queens.ok_diag_N? (V18790 V18791 V18792) (cond ((= () V18792) true) ((and (cons? V18792) (= V18790 (hd V18792))) false) ((and (cons? V18792) (= V18791 (hd V18792))) false) ((cons? V18792) (n-queens.ok_diag_N? (+ 1 V18790) (- V18791 1) (tl V18792))) (true (simple-error "partial function n-queens.ok_diag_N?"))))
-
diff --git a/tests/n queens.shen b/tests/n queens.shen
index b7634c9..6493fc5 100644
--- a/tests/n queens.shen	
+++ b/tests/n queens.shen	
@@ -1,47 +1,47 @@
-(package n-queens [n-queens]
-
-(define n-queens
-  {number --> (list (list number))}
-  N -> (n-queens-loop N (initialise N)))
-
-(define initialise
-   {number --> (list number)}
-   0 -> []
-   N -> [1 | (initialise (- N 1))])
- 
-(define n-queens-loop
-  {number --> (list number) --> (list (list number))}
-  N Config -> []    where (all_Ns? N Config)
-  N Config -> [Config | (n-queens-loop N (next_n N Config))] 
-                                       where (and (ok_row? Config) (ok_diag? Config))
-  N Config -> (n-queens-loop N (next_n N Config)))
- 
-(define all_Ns?
-  {number --> (list number) --> boolean}
-   _ [] -> true
-  N [N | Ns] -> (all_Ns? N Ns)
-  _ _ -> false)
- 
-(define next_n
-  {number --> (list number) --> (list number)}
-  N [N | Ns] -> [1 | (next_n N Ns)]
-  _ [N | Ns] -> [(+ 1 N) | Ns])
- 
-(define ok_row?
-  {(list number) --> boolean}
-  [] -> true
-  [N | Ns] -> false     where (element? N Ns)
-  [_ | Ns] -> (ok_row? Ns))
- 
-(define ok_diag?
-  {(list number) --> boolean} 
-  [] -> true
-  [N | Ns] -> (and (ok_diag_N? (+ N 1) (- N 1) Ns) 
-                                (ok_diag? Ns)))
- 
-(define ok_diag_N?
-  {number --> number --> (list number) --> boolean}
-  _ _ [] -> true
-  Up Down [Up | _] -> false
-  Up Down [Down | _] -> false
-  Up Down [_ | Ns] -> (ok_diag_N? (+ 1 Up) (- Down 1) Ns))) 
+(package n-queens [n-queens]
+
+(define n-queens
+  {number --> (list (list number))}
+  N -> (n-queens-loop N (initialise N)))
+
+(define initialise
+   {number --> (list number)}
+   0 -> []
+   N -> [1 | (initialise (- N 1))])
+
+(define n-queens-loop
+  {number --> (list number) --> (list (list number))}
+  N Config -> []    where (all_Ns? N Config)
+  N Config -> [Config | (n-queens-loop N (next_n N Config))]
+                                       where (and (ok_row? Config) (ok_diag? Config))
+  N Config -> (n-queens-loop N (next_n N Config)))
+
+(define all_Ns?
+  {number --> (list number) --> boolean}
+   _ [] -> true
+  N [N | Ns] -> (all_Ns? N Ns)
+  _ _ -> false)
+
+(define next_n
+  {number --> (list number) --> (list number)}
+  N [N | Ns] -> [1 | (next_n N Ns)]
+  _ [N | Ns] -> [(+ 1 N) | Ns])
+
+(define ok_row?
+  {(list number) --> boolean}
+  [] -> true
+  [N | Ns] -> false     where (element? N Ns)
+  [_ | Ns] -> (ok_row? Ns))
+
+(define ok_diag?
+  {(list number) --> boolean}
+  [] -> true
+  [N | Ns] -> (and (ok_diag_N? (+ N 1) (- N 1) Ns)
+                                (ok_diag? Ns)))
+
+(define ok_diag_N?
+  {number --> number --> (list number) --> boolean}
+  _ _ [] -> true
+  Up Down [Up | _] -> false
+  Up Down [Down | _] -> false
+  Up Down [_ | Ns] -> (ok_diag_N? (+ 1 Up) (- Down 1) Ns)))
diff --git a/tests/nreverseprolog.shen b/tests/nreverseprolog.shen
index 2cdae7b..3ea5148 100644
--- a/tests/nreverseprolog.shen
+++ b/tests/nreverseprolog.shen
@@ -1,7 +1,7 @@
-(defprolog nreverse
-  [] [] <--;
-  [X | Y] R <-- (nreverse Y RY) (nappend RY [X] R);)
-  
-(defprolog nappend
-  [] X X <--;
+(defprolog nreverse
+  [] [] <--;
+  [X | Y] R <-- (nreverse Y RY) (nappend RY [X] R);)
+
+(defprolog nappend
+  [] X X <--;
   [X | Y] Z [X | W] <-- (nappend Y Z W);)
\ No newline at end of file
diff --git a/tests/parseprolog.shen b/tests/parseprolog.shen
index e0bd91a..32c3706 100644
--- a/tests/parseprolog.shen
+++ b/tests/parseprolog.shen
@@ -1,16 +1,16 @@
-(defprolog pparse
-  S Grammar <-- (parsing [[s + 0] = [S + 0]] Grammar);) 
-
-(defprolog parsing  
-  [X = X] _ <--;
-  [[X + Y] = [X + Z]] Grammar <-- ! (parsing [Y = Z] Grammar);
-  [[[X + Y] + Z] = W] Grammar <-- ! (parsing [[X + [Y + Z]] = W] Grammar);
-  [W = [[X + Y] + Z]] Grammar <-- ! (parsing [W = [X + [Y + Z]]] Grammar);
-  [[X + Y] = Z] Grammar <-- (member [X = W] Grammar) (parsing [[W + Y] = Z] Grammar);)
-
-(defprolog member
-   X [X | _] <--;
-   X [_ | Y] <-- (member X Y);)
-   
-   
-
+(defprolog pparse
+  S Grammar <-- (parsing [[s + 0] = [S + 0]] Grammar);)
+
+(defprolog parsing
+  [X = X] _ <--;
+  [[X + Y] = [X + Z]] Grammar <-- ! (parsing [Y = Z] Grammar);
+  [[[X + Y] + Z] = W] Grammar <-- ! (parsing [[X + [Y + Z]] = W] Grammar);
+  [W = [[X + Y] + Z]] Grammar <-- ! (parsing [W = [X + [Y + Z]]] Grammar);
+  [[X + Y] = Z] Grammar <-- (member [X = W] Grammar) (parsing [[W + Y] = Z] Grammar);)
+
+(defprolog member
+   X [X | _] <--;
+   X [_ | Y] <-- (member X Y);)
+
+
+
diff --git a/tests/parser.shen b/tests/parser.shen
index 19e8573..1da7b5b 100644
--- a/tests/parser.shen
+++ b/tests/parser.shen
@@ -1,52 +1,52 @@
-(define parse
-   Sentence -> (let Parse (sent [Sentence []])
-                  (if (parsed? Parse)
-                      (output_parse Parse)
-                      ungrammatical)))
-
-(define parsed?
-  [[] _] -> true
-  _ -> false)
-
-(define output_parse
-  [_ Parse_Rules] -> (reverse Parse_Rules))
-
-(define sent
-   [Input Output] <- (vp (np [Input [[sent --> np vp] | Output]]))
-   _ -> (fail))
-
-(define np
-   [Input Output] <- (n (det [Input [[np --> det n] | Output]]))
-   [Input Output] <- (name [Input [[np --> name] | Output]])
-   _ -> (fail))
-
-(define name
-  [["John" | Input] Output] -> [Input [[name --> "John"] | Output]]
-  [["Bill" | Input] Output] -> [Input [[name --> "Bill"] | Output]]
-   _ -> (fail))
-
- (define det
-  [["the" | Input] Output] -> [Input [[det --> "the"] | Output]]
-  [["a" | Input] Output] -> [Input [[det --> "a"] | Output]]
-  [["that" | Input] Output] -> [Input [[det --> "that"] | Output]]
-  [["this" | Input] Output] -> [Input [[det --> "this"] | Output]]
-  _ -> (fail))
- 
-(define n
-  [["boy" | Input] Output] -> [Input [[n --> "boy"] | Output]]
-  [["girl" | Input] Output] -> [Input [[n --> "girl"] | Output]]
-   _ -> (fail))
-
-(define vp
-   [Input Output] <- (np (vtrans [Input [[vp --> vtrans np] | Output]]))
-   [Input Output] <- (vp [Input [[vp --> vintrans] | Output]])
-   _ -> (fail))
-
-(define vtrans
-  [["kicks" | Input] Output] -> [Input [[vtrans --> "kicks"] | Output]]
-  [["likes" | Input] Output] -> [Input [[vtrans --> "likes"] | Output]]
-   _ -> (fail))
-
-(define vintrans
-  [["jumps" | Input] Output] -> [Input [[vintrans --> "jumps"] | Output]]
+(define parse
+   Sentence -> (let Parse (sent [Sentence []])
+                  (if (parsed? Parse)
+                      (output_parse Parse)
+                      ungrammatical)))
+
+(define parsed?
+  [[] _] -> true
+  _ -> false)
+
+(define output_parse
+  [_ Parse_Rules] -> (reverse Parse_Rules))
+
+(define sent
+   [Input Output] <- (vp (np [Input [[sent --> np vp] | Output]]))
+   _ -> (fail))
+
+(define np
+   [Input Output] <- (n (det [Input [[np --> det n] | Output]]))
+   [Input Output] <- (name [Input [[np --> name] | Output]])
+   _ -> (fail))
+
+(define name
+  [["John" | Input] Output] -> [Input [[name --> "John"] | Output]]
+  [["Bill" | Input] Output] -> [Input [[name --> "Bill"] | Output]]
+   _ -> (fail))
+
+ (define det
+  [["the" | Input] Output] -> [Input [[det --> "the"] | Output]]
+  [["a" | Input] Output] -> [Input [[det --> "a"] | Output]]
+  [["that" | Input] Output] -> [Input [[det --> "that"] | Output]]
+  [["this" | Input] Output] -> [Input [[det --> "this"] | Output]]
+  _ -> (fail))
+
+(define n
+  [["boy" | Input] Output] -> [Input [[n --> "boy"] | Output]]
+  [["girl" | Input] Output] -> [Input [[n --> "girl"] | Output]]
+   _ -> (fail))
+
+(define vp
+   [Input Output] <- (np (vtrans [Input [[vp --> vtrans np] | Output]]))
+   [Input Output] <- (vp [Input [[vp --> vintrans] | Output]])
+   _ -> (fail))
+
+(define vtrans
+  [["kicks" | Input] Output] -> [Input [[vtrans --> "kicks"] | Output]]
+  [["likes" | Input] Output] -> [Input [[vtrans --> "likes"] | Output]]
+   _ -> (fail))
+
+(define vintrans
+  [["jumps" | Input] Output] -> [Input [[vintrans --> "jumps"] | Output]]
   _ -> (fail))
\ No newline at end of file
diff --git a/tests/parsetest.shen b/tests/parsetest.shen
deleted file mode 100644
index f085aee..0000000
--- a/tests/parsetest.shen
+++ /dev/null
@@ -1,2 +0,0 @@
-a b c [ d e ] "ddd
-\\
diff --git a/tests/powerset.shen b/tests/powerset.shen
index 4494265..b7aceee 100644
--- a/tests/powerset.shen
+++ b/tests/powerset.shen
@@ -1,10 +1,10 @@
-(define powerset*
-   [] -> [[]]
-   [X | Y] -> (let Powerset (powerset* Y)
-                (append (cons-X-to-each-set X Powerset) Powerset)))
-
-(define cons-X-to-each-set  
-    _ [ ] -> [ ]  
-    X [Y | Z] -> [[X | Y] | (cons-X-to-each-set X Z)])
-
-
+(define powerset*
+   [] -> [[]]
+   [X | Y] -> (let Powerset (powerset* Y)
+                (append (cons-X-to-each-set X Powerset) Powerset)))
+
+(define cons-X-to-each-set
+    _ [ ] -> [ ]
+    X [Y | Z] -> [[X | Y] | (cons-X-to-each-set X Z)])
+
+
diff --git a/tests/prime.shen b/tests/prime.shen
index 8122921..fc443f4 100644
--- a/tests/prime.shen
+++ b/tests/prime.shen
@@ -1,10 +1,10 @@
-(define prime*? 
-  X -> (prime* X (/ X 2) 2))
-
-(define prime*
-  X Max Div -> false	where (integer? (/ X Div))				
-  X Max Div -> true	where (> Div Max)			
-  X Max Div -> (prime* X Max (+ 1 Div)))
-
- 
-
+(define prime*?
+  X -> (prime* X (/ X 2) 2))
+
+(define prime*
+  X Max Div -> false	where (integer? (/ X Div))
+  X Max Div -> true	where (> Div Max)
+  X Max Div -> (prime* X Max (+ 1 Div)))
+
+
+
diff --git a/tests/prolog.shen b/tests/prolog.shen
index f6f3fd5..bb3e479 100644
--- a/tests/prolog.shen
+++ b/tests/prolog.shen
@@ -1,52 +1,52 @@
-(defprolog prop
-  A C <-- (proph [[~  C] | A]);) 
-
-(defprolog proph
-  A <-- (mem [~ P] A) (mem P A) !;
-       A <-- (consistent A) ! (when false);
-       (mode [[P & Q] | A] -) <-- ! (proph [P Q | A]);
-       (mode [[P <=> Q] | A] -) <-- ! (proph [[P => Q] [Q => P] | A]);
-       (mode [[P => Q] | A] -) <-- ! (proph [[[~ P] v Q] | A]);
-       (mode [[~ [P v Q]] | A] -)  <-- ! (proph [[~ P] [~ Q] | A]);
-       (mode [[~ [P & Q]] | A] -) <-- ! (proph [[[~ P] v [~ Q]] | A]);
-       (mode [[~ [P => Q]] | A] -) <-- ! (proph [P [~ Q] | A]);
-       (mode [[~ [P <=> Q]] | A] -) <-- ! (proph [[~ [[P => Q] v [~ [Q => P]]]] | A]);
-       (mode [[P & Q] | A] -) <-- !  (proph [P Q | A]);
-       (mode [[P v Q] | A] -) <-- !  (proph [P | A]) ! (proph [Q | A]);
-       (mode [P | Ps] -) <-- (app Ps [P] Qs) ! (proph Qs);) 
-
-(defprolog consistent
-         [] <--;
-         [P | Ps] <-- (when (symbol? P)) ! (consistent Ps);
-         [[~ P] | Ps] <-- (when (symbol? P)) ! (consistent Ps);) 
-
-(defprolog app
-         [] X X <--;
-         (mode [X | Y] -) W [X | Z] <-- (app Y W Z);) 
-
-(defprolog mem
-         X (mode [X | _] -) <--;
-         X (mode [_ | Y] -) <-- (mem X Y);) 
-
-(defprolog mapit
-  _  [] [] <--;
-  Pred [X | Y] [W | Z] <-- (call (Pred X W)) (mapit Pred Y Z);) 
-
-       (defprolog consit
-         X [1 X] <--;) 
-
-        (defprolog different
-          X Y <--  (not! (is X Y));) 
-
-        (defprolog not!
-          P <-- (call P) ! (when false);
-          _ <--;) 
-
-        (defprolog likes
-           john  X <-- (tall X)  (pretty X);) 
-
-        (defprolog tall
-           mary <--;) 
-
-        (defprolog pretty
-           mary <--;) 
\ No newline at end of file
+(defprolog prop
+  A C <-- (proph [[~  C] | A]);)
+
+(defprolog proph
+  A <-- (mem [~ P] A) (mem P A) !;
+       A <-- (consistent A) ! (when false);
+       (mode [[P & Q] | A] -) <-- ! (proph [P Q | A]);
+       (mode [[P <=> Q] | A] -) <-- ! (proph [[P => Q] [Q => P] | A]);
+       (mode [[P => Q] | A] -) <-- ! (proph [[[~ P] v Q] | A]);
+       (mode [[~ [P v Q]] | A] -)  <-- ! (proph [[~ P] [~ Q] | A]);
+       (mode [[~ [P & Q]] | A] -) <-- ! (proph [[[~ P] v [~ Q]] | A]);
+       (mode [[~ [P => Q]] | A] -) <-- ! (proph [P [~ Q] | A]);
+       (mode [[~ [P <=> Q]] | A] -) <-- ! (proph [[~ [[P => Q] v [~ [Q => P]]]] | A]);
+       (mode [[P & Q] | A] -) <-- !  (proph [P Q | A]);
+       (mode [[P v Q] | A] -) <-- !  (proph [P | A]) ! (proph [Q | A]);
+       (mode [P | Ps] -) <-- (app Ps [P] Qs) ! (proph Qs);)
+
+(defprolog consistent
+         [] <--;
+         [P | Ps] <-- (when (symbol? P)) ! (consistent Ps);
+         [[~ P] | Ps] <-- (when (symbol? P)) ! (consistent Ps);)
+
+(defprolog app
+         [] X X <--;
+         (mode [X | Y] -) W [X | Z] <-- (app Y W Z);)
+
+(defprolog mem
+         X (mode [X | _] -) <--;
+         X (mode [_ | Y] -) <-- (mem X Y);)
+
+(defprolog mapit
+  _  [] [] <--;
+  Pred [X | Y] [W | Z] <-- (call (Pred X W)) (mapit Pred Y Z);)
+
+       (defprolog consit
+         X [1 X] <--;)
+
+        (defprolog different
+          X Y <--  (not! (is X Y));)
+
+        (defprolog not!
+          P <-- (call P) ! (when false);
+          _ <--;)
+
+        (defprolog likes
+           john  X <-- (tall X)  (pretty X);)
+
+        (defprolog tall
+           mary <--;)
+
+        (defprolog pretty
+           mary <--;)
\ No newline at end of file
diff --git a/tests/prologinterp.shen b/tests/prologinterp.shen
index 44405d8..72bee81 100644
--- a/tests/prologinterp.shen
+++ b/tests/prologinterp.shen
@@ -1,175 +1,175 @@
-(datatype atom
-
-  F : symbol; X : (list term);
-  ============================
-  [F | X] : atom;)
-
-(datatype term
-
-  P : symbol;
-  ___________
-  P : term;
-
-  P : number;
-  ___________
-  P : term;
-    
-  P : string;
-  ___________
-  P : term;
-
-  P : boolean;
-  ____________
-  P : term;
-
-  F : symbol; X : (list term);
-  ============================
-  [F | X] : term;)
-
-(datatype horn-clause
-
-   H : atom; B : (list atom);
-   ==========================
-   [H <= | B] : horn-clause;)
-
-(define unify-atoms
-  {atom --> atom --> (list (term * term))}
-   P P -> []
-   [F | X] [F | Y] -> (unify-terms X Y [ ])
-   _ _ -> (error "unification failure!"))
- 
-(define unify-terms 
-  {(list term) --> (list term) --> (list (term * term)) --> (list (term * term))} 
-   X X Mgu -> Mgu
-   [X | Y] [W | Z] Mgu 
-   -> (unify-terms Y Z (unify-term (dereference X Mgu) 
-                                   (dereference W Mgu) 
-                                   Mgu))
-   _ _ _ -> (error "unification failure!"))
-
-(define unify-term
-  {term --> term --> (list (term * term)) --> (list (term * term))}     
-   X X Mgu -> Mgu
-   X Y Mgu -> [(@p X Y) | Mgu]   where (occurs-check? X Y)
-   X Y Mgu -> [(@p Y X) | Mgu]   where (occurs-check? Y X)
-   [F | Y] [F | Z] Mgu -> (unify-terms Y Z Mgu)
-   _ _ _ -> (error "unification failure!")) 
-
-(define occurs-check?
-   {term --> term --> boolean}
-   X Y -> (and (variable? X) (not (my-occurs? X Y))))
-
-(define dereference
-  {term --> (list (term * term)) --> term}
-   [X | Y] Mgu -> [X | (map (/. Z (dereference Z Mgu)) Y)] 
-   X Mgu -> (let Val (lookup X Mgu) 
-                        (if (= Val X) X (dereference Val Mgu))))
-		                 
-(define lookup
-  {term --> (list (term * term)) --> term}
-   X [] -> X
-   X [(@p X Y) | _] -> Y
-   X [_ | Y] -> (lookup X Y))	
-	                  
-(define my-occurs?
-  {term --> term --> boolean}
-   X X -> true
-   X [Y | Z] -> (or (== X Y) (some (/. W (my-occurs? X W)) Z))
-   _ _ -> false)
- 
-(define some
-  {(A --> boolean) --> (list A) --> boolean}
-    _ [] -> false
-    F [X | Y] -> (or (F X) (some F Y))) 
- 
-(define prolog
-   {(list atom) --> (list horn-clause)  -->  boolean}
-     Goals Program -> (prolog-help (insert-answer-literal Goals) 
-                                                    Program 
-                                                    Program))
-
-(define insert-answer-literal
-   {(list atom) --> (list atom)}
-    Goals -> (append Goals 
-                     (answer-literal (mapcan (fn variables-in-atom) Goals))))
-
-(define answer-literal
-   {(list term) --> (list atom)}
-    Vs -> [[answer | (answer-terms Vs)]])
-
-(define answer-terms
-   {(list term) --> (list term)}
-    [] -> []
-    [V | Vs] -> [(str V) V | (answer-terms (remove V Vs))])
-
-(define prolog-help
-   {(list atom) --> (list horn-clause) --> (list horn-clause) --> boolean}
-    [] _ _ -> true
-    [[answer | Terms]] _ _ -> (answer Terms)
-    [P | Ps] [Clause | Clauses] Program
-      -> (let StClause (standardise-apart Clause)
-                H (hdcl StClause)
-                B (body StClause)
-                (or (trap-error 
-                       (let MGU (unify-atoms P H)
-                             Goals (map (/. X (dereference-atom X MGU)) 
-                                                (append B Ps))
-                             (prolog-help Goals Program Program)) (/. E false))
-                       (prolog-help [P | Ps] Clauses Program)))  
-    _ _ _ -> false)
- 
-(define hdcl
-  {horn-clause --> atom}
-  [H <= | _] -> H)
-
-(define body
-  {horn-clause --> (list atom)}   
-   [_ <= | Body] -> Body)
-
-(define dereference-atom
-  {atom --> (list (term * term)) --> atom}
-   [F | Terms] MGU -> [F | (map (/. T (dereference T MGU)) Terms)])
-
-(define answer
-    {(list term) --> boolean}
-    [ ] -> (not (y-or-n? "~%more? "))
-    [String Value | Answer] -> (do (output "~%~A = ~S"  String Value) (answer Answer)))
-
-(define standardise-apart
-  {horn-clause --> horn-clause}
-  Clause -> (st-all (variables-in-clause Clause) Clause))
-
-(define variables-in-clause
-   {horn-clause --> (list term)} 
-   [H <= | B] -> (append (variables-in-atom H) (mapcan (fn variables-in-atom) B)))
-
-(define variables-in-atom
-  {atom --> (list term)}
-  [Predicate | Terms] -> (mapcan (fn variables-in-term) Terms))
-
-(define variables-in-term
-   {term --> (list term)}
-    Term -> [Term]		where (variable? Term)
-    [F | Terms] -> (mapcan (fn variables-in-term) Terms)
-    _ -> [])
-
-(define st-all
-   {(list term) --> horn-clause --> horn-clause}
-    [] Clause -> Clause
-    [V | Vs] Clause -> (st-all (remove V Vs)
-                               (replace-term-in-clause V (gensym (protect X)) Clause)))
-
-(define replace-term-in-clause
-   {term --> term --> horn-clause --> horn-clause}
-    V NewV [H <= | B] -> [(replace-term-in-atom V NewV H) <= 
-                                          | (map (/. A (replace-term-in-atom V NewV A)) B)])
-
-(define replace-term-in-atom
-   {term --> term --> atom --> atom}
-   V NewV [F | Terms] -> [F | (map (/. T (replace-term V NewV T)) Terms)])
-
-(define replace-term
-   {term --> term --> term --> term}
-    V NewV V -> NewV
-    V NewV [F | Terms] -> [F | (map (/. T (replace-term V NewV T)) Terms)]
+(datatype atom
+
+  F : symbol; X : (list term);
+  ============================
+  [F | X] : atom;)
+
+(datatype term
+
+  P : symbol;
+  ___________
+  P : term;
+
+  P : number;
+  ___________
+  P : term;
+
+  P : string;
+  ___________
+  P : term;
+
+  P : boolean;
+  ____________
+  P : term;
+
+  F : symbol; X : (list term);
+  ============================
+  [F | X] : term;)
+
+(datatype horn-clause
+
+   H : atom; B : (list atom);
+   ==========================
+   [H <= | B] : horn-clause;)
+
+(define unify-atoms
+  {atom --> atom --> (list (term * term))}
+   P P -> []
+   [F | X] [F | Y] -> (unify-terms X Y [ ])
+   _ _ -> (error "unification failure!"))
+
+(define unify-terms
+  {(list term) --> (list term) --> (list (term * term)) --> (list (term * term))}
+   X X Mgu -> Mgu
+   [X | Y] [W | Z] Mgu
+   -> (unify-terms Y Z (unify-term (dereference X Mgu)
+                                   (dereference W Mgu)
+                                   Mgu))
+   _ _ _ -> (error "unification failure!"))
+
+(define unify-term
+  {term --> term --> (list (term * term)) --> (list (term * term))}
+   X X Mgu -> Mgu
+   X Y Mgu -> [(@p X Y) | Mgu]   where (occurs-check? X Y)
+   X Y Mgu -> [(@p Y X) | Mgu]   where (occurs-check? Y X)
+   [F | Y] [F | Z] Mgu -> (unify-terms Y Z Mgu)
+   _ _ _ -> (error "unification failure!"))
+
+(define occurs-check?
+   {term --> term --> boolean}
+   X Y -> (and (variable? X) (not (my-occurs? X Y))))
+
+(define dereference
+  {term --> (list (term * term)) --> term}
+   [X | Y] Mgu -> [X | (map (/. Z (dereference Z Mgu)) Y)]
+   X Mgu -> (let Val (lookup X Mgu)
+                        (if (= Val X) X (dereference Val Mgu))))
+
+(define lookup
+  {term --> (list (term * term)) --> term}
+   X [] -> X
+   X [(@p X Y) | _] -> Y
+   X [_ | Y] -> (lookup X Y))
+
+(define my-occurs?
+  {term --> term --> boolean}
+   X X -> true
+   X [Y | Z] -> (or (== X Y) (some (/. W (my-occurs? X W)) Z))
+   _ _ -> false)
+
+(define some
+  {(A --> boolean) --> (list A) --> boolean}
+    _ [] -> false
+    F [X | Y] -> (or (F X) (some F Y)))
+
+(define prolog
+   {(list atom) --> (list horn-clause)  -->  boolean}
+     Goals Program -> (prolog-help (insert-answer-literal Goals)
+                                                    Program
+                                                    Program))
+
+(define insert-answer-literal
+   {(list atom) --> (list atom)}
+    Goals -> (append Goals
+                     (answer-literal (mapcan (fn variables-in-atom) Goals))))
+
+(define answer-literal
+   {(list term) --> (list atom)}
+    Vs -> [[answer | (answer-terms Vs)]])
+
+(define answer-terms
+   {(list term) --> (list term)}
+    [] -> []
+    [V | Vs] -> [(str V) V | (answer-terms (remove V Vs))])
+
+(define prolog-help
+   {(list atom) --> (list horn-clause) --> (list horn-clause) --> boolean}
+    [] _ _ -> true
+    [[answer | Terms]] _ _ -> (answer Terms)
+    [P | Ps] [Clause | Clauses] Program
+      -> (let StClause (standardise-apart Clause)
+                H (hdcl StClause)
+                B (body StClause)
+                (or (trap-error
+                       (let MGU (unify-atoms P H)
+                             Goals (map (/. X (dereference-atom X MGU))
+                                                (append B Ps))
+                             (prolog-help Goals Program Program)) (/. E false))
+                       (prolog-help [P | Ps] Clauses Program)))
+    _ _ _ -> false)
+
+(define hdcl
+  {horn-clause --> atom}
+  [H <= | _] -> H)
+
+(define body
+  {horn-clause --> (list atom)}
+   [_ <= | Body] -> Body)
+
+(define dereference-atom
+  {atom --> (list (term * term)) --> atom}
+   [F | Terms] MGU -> [F | (map (/. T (dereference T MGU)) Terms)])
+
+(define answer
+    {(list term) --> boolean}
+    [ ] -> (not (y-or-n? "~%more? "))
+    [String Value | Answer] -> (do (output "~%~A = ~S"  String Value) (answer Answer)))
+
+(define standardise-apart
+  {horn-clause --> horn-clause}
+  Clause -> (st-all (variables-in-clause Clause) Clause))
+
+(define variables-in-clause
+   {horn-clause --> (list term)}
+   [H <= | B] -> (append (variables-in-atom H) (mapcan (fn variables-in-atom) B)))
+
+(define variables-in-atom
+  {atom --> (list term)}
+  [Predicate | Terms] -> (mapcan (fn variables-in-term) Terms))
+
+(define variables-in-term
+   {term --> (list term)}
+    Term -> [Term]		where (variable? Term)
+    [F | Terms] -> (mapcan (fn variables-in-term) Terms)
+    _ -> [])
+
+(define st-all
+   {(list term) --> horn-clause --> horn-clause}
+    [] Clause -> Clause
+    [V | Vs] Clause -> (st-all (remove V Vs)
+                               (replace-term-in-clause V (gensym (protect X)) Clause)))
+
+(define replace-term-in-clause
+   {term --> term --> horn-clause --> horn-clause}
+    V NewV [H <= | B] -> [(replace-term-in-atom V NewV H) <=
+                                          | (map (/. A (replace-term-in-atom V NewV A)) B)])
+
+(define replace-term-in-atom
+   {term --> term --> atom --> atom}
+   V NewV [F | Terms] -> [F | (map (/. T (replace-term V NewV T)) Terms)])
+
+(define replace-term
+   {term --> term --> term --> term}
+    V NewV V -> NewV
+    V NewV [F | Terms] -> [F | (map (/. T (replace-term V NewV T)) Terms)]
     _ _ Term -> Term)
\ No newline at end of file
diff --git a/tests/proof assistant.shen b/tests/proof assistant.shen
index 7fa22a0..7c4ad92 100644
--- a/tests/proof assistant.shen	
+++ b/tests/proof assistant.shen	
@@ -1,81 +1,81 @@
-(synonyms
-
-    proof  (list step)
-    step ((list sequent) * tactic)
-    tactic ((list sequent) --> (list sequent))
-    sequent ((list wff) * wff))
-
-(datatype globals
-
-   _______________________
-   (value *proof*) : proof;)
-
-(define proof-assistant
-   {A --> symbol}
-    _ -> (let Assumptions (input-assumptions 1) 
-              Conclusion (input-conclusion _)
-              Sequents [(@p Assumptions Conclusion)]
-              Proof (time (proof-loop Sequents []))
-              (do (nl) proved)))
-
-(define input-assumptions
-   {number --> (list wff)}
-     N -> (let More? (y-or-n? "~%Input assumptions? ")
-                   (if More? 
-                       (do (output "~%~A. " N)
-                           [(input+ wff) | (input-assumptions (+ N 1))])
-                       [ ])))
-
-(define input-conclusion
-    {A --> wff}
-     _ -> (do (output "~%Enter conclusion: ") (input+ wff)))
-                                 
-(define proof-loop
-    {(list sequent) --> proof --> proof}
-     [ ] Proof -> (set *proof* (reverse Proof))       
-     S Proof -> (let Show (show-sequent S (+ 1 (length Proof)))
-                     D (user-directive _) 
-                     Step (@p S D)
-                     (if (= D (fn back))
-                         (proof-loop (go-back Proof) (tail Proof))
-                         (proof-loop (D S) [Step | Proof]))))
-
-(define show-proof
-  {string --> symbol}
-   S -> (show-proof-help (value *proof*) 1))
-
-(define show-proof-help
-   {proof --> number --> symbol}
-    [ ] _ -> proved
-    [(@p Sequents Tactic) | Proof] N -> (do (show-sequent Sequents N) 
-                                            (output "~%Tactic: ~A~%" Tactic)
-                                            (show-proof-help Proof (+ N 1))))  
-
-(define show-sequent
-   {(list sequent) --> number --> symbol}
-     Sequents N -> (let Unsolved (length Sequents)
-                        Sequent (head Sequents)
-                        Wffs (fst Sequent)
-                        Wff (snd Sequent)
-                        (do (output "==============================~%")
-                            (output "Step ~A     	unsolved ~A~%~%" 
-                                           N Unsolved)
-                            (output "?- ~S~%~%" Wff)
-                            (enumerate Wffs 1))))
-
-(define enumerate
-    {(list A) --> number --> symbol}
-     [] _ -> _
-     [X | Y] N -> (do (output "~A. ~S~%" N X) (enumerate Y (+ N 1))))
-
-(define user-directive
-    {A --> tactic}
-     _ -> (do (output "~%Tactic: ") (input+ tactic)))
-
-(define back
-   {(list sequent) --> (list sequent)}
-     S -> S)
-
-(define go-back
-   {proof --> (list sequent)}
+(synonyms
+
+    proof  (list step)
+    step ((list sequent) * tactic)
+    tactic ((list sequent) --> (list sequent))
+    sequent ((list wff) * wff))
+
+(datatype globals
+
+   _______________________
+   (value *proof*) : proof;)
+
+(define proof-assistant
+   {A --> symbol}
+    _ -> (let Assumptions (input-assumptions 1)
+              Conclusion (input-conclusion _)
+              Sequents [(@p Assumptions Conclusion)]
+              Proof (time (proof-loop Sequents []))
+              (do (nl) proved)))
+
+(define input-assumptions
+   {number --> (list wff)}
+     N -> (let More? (y-or-n? "~%Input assumptions? ")
+                   (if More?
+                       (do (output "~%~A. " N)
+                           [(input+ wff) | (input-assumptions (+ N 1))])
+                       [ ])))
+
+(define input-conclusion
+    {A --> wff}
+     _ -> (do (output "~%Enter conclusion: ") (input+ wff)))
+
+(define proof-loop
+    {(list sequent) --> proof --> proof}
+     [ ] Proof -> (set *proof* (reverse Proof))
+     S Proof -> (let Show (show-sequent S (+ 1 (length Proof)))
+                     D (user-directive _)
+                     Step (@p S D)
+                     (if (= D (fn back))
+                         (proof-loop (go-back Proof) (tail Proof))
+                         (proof-loop (D S) [Step | Proof]))))
+
+(define show-proof
+  {string --> symbol}
+   S -> (show-proof-help (value *proof*) 1))
+
+(define show-proof-help
+   {proof --> number --> symbol}
+    [ ] _ -> proved
+    [(@p Sequents Tactic) | Proof] N -> (do (show-sequent Sequents N)
+                                            (output "~%Tactic: ~A~%" Tactic)
+                                            (show-proof-help Proof (+ N 1))))
+
+(define show-sequent
+   {(list sequent) --> number --> symbol}
+     Sequents N -> (let Unsolved (length Sequents)
+                        Sequent (head Sequents)
+                        Wffs (fst Sequent)
+                        Wff (snd Sequent)
+                        (do (output "==============================~%")
+                            (output "Step ~A     	unsolved ~A~%~%"
+                                           N Unsolved)
+                            (output "?- ~S~%~%" Wff)
+                            (enumerate Wffs 1))))
+
+(define enumerate
+    {(list A) --> number --> symbol}
+     [] _ -> _
+     [X | Y] N -> (do (output "~A. ~S~%" N X) (enumerate Y (+ N 1))))
+
+(define user-directive
+    {A --> tactic}
+     _ -> (do (output "~%Tactic: ") (input+ tactic)))
+
+(define back
+   {(list sequent) --> (list sequent)}
+     S -> S)
+
+(define go-back
+   {proof --> (list sequent)}
     [(@p S _) | _] -> S)
\ No newline at end of file
diff --git a/tests/propcalcprolog.shen b/tests/propcalcprolog.shen
index d318f33..fb785aa 100644
--- a/tests/propcalcprolog.shen
+++ b/tests/propcalcprolog.shen
@@ -1,15 +1,14 @@
-(defprolog mapit
-  _  [] [] <--;
-  Pred [X | Y] [W | Z] <-- (call (Pred X W)) (mapit Pred Y Z);) 
-
-(defprolog consit
-         X [1 X] <--;) 
-
-(defprolog different
-          X Y <--  (not! (is X Y));) 
-
-(defprolog not!
-  P <-- (call P) ! (when false);
-  _ <--;) 
-
-     
\ No newline at end of file
+(defprolog mapit
+  _  [] [] <--;
+  Pred [X | Y] [W | Z] <-- (call (Pred X W)) (mapit Pred Y Z);)
+
+(defprolog consit
+         X [1 X] <--;)
+
+(defprolog different
+          X Y <--  (not! (is X Y));)
+
+(defprolog not!
+  P <-- (call P) ! (when false);
+  _ <--;)
+
diff --git a/tests/proplog version 1.shen b/tests/proplog version 1.shen
index 740ffff..009aa6d 100644
--- a/tests/proplog version 1.shen	
+++ b/tests/proplog version 1.shen	
@@ -1,25 +1,25 @@
-(define backchain  
-   Conc Assumptions -> (backchain* [Conc] Assumptions Assumptions))
-
-(define backchain* 
-   [] _ _ -> proved 
-   [[P & Q] | Goals] _ Assumptions 
-   -> (backchain* [P Q | Goals] Assumptions Assumptions) 
-   [P | Goals] [[P <= | Subgoal] | _] Assumptions  
-   <- (backchain* (append Subgoal Goals) Assumptions Assumptions)  
-   Goals [_ | Rest] Assumptions -> (backchain* Goals Rest Assumptions)  
-   _ _ _ -> (fail)) 
-
-
-
-
-
-
-
-
-
-
-
-
- 
-
+(define backchain
+   Conc Assumptions -> (backchain* [Conc] Assumptions Assumptions))
+
+(define backchain*
+   [] _ _ -> proved
+   [[P & Q] | Goals] _ Assumptions
+   -> (backchain* [P Q | Goals] Assumptions Assumptions)
+   [P | Goals] [[P <= | Subgoal] | _] Assumptions
+   <- (backchain* (append Subgoal Goals) Assumptions Assumptions)
+   Goals [_ | Rest] Assumptions -> (backchain* Goals Rest Assumptions)
+   _ _ _ -> (fail))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/proplog version 2.shen b/tests/proplog version 2.shen
index 99f381b..41cf66b 100644
--- a/tests/proplog version 2.shen	
+++ b/tests/proplog version 2.shen	
@@ -1,27 +1,27 @@
-(define backchain  
-   Conc Assumptions -> (backchain* Conc Assumptions Assumptions))
-
-(define backchain*
-   P [P | _] _ -> true
-   [P & Q] _ Assumptions
-   -> (and (backchain* P Assumptions Assumptions)
-           (backchain* Q Assumptions Assumptions))
-   P [[P <= Q] | _] Assumptions
-   <- (fail-if (/. X (= X false)) (backchain* Q Assumptions Assumptions))
-   P [_ | Rest] Assumptions -> (backchain* P Rest Assumptions)
-   _ _ _ -> false)
-
-
-
-
-
-
-
-
-
-
-
-
-
- 
-
+(define backchain
+   Conc Assumptions -> (backchain* Conc Assumptions Assumptions))
+
+(define backchain*
+   P [P | _] _ -> true
+   [P & Q] _ Assumptions
+   -> (and (backchain* P Assumptions Assumptions)
+           (backchain* Q Assumptions Assumptions))
+   P [[P <= Q] | _] Assumptions
+   <- (fail-if (/. X (= X false)) (backchain* Q Assumptions Assumptions))
+   P [_ | Rest] Assumptions -> (backchain* P Rest Assumptions)
+   _ _ _ -> false)
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/qmachine.shen b/tests/qmachine.shen
index 4ad1c26..08eca63 100644
--- a/tests/qmachine.shen
+++ b/tests/qmachine.shen
@@ -1,67 +1,67 @@
-(datatype progression
-
-	X : A; S : (A --> A); E : (A --> boolean);
-	==========================================
-	[X S E] : (progression A);)
-
-(define force
- {(progression A) --> A}
-  [X S E] -> X)
-
-(define delay
-  {(progression A) --> (progression A)}
-    [X S E] -> [(S X) S E])
- 
-(define end?
-  {(progression A) --> boolean}
-   [X S E] -> (E X)) 
-
-(define push
-  {A --> (progression A) --> (progression A)}
-  X [Y S E] -> [X (/. Z (if (= Z X) Y (S Z))) E]) 
-
-(define forall
-  {(progression A) --> (A --> boolean) --> boolean}
-   [X S E] P -> (if (E X) true (and (P X) (forall [(S X) S E] P))))
-
-(define exists
-  {(progression A) --> (A --> boolean) --> boolean}
-  [X S E] P -> (if (E X) false (or (P X) (exists [(S X) S E] P))))
-
-(define super
-  {(progression A) --> (A --> B) --> (B --> C --> C) --> C --> C}
-   [X S E] P F Y -> (if (E X) Y (F (P X) (super [(S X) S E] P F Y))))
-
-(define forall
-  {(progression A) --> (A --> boolean) --> boolean}
-   Progression P -> (super Progression P (fn and) true)) 
-
-(define exists
-  {(progression A) --> (A --> boolean) --> boolean}
-   Progression P -> (super Progression P (fn or) false)) 
-
-(define for*
-  {(progression A) --> (A --> B) --> number}
-   Progression P -> (super Progression P (fn progn) 0))
-
-(define progn
-  {A --> B --> B}
-   X Y -> Y)
-
-(define filter*
-  {(progression A) --> (A --> boolean) --> (list A)}
-  Progression P -> (super Progression (/. X (if (P X) [X] [])) (fn append) []))
-
-(define next-prime
-  {number --> number}
-  N -> (if (prime*? (+ N 1)) (+ N 1) (next-prime (+ N 1))))
-
-(define prime*?
-  {number --> boolean}
-  X -> (prime-help X (/ X 2) 2))
-
-(define prime-help
-  {number --> number --> number --> boolean}
-   X Max Div -> false 		where (integer? (/ X Div))
-   X Max Div -> true 		where (> Div Max)
+(datatype progression
+
+	X : A; S : (A --> A); E : (A --> boolean);
+	==========================================
+	[X S E] : (progression A);)
+
+(define force
+ {(progression A) --> A}
+  [X S E] -> X)
+
+(define delay
+  {(progression A) --> (progression A)}
+    [X S E] -> [(S X) S E])
+
+(define end?
+  {(progression A) --> boolean}
+   [X S E] -> (E X))
+
+(define push
+  {A --> (progression A) --> (progression A)}
+  X [Y S E] -> [X (/. Z (if (= Z X) Y (S Z))) E])
+
+(define forall
+  {(progression A) --> (A --> boolean) --> boolean}
+   [X S E] P -> (if (E X) true (and (P X) (forall [(S X) S E] P))))
+
+(define exists
+  {(progression A) --> (A --> boolean) --> boolean}
+  [X S E] P -> (if (E X) false (or (P X) (exists [(S X) S E] P))))
+
+(define super
+  {(progression A) --> (A --> B) --> (B --> C --> C) --> C --> C}
+   [X S E] P F Y -> (if (E X) Y (F (P X) (super [(S X) S E] P F Y))))
+
+(define forall
+  {(progression A) --> (A --> boolean) --> boolean}
+   Progression P -> (super Progression P (fn and) true))
+
+(define exists
+  {(progression A) --> (A --> boolean) --> boolean}
+   Progression P -> (super Progression P (fn or) false))
+
+(define for*
+  {(progression A) --> (A --> B) --> number}
+   Progression P -> (super Progression P (fn progn) 0))
+
+(define progn
+  {A --> B --> B}
+   X Y -> Y)
+
+(define filter*
+  {(progression A) --> (A --> boolean) --> (list A)}
+  Progression P -> (super Progression (/. X (if (P X) [X] [])) (fn append) []))
+
+(define next-prime
+  {number --> number}
+  N -> (if (prime*? (+ N 1)) (+ N 1) (next-prime (+ N 1))))
+
+(define prime*?
+  {number --> boolean}
+  X -> (prime-help X (/ X 2) 2))
+
+(define prime-help
+  {number --> number --> number --> boolean}
+   X Max Div -> false 		where (integer? (/ X Div))
+   X Max Div -> true 		where (> Div Max)
    X Max Div -> (prime-help X Max (+ 1 Div)))
\ No newline at end of file
diff --git a/tests/runme.shen b/tests/runme.shen
index dc51f66..926b6b0 100644
--- a/tests/runme.shen
+++ b/tests/runme.shen
@@ -1,2 +1,2 @@
-(load "harness.shen")
+(load "harness.shen")
 (load "kerneltests.shen")
\ No newline at end of file
diff --git a/tests/search.shen b/tests/search.shen
index 86c32aa..8e915c5 100644
--- a/tests/search.shen
+++ b/tests/search.shen
@@ -1,56 +1,56 @@
-(define breadth-first
-   {state --> (state --> (list state)) --> (state --> boolean) --> boolean}
-    Start F Test -> (b* F Test (F Start))) 
-
-(define b*
-   {(state --> (list state)) --> (state --> boolean) --> (list state) --> boolean}
-    F Test States -> true 	where (some Test States)
-    F Test States -> (let NewStates (mapcan F States)
-                              (if (empty? NewStates)
-                                  false
-                                  (b* F Test NewStates))))
-
-(define some
-  {(A --> boolean) --> (list A) --> boolean}
-   Test [] -> false
-   Test [X|Y] -> (or (Test X) (some Test Y)))
-
-(define depth
-  {state --> (state --> (list state)) --> (state --> boolean) --> boolean}
-    Start _ Test -> true 	where (Test Start)
-    Start F Test -> (d* F Test (F Start))) 
-
-(define d*
-   {(state --> (list state)) --> (state --> boolean) --> (list state) --> boolean}
-    _ Test [State | _] -> true 	where (Test State)
-    F Test [State | States] <- (fail-if (= false) (d* F Test (F State)))
-    F Test [_ | States] -> (d* F Test States)
-    _ _ _ -> false)
-
-(define hill
-  {(state --> number) --> state --> (state --> (list state)) --> (state --> boolean) --> boolean}
-    _ Start _ Test -> true 	where (Test Start)
-    E Start F Test -> (h* E F Test (order_states E (F Start))))  
-
-(define h*
-   {(state --> number) --> (state --> (list state)) --> (state --> boolean) --> (list state) --> boolean}
-    _ _ Test [State | _] -> true 	where (Test State)
-    E F Test [State | States] 
-    <- (fail-if (/. X (= X false)) (h* E F Test (order_states E (F State))))
-    E F Test [_ | States] -> (h* E F Test States)
-    _ _ _ _ -> false)    
-    
-(define order_states
-  {(state --> number) --> (list state) --> (list state)}
-   E States -> (bsort (/. S1 (/. S2 (> (E S1) (E S2)))) States))
-
-(define bsort
-  {(A --> (A --> boolean)) --> (list A) --> (list A)}
-   R X -> (fix (/. Y (bsort* R Y)) X))
-
-(define bsort*
-   {(A --> A --> boolean) --> (list A) --> (list A)}
-    _ [] -> []
-    _ [X] -> [X]
-    R [X Y | Z] -> [Y | (bsort* R [X | Z])]	where (R Y X)
+(define breadth-first
+   {state --> (state --> (list state)) --> (state --> boolean) --> boolean}
+    Start F Test -> (b* F Test (F Start)))
+
+(define b*
+   {(state --> (list state)) --> (state --> boolean) --> (list state) --> boolean}
+    F Test States -> true 	where (some Test States)
+    F Test States -> (let NewStates (mapcan F States)
+                              (if (empty? NewStates)
+                                  false
+                                  (b* F Test NewStates))))
+
+(define some
+  {(A --> boolean) --> (list A) --> boolean}
+   Test [] -> false
+   Test [X|Y] -> (or (Test X) (some Test Y)))
+
+(define depth
+  {state --> (state --> (list state)) --> (state --> boolean) --> boolean}
+    Start _ Test -> true 	where (Test Start)
+    Start F Test -> (d* F Test (F Start)))
+
+(define d*
+   {(state --> (list state)) --> (state --> boolean) --> (list state) --> boolean}
+    _ Test [State | _] -> true 	where (Test State)
+    F Test [State | States] <- (fail-if (= false) (d* F Test (F State)))
+    F Test [_ | States] -> (d* F Test States)
+    _ _ _ -> false)
+
+(define hill
+  {(state --> number) --> state --> (state --> (list state)) --> (state --> boolean) --> boolean}
+    _ Start _ Test -> true 	where (Test Start)
+    E Start F Test -> (h* E F Test (order_states E (F Start))))
+
+(define h*
+   {(state --> number) --> (state --> (list state)) --> (state --> boolean) --> (list state) --> boolean}
+    _ _ Test [State | _] -> true 	where (Test State)
+    E F Test [State | States]
+    <- (fail-if (/. X (= X false)) (h* E F Test (order_states E (F State))))
+    E F Test [_ | States] -> (h* E F Test States)
+    _ _ _ _ -> false)
+
+(define order_states
+  {(state --> number) --> (list state) --> (list state)}
+   E States -> (bsort (/. S1 (/. S2 (> (E S1) (E S2)))) States))
+
+(define bsort
+  {(A --> (A --> boolean)) --> (list A) --> (list A)}
+   R X -> (fix (/. Y (bsort* R Y)) X))
+
+(define bsort*
+   {(A --> A --> boolean) --> (list A) --> (list A)}
+    _ [] -> []
+    _ [X] -> [X]
+    R [X Y | Z] -> [Y | (bsort* R [X | Z])]	where (R Y X)
     R [X Y | Z] -> [X | (bsort* R [Y | Z])])
\ No newline at end of file
diff --git a/tests/secd1.shen b/tests/secd1.shen
index 24c8ea9..5291be1 100644
--- a/tests/secd1.shen
+++ b/tests/secd1.shen
@@ -1,49 +1,48 @@
-(synonyms 	stack (list ob)
-          	environment (list (symbol * ob))
-          	control (list ob)
-          	dump (list (stack * environment * control)))
-          	
-(datatype ob
-
- E : environment; X : symbol; Y : ob;
-  ====================================
-  [closure E X Y] : ob; 
-
-  X : symbol; Y : ob;
-  ===================
-  [lambda X Y] : ob;
-  
-  X : ob; Y : ob;
-  ===============
-  [X Y] : ob;
-  
-  X : symbol;
-  ___________
-  X : ob;)          	
-
-(define evaluate
-  {ob --> ob}
-  X -> (secd [] [] [X] []))
-  
-(define secd
-  {stack --> environment --> control --> dump --> ob}
-  [V] E [] [] -> V
-  [V] _ [] [(@p S E C) | D] -> (secd [V | S] E C D)
-  S E [[lambda X Y] | C] D -> (secd [[closure E X Y] | S] E C D)
-  S E [[X Y] | C] D -> (secd S E [Y X @ | C] D)
-  [[closure E* X Y] Z | S] E [@ | C] D -> (secd [] [(@p X Z) | E*] [Y] [(@p S E C) | D])
-  S E [X | C] D ->(if (bnd? X E) (secd [(lookup X E) | S] E C D)  (secd [X | S] E C D)))
-  
-(define bnd?
-  {ob --> environment --> boolean}
-   X [] -> false
-   X [(@p Y _) | _] -> true  where (== X Y) 
-   X [_ | Y] -> (bnd? X Y))  
-   
-(define lookup
-  {ob --> environment --> ob}
-   X [] -> X
-   X [(@p Y Z) | _] -> Z  where (== X Y)
-   X [_ | Y] -> (lookup X Y))   
-   
-         
\ No newline at end of file
+(synonyms 	stack (list ob)
+          	environment (list (symbol * ob))
+          	control (list ob)
+          	dump (list (stack * environment * control)))
+
+(datatype ob
+
+ E : environment; X : symbol; Y : ob;
+  ====================================
+  [closure E X Y] : ob;
+
+  X : symbol; Y : ob;
+  ===================
+  [lambda X Y] : ob;
+
+  X : ob; Y : ob;
+  ===============
+  [X Y] : ob;
+
+  X : symbol;
+  ___________
+  X : ob;)
+
+(define evaluate
+  {ob --> ob}
+  X -> (secd [] [] [X] []))
+
+(define secd
+  {stack --> environment --> control --> dump --> ob}
+  [V] E [] [] -> V
+  [V] _ [] [(@p S E C) | D] -> (secd [V | S] E C D)
+  S E [[lambda X Y] | C] D -> (secd [[closure E X Y] | S] E C D)
+  S E [[X Y] | C] D -> (secd S E [Y X @ | C] D)
+  [[closure E* X Y] Z | S] E [@ | C] D -> (secd [] [(@p X Z) | E*] [Y] [(@p S E C) | D])
+  S E [X | C] D ->(if (bnd? X E) (secd [(lookup X E) | S] E C D)  (secd [X | S] E C D)))
+
+(define bnd?
+  {ob --> environment --> boolean}
+   X [] -> false
+   X [(@p Y _) | _] -> true  where (== X Y)
+   X [_ | Y] -> (bnd? X Y))
+
+(define lookup
+  {ob --> environment --> ob}
+   X [] -> X
+   X [(@p Y Z) | _] -> Z  where (== X Y)
+   X [_ | Y] -> (lookup X Y))
+
diff --git a/tests/semantic net.shen b/tests/semantic net.shen
index 6696ceb..bac64d1 100644
--- a/tests/semantic net.shen	
+++ b/tests/semantic net.shen	
@@ -1,44 +1,44 @@
-(define query  
-  [is Object Concept] -> (if (belongs? Object Concept) yes no))
-
-(define belongs?  
-  Object Concept -> (element? Concept (fix (fn spread-activation) [Object])))
-
-(define spread-activation  
-  [] -> [] 
-  [Vertex | Vertices] -> (union (accessible-from Vertex)
-                                (spread-activation Vertices)))
-
-(define accessible-from  
-  Vertex -> [Vertex | (union (is_links Vertex) (type_links Vertex))])
-
-(define is_links  
-  Vertex -> (get-prop Vertex is_a []))
-
-(define type_links 
-  Vertex -> (get-prop Vertex type_of []))
-
-(define assert
-   [Object is_a Type] -> (put Object is_a [Type | (is_links Object)])
-   [Type1 type_of Type2] -> (put Type1 type_of [Type2 | (type_links Type1)]))
-
-(define get-prop
-  Ob Pointer Default -> (trap-error (get Ob Pointer) (/. E Default)))
-
-(define clear
-  Ob -> (put Ob is_a (put Ob type_of [])))
-
-
-
-
-
-
-
-
-
-
-
-
-
- 
-
+(define query
+  [is Object Concept] -> (if (belongs? Object Concept) yes no))
+
+(define belongs?
+  Object Concept -> (element? Concept (fix (fn spread-activation) [Object])))
+
+(define spread-activation
+  [] -> []
+  [Vertex | Vertices] -> (union (accessible-from Vertex)
+                                (spread-activation Vertices)))
+
+(define accessible-from
+  Vertex -> [Vertex | (union (is_links Vertex) (type_links Vertex))])
+
+(define is_links
+  Vertex -> (get-prop Vertex is_a []))
+
+(define type_links
+  Vertex -> (get-prop Vertex type_of []))
+
+(define assert
+   [Object is_a Type] -> (put Object is_a [Type | (is_links Object)])
+   [Type1 type_of Type2] -> (put Type1 type_of [Type2 | (type_links Type1)]))
+
+(define get-prop
+  Ob Pointer Default -> (trap-error (get Ob Pointer) (/. E Default)))
+
+(define clear
+  Ob -> (put Ob is_a (put Ob type_of [])))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/spreadsheet.shen b/tests/spreadsheet.shen
index 0f3150e..d4e2d59 100644
--- a/tests/spreadsheet.shen
+++ b/tests/spreadsheet.shen
@@ -1,35 +1,35 @@
-(define assess-spreadsheet
-  Spreadsheet -> (map (/. Row (assign-fixed-values Row Spreadsheet))
-                      Spreadsheet))
-
-(define assign-fixed-values 
-   [Index | Cells] Spreadsheet 
-   -> [Index | (map (/. Cell (assign-cell-value Cell Spreadsheet)) Cells)]) 
-
-(define assign-cell-value 
-   [Attribute Value]  _ -> [Attribute Value] where (fixed-value? Value) 
-   [Attribute Value] Spreadsheet -> [Attribute (Value Spreadsheet)])
-
-(define fixed-value?
- \* number?, symbol? and string? are system functions - see appendix A *\
-  Value -> (or (number? Value) (or (symbol? Value) (string? Value))))
-
-(define get'
-  \* spreads the spreadsheet! *\
-  Index Attribute Spreadsheet
-   -> (get-row Index Attribute Spreadsheet Spreadsheet))
-
-(define get-row
-   \* looks for the right row using the index *\
-   Index Attribute [[Index | Cells] | _] Spreadsheet
-   -> (get-cell Attribute Cells Spreadsheet)
-   Index Attribute [_ | Rows] Spreadsheet
-   -> (get-row Index Attribute Rows Spreadsheet)
-   Index _ _ _ -> (error "Index ~A not found" Index))
-
-(define get-cell
-   Attribute [[Attribute Value] | _] Spreadsheet 
-   -> (if (fixed-value? Value) Value (Value Spreadsheet))
-   Attribute [_ | Cells] Spreadsheet
-   -> (get-cell Attribute Cells Spreadsheet)
+(define assess-spreadsheet
+  Spreadsheet -> (map (/. Row (assign-fixed-values Row Spreadsheet))
+                      Spreadsheet))
+
+(define assign-fixed-values
+   [Index | Cells] Spreadsheet
+   -> [Index | (map (/. Cell (assign-cell-value Cell Spreadsheet)) Cells)])
+
+(define assign-cell-value
+   [Attribute Value]  _ -> [Attribute Value] where (fixed-value? Value)
+   [Attribute Value] Spreadsheet -> [Attribute (Value Spreadsheet)])
+
+(define fixed-value?
+ \* number?, symbol? and string? are system functions - see appendix A *\
+  Value -> (or (number? Value) (or (symbol? Value) (string? Value))))
+
+(define get'
+  \* spreads the spreadsheet! *\
+  Index Attribute Spreadsheet
+   -> (get-row Index Attribute Spreadsheet Spreadsheet))
+
+(define get-row
+   \* looks for the right row using the index *\
+   Index Attribute [[Index | Cells] | _] Spreadsheet
+   -> (get-cell Attribute Cells Spreadsheet)
+   Index Attribute [_ | Rows] Spreadsheet
+   -> (get-row Index Attribute Rows Spreadsheet)
+   Index _ _ _ -> (error "Index ~A not found" Index))
+
+(define get-cell
+   Attribute [[Attribute Value] | _] Spreadsheet
+   -> (if (fixed-value? Value) Value (Value Spreadsheet))
+   Attribute [_ | Cells] Spreadsheet
+   -> (get-cell Attribute Cells Spreadsheet)
    Attribute _ _ -> (error "Attribute ~A not found" Attribute))
\ No newline at end of file
diff --git a/tests/stack.shen b/tests/stack.shen
index dcc2e4f..01f32a2 100644
--- a/tests/stack.shen
+++ b/tests/stack.shen
@@ -1,27 +1,27 @@
-(declare empty-stack [A --> [stack B]])
-
-(declare push [A --> [stack A] --> [stack A]])
-
-(declare top [[stack A] --> A])
-
-(declare pop [[stack A] --> [stack A]])
-
-(define empty-stack
-   _ -> (/.  X (if (or (= X pop) (= X top))
-                        (error "this stack is empty~%")
-                        (error "~A is not an operation on stacks.~%" X))))
-                        
-(define push
-   X S -> (/. Y (if (= Y pop) 
-                    S 
-                   (if (= Y top) 
-                       X 
-                       (error "~A is not an operation on stacks.~%" Y)))))
-
-(define top
-   S -> (S top))
-
-(define pop
-   S -> (S pop))
-
-
+(declare empty-stack [A --> [stack B]])
+
+(declare push [A --> [stack A] --> [stack A]])
+
+(declare top [[stack A] --> A])
+
+(declare pop [[stack A] --> [stack A]])
+
+(define empty-stack
+   _ -> (/.  X (if (or (= X pop) (= X top))
+                        (error "this stack is empty~%")
+                        (error "~A is not an operation on stacks.~%" X))))
+
+(define push
+   X S -> (/. Y (if (= Y pop)
+                    S
+                   (if (= Y top)
+                       X
+                       (error "~A is not an operation on stacks.~%" Y)))))
+
+(define top
+   S -> (S top))
+
+(define pop
+   S -> (S pop))
+
+
diff --git a/tests/streams.shen b/tests/streams.shen
index 1001166..d521f3d 100644
--- a/tests/streams.shen
+++ b/tests/streams.shen
@@ -1,20 +1,20 @@
-(datatype progression
-
-    X : (A * (A --> A) * (A --> boolean));
-    ======================================
-    X : (progression A);)    
-
-(define delay
-   {(progression A) --> (progression A)}
-   (@p X F E) -> (if (not (E X)) 
-                     (@p (F X) F E) 
-                     (error "progression exhausted!~%")))
-
-(define force
-    {(progression A) --> A}
-     (@p X F E) -> X)
-
-(define end?
-    {(progression A) --> boolean}
-     (@p X _ E) -> (E X))
-
+(datatype progression
+
+    X : (A * (A --> A) * (A --> boolean));
+    ======================================
+    X : (progression A);)
+
+(define delay
+   {(progression A) --> (progression A)}
+   (@p X F E) -> (if (not (E X))
+                     (@p (F X) F E)
+                     (error "progression exhausted!~%")))
+
+(define force
+    {(progression A) --> A}
+     (@p X F E) -> X)
+
+(define end?
+    {(progression A) --> boolean}
+     (@p X _ E) -> (E X))
+
diff --git a/tests/strings.shen b/tests/strings.shen
index d0c480e..3a97617 100644
--- a/tests/strings.shen
+++ b/tests/strings.shen
@@ -1,50 +1,50 @@
-(define subst-string
-  {string --> string --> string --> string}
-   _ _ "" -> ""
-  Rep (@s S Ss) (@s S Ss') <- (fail-if (= "failed!") (subst-string' Rep Ss Ss'))
-  Rep Rem (@s S Ss) -> (@s S (subst-string Rep Rem Ss)))
-
-(define subst-string'
-  {string --> string --> string --> string}
-  Rep "" Ss -> (@s Rep Ss)
-  Rep (@s S Ss) (@s S Ss') -> (subst-string' Rep Ss Ss')
-   _ _ _ -> "failed!")
-      
-(define rwilli
-  {string --> string}
-  "" -> ""
-  (@s "Willi" Ss) -> (rwilli Ss)
-  (@s _ Ss) -> (rwilli Ss))  
-
-(define strlen
-   {string --> number}
-    "" -> 0
-    (@s _ S) -> (+ 1 (strlen S)))
-    
-(define trim-string-left
-   {(list string) --> string --> string}
-     _ "" -> ""
-     Trim (@s S Ss) -> (@s S Ss)  where (not (element? S Trim))
-     Trim (@s _ Ss) -> (trim-string-left Trim Ss)) 
-
-(define trim-string-right
-   {(list string) --> string --> string}          
-     Trim S -> (reverse-string (trim-string-left Trim (reverse-string S))))
-     
-(define trim-string
-   {(list string) --> string --> string}          
-     Trim S -> (reverse-string (trim-string-left Trim (reverse-string (trim-string-left Trim S)))))     
-
-(define reverse-string
-  {string --> string}
-   "" -> ""
-   (@s S Ss) -> (@s (reverse-string Ss) S))   
-
-(define alldigits?
-   {string --> boolean}
-   "" -> true
-   (@s S Ss) -> (and (digit? S) (alldigits? Ss)))
-   
-(define digit?
-  {string --> boolean}
-   S -> (element? S ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9"]))   
\ No newline at end of file
+(define subst-string
+  {string --> string --> string --> string}
+   _ _ "" -> ""
+  Rep (@s S Ss) (@s S Ss') <- (fail-if (= "failed!") (subst-string' Rep Ss Ss'))
+  Rep Rem (@s S Ss) -> (@s S (subst-string Rep Rem Ss)))
+
+(define subst-string'
+  {string --> string --> string --> string}
+  Rep "" Ss -> (@s Rep Ss)
+  Rep (@s S Ss) (@s S Ss') -> (subst-string' Rep Ss Ss')
+   _ _ _ -> "failed!")
+
+(define rwilli
+  {string --> string}
+  "" -> ""
+  (@s "Willi" Ss) -> (rwilli Ss)
+  (@s _ Ss) -> (rwilli Ss))
+
+(define strlen
+   {string --> number}
+    "" -> 0
+    (@s _ S) -> (+ 1 (strlen S)))
+
+(define trim-string-left
+   {(list string) --> string --> string}
+     _ "" -> ""
+     Trim (@s S Ss) -> (@s S Ss)  where (not (element? S Trim))
+     Trim (@s _ Ss) -> (trim-string-left Trim Ss))
+
+(define trim-string-right
+   {(list string) --> string --> string}
+     Trim S -> (reverse-string (trim-string-left Trim (reverse-string S))))
+
+(define trim-string
+   {(list string) --> string --> string}
+     Trim S -> (reverse-string (trim-string-left Trim (reverse-string (trim-string-left Trim S)))))
+
+(define reverse-string
+  {string --> string}
+   "" -> ""
+   (@s S Ss) -> (@s (reverse-string Ss) S))
+
+(define alldigits?
+   {string --> boolean}
+   "" -> true
+   (@s S Ss) -> (and (digit? S) (alldigits? Ss)))
+
+(define digit?
+  {string --> boolean}
+   S -> (element? S ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9"]))
\ No newline at end of file
diff --git a/tests/structures-typed.shen b/tests/structures-typed.shen
index aafba32..b7dde61 100644
--- a/tests/structures-typed.shen
+++ b/tests/structures-typed.shen
@@ -1,71 +1,71 @@
-(define defstruct
-  Name Slots 
-  -> (let Attributes (map (fn fst) Slots)
-          Types (map (fn snd) Slots)
-          Selectors (selectors Name Attributes)
-          Constructor (constructor Name Attributes)
-          Recognisor (recognisor Name)
-          ConstructorType (constructor-type Name Types)
-          SelectorTypes (selector-types Name Attributes Types)
-          RecognisorType (recognisor-type Name)
-          Name))
-
-(define selector-types
-  _ [] [] -> (gensym (protect X))
-  Name [Attribute | Attributes] [Type | Types] 
-  -> (let Selector (concat Name (concat - Attribute))
-          SelectorType [Name --> Type] 
-          TypeDecl (declare Selector SelectorType)
-          (selector-types Name Attributes Types)))
-
-(define recognisor-type
-  Name -> (let Recognisor (concat Name ?)
-                        (declare Recognisor [Name --> boolean])))
-
-(define constructor-type
-  Name Types -> (let Constructor (concat make- Name)
-                     Type (assemble-type Types Name)
-                     (declare Constructor Type)))
-
-(define assemble-type
-  [ ] Name -> Name
-  [Type | Types] Name -> [Type --> (assemble-type Types Name)])
-
-(declare defstruct [symbol --> [list [symbol * symbol]] --> symbol])
-
-(define selectors
-    Name Attributes -> (map (/. A (selector Name A)) Attributes))
-
-(define selector
-    Name Attribute 
-    -> (let SelectorName (concat Name (concat - Attribute))
-           (eval [define SelectorName
-                   (protect Structure) -> [let (protect LookUp) [assoc Attribute (protect Structure)]
-                                     [if [empty? (protect LookUp)]
-                                         [error "~A is not an attribute of ~A.~%" 
-                                                    Attribute Name]
-                                         [tail (protect LookUp)]]]])))
-
-(define constructor
-   Name Attributes 
-   -> (let ConstructorName (concat make- Name)
-           Parameters (params Attributes)
-           (eval [define ConstructorName |
-                    (append Parameters 
-                            [-> [cons [cons structure Name] 
-                                      (make-association-list Attributes
-                                                             Parameters)]])])))
-
-(define params
-   [] -> []
-   [_ | Attributes] -> [(gensym (protect X)) | (params Attributes)])
-
-(define make-association-list
-   [] [] -> []
-   [A | As] [P | Ps] -> [cons [cons A P] (make-association-list As Ps)])
-
-(define recognisor
-  Name -> (let RecognisorName (concat Name ?)
-               (eval [define RecognisorName 
-                       [cons [cons structure Name] _] -> true
-                        _ -> false])))
+(define defstruct
+  Name Slots
+  -> (let Attributes (map (fn fst) Slots)
+          Types (map (fn snd) Slots)
+          Selectors (selectors Name Attributes)
+          Constructor (constructor Name Attributes)
+          Recognisor (recognisor Name)
+          ConstructorType (constructor-type Name Types)
+          SelectorTypes (selector-types Name Attributes Types)
+          RecognisorType (recognisor-type Name)
+          Name))
+
+(define selector-types
+  _ [] [] -> (gensym (protect X))
+  Name [Attribute | Attributes] [Type | Types]
+  -> (let Selector (concat Name (concat - Attribute))
+          SelectorType [Name --> Type]
+          TypeDecl (declare Selector SelectorType)
+          (selector-types Name Attributes Types)))
+
+(define recognisor-type
+  Name -> (let Recognisor (concat Name ?)
+                        (declare Recognisor [Name --> boolean])))
+
+(define constructor-type
+  Name Types -> (let Constructor (concat make- Name)
+                     Type (assemble-type Types Name)
+                     (declare Constructor Type)))
+
+(define assemble-type
+  [ ] Name -> Name
+  [Type | Types] Name -> [Type --> (assemble-type Types Name)])
+
+(declare defstruct [symbol --> [list [symbol * symbol]] --> symbol])
+
+(define selectors
+    Name Attributes -> (map (/. A (selector Name A)) Attributes))
+
+(define selector
+    Name Attribute
+    -> (let SelectorName (concat Name (concat - Attribute))
+           (eval [define SelectorName
+                   (protect Structure) -> [let (protect LookUp) [assoc Attribute (protect Structure)]
+                                     [if [empty? (protect LookUp)]
+                                         [error "~A is not an attribute of ~A.~%"
+                                                    Attribute Name]
+                                         [tail (protect LookUp)]]]])))
+
+(define constructor
+   Name Attributes
+   -> (let ConstructorName (concat make- Name)
+           Parameters (params Attributes)
+           (eval [define ConstructorName |
+                    (append Parameters
+                            [-> [cons [cons structure Name]
+                                      (make-association-list Attributes
+                                                             Parameters)]])])))
+
+(define params
+   [] -> []
+   [_ | Attributes] -> [(gensym (protect X)) | (params Attributes)])
+
+(define make-association-list
+   [] [] -> []
+   [A | As] [P | Ps] -> [cons [cons A P] (make-association-list As Ps)])
+
+(define recognisor
+  Name -> (let RecognisorName (concat Name ?)
+               (eval [define RecognisorName
+                       [cons [cons structure Name] _] -> true
+                        _ -> false])))
diff --git a/tests/structures-untyped.shen b/tests/structures-untyped.shen
index 473e134..e0f2c40 100644
--- a/tests/structures-untyped.shen
+++ b/tests/structures-untyped.shen
@@ -1,42 +1,42 @@
-(define defstruct
-  Name Attributes -> (let Selectors (selectors Name Attributes)
-                          Constructor (constructor Name Attributes)
-                          Recognisor (recognisor Name)
-                          Name))
-
-(define selectors
-    Name Attributes -> (map (/. A (selector Name A)) Attributes))
-
-(define selector
-    Name Attribute 
-    -> (let SelectorName (concat Name (concat - Attribute))
-           (eval [define SelectorName
-                   (protect Structure) -> [let (protect LookUp) [assoc Attribute (protect Structure)]
-                                     [if [empty? (protect LookUp)]
-                                         [error "~A is not an attribute of ~A.~%" 
-                                                    Attribute Name]
-                                         [tail (protect LookUp)]]]])))
-
-(define constructor
-   Name Attributes 
-   -> (let ConstructorName (concat make- Name)
-           Parameters (params Attributes)
-           (eval [define ConstructorName |
-                    (append Parameters 
-                            [-> [cons [cons structure Name] 
-                                      (make-association-list Attributes
-                                                             Parameters)]])])))
-
-(define params
-   [] -> []
-   [_ | Attributes] -> [(gensym (protect X)) | (params Attributes)])
-
-(define make-association-list
-   [] [] -> []
-   [A | As] [P | Ps] -> [cons [cons A P] (make-association-list As Ps)])
-
-(define recognisor
-  Name -> (let RecognisorName (concat Name ?)
-               (eval [define RecognisorName
-                       [cons [cons structure Name] _] -> true
+(define defstruct
+  Name Attributes -> (let Selectors (selectors Name Attributes)
+                          Constructor (constructor Name Attributes)
+                          Recognisor (recognisor Name)
+                          Name))
+
+(define selectors
+    Name Attributes -> (map (/. A (selector Name A)) Attributes))
+
+(define selector
+    Name Attribute
+    -> (let SelectorName (concat Name (concat - Attribute))
+           (eval [define SelectorName
+                   (protect Structure) -> [let (protect LookUp) [assoc Attribute (protect Structure)]
+                                     [if [empty? (protect LookUp)]
+                                         [error "~A is not an attribute of ~A.~%"
+                                                    Attribute Name]
+                                         [tail (protect LookUp)]]]])))
+
+(define constructor
+   Name Attributes
+   -> (let ConstructorName (concat make- Name)
+           Parameters (params Attributes)
+           (eval [define ConstructorName |
+                    (append Parameters
+                            [-> [cons [cons structure Name]
+                                      (make-association-list Attributes
+                                                             Parameters)]])])))
+
+(define params
+   [] -> []
+   [_ | Attributes] -> [(gensym (protect X)) | (params Attributes)])
+
+(define make-association-list
+   [] [] -> []
+   [A | As] [P | Ps] -> [cons [cons A P] (make-association-list As Ps)])
+
+(define recognisor
+  Name -> (let RecognisorName (concat Name ?)
+               (eval [define RecognisorName
+                       [cons [cons structure Name] _] -> true
                         _ -> false])))
\ No newline at end of file
diff --git a/tests/tableauprolog.shen b/tests/tableauprolog.shen
index 14b8583..bf44a4d 100644
--- a/tests/tableauprolog.shen
+++ b/tests/tableauprolog.shen
@@ -1,33 +1,33 @@
-(defprolog prop
-  A C <-- (proph [[~  C] | A]);)
-
-(defprolog proph
-  A                       <-- (inconsistent A) !;
-  A                       <-- (consistent A) ! (when false);
-  (- [[P & Q] | A])       <-- ! (proph (append A [P Q]));
-  (- [[P <=> Q] | A])     <-- ! (proph [[P => Q] [Q => P] | A]);
-  (- [[P => Q] | A])      <-- ! (proph [[[~ P] v Q] | A]);
-  (- [[P v Q] | A])       <-- ! (proph (append A [P])) ! (proph (append A [Q]));
-  (- [[~ [~ P]] | A])     <-- ! (proph (append A [P]));
-  (- [[~ [P v Q]] | A])   <-- ! (proph (append A [[~ P] [~ Q]]));
-  (- [[~ [P & Q]] | A])   <-- ! (proph [[[~ P] v [~ Q]] | A]);
-  (- [[~ [P => Q]] | A])  <-- ! (proph (append A [P [~ Q]]));
-  (- [[~ [P <=> Q]] | A]) <-- ! (proph [[~ [[P => Q] & [Q => P]]] | A]);
-  (- [P | Ps])            <-- ! (proph (append Ps [P]));)
- 
-(defprolog inconsistent
-   [P | Ps] <-- (complement P NotP) (member NotP Ps) !;
-   [_ | Ps] <-- (inconsistent Ps);)
-   
-(defprolog consistent
-  [] <--;
-  [P | Ps]     <-- (when (symbol? P)) ! (consistent Ps);
-  [[~ P] | Ps] <-- (when (symbol? P)) (consistent Ps);)   
-   
-(defprolog complement
-  [~ P] P <-- !;
-  P [~ P] <--;)   
-
-(defprolog member
-  X (- [X | _]) <--;
+(defprolog prop
+  A C <-- (proph [[~  C] | A]);)
+
+(defprolog proph
+  A                       <-- (inconsistent A) !;
+  A                       <-- (consistent A) ! (when false);
+  (- [[P & Q] | A])       <-- ! (proph (append A [P Q]));
+  (- [[P <=> Q] | A])     <-- ! (proph [[P => Q] [Q => P] | A]);
+  (- [[P => Q] | A])      <-- ! (proph [[[~ P] v Q] | A]);
+  (- [[P v Q] | A])       <-- ! (proph (append A [P])) ! (proph (append A [Q]));
+  (- [[~ [~ P]] | A])     <-- ! (proph (append A [P]));
+  (- [[~ [P v Q]] | A])   <-- ! (proph (append A [[~ P] [~ Q]]));
+  (- [[~ [P & Q]] | A])   <-- ! (proph [[[~ P] v [~ Q]] | A]);
+  (- [[~ [P => Q]] | A])  <-- ! (proph (append A [P [~ Q]]));
+  (- [[~ [P <=> Q]] | A]) <-- ! (proph [[~ [[P => Q] & [Q => P]]] | A]);
+  (- [P | Ps])            <-- ! (proph (append Ps [P]));)
+
+(defprolog inconsistent
+   [P | Ps] <-- (complement P NotP) (member NotP Ps) !;
+   [_ | Ps] <-- (inconsistent Ps);)
+
+(defprolog consistent
+  [] <--;
+  [P | Ps]     <-- (when (symbol? P)) ! (consistent Ps);
+  [[~ P] | Ps] <-- (when (symbol? P)) (consistent Ps);)
+
+(defprolog complement
+  [~ P] P <-- !;
+  P [~ P] <--;)
+
+(defprolog member
+  X (- [X | _]) <--;
   X (- [_ | Y]) <-- (member X Y);)
\ No newline at end of file
diff --git a/tests/totalprolog.shen b/tests/totalprolog.shen
index 3b2fdfe..1c648e6 100644
--- a/tests/totalprolog.shen
+++ b/tests/totalprolog.shen
@@ -1,28 +1,28 @@
-(defprolog lived
-   "Adam" 930 <--;
-   "Seth" 912 <--;
-   "Enos" 905 <--;
-   "Ca-i'nan" 910 <--;
-   "Mahal'aleel" 895 <--;
-   "Jared" 962 <--;
-   "Enoch" 365 <--;
-   "Methu'selah" 969 <--;
-   "Lamech" 777 <--;)
-
-(defprolog begat
-   "Adam" "Seth"  <--;
-   "Seth" "Enos" <--;
-   "Enos" "Ca-i'nan" <--;
-   "Ca-i'nan" "Mahal'aleel" <--;
-   "Mahal'aleel" "Jared" <--;
-   "Jared" "Enoch" <--;
-   "Enoch" "Methu'selah" <--;
-   "Methu'selah" "Lamech" <--;)
-
-(prolog? (findall Age (lived Person Age) Ages) 
-         (return (sum Ages)))
-         
-(defprolog total
-           [] 0 <--;
-           [X | Y] N <-- (total Y M) (is N (+ M X));)
-
+(defprolog lived
+   "Adam" 930 <--;
+   "Seth" 912 <--;
+   "Enos" 905 <--;
+   "Ca-i'nan" 910 <--;
+   "Mahal'aleel" 895 <--;
+   "Jared" 962 <--;
+   "Enoch" 365 <--;
+   "Methu'selah" 969 <--;
+   "Lamech" 777 <--;)
+
+(defprolog begat
+   "Adam" "Seth"  <--;
+   "Seth" "Enos" <--;
+   "Enos" "Ca-i'nan" <--;
+   "Ca-i'nan" "Mahal'aleel" <--;
+   "Mahal'aleel" "Jared" <--;
+   "Jared" "Enoch" <--;
+   "Enoch" "Methu'selah" <--;
+   "Methu'selah" "Lamech" <--;)
+
+(prolog? (findall Age (lived Person Age) Ages)
+         (return (sum Ages)))
+
+(defprolog total
+           [] 0 <--;
+           [X | Y] N <-- (total Y M) (is N (+ M X));)
+
diff --git a/tests/unification.shen b/tests/unification.shen
index 283c97e..d3781fd 100644
--- a/tests/unification.shen
+++ b/tests/unification.shen
@@ -1,24 +1,24 @@
-(define unify
-   X Y -> (unify-loop X Y []))
-
-(define unify-loop
-   X X MGU -> MGU
-   X Y MGU -> [[X | Y] | MGU]    where (and (variable? X) (occurs-check? X Y))
-   X Y MGU -> [[Y | X] | MGU]    where (and (variable? Y) (occurs-check? Y X))
-   [X | Y] [W | Z] MGU -> (let NewMGU (unify-loop X W MGU)
-                               (unify-loop (deref Y NewMGU) 
-                                           (deref Z NewMGU) 
-                                           NewMGU))
-    _ _ _ ->  (error "unification failure"))
-
-(define occurs-check?
-   X X -> false
-   X [Y | Z] -> (and (occurs-check? X Y) (occurs-check? X Z))
-   _ _ -> true)
-
-(define deref
-   [X | Y] MGU -> (map (/. Term (deref Term MGU)) [X | Y])
-   X MGU -> (let Binding (assoc X MGU)
-                 (if (empty? Binding) 
-                     X 
-                     (deref (tl Binding) MGU))))
+(define unify
+   X Y -> (unify-loop X Y []))
+
+(define unify-loop
+   X X MGU -> MGU
+   X Y MGU -> [[X | Y] | MGU]    where (and (variable? X) (occurs-check? X Y))
+   X Y MGU -> [[Y | X] | MGU]    where (and (variable? Y) (occurs-check? Y X))
+   [X | Y] [W | Z] MGU -> (let NewMGU (unify-loop X W MGU)
+                               (unify-loop (deref Y NewMGU)
+                                           (deref Z NewMGU)
+                                           NewMGU))
+    _ _ _ ->  (error "unification failure"))
+
+(define occurs-check?
+   X X -> false
+   X [Y | Z] -> (and (occurs-check? X Y) (occurs-check? X Z))
+   _ _ -> true)
+
+(define deref
+   [X | Y] MGU -> (map (/. Term (deref Term MGU)) [X | Y])
+   X MGU -> (let Binding (assoc X MGU)
+                 (if (empty? Binding)
+                     X
+                     (deref (tl Binding) MGU))))
diff --git a/tests/yacc.shen b/tests/yacc.shen
index 2777427..ce3f023 100644
--- a/tests/yacc.shen
+++ b/tests/yacc.shen
@@ -1,140 +1,140 @@
-(defcc 
- {(list symbol) ==> (list symbol)}
- ;) 
-
-(defcc 
-{(list symbol) ==> (list symbol)}
-the; a;) 
-
-(defcc 
-{(list symbol) ==> (list symbol)}
- ;
-;) 
-
-(defcc 
- {(list symbol) ==> (list symbol)}
-cat; dog;)  
-
-(defcc 
-{(list symbol) ==> (list symbol)}
- X := [X]	where (element? X [bill ben]);) 
-
-(defcc 
-{(list symbol) ==> (list symbol)}
- ;) 
-
-(defcc 
-{(list symbol) ==> (list symbol)}
-likes; chases;)
-
-(defcc 
-[] [] := (append  );) 
-
-(defcc 
-  {(list symbol) ==> (list symbol)}
-  d ; 
-  d;) 
-
-(defcc 
-  e ; 
-  e;)
-
-(defcc 
-  := (question  );) 
-
-(define question
-NP VP -> (append [is it true that your father] VP [?]))
-
-(defcc bs>
-  a bs> := [b | bs>];
-  a := [b];) 
-
-(defcc 
-    := ;
-   := ;
-  X  := ;) 
-
-(defcc 
-  X ; 
-  X;) 
-
-(defcc 
-0; 1; 2; 3; 4; 5; 6; 7; 8; 9;)
-
-(defcc 
-   ;
-   := ;
-  X  := ;) 
-
-(defcc 
-    ;) 
-
-(defcc 
-  a ; 
-  a;) 
-
-(defcc 
-b ; 
-b; 
-;) 
-
-(defcc 
-c ; 
-c;) 
-
-(defcc 
-    ;)
-
-(defcc 
-b ; 
-b; 
-;)
-
-(defcc 
-    := ;
-   := ;
-  X  := ;) 
-
-(defcc 
-  X := X  where (element? X [0 1 2 3 4 5 6 7 8 9]);) 
-
-(defcc 
-   := (appendall [  ]) 
-                       where (equal-length? [  ]);) 
-
-(defcc 
-a ; 
-a;) 
-
-(defcc 
-b ; 
-b;) 
-
-(defcc 
-c ; 
-c;) 
-
-(define equal-length?
-[] -> true
-[L] -> true
-[L1 L2 | Ls] -> (and (= (length L1) (length L2)) (equal-length? [L2 | Ls])))
-
-(define appendall
-[] -> []
-[L | Ls] -> (append L (appendall Ls))) 
-
-(defcc 
-   [a] := a;)
-   
- (defcc 
-  [b] b;)
-  
- (defcc 
-   [] := [];
-   c;)
-   
- (defcc 
-    []  := [[] | ];
-    d  := [d | ];
-    d := [d];)
-
+(defcc 
+ {(list symbol) ==> (list symbol)}
+ ;)
+
+(defcc 
+{(list symbol) ==> (list symbol)}
+the; a;)
+
+(defcc 
+{(list symbol) ==> (list symbol)}
+ ;
+;)
+
+(defcc 
+ {(list symbol) ==> (list symbol)}
+cat; dog;)
+
+(defcc 
+{(list symbol) ==> (list symbol)}
+ X := [X]	where (element? X [bill ben]);)
+
+(defcc 
+{(list symbol) ==> (list symbol)}
+ ;)
+
+(defcc 
+{(list symbol) ==> (list symbol)}
+likes; chases;)
+
+(defcc 
+[] [] := (append  );)
+
+(defcc 
+  {(list symbol) ==> (list symbol)}
+  d ;
+  d;)
+
+(defcc 
+  e ;
+  e;)
+
+(defcc 
+  := (question  );)
+
+(define question
+NP VP -> (append [is it true that your father] VP [?]))
+
+(defcc bs>
+  a bs> := [b | bs>];
+  a := [b];)
+
+(defcc 
+    := ;
+   := ;
+  X  := ;)
+
+(defcc 
+  X ;
+  X;)
+
+(defcc 
+0; 1; 2; 3; 4; 5; 6; 7; 8; 9;)
+
+(defcc 
+   ;
+   := ;
+  X  := ;)
+
+(defcc 
+    ;)
+
+(defcc 
+  a ;
+  a;)
+
+(defcc 
+b ;
+b;
+;)
+
+(defcc 
+c ;
+c;)
+
+(defcc 
+    ;)
+
+(defcc 
+b ;
+b;
+;)
+
+(defcc 
+    := ;
+   := ;
+  X  := ;)
+
+(defcc 
+  X := X  where (element? X [0 1 2 3 4 5 6 7 8 9]);)
+
+(defcc 
+   := (appendall [  ])
+                       where (equal-length? [  ]);)
+
+(defcc 
+a ;
+a;)
+
+(defcc 
+b ;
+b;)
+
+(defcc 
+c ;
+c;)
+
+(define equal-length?
+[] -> true
+[L] -> true
+[L1 L2 | Ls] -> (and (= (length L1) (length L2)) (equal-length? [L2 | Ls])))
+
+(define appendall
+[] -> []
+[L | Ls] -> (append L (appendall Ls)))
+
+(defcc 
+   [a] := a;)
+
+ (defcc 
+  [b] b;)
+
+ (defcc 
+   [] := [];
+   c;)
+
+ (defcc 
+    []  := [[] | ];
+    d  := [d | ];
+    d := [d];)
+
diff --git a/typecheck_native.lua b/typecheck_native.lua
index 88f835d..441bd52 100644
--- a/typecheck_native.lua
+++ b/typecheck_native.lua
@@ -345,10 +345,11 @@ function M.install(Pmod, Emod)
     end
     return nil
   end
-  -- 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
+  -- Kernel signatures: Tarver S41.2/S42 kernels carry them as (declare ...)
+  -- forms in types.kl; ShenOSKernel 42.2 (vendored) carries them as
+  -- shen.initialise-signedfuncs CPS lambdas in init.kl (164 harvested). Try
+  -- types.kl first (it has no declares on 42.2, so it reports incomplete),
+  -- then init.kl. 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"))
@@ -416,6 +417,9 @@ function M.install(Pmod, Emod)
   --    boot.lua installs the engine before initialise(), so every kernel
   --    declare is captured. Delegates unconditionally (legacy *sigf* stays
   --    the source of truth for the legacy engine).
+  -- boot.lua replays cached stdlib signatures without calling `declare`;
+  -- this keeps the native signature table in step with shen.*sigf*.
+  M.record_sig = function(name, type_) NativeSig[name] = type_ end
   local orig_declare = F["declare"]
   if orig_declare then
     F["declare"] = function(name, type_)