diff --git a/LICENSE b/LICENSE index a825eb3..3fcc2ec 100644 --- a/LICENSE +++ b/LICENSE @@ -32,7 +32,7 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ---------------------------------------------------------------------------- The vendored Shen kernel sources (klambda/) and the official kernel test -suite (tests/) are from the ShenOSKernel 41.2 distribution and are: +suite (tests/) are from the ShenOSKernel 42 distribution and are: Copyright (c) 2010-2022, Mark Tarver All rights reserved. diff --git a/README.md b/README.md index 5702764..b688b78 100644 --- a/README.md +++ b/README.md @@ -14,8 +14,8 @@ primitives on a host runtime and (b) translating the kernel's `.kl` files into that host. This port does both by **compiling KLambda to Lua source** that LuaJIT then trace-compiles to machine code. -It targets **Shen 41.2** (the KLambda is vendored under `klambda/`; see -[`klambda/PROVENANCE.md`](klambda/PROVENANCE.md)) and passes the official 41.2 +It targets **Shen 42** (the KLambda is vendored under `klambda/`; see +[`klambda/PROVENANCE.md`](klambda/PROVENANCE.md)) and passes the official 42 kernel test suite (134/134). Earlier versions were certified against the Shen 22.4 kernel test suite. @@ -155,7 +155,7 @@ configuration. ## Requirements * **LuaJIT 2.1** (Lua 5.1 semantics). On Debian/Ubuntu: `apt-get install luajit`. -* Nothing else — the **Shen 41.2 KLambda sources** (`klambda/`) are vendored in this +* Nothing else — the **Shen 42 KLambda sources** (`klambda/`) are vendored in this repository for a self-contained clone-and-run experience. You can still point `SHEN_KL_DIR` at an external checkout if you are working against a different ShenOSKernel tree. @@ -250,7 +250,7 @@ bin/shen -q prog.shen # -q sets *hush*: silences load echo AND (output #### Batch and golden-suite runners: `--hush-load`, not `-q` -On the 41.2 kernel the `*hush*` global gates **`pr` itself**, so `-q` silences +On the 42 kernel the `*hush*` global gates **`pr` itself**, so `-q` silences *all* standard output — including the program's own `(output ...)`. That makes `-q` useless for a runner that diffs a suite's printed results against a golden file (issue #46): the file comes back empty. @@ -295,8 +295,8 @@ luarocks make --local shen-scm-1.rockspec # or: install the development tree luarocks tree whose interpreter is LuaJIT, e.g. `luarocks --lua-dir=$(brew --prefix luajit) --lua-version=5.1 install shen`.) -Rock versions map to kernels: **0.9.0** bundles kernel **41.1**, **0.10.0+** -bundles **41.2** (check with `shen -e '(version)'`). **0.10.1** is the current +Rock versions map to kernels: **0.9.0** bundles kernel **41.1**, while +**0.10.0+** bundles **42** (check with `shen -e '(version)'`). **0.10.1** is the current release (0.10.0 + the warm-FASL `(load)` echo fix, #40). If luarocks hands you 0.9.0, ask for the newer rock explicitly (`luarocks install shen 0.10.1-1`) or build from a checkout with the `scm` rockspec above. @@ -364,9 +364,9 @@ browser. One `rules.shen`, two runtimes, no client/server drift. See its ## Certification / Testing -The port loads and initialises the full 41.2 kernel plus the standard library +The port loads and initialises the full 42 kernel plus the standard library (loaded at boot from the S-lineage Shen sources under `lib/StLib/`) and the -extensions, and **passes the official 41.2 kernel test suite, 134/134**: +extensions, and **passes the official 42 kernel test suite, 134/134**: ```sh luajit run-kernel-tests.lua # => "passed ... 134 / failed ... 0 / pass rate ... 100%" @@ -374,12 +374,12 @@ lua run-kernel-tests.lua # same result on PUC Lua 5.1 / 5.4 / 5.5 (slower) ``` The official test suite is vendored in `tests/` (BSD-licensed, from the -ShenOSKernel 41.2 distribution), so certification is verifiable from a bare +ShenOSKernel 42 distribution), so certification is verifiable from a bare clone. `SHEN_TESTS_DIR` points the driver at a different suite location. Port-specific specs live in `test/` (engine, interop, REPL, tail-call lowering). -See [doc/41.1-STATUS.md](doc/41.1-STATUS.md) for the original 41.1 certification write-up (the 41.2 upgrade re-ran the same suite, 134/134). +See [doc/41.1-STATUS.md](doc/41.1-STATUS.md) for the original certification write-up. ## Benchmarks @@ -391,8 +391,8 @@ deterministic metric): |----------|-----:| | Kernel boot, cold (compile all `.kl`) | ~0.7 s | | Kernel boot, warm (bytecode cache) | **~0.03 s** | -| **Full 41.2 test suite, warm** (kernel + fasl caches) | **~2.3 s** | -| Full 41.2 test suite, cold (caches off) | ~5.4 s | +| **Full 42 test suite, warm** (kernel + fasl caches) | **~2.3 s** | +| Full 42 test suite, cold (caches off) | ~5.4 s | | Reference typecheck (431,741 inferences) | ~0.061 s (8.9× vs legacy engine) | | Typechecker allocation | ~24 B/inf (−93% vs legacy) | | Einstein's riddle (Prolog backtracking) | ~0.002 s / solve (22× vs legacy) | diff --git a/bench.lua b/bench.lua index 5ad32b0..20068ab 100644 --- a/bench.lua +++ b/bench.lua @@ -1,4 +1,4 @@ --- bench.lua : self-contained benchmark for the 41.2 port +-- bench.lua : self-contained benchmark for the 42 port -- Runs cold startup, then defines fib through the real Shen pipeline and -- measures fib(30), fib(32). Also runs Einstein's riddle through the live -- Prolog engine. @@ -68,7 +68,7 @@ local ffi = require("ffi") ffi.cdef[[ int chdir(const char *path); ]] -if ffi.C.chdir("../cl-source/ShenOSKernel-41.2/tests") == 0 then +if ffi.C.chdir("../cl-source/ShenOSKernel-42/tests") == 0 then -- run the test through Shen's load (which evaluates the file's top forms) bench("einstein-load", function() P.F["load"]("einsteins-riddle.shen") diff --git a/bench/alloc_attrib.lua b/bench/alloc_attrib.lua index 17e4e76..b94383b 100644 --- a/bench/alloc_attrib.lua +++ b/bench/alloc_attrib.lua @@ -7,7 +7,7 @@ local P = require("boot"); local R = require("runtime") P.load_kernel(false); P.initialise() local ffi = require("ffi"); ffi.cdef[[int chdir(const char*);]] -ffi.C.chdir("../cl-source/ShenOSKernel-41.2/tests") +ffi.C.chdir("../cl-source/ShenOSKernel-42/tests") local mf=P.F["shen.macros"] if mf and not P.GLOBALS["*macros*"] then P.GLOBALS["*macros*"]=R.cons(R.cons(R.cons(R.intern("shen.macros"),mf),R.NIL),R.NIL) end if P.GLOBALS["shen.*tc*"]~=nil and P.GLOBALS["*tc*"]==nil then P.GLOBALS["*tc*"]=P.GLOBALS["shen.*tc*"] end diff --git a/bench/callfreq.lua b/bench/callfreq.lua index 547bbcc..9a72370 100644 --- a/bench/callfreq.lua +++ b/bench/callfreq.lua @@ -1,5 +1,5 @@ -- bench/callfreq.lua — THROWAWAY profiler (Track 0.1). --- Wraps every F-table entry with a call counter, runs the full 41.2 suite, +-- Wraps every F-table entry with a call counter, runs the full 42 suite, -- and dumps the most-called functions. Used to find native-override targets. -- Run from the shen-lua dir: luajit bench/callfreq.lua 2>/tmp/callfreq.txt package.path = "./?.lua;" .. package.path @@ -11,7 +11,7 @@ P.initialise() local ffi = require("ffi") ffi.cdef[[int chdir(const char *path);]] -assert(ffi.C.chdir("../cl-source/ShenOSKernel-41.2/tests") == 0, "chdir failed") +assert(ffi.C.chdir("../cl-source/ShenOSKernel-42/tests") == 0, "chdir failed") -- kernel compat seeding (mirror run-kernel-tests.lua) do @@ -50,7 +50,7 @@ P.F["load"]("kerneltests.shen") local rows = {} for name, c in pairs(counts) do if c > 0 then rows[#rows+1] = {name, c} end end table.sort(rows, function(a,b) return a[2] > b[2] end) -io.stderr:write("\n=== CALL FREQUENCY (41.2 suite) ===\n") +io.stderr:write("\n=== CALL FREQUENCY (42 suite) ===\n") for i = 1, math.min(60, #rows) do io.stderr:write(string.format("%3d %-32s %12d\n", i, rows[i][1], rows[i][2])) end diff --git a/bench/evalstats.lua b/bench/evalstats.lua index 4fc227b..edec268 100644 --- a/bench/evalstats.lua +++ b/bench/evalstats.lua @@ -1,4 +1,4 @@ --- bench/evalstats.lua : measure runtime recompilation over the 41.2 suite. +-- bench/evalstats.lua : measure runtime recompilation over the 42 suite. -- Counts P.eval calls, compile_top/compile_expr_chunk invocations, duplicate -- form identities and duplicate generated sources, and total time inside eval. -- Run from the repo root: luajit bench/evalstats.lua diff --git a/bench/golden_typecheck.lua b/bench/golden_typecheck.lua index 0c77a64..3bd6693 100644 --- a/bench/golden_typecheck.lua +++ b/bench/golden_typecheck.lua @@ -27,8 +27,8 @@ ffi.cdef[[int chdir(const char*); char *getcwd(char*, size_t);]] local cwdbuf = ffi.new("char[4096]") assert(ffi.C.getcwd(cwdbuf, 4096) ~= nil) local ROOT = ffi.string(cwdbuf) -assert(ffi.C.chdir("../cl-source/ShenOSKernel-41.2/tests") == 0, - "tests dir not found (expected ../cl-source/ShenOSKernel-41.2/tests)") +assert(ffi.C.chdir("../cl-source/ShenOSKernel-42/tests") == 0, + "tests dir not found (expected ../cl-source/ShenOSKernel-42/tests)") -- same environment fixes typecheck_alloc.lua needs local mf = P.F["shen.macros"] diff --git a/bench/native_deref_ab.lua b/bench/native_deref_ab.lua index 6edcb25..2cd0fee 100644 --- a/bench/native_deref_ab.lua +++ b/bench/native_deref_ab.lua @@ -1,6 +1,6 @@ local P = require("boot"); local R = require("runtime") P.load_kernel(false); P.initialise() -local ffi=require("ffi"); ffi.cdef[[int chdir(const char*);]]; ffi.C.chdir("../cl-source/ShenOSKernel-41.2/tests") +local ffi=require("ffi"); ffi.cdef[[int chdir(const char*);]]; ffi.C.chdir("../cl-source/ShenOSKernel-42/tests") local mf=P.F["shen.macros"]; if mf and not P.GLOBALS["*macros*"] then P.GLOBALS["*macros*"]=R.cons(R.cons(R.cons(R.intern("shen.macros"),mf),R.NIL),R.NIL) end if P.GLOBALS["shen.*tc*"]~=nil and P.GLOBALS["*tc*"]==nil then P.GLOBALS["*tc*"]=P.GLOBALS["shen.*tc*"] end P.F["load"]("interpreter.shen") diff --git a/bench/typecheck_alloc.lua b/bench/typecheck_alloc.lua index f201e19..cb23d4d 100644 --- a/bench/typecheck_alloc.lua +++ b/bench/typecheck_alloc.lua @@ -1,7 +1,7 @@ local P = require("boot"); local R = require("runtime") P.load_kernel(false); P.initialise() local ffi = require("ffi"); ffi.cdef[[int chdir(const char*);]] -ffi.C.chdir("../cl-source/ShenOSKernel-41.2/tests") +ffi.C.chdir("../cl-source/ShenOSKernel-42/tests") local mf=P.F["shen.macros"] if mf and not P.GLOBALS["*macros*"] then P.GLOBALS["*macros*"]=R.cons(R.cons(R.cons(R.intern("shen.macros"),mf),R.NIL),R.NIL) end if P.GLOBALS["shen.*tc*"]~=nil and P.GLOBALS["*tc*"]==nil then P.GLOBALS["*tc*"]=P.GLOBALS["shen.*tc*"] end diff --git a/bench/typecheck_time.lua b/bench/typecheck_time.lua index 449a477..e706d95 100644 --- a/bench/typecheck_time.lua +++ b/bench/typecheck_time.lua @@ -1,7 +1,7 @@ local P = require("boot"); local R = require("runtime") P.load_kernel(false); P.initialise() local ffi = require("ffi"); ffi.cdef[[int chdir(const char*);]] -ffi.C.chdir("../cl-source/ShenOSKernel-41.2/tests") +ffi.C.chdir("../cl-source/ShenOSKernel-42/tests") local mf=P.F["shen.macros"] if mf and not P.GLOBALS["*macros*"] then P.GLOBALS["*macros*"]=R.cons(R.cons(R.cons(R.intern("shen.macros"),mf),R.NIL),R.NIL) end if P.GLOBALS["shen.*tc*"]~=nil and P.GLOBALS["*tc*"]==nil then P.GLOBALS["*tc*"]=P.GLOBALS["shen.*tc*"] end diff --git a/bench/wam_fingerprint.lua b/bench/wam_fingerprint.lua index 28b06ca..b01c1a8 100644 --- a/bench/wam_fingerprint.lua +++ b/bench/wam_fingerprint.lua @@ -19,7 +19,7 @@ package.path = "./?.lua;" .. package.path local P = require("boot"); local R = require("runtime") P.load_kernel(false); P.initialise() local ffi = require("ffi"); ffi.cdef[[int chdir(const char*);]] -ffi.C.chdir("../cl-source/ShenOSKernel-41.2/tests") +ffi.C.chdir("../cl-source/ShenOSKernel-42/tests") local mf=P.F["shen.macros"] if mf and not P.GLOBALS["*macros*"] then P.GLOBALS["*macros*"]=R.cons(R.cons(R.cons(R.intern("shen.macros"),mf),R.NIL),R.NIL) end if P.GLOBALS["shen.*tc*"]~=nil and P.GLOBALS["*tc*"]==nil then P.GLOBALS["*tc*"]=P.GLOBALS["shen.*tc*"] end diff --git a/bin/shen b/bin/shen index 3e3f44f..d8ef539 100755 --- a/bin/shen +++ b/bin/shen @@ -26,7 +26,7 @@ usage: shen [-q] [--hush-load] [-e EXPR | FILE] ... FILE (load) the file (full Shen syntax), then exit -e, --eval EXPR evaluate EXPR and print its value -q, --quiet (set *hush* true) — silence load echo and hushable output - (on the 41.2 kernel *hush* gates pr itself, so -q also + (on the 42 kernel *hush* gates pr itself, so -q also silences the program's own (output ...) lines) --hush-load silence only load's chatter — the per-form value/type echo and "run time"/"typechecked" banners; (output ...) diff --git a/bin/yggdrasil-build.lua b/bin/yggdrasil-build.lua index 70e1704..2882867 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-41.2 defuns in load order), the user +-- kernel (kernel.kl, ShenOSKernel-42 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 @@ -27,7 +27,7 @@ -- "lib boot" derived from boot.lua — -- 1. jit.opt mcode-area tuning (perf only, SHEN_JIT_OPT=off to skip), -- 2. *stinput*/*stoutput*/*sterror* stream setup + *home-directory*, --- 3. platform globals (*language* ... *release*) the 41.2 kernel reads, +-- 3. platform globals (*language* ... *release*) the 42 kernel reads, -- 4. run the compiled kernel chunks (the shaken defuns, in load order), -- 5. install the native overrides that REPLACE kernel KL functions -- (P.install_native_prolog + P.install_native_stdlib, after the @@ -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"] ~= "41.2" then - io.stderr:write(("yggdrasil-build: warning: manifest kernel-version=%s, this port is certified against 41.2\n") +if man["kernel-version"] ~= "42" then + io.stderr:write(("yggdrasil-build: warning: manifest kernel-version=%s, this port is certified against 42\n") :format(tostring(man["kernel-version"]))) end @@ -159,7 +159,7 @@ end -- Walk every form collecting names in call (head) position that are neither -- locally bound, port-provided (P.F / special forms), nor defined by a defun -- in the shaken output. Any such name found in the port's vendored certified --- 41.2 kernel (klambda/*.kl) is BACKFILLED into the kernel chunk — with a +-- 42 kernel (klambda/*.kl) is BACKFILLED into the kernel chunk — with a -- loud warning, because each backfill is a stage-1 shaker bug that should be -- fixed in yggdrasil.shen. Names found nowhere are warn-only (they may be -- guarded-dead, like shen.write-string behind shen.char-stoutput?). diff --git a/boot.lua b/boot.lua index ac524e5..eabad1d 100644 --- a/boot.lua +++ b/boot.lua @@ -1,6 +1,6 @@ -- 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 --- S41.2 2026-07-11 kernel the kernel self-initialises at load time; see FILES +-- S42 (2026-08-25) kernel self-initialises at load time; see FILES -- and initialise() below.) local R = require("runtime") local C = require("compiler") @@ -114,8 +114,8 @@ local function find_kldir() -- 2. Common external locations (useful when developing against a full -- ShenOSKernel checkout or the legacy shen-c reference implementation) local candidates = { - "../cl-source/ShenOSKernel-41.2/klambda", - "../ShenOSKernel-41.2/klambda", + "../cl-source/ShenOSKernel-42/klambda", + "../ShenOSKernel-42/klambda", -- legacy shen-c (22.4) clone for comparison / older certification "../shen-c/shen/src/kl", "../shen-c/klambda", @@ -153,7 +153,7 @@ local function find_kldir() end local KLDIR = find_kldir() .. "/" P.KLDIR = KLDIR -- resolved .kl directory (trailing /), for typecheck_native --- Boot order for the S41.2 (2026-07-11 refresh) kernel. The first 15 entries +-- 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 ...), @@ -201,13 +201,13 @@ P.GLOBALS["*sterror*"] = err_stream P.GLOBALS["*stinput*"] = in_stream P.GLOBALS["*home-directory*"] = "" --- ---- platform metadata (required by 41.2+ kernel) ------------------------- +-- ---- platform metadata (required by 42+ kernel) --------------------------- P.GLOBALS["*language*"] = "Lua" 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 ("41.2") +P.GLOBALS["*release*"] = "0.1" -- port release; kernel *version* comes from declarations.kl ("42") -- ---- kernel bytecode cache ------------------------------------------------- -- Loading the kernel from .kl sources costs ~0.8s (read + parse + KL->Lua @@ -439,7 +439,7 @@ local function read_cache(path, key) end -- ---- load the kernel ----------------------------------------------------- --- Loads the 19 .kl modules in FILES (see above): the 15 refreshed S41.2 +-- 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. @@ -525,7 +525,7 @@ local function is_declare_form(f) and R.is_cons(f[2]) and R.is_cons(f[2][2]) and f[2][2][2] == R.NIL end --- A declare's type argument is a KL EXPRESSION — in the 41.2 kernel always a +-- A declare's type argument is a KL EXPRESSION — in the 42 kernel always a -- pure rcons constructor tree, e.g. (cons number (cons --> (cons number ()))). -- Running the form inline evaluates it before `declare` sees it; a hoisted -- declare must do the same, or the signature registered in shen.*sigf* is over @@ -556,7 +556,7 @@ 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 41.2 kernel exactly two files have such a run: types.kl (161 declares) +-- 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))). -- Anything less tidy than [defuns...][inits...][declares...] is left inline. local function hoist_tail(forms) @@ -1018,7 +1018,7 @@ local function fasl_replay(cached) P.F["put"](r.name, R.intern("shen.lambda-form"), val, P.GLOBALS["*property-vector*"]) elseif r.k == "lt" then - -- 41.2 kernel path: (set shen.*lambdatable* ...) carries live curried + -- 42 kernel path: (set shen.*lambdatable* ...) carries live curried -- lambdas, so the recording stored only the NAMES whose entries the set -- added/replaced. Rebuild each entry from the live defun exactly the way -- shen.update-lambdatable does (shen.lambda-entry reads the arity @@ -1082,7 +1082,7 @@ end -- "typechecked in N inferences" banners — while user (output ...)/pr from the -- loaded forms still writes. That makes `bin/shen --hush-load FILE` output -- deterministic and cross-port comparable (only the program's own output), --- which -q cannot do: on the 41.2 kernel *hush* gates pr itself, so -q +-- which -q cannot do: on the 42 kernel *hush* gates pr itself, so -q -- silences the tests' (output ...) lines too. -- -- Mechanism: load's own chatter is pr'd to (stoutput) OUTSIDE any eval-kl @@ -1200,7 +1200,7 @@ local function install_fasl() -- fast-forward (max) covers it without hundreds of noise records if nm == "shen.*gensym*" then return nil end if nm == "shen.*lambdatable*" then - -- 41.2 kernel: shen.update-lambdatable / update-lambda-table set the + -- 42 kernel: shen.update-lambdatable / update-lambda-table set the -- whole assoc list, whose entries are (name . live-curried-lambda) — -- unserializable, and the reason every stdlib/user load used to be -- fasl-uncacheable. The recorder runs BEFORE the original set, so the @@ -1375,7 +1375,7 @@ end -- ---- initialise ---------------------------------------------------------- -- ---- standard library (S-lineage lib/StLib sources) ---------------------- --- Tarver's S41.2 refresh ships the standard library as Shen SOURCES under +-- 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 @@ -1608,7 +1608,7 @@ P.load_stdlib = load_stdlib local function initialise() -- Kernel environment setup (env globals, *property-vector*, arity table). -- - -- On the S41.2 (2026-07-11 refresh) kernel this all happens at LOAD time via + -- 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. -- @@ -1637,7 +1637,7 @@ local function initialise() 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 41.2 kernel. Seed its backing global + -- 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) diff --git a/build/make-bundle.lua b/build/make-bundle.lua index 577c31b..fb86cf8 100644 --- a/build/make-bundle.lua +++ b/build/make-bundle.lua @@ -70,7 +70,7 @@ do if nm then kl_names[#kl_names + 1] = nm end end p:close() - -- 19 vendored .kl: 15 refreshed S41.2 kernel modules + 4 extensions + -- 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 @@ -105,7 +105,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 41.2 on LuaJIT. require() it and go:\n") +emit("-- Shen kernel 42 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") diff --git a/compiler.lua b/compiler.lua index 6455dde..983219b 100644 --- a/compiler.lua +++ b/compiler.lua @@ -874,7 +874,7 @@ local function try_const(form, env) end -- General literal data hoisting for (cons ...) trees used as arguments --- (e.g. embedded source forms passed to shen.record-kl in 41.2 stlib, giant +-- (e.g. embedded source forms passed to shen.record-kl in 42 stlib, giant -- arity tables, etc.). A form is "literal data" only if it self-evaluates: -- atoms / unbound symbols / NIL, or a `(cons L R)` call whose subtrees are -- literal data. Crucially this MUST NOT match other calls like `(set ...)`, @@ -933,7 +933,7 @@ end -- A KLambda expression like `(cons A (cons B (cons (cons ...) ...)))` compiles -- naively into deeply-nested `F["cons"](_, F["cons"](_, F["cons"](_, _)))` -- expressions. Lua's parser refuses to compile expressions nested past about --- 200 levels, so the 41.2 stlib's giant `shen.record-kl ` +-- 200 levels, so the 42 stlib's giant `shen.record-kl ` -- calls (some have tree depth ~216 and ~7000 cons cells) blow up at load. -- -- The fix: emit deep cons-trees through a flat blueprint array consumed by @@ -1257,7 +1257,7 @@ function ctail(form, env) -- Always turn intermediate do values into a statement via IIFE. -- This is guaranteed valid Lua syntax for any expression (var, call, etc.) -- and introduces no new named locals in the enclosing function scope. - -- Critical for giant do-chains in 41.2 stlib.initialise-* and + -- Critical for giant do-chains in 42 stlib.initialise-* and -- shen.initialise-lambda-forms. s[#s+1] = "(function() return " .. es .. " end)();" end diff --git a/demo/walkthrough.md b/demo/walkthrough.md index a24c04c..d2ab589 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 41.2 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 Shen 42 kernel test suite and runs (slower) on plain Lua 5.1/5.4/5.5. ## 1. The language, through the launcher @@ -127,7 +127,7 @@ print(string.format(\"boot+initialise under 250ms: %s\", tostring(ms < 250)))" boot+initialise under 250ms: true ``` -## 7. Certification: the official 41.2 test suite, from this clone +## 7. Certification: the official 42 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: diff --git a/doc/41.1-STATUS.md b/doc/41.1-STATUS.md index 76cf210..b93aaed 100644 --- a/doc/41.1-STATUS.md +++ b/doc/41.1-STATUS.md @@ -1,26 +1,26 @@ -# Shen 41.1 Port Status for shen-lua +# Shen 42 Port Status for shen-lua -This document describes the current state of the Shen 41.1 port (targeting `ShenOSKernel-41.1/klambda`). +This document describes the current state of the Shen 42 port (targeting `ShenOSKernel-42/klambda`). ## What Works -- The full 41.1 KLambda kernel loads successfully: +- The full 42 KLambda kernel loads successfully: - All 21 `.kl` files (core + `stlib`, `compiler`, `extension-*`, etc.). - `shen.initialise` completes without fatal error. - - `version` reports `"41.1"`. + - `version` reports `"42"`. - Basic primitives function (`+`, `cons`, `load`, `eval-kl`, etc.). - Simple KLambda evaluation works via `run_kl_string` / `eval`. - Platform globals are set (`*language*`, `*implementation*`, `*port*`, `*porters*`, `*os*`, `*release*`). - `*macros*`, `shen.*tc*`, `*property-vector*`, `*version*`, and the rest of the globals initialised by `shen.initialise-environment` are populated correctly. -- The 41.1 KLambda sources (all 21 `.kl` files) are **vendored** under `klambda/` +- The 42 KLambda sources (all 21 `.kl` files) are **vendored** under `klambda/` so a normal `git clone` is sufficient. `SHEN_KL_DIR` can still override the location. - The full Shen test harness (`harness.shen`) loads, and `kerneltests.shen` runs end-to-end. **134 / 134 reports pass (100 % pass rate)** on the - current 41.1 suite; see Counts below. + current 42 suite; see Counts below. - Convenience test driver (`run-kernel-tests.lua`) reproduces the official run. -## Test results (Shen 41.1 official suite) +## Test results (Shen 42 official suite) ``` Total reports: 134 @@ -38,9 +38,9 @@ Workloads exercised by the suite include: - Typed mode (`tc +`) sections (lambda interpreter, structures, classes, proof assistant) -## Compiler changes required for 41.1 +## Compiler changes required for 42 -The 41.1 stlib and Prolog-compiled output stress LuaJIT's parser / VM limits +The 42 stlib and Prolog-compiled output stress LuaJIT's parser / VM limits much harder than the old 22.4 kernel did. Several new code-generation strategies were needed: @@ -77,7 +77,7 @@ strategies were needed: ## Last-mile fixes (5 → 0 failures) -Two additional bugs were resolved after the initial 41.1 bring-up: +Two additional bugs were resolved after the initial 42 bring-up: 8. **Let-float must skip binders.** `try_let_float` (`compiler.lua`) used to treat any cons whose head was an unbound symbol as an ordinary call, so @@ -113,7 +113,7 @@ luajit -e ' ' # To run the official suite (set SHEN_TESTS_DIR or place tests at -# ../cl-source/ShenOSKernel-41.1/tests): +# ../cl-source/ShenOSKernel-42/tests): luajit run-kernel-tests.lua # Microbenchmarks: @@ -124,7 +124,7 @@ You can still point at an external tree with `SHEN_KL_DIR=...` (useful when working against a full ShenOSKernel checkout or a legacy 22.4 reference). ## Version Notes -- This port targets **Shen 41.1** (March 2026 kernel). +- This port targets **Shen 42** (March 2026 kernel). - The old `port's 22.4-era certification predates this kernel. -- The 41.1 test suite lives in the official `shen-sources` repo under +- The 42 test suite lives in the official `shen-sources` repo under `tests/` (run via `(load "kerneltests.shen")` after loading the harness). diff --git a/doc/BENCHMARKS.md b/doc/BENCHMARKS.md index 50fd5b3..30166f4 100644 --- a/doc/BENCHMARKS.md +++ b/doc/BENCHMARKS.md @@ -1,24 +1,24 @@ -# shen-lua benchmarks (Shen 41.1) +# shen-lua benchmarks (Shen 42) -All numbers below are from the current 41.1 port running under +All numbers below are from the current 42 port running under **LuaJIT 2.1**. Host: Ubuntu 24.04 sandbox, 1 vCPU, x86_64. Times are CPU seconds (`os.clock()` / `(get-time run)`). The previous 22.4 results — which compared against the shen-c 0.2.3 reference interpreter on a different host — are preserved at the end of -this file for context. shen-c does not build for 41.1 and was not +this file for context. shen-c does not build for 42 and was not re-measured here, so the *primary* numbers below are absolute shen-lua-on-LuaJIT performance, not a head-to-head. --- -## 1. Cold startup (Shen 41.1) +## 1. Cold startup (Shen 42) | | mean of 5 runs | |---|---:| -| shen-lua (41.1) | **~0.58 s** (load 0.56 s + initialise 0.02 s) | +| shen-lua (42) | **~0.58 s** (load 0.56 s + initialise 0.02 s) | -The 41.1 kernel is substantially larger than 22.4 (21 `.kl` files including +The 42 kernel is substantially larger than 22.4 (21 `.kl` files including `stlib`, `compiler`, `extension-*`; 838 → ~2600 top-level forms after the new stlib). Boot reads, parses, and compiles every file to Lua on every launch — no on-disk cache yet. Cache of the generated Lua is an obvious @@ -33,7 +33,7 @@ next step (see §4). read, macro-expanded, and pattern-compiled by the kernel itself into a `cond` tree, which the backend turns into native Lua `if/elseif`). -| n | shen-lua (41.1) | +| n | shen-lua (42) | |---|---:| | 25 | 0.005 s | | 28 | 0.020 s | @@ -56,17 +56,17 @@ allocates a `freeze` thunk. | | per solve (best of 3) | |---|---:| -| shen-lua (41.1) | **~0.43 s** | +| shen-lua (42) | **~0.43 s** | For reference, the previous 22.4 port measured 1.82 s / solve here, with -shen-c at 1.24 s / solve. The 41.1 port is ~4× faster than the old 22.4 +shen-c at 1.24 s / solve. The 42 port is ~4× faster than the old 22.4 shen-lua on this workload, primarily because the new compiler emits the Prolog CPS chain flatly (see §5) instead of as deeply-nested closures, which lets LuaJIT trace through the continuations cleanly. --- -## 4. Pass rate (Shen 41.1 official suite) +## 4. Pass rate (Shen 42 official suite) ``` Total reports: 134 @@ -82,9 +82,9 @@ mode runs to completion. --- -## 5. Compiler improvements that paid for 41.1 +## 5. Compiler improvements that paid for 42 -The 41.1 stlib and Prolog code stress LuaJIT's parser limits much harder +The 42 stlib and Prolog code stress LuaJIT's parser limits much harder than 22.4 did. The following code-generation changes were added (see `compiler.lua` for details): @@ -106,7 +106,7 @@ than 22.4 did. The following code-generation changes were added (see `(set *macros* …)` and `(shen.record-kl …)` are always evaluated. Combined, these are what unblocked the full kernel boot and the Prolog -workloads on 41.1. +workloads on 42. --- @@ -139,7 +139,7 @@ luajit -e ' ' # Full official suite (set SHEN_TESTS_DIR or place the official tests at -# ../cl-source/ShenOSKernel-41.1/tests): +# ../cl-source/ShenOSKernel-42/tests): luajit run-kernel-tests.lua # fib + Einstein microbench: @@ -152,7 +152,7 @@ luajit bench.lua Preserved for context; these were measured against shen-c 0.2.3 (Shen 22.4) on a different host and a different (smaller) kernel. They are -NOT directly comparable to the 41.1 numbers above. +NOT directly comparable to the 42 numbers above. | | shen-c 22.4 | shen-lua 22.4 | |---|---:|---:| @@ -163,5 +163,5 @@ NOT directly comparable to the 41.1 numbers above. shen-lua 22.4 was ~50–60× faster than shen-c on `fib`, ~2.5× faster on n-queens, and ~1.5× slower on Einstein (a Prolog workload bound by -allocation and CPS closure churn). The 41.1 port now wins on Einstein +allocation and CPS closure churn). The 42 port now wins on Einstein too, largely because of the BIND / chain-flatten changes (§5). diff --git a/doc/PERF-URDR-RESULTS.md b/doc/PERF-URDR-RESULTS.md index 88acd79..99e7239 100644 --- a/doc/PERF-URDR-RESULTS.md +++ b/doc/PERF-URDR-RESULTS.md @@ -3,14 +3,14 @@ Branch: `perf/urdr-workload` Host: macOS arm64, LuaJIT 2.1 rolling (`/Users/reuben/.local/Homebrew/bin/luajit`) Pins: urdr suites under `shen/tests/{prng,world,search}`; shen-cl baseline -`urdr-shen-cl-41.2/bin/sbcl/shen script …`. +`urdr-shen-cl-42/bin/sbcl/shen script …`. Invocation (warm fasl; no `script` subcommand on shen-lua): ```bash export PATH="/Users/reuben/.local/Homebrew/bin:$PATH" export SHEN_LUA=/Users/reuben/projects/shen-lua/bin/shen -export SHEN_CL=/Users/reuben/projects/urdr-shen-cl-41.2/bin/sbcl/shen +export SHEN_CL=/Users/reuben/projects/urdr-shen-cl-42/bin/sbcl/shen cd /Users/reuben/projects/urdr /usr/bin/time -lp $SHEN_LUA shen/tests/prng/run-tests.shen /usr/bin/time -lp $SHEN_CL script shen/tests/prng/run-tests.shen @@ -189,7 +189,7 @@ installed, not work being redone. | `bin/shen -q run-tests.shen` | 0 | `-q` is empty — the reported blocker — and is kernel-faithful (*hush* gates -`pr` on 41.2), so it stays. `--hush-load` yields exactly the 71 lines the +`pr` on 42), so it stays. `--hush-load` yields exactly the 71 lines the suite itself prints, and the relationship to shen-cl is exact: `diff` turns shen-cl's 232 lines into shen-lua's 71 by **deletion only** (161 deletions, 0 insertions, 0 changes), i.e. shen-lua `--hush-load` stdout is byte-for-byte diff --git a/examples/hello_embed.lua b/examples/hello_embed.lua index 5de5f60..55bbc47 100644 --- a/examples/hello_embed.lua +++ b/examples/hello_embed.lua @@ -11,7 +11,7 @@ local shen = require("shen") shen.boot{quiet = true} -- warm boot is ~30 ms (bytecode cache) -- Define a Shen function at runtime, with the typechecker on --- (sum/length come from the 41.2 stlib). +-- (sum/length come from the 42 stlib). shen.eval([[ (tc +) (define mean diff --git a/klambda/PROVENANCE.md b/klambda/PROVENANCE.md index 6bbb075..d6cc4da 100644 --- a/klambda/PROVENANCE.md +++ b/klambda/PROVENANCE.md @@ -3,18 +3,18 @@ The vendored `klambda/` tree has **two lineages**. Read both sections — they come from different upstreams and are updated independently. -## 1. Kernel proper — S41.2 (2026-07-11 refresh) +## 1. Kernel proper — S42 (2026-08-25 refresh) -- **Canonical source**: `pyrex41/shen-s41.1` — the designated mirror of Mark +- **Canonical source**: `pyrex41/shen-upstream` — the designated mirror of Mark Tarver's shenlanguage.org uploads (private repo). - - Tag: `s41.2-pristine-20260711` - - Commit: `11fc51bdf53a4dcb505adeec6ec8352754cbe50f` - ("Pristine import of the 2026-07-11 S41.2 refresh from shenlanguage.org") -- **Upstream origin** (what the mirror imported): Mark Tarver's `S41.2.zip`, + - 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/S41.2.zip - - Last-Modified: 2026-07-11 - - Zip SHA-256: `51becbfd60fa8c93c3f8ae5b20b948eaa84c4b1d14ad2f5d2a056002a53ee836` + - 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 @@ -23,16 +23,11 @@ that tag — equivalently, to the zip's `KLambda/` directory (both verified with yacc core load prolog reader sequent sys t-star toplevel track types writer backend declarations macros -> **Caveat — the "41.2" version number was reused.** Upstream re-uploaded a -> *restructured* kernel under the same `41.2` version. This is a **different -> lineage** from the community `ShenOSKernel-41.2` -> (github.com/Shen-Language/shen-sources, tag `shen-41.2`, -> zip SHA-256 `49f1b85d02348d9b3ebc461570c5c56cc066270ab81e35d5257625fb9d17fe82`) -> that this file previously described. We call the current one -> **"S41.2 (2026-07-11 refresh)"** to disambiguate. `(version)` still reports -> `"41.2"` (it is set in `declarations.kl`). +> **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-41.2 we used to vendor +### 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 @@ -60,10 +55,10 @@ that tag — equivalently, to the zip's `KLambda/` directory (both verified with - 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-41.2 (retained); stdlib moved out +## 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-41.2`** release (zip SHA-256 +byte-identical from the community `ShenOSKernel-42`** release (zip SHA-256 `49f1b85d02348d9b3ebc461570c5c56cc066270ab81e35d5257625fb9d17fe82`) so the CLI launcher etc. stay available: diff --git a/klambda/README.md b/klambda/README.md index 260b29f..05dd66c 100644 --- a/klambda/README.md +++ b/klambda/README.md @@ -1,6 +1,6 @@ -# Vendored KLambda for Shen 41.2 +# Vendored KLambda for Shen 42 -These are the KLambda kernel sources for **Shen 41.2**. They are included +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. @@ -14,12 +14,12 @@ sources, checksums, and the full list of what the refresh added/removed. There are 19 `.kl` files. -**Kernel proper — S41.2 (2026-07-11 refresh), 15 files, byte-identical to -`shenlanguage.org/Download/S41.2.zip`:** +**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 -**Extensions — retained from community ShenOSKernel-41.2:** +**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) diff --git a/klambda/backend.kl b/klambda/backend.kl index ae3cddf..db98dc3 100644 --- a/klambda/backend.kl +++ b/klambda/backend.kl @@ -1,20 +1,20 @@ -(defun cl.kl-to-lisp (V5674) (cl.kl-to-lisp-h () V5674)) +(defun cl.kl-to-lisp (V5715) (cl.kl-to-lisp-h () V5715)) -(defun cl.kl-to-lisp-h (V5682 V5683) (cond ((= T (MEMBER V5683 V5682)) V5683) ((and (cons? V5683) (and (= type (hd V5683)) (and (cons? (tl V5683)) (and (cons? (tl (tl V5683))) (= () (tl (tl (tl V5683)))))))) (cl.kl-to-lisp-h V5682 (hd (tl V5683)))) ((and (cons? V5683) (and (= protect (hd V5683)) (and (cons? (tl V5683)) (= () (tl (tl V5683)))))) (cl.kl-to-lisp-h V5682 (hd (tl V5683)))) ((and (cons? V5683) (and (= lambda (hd V5683)) (and (cons? (tl V5683)) (and (cons? (tl (tl V5683))) (and (= () (tl (tl (tl V5683)))) (= (hd (tl V5683)) T)))))) (cl.kl-to-lisp-h V5682 (cl.rectify-t V5683))) ((and (cons? V5683) (and (= lambda (hd V5683)) (and (cons? (tl V5683)) (and (cons? (tl (tl V5683))) (= () (tl (tl (tl V5683)))))))) (cons FUNCTION (cons (cons LAMBDA (cons (cons (hd (tl V5683)) ()) (cons (cl.kl-to-lisp-h (cons (hd (tl V5683)) V5682) (hd (tl (tl V5683)))) ()))) ()))) ((and (cons? V5683) (and (= let (hd V5683)) (and (cons? (tl V5683)) (and (cons? (tl (tl V5683))) (and (cons? (tl (tl (tl V5683)))) (and (= () (tl (tl (tl (tl V5683))))) (= (hd (tl V5683)) T))))))) (cl.kl-to-lisp-h V5682 (cl.rectify-t V5683))) ((and (cons? V5683) (and (= let (hd V5683)) (and (cons? (tl V5683)) (and (cons? (tl (tl V5683))) (and (cons? (tl (tl (tl V5683)))) (= () (tl (tl (tl (tl V5683)))))))))) (cons LET (cons (cons (cons (hd (tl V5683)) (cons (cl.kl-to-lisp-h V5682 (hd (tl (tl V5683)))) ())) ()) (cons (cl.kl-to-lisp-h (cons (hd (tl V5683)) V5682) (hd (tl (tl (tl V5683))))) ())))) ((and (cons? V5683) (and (= defun (hd V5683)) (and (cons? (tl V5683)) (and (cons? (tl (tl V5683))) (and (cons? (tl (tl (tl V5683)))) (= () (tl (tl (tl (tl V5683)))))))))) (cons DEFUN (cons (hd (tl V5683)) (cons (hd (tl (tl V5683))) (cons (cl.kl-to-lisp-h (hd (tl (tl V5683))) (hd (tl (tl (tl V5683))))) ()))))) ((and (cons? V5683) (= cond (hd V5683))) (cons COND (CL.MAPCAR (lambda Z5684 (cl.cond-code V5682 Z5684)) (tl V5683)))) ((and (cons? V5683) (or (= T (MEMBER (hd V5683) V5682)) (cons? (hd V5683)))) (let W5685 (CL.MAPCAR (lambda Z5686 (cl.kl-to-lisp-h V5682 Z5686)) V5683) (cl.currylisp W5685))) ((and (cons? V5683) (cl.fastsymbol? (hd V5683))) (let W5687 (CL.MAPCAR (lambda Z5688 (cl.kl-to-lisp-h V5682 Z5688)) (tl V5683)) (let W5689 (cl.maplispsym (hd V5683)) (cl.optimise-application (cons W5689 W5687))))) ((or (number? V5683) (or (string? V5683) (empty? V5683))) V5683) (true (cons QUOTE (cons V5683 ()))))) +(defun cl.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 (V5690) (SUBST (GENSYM "x") T V5690)) +(defun cl.rectify-t (V5731) (SUBST (GENSYM "x") T V5731)) -(defun cl.currylisp (V5691) (cond ((and (cons? V5691) (and (cons? (tl V5691)) (cons? (tl (tl V5691))))) (cl.currylisp (cons (cons FUNCALL (cons (hd V5691) (cons (hd (tl V5691)) ()))) (tl (tl V5691))))) ((and (cons? V5691) (and (cons? (tl V5691)) (= () (tl (tl V5691))))) (cons FUNCALL V5691)) ((and (cons? V5691) (= () (tl V5691))) (cons FUNCALL V5691)) (true V5691))) +(defun cl.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 (V5692) (cond ((and (cons? V5692) (and (= protect (hd V5692)) (and (cons? (tl V5692)) (= () (tl (tl V5692)))))) (cl.optimise-application (hd (tl V5692)))) ((and (cons? V5692) (and (= hd (hd V5692)) (and (cons? (tl V5692)) (= () (tl (tl V5692)))))) (cons CAR (cons (cl.optimise-application (hd (tl V5692))) ()))) ((and (cons? V5692) (and (= tl (hd V5692)) (and (cons? (tl V5692)) (= () (tl (tl V5692)))))) (cons CDR (cons (cl.optimise-application (hd (tl V5692))) ()))) ((and (cons? V5692) (and (= cons (hd V5692)) (and (cons? (tl V5692)) (and (cons? (tl (tl V5692))) (= () (tl (tl (tl V5692)))))))) (cons CONS (cons (cl.optimise-application (hd (tl V5692))) (cons (cl.optimise-application (hd (tl (tl V5692)))) ())))) ((and (cons? V5692) (and (= append (hd V5692)) (and (cons? (tl V5692)) (and (cons? (tl (tl V5692))) (= () (tl (tl (tl V5692)))))))) (cons APPEND (cons (cl.optimise-application (hd (tl V5692))) (cons (cl.optimise-application (hd (tl (tl V5692)))) ())))) ((and (cons? V5692) (and (= reverse (hd V5692)) (and (cons? (tl V5692)) (= () (tl (tl V5692)))))) (cons REVERSE (cons (cl.optimise-application (hd (tl V5692))) ()))) ((and (cons? V5692) (and (= length (hd V5692)) (and (cons? (tl V5692)) (= () (tl (tl V5692)))))) (cons CL.LIST-LENGTH (cons (cl.optimise-application (hd (tl V5692))) ()))) ((and (cons? V5692) (and (= if (hd V5692)) (and (cons? (tl V5692)) (and (cons? (tl (tl V5692))) (and (cons? (tl (tl (tl V5692)))) (= () (tl (tl (tl (tl V5692)))))))))) (cons IF (cons (cl.wrap (hd (tl V5692))) (cons (cl.optimise-application (hd (tl (tl V5692)))) (cons (cl.optimise-application (hd (tl (tl (tl V5692))))) ()))))) ((and (cons? V5692) (and (= value (hd V5692)) (and (cons? (tl V5692)) (and (cons? (hd (tl V5692))) (and (cons? (tl (hd (tl V5692)))) (and (= () (tl (tl (hd (tl V5692))))) (and (= () (tl (tl V5692))) (= (hd (hd (tl V5692))) QUOTE)))))))) (hd (tl (hd (tl V5692))))) ((and (cons? V5692) (and (= map (hd V5692)) (and (cons? (tl V5692)) (and (cons? (tl (tl V5692))) (= () (tl (tl (tl V5692)))))))) (cons CL.MAPCAR (tl V5692))) ((and (cons? V5692) (and (= + (hd V5692)) (and (cons? (tl V5692)) (and (= 1 (hd (tl V5692))) (and (cons? (tl (tl V5692))) (= () (tl (tl (tl V5692))))))))) (cons (intern "1+") (cons (cl.optimise-application (hd (tl (tl V5692)))) ()))) ((and (cons? V5692) (and (= + (hd V5692)) (and (cons? (tl V5692)) (and (cons? (tl (tl V5692))) (and (= 1 (hd (tl (tl V5692)))) (= () (tl (tl (tl V5692))))))))) (cons (intern "1+") (cons (cl.optimise-application (hd (tl V5692))) ()))) ((and (cons? V5692) (and (= - (hd V5692)) (and (cons? (tl V5692)) (and (cons? (tl (tl V5692))) (and (= 1 (hd (tl (tl V5692)))) (= () (tl (tl (tl V5692))))))))) (cons (intern "1-") (cons (cl.optimise-application (hd (tl V5692))) ()))) ((cons? V5692) (CL.MAPCAR (lambda Z5693 (cl.optimise-application Z5693)) V5692)) (true V5692))) +(defun cl.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 (V5698 V5699) (cond ((and (cons? V5699) (and (cons? (tl V5699)) (= () (tl (tl V5699))))) (let W5700 (cl.wrap (cl.kl-to-lisp-h V5698 (hd V5699))) (let W5701 (cl.kl-to-lisp-h V5698 (hd (tl V5699))) (cons W5700 (cons W5701 ()))))) (true (simple-error "implementation error in shen.cond-code")))) +(defun cl.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 (V5702) (cond ((and (cons? V5702) (and (cons? (tl V5702)) (and (= true (hd (tl V5702))) (and (= () (tl (tl V5702))) (= (hd V5702) QUOTE))))) T) ((and (cons? V5702) (and (= cons? (hd V5702)) (and (cons? (tl V5702)) (= () (tl (tl V5702)))))) (cons CONSP (tl V5702))) ((and (cons? V5702) (and (= string? (hd V5702)) (and (cons? (tl V5702)) (= () (tl (tl V5702)))))) (cons STRINGP (tl V5702))) ((and (cons? V5702) (and (= number? (hd V5702)) (and (cons? (tl V5702)) (= () (tl (tl V5702)))))) (cons NUMBERP (tl V5702))) ((and (cons? V5702) (and (= empty? (hd V5702)) (and (cons? (tl V5702)) (= () (tl (tl V5702)))))) (cons NULL (tl V5702))) ((and (cons? V5702) (and (= and (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (= () (tl (tl (tl V5702)))))))) (cons AND (cons (cl.wrap (hd (tl V5702))) (cons (cl.wrap (hd (tl (tl V5702)))) ())))) ((and (cons? V5702) (and (= or (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (= () (tl (tl (tl V5702)))))))) (cons OR (cons (cl.wrap (hd (tl V5702))) (cons (cl.wrap (hd (tl (tl V5702)))) ())))) ((and (cons? V5702) (and (= not (hd V5702)) (and (cons? (tl V5702)) (= () (tl (tl V5702)))))) (cons NOT (cons (cl.wrap (hd (tl V5702))) ()))) ((and (cons? V5702) (and (= cl.equal? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (and (= () (hd (tl (tl V5702)))) (= () (tl (tl (tl V5702))))))))) (cons NULL (cons (hd (tl V5702)) ()))) ((and (cons? V5702) (and (= cl.equal? (hd V5702)) (and (cons? (tl V5702)) (and (= () (hd (tl V5702))) (and (cons? (tl (tl V5702))) (= () (tl (tl (tl V5702))))))))) (cons NULL (tl (tl V5702)))) ((and (cons? V5702) (and (= cl.equal? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (and (cons? (hd (tl (tl V5702)))) (and (cons? (tl (hd (tl (tl V5702))))) (and (= () (tl (tl (hd (tl (tl V5702)))))) (and (= () (tl (tl (tl V5702)))) (and (= (hd (hd (tl (tl V5702)))) QUOTE) (cl.fastsymbol? (hd (tl (hd (tl (tl V5702))))))))))))))) (cons EQ (tl V5702))) ((and (cons? V5702) (and (= cl.equal? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (hd (tl V5702))) (and (cons? (tl (hd (tl V5702)))) (and (= () (tl (tl (hd (tl V5702))))) (and (cons? (tl (tl V5702))) (and (= () (tl (tl (tl V5702)))) (and (= (hd (hd (tl V5702))) QUOTE) (cl.fastsymbol? (hd (tl (hd (tl V5702)))))))))))))) (cons EQ (tl V5702))) ((and (cons? V5702) (and (= cl.equal? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (hd (tl V5702))) (and (= fail (hd (hd (tl V5702)))) (and (= () (tl (hd (tl V5702)))) (and (cons? (tl (tl V5702))) (= () (tl (tl (tl V5702))))))))))) (cons EQ (tl V5702))) ((and (cons? V5702) (and (= cl.equal? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (and (cons? (hd (tl (tl V5702)))) (and (= fail (hd (hd (tl (tl V5702))))) (and (= () (tl (hd (tl (tl V5702))))) (= () (tl (tl (tl V5702))))))))))) (cons EQ (tl V5702))) ((and (cons? V5702) (and (= cl.equal? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (and (= () (tl (tl (tl V5702)))) (string? (hd (tl V5702)))))))) (cons EQUAL (tl V5702))) ((and (cons? V5702) (and (= cl.equal? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (and (= () (tl (tl (tl V5702)))) (string? (hd (tl (tl V5702))))))))) (cons EQUAL (tl V5702))) ((and (cons? V5702) (and (= cl.equal? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (and (= () (tl (tl (tl V5702)))) (number? (hd (tl V5702)))))))) (cons EQUALP (tl V5702))) ((and (cons? V5702) (and (= cl.equal? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (and (= () (tl (tl (tl V5702)))) (number? (hd (tl (tl V5702))))))))) (cons EQUALP (tl V5702))) ((and (cons? V5702) (and (= cl.equal? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (= () (tl (tl (tl V5702)))))))) (cons cl.ABSEQUAL (tl V5702))) ((and (cons? V5702) (and (= cl.greater? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (= () (tl (tl (tl V5702)))))))) (cons > (tl V5702))) ((and (cons? V5702) (and (= cl.greater-than-or-equal-to? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (= () (tl (tl (tl V5702)))))))) (cons >= (tl V5702))) ((and (cons? V5702) (and (= cl.less? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (= () (tl (tl (tl V5702)))))))) (cons < (tl V5702))) ((and (cons? V5702) (and (= cl.less-than-or-equal-to? (hd V5702)) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (= () (tl (tl (tl V5702)))))))) (cons <= (tl V5702))) (true (cons cl.wrapper (cons V5702 ()))))) +(defun cl.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? (V5709) (cond ((cons? V5709) false) ((= () V5709) false) ((string? V5709) false) ((number? V5709) false) (true true))) +(defun cl.fastsymbol? (V5750) (cond ((cons? V5750) false) ((= () V5750) false) ((string? V5750) false) ((number? V5750) false) (true true))) -(defun cl.wrapper (V5710) (cond ((= true V5710) T) ((= false V5710) ()) (true (simple-error "boolean expected")))) +(defun cl.wrapper (V5751) (cond ((= true V5751) T) ((= false V5751) ()) (true (simple-error "boolean expected")))) -(defun cl.maplispsym (V5711) (cond ((= = V5711) cl.equal?) ((= > V5711) cl.greater?) ((= < V5711) cl.less?) ((= >= V5711) cl.greater-than-or-equal-to?) ((= <= V5711) cl.less-than-or-equal-to?) ((= + V5711) cl.add) ((= - V5711) cl.subtract) ((= / V5711) cl.divide) ((= * V5711) cl.multiply) (true V5711))) +(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 da44a84..ac4b06c 100644 --- a/klambda/core.kl +++ b/klambda/core.kl @@ -1,121 +1,127 @@ -(defun shen.shen->kl (V521) (let W522 (shen.shen->kl-h V521) (shen.record-and-evaluate W522))) +(defun shen.shen->kl (V528) (let W529 (shen.shen->kl-h V528) (shen.record-and-evaluate W529))) -(defun shen.record-and-evaluate (V523) (cond ((and (cons? V523) (and (= defun (hd V523)) (and (cons? (tl V523)) (and (cons? (tl (tl V523))) (and (cons? (tl (tl (tl V523)))) (= () (tl (tl (tl (tl V523)))))))))) (let W524 (if (shen.sysfunc? (hd (tl V523))) (simple-error (shen.app (hd (tl V523)) " is not a legitimate function name -" shen.a)) shen.skip) (let W525 (shen.store-arity (hd (tl V523)) (length (hd (tl (tl V523))))) (let W526 (shen.record-kl (hd (tl V523)) V523) (let W527 (eval-kl V523) (shen.fn-print (hd (tl V523)))))))) (true V523))) +(defun shen.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.shen->kl-h (V528) (cond ((and (cons? V528) (and (= define (hd V528)) (cons? (tl V528)))) (shen.shendef->kldef (hd (tl V528)) (tl (tl V528)))) ((and (cons? V528) (and (= defun (hd V528)) (and (cons? (tl V528)) (and (cons? (tl (tl V528))) (and (cons? (tl (tl (tl V528)))) (= () (tl (tl (tl (tl V528)))))))))) V528) ((and (cons? V528) (and (= type (hd V528)) (and (cons? (tl V528)) (and (cons? (tl (tl V528))) (= () (tl (tl (tl V528)))))))) (cons type (cons (hd (tl V528)) (cons (shen.rcons_form (hd (tl (tl V528)))) ())))) ((and (cons? V528) (and (= input+ (hd V528)) (and (cons? (tl V528)) (and (cons? (tl (tl V528))) (= () (tl (tl (tl V528)))))))) (cons input+ (cons (shen.rcons_form (hd (tl V528))) (tl (tl V528))))) ((cons? V528) (map (lambda Z529 (shen.shen->kl-h Z529)) V528)) (true V528))) +(defun shen.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.shendef->kldef (V530 V531) (compile (lambda Z532 (shen. Z532)) (cons V530 V531))) +(defun shen.shendef->kldef (V537 V538) (compile (lambda Z539 (shen. Z539)) (cons V537 V538))) -(defun shen. (V533) (let W534 (let W535 (shen. V533) (if (shen.parse-failure? W535) (shen.parse-failure) (let W536 (shen.<-out W535) (let W537 (shen.in-> W535) (if (shen.hds=? W537 {) (let W538 (tail W537) (let W539 (shen. W538) (if (shen.parse-failure? W539) (shen.parse-failure) (let W540 (shen.in-> W539) (if (shen.hds=? W540 }) (let W541 (tail W540) (let W542 (shen. W541) (if (shen.parse-failure? W542) (shen.parse-failure) (let W543 (shen.<-out W542) (let W544 (shen.in-> W542) (shen.comb W544 (shen.shendef->kldef-h W536 W543))))))) (shen.parse-failure)))))) (shen.parse-failure)))))) (if (shen.parse-failure? W534) (let W545 (let W546 (shen. V533) (if (shen.parse-failure? W546) (shen.parse-failure) (let W547 (shen.<-out W546) (let W548 (shen.in-> W546) (let W549 (shen. W548) (if (shen.parse-failure? W549) (shen.parse-failure) (let W550 (shen.<-out W549) (let W551 (shen.in-> W549) (shen.comb W551 (shen.shendef->kldef-h W547 W550)))))))))) (if (shen.parse-failure? W545) (shen.parse-failure) W545)) W534))) +(defun shen. (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.shendef->kldef-h (V552 V553) (let W554 (map (lambda Z555 (fst Z555)) V553) (let W556 (shen.arity-chk V552 W554) (let W557 (map (lambda Z558 (shen.free-var-chk V552 Z558)) V553) (let W559 (shen.unprotect V553) (let W560 (shen.factorise-code (shen.compile-to-kl V552 W559 W556)) W560)))))) +(defun shen.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.unprotect (V561) (cond ((tuple? V561) (@p (shen.unprotect (fst V561)) (shen.unprotect (snd V561)))) ((and (cons? V561) (and (= protect (hd V561)) (and (cons? (tl V561)) (= () (tl (tl V561)))))) (shen.unprotect (hd (tl V561)))) ((cons? V561) (map (lambda Z562 (shen.unprotect Z562)) V561)) (true V561))) +(defun shen.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. (V563) (let W564 (if (cons? V563) (let W565 (head V563) (let W566 (tail V563) (shen.comb W566 (if (and (symbol? W565) (not (variable? W565))) W565 (simple-error (shen.app W565 " is not a legitimate function name. -" shen.a)))))) (shen.parse-failure)) (if (shen.parse-failure? W564) (shen.parse-failure) W564))) +(defun shen. (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. (V567) (let W568 (if (cons? V567) (let W569 (head V567) (let W570 (tail V567) (let W571 (shen. W570) (if (shen.parse-failure? W571) (shen.parse-failure) (let W572 (shen.<-out W571) (let W573 (shen.in-> W571) (if (not (element? W569 (cons { (cons } ())))) (shen.comb W573 (cons W569 W572)) (shen.parse-failure)))))))) (shen.parse-failure)) (if (shen.parse-failure? W568) (let W574 (let W575 ( V567) (if (shen.parse-failure? W575) (shen.parse-failure) (let W576 (shen.in-> W575) (shen.comb W576 ())))) (if (shen.parse-failure? W574) (shen.parse-failure) W574)) W568))) +(defun shen. (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. (V577) (let W578 (let W579 (shen. V577) (if (shen.parse-failure? W579) (shen.parse-failure) (let W580 (shen.<-out W579) (let W581 (shen.in-> W579) (let W582 (shen. W581) (if (shen.parse-failure? W582) (shen.parse-failure) (let W583 (shen.<-out W582) (let W584 (shen.in-> W582) (shen.comb W584 (cons (shen.linearise W580) W583)))))))))) (if (shen.parse-failure? W578) (let W585 (let W586 ( V577) (if (shen.parse-failure? W586) (shen.parse-failure) (let W587 (shen.<-out W586) (let W588 (shen.in-> W586) (shen.comb W588 (if (empty? W587) () (simple-error (cn "Shen syntax error here: - " (shen.app W587 " - ..." shen.r))))))))) (if (shen.parse-failure? W585) (shen.parse-failure) W585)) W578))) +(defun shen. (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.linearise (V591) (cond ((tuple? V591) (shen.linearise-h (fst V591) (fst V591) () (snd V591))) (true (simple-error "implementation error in shen.linearise")))) +(defun shen.linearise (V598) (cond ((tuple? V598) (shen.linearise-h (fst V598) (fst V598) () (snd V598))) (true (simple-error "implementation error in shen.linearise")))) -(defun shen.linearise-h (V604 V605 V606 V607) (cond ((= () V604) (@p V605 V607)) ((and (cons? V604) (cons? (hd V604))) (shen.linearise-h (append (hd V604) (tl V604)) V605 V606 V607)) ((and (cons? V604) (variable? (hd V604))) (if (element? (hd V604) V606) (let W608 (gensym V) (shen.linearise-h (tl V604) (shen.rep-X (hd V604) W608 V605) V606 (cons where (cons (cons = (cons W608 (cons (hd V604) ()))) (cons V607 ()))))) (shen.linearise-h (tl V604) V605 (cons (hd V604) V606) V607))) ((cons? V604) (shen.linearise-h (tl V604) V605 V606 V607)) (true (simple-error "implementation error in shen.linearise-h")))) +(defun shen.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. (V609) (let W610 (let W611 (shen. V609) (if (shen.parse-failure? W611) (shen.parse-failure) (let W612 (shen.<-out W611) (let W613 (shen.in-> W611) (if (shen.hds=? W613 ->) (let W614 (tail W613) (if (cons? W614) (let W615 (head W614) (let W616 (tail W614) (if (shen.hds=? W616 where) (let W617 (tail W616) (if (cons? W617) (let W618 (head W617) (let W619 (tail W617) (shen.comb W619 (@p W612 (cons where (cons W618 (cons W615 ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W610) (let W620 (let W621 (shen. V609) (if (shen.parse-failure? W621) (shen.parse-failure) (let W622 (shen.<-out W621) (let W623 (shen.in-> W621) (if (shen.hds=? W623 ->) (let W624 (tail W623) (if (cons? W624) (let W625 (head W624) (let W626 (tail W624) (shen.comb W626 (@p W622 W625)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W620) (let W627 (let W628 (shen. V609) (if (shen.parse-failure? W628) (shen.parse-failure) (let W629 (shen.<-out W628) (let W630 (shen.in-> W628) (if (shen.hds=? W630 <-) (let W631 (tail W630) (if (cons? W631) (let W632 (head W631) (let W633 (tail W631) (if (shen.hds=? W633 where) (let W634 (tail W633) (if (cons? W634) (let W635 (head W634) (let W636 (tail W634) (shen.comb W636 (@p W629 (cons where (cons W635 (cons (cons shen.choicepoint! (cons W632 ())) ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W627) (let W637 (let W638 (shen. V609) (if (shen.parse-failure? W638) (shen.parse-failure) (let W639 (shen.<-out W638) (let W640 (shen.in-> W638) (if (shen.hds=? W640 <-) (let W641 (tail W640) (if (cons? W641) (let W642 (head W641) (let W643 (tail W641) (shen.comb W643 (@p W639 (cons shen.choicepoint! (cons W642 ())))))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W637) (shen.parse-failure) W637)) W627)) W620)) W610))) +(defun shen. (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. (V644) (let W645 (let W646 (shen. V644) (if (shen.parse-failure? W646) (shen.parse-failure) (let W647 (shen.<-out W646) (let W648 (shen.in-> W646) (let W649 (shen. W648) (if (shen.parse-failure? W649) (shen.parse-failure) (let W650 (shen.<-out W649) (let W651 (shen.in-> W649) (shen.comb W651 (cons W647 W650)))))))))) (if (shen.parse-failure? W645) (let W652 (let W653 ( V644) (if (shen.parse-failure? W653) (shen.parse-failure) (let W654 (shen.in-> W653) (shen.comb W654 ())))) (if (shen.parse-failure? W652) (shen.parse-failure) W652)) W645))) +(defun shen. (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. (V655) (let W656 (if (shen.ccons? V655) (let W657 (head V655) (let W658 (tail V655) (let W659 (shen. W657) (if (shen.parse-failure? W659) (shen.parse-failure) (let W660 (shen.<-out W659) (let W661 (shen.in-> W659) (let W662 (shen. W661) (if (shen.parse-failure? W662) (shen.parse-failure) (let W663 (shen.<-out W662) (let W664 (shen.in-> W662) (let W665 (shen. W664) (if (shen.parse-failure? W665) (shen.parse-failure) (let W666 (shen.<-out W665) (let W667 (shen.in-> W665) (let W668 ( W667) (if (shen.parse-failure? W668) (shen.parse-failure) (let W669 (shen.in-> W668) (shen.comb W658 (cons W660 (cons W663 (cons W666 ()))))))))))))))))))))) (shen.parse-failure)) (if (shen.parse-failure? W656) (let W670 (if (shen.ccons? V655) (let W671 (head V655) (let W672 (tail V655) (if (shen.hds=? W671 vector) (let W673 (tail W671) (if (shen.hds=? W673 0) (let W674 (tail W673) (let W675 ( W674) (if (shen.parse-failure? W675) (shen.parse-failure) (let W676 (shen.in-> W675) (shen.comb W672 (cons vector (cons 0 ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W670) (let W677 (if (cons? V655) (let W678 (head V655) (let W679 (tail V655) (if (cons? W678) (shen.comb W679 (shen.constructor-error W678)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W677) (let W680 (let W681 (shen. V655) (if (shen.parse-failure? W681) (shen.parse-failure) (let W682 (shen.<-out W681) (let W683 (shen.in-> W681) (shen.comb W683 W682))))) (if (shen.parse-failure? W680) (shen.parse-failure) W680)) W677)) W670)) W656))) +(defun shen. (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. (V684) (let W685 (if (cons? V684) (let W686 (head V684) (let W687 (tail V684) (if (shen.constructor? W686) (shen.comb W687 W686) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W685) (shen.parse-failure) W685))) +(defun shen. (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.constructor? (V688) (element? V688 (cons cons (cons @p (cons @s (cons @v ())))))) +(defun shen.constructor? (V695) (element? V695 (cons cons (cons @p (cons @s (cons @v ())))))) -(defun shen.constructor-error (V689) (simple-error (shen.app V689 " is not a legitimate constructor +(defun shen.constructor-error (V696) (simple-error (shen.app V696 " is not a legitimate constructor " shen.r))) -(defun shen. (V690) (let W691 (if (cons? V690) (let W692 (head V690) (let W693 (tail V690) (if (= W692 _) (shen.comb W693 (gensym Y)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W691) (let W694 (if (cons? V690) (let W695 (head V690) (let W696 (tail V690) (if (not (element? W695 (cons -> (cons <- ())))) (shen.comb W696 W695) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W694) (shen.parse-failure) W694)) W691))) +(defun shen. (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. (V697) (let W698 (let W699 (shen. V697) (if (shen.parse-failure? W699) (shen.parse-failure) (let W700 (shen.<-out W699) (let W701 (shen.in-> W699) (shen.comb W701 W700))))) (if (shen.parse-failure? W698) (shen.parse-failure) W698))) +(defun shen. (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. (V702) (let W703 (let W704 (shen. V702) (if (shen.parse-failure? W704) (shen.parse-failure) (let W705 (shen.<-out W704) (let W706 (shen.in-> W704) (shen.comb W706 W705))))) (if (shen.parse-failure? W703) (shen.parse-failure) W703))) +(defun shen. (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.fn-print (V707) (let W708 (absvector 2) (let W709 (address-> W708 0 shen.printF) (let W710 (address-> W709 1 (@s "(" (@s "f" (@s "n" (@s " " (@s (str V707) ")")))))) W710)))) +(defun shen.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.printF (V711) (<-address V711 1)) +(defun shen.printF (V718) (<-address V718 1)) -(defun shen.arity-chk (V716 V717) (cond ((and (cons? V717) (= () (tl V717))) (length (hd V717))) ((and (cons? V717) (and (cons? (tl V717)) (= (length (hd V717)) (length (hd (tl V717)))))) (shen.arity-chk V716 (tl V717))) (true (simple-error (cn "arity error in " (shen.app V716 " +(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 " " shen.a)))))) -(defun shen.free-var-chk (V718 V719) (cond ((tuple? V719) (shen.free-variable-error-message V718 (shen.find-free-vars (shen.extract-vars (fst V719)) (snd V719)))) (true (simple-error "partial function shen.free-var-chk")))) +(defun shen.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-variable-error-message (V720 V721) (if (empty? V721) shen.skip (do (pr (cn "free variables in " (shen.app V720 ":" shen.a)) (stoutput)) (do (map (lambda Z722 (pr (cn " " (shen.app Z722 "" shen.a)) (stoutput))) V721) (do (nl 1) (abort)))))) +(defun shen.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 (V725) (cond ((variable? V725) (cons V725 ())) ((cons? V725) (union (shen.extract-vars (hd V725)) (shen.extract-vars (tl V725)))) (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 (V730 V731) (cond ((and (cons? V731) (and (= protect (hd V731)) (and (cons? (tl V731)) (= () (tl (tl V731)))))) ()) ((and (cons? V731) (and (= let (hd V731)) (and (cons? (tl V731)) (and (cons? (tl (tl V731))) (and (cons? (tl (tl (tl V731)))) (= () (tl (tl (tl (tl V731)))))))))) (union (shen.find-free-vars V730 (hd (tl (tl V731)))) (shen.find-free-vars (cons (hd (tl V731)) V730) (hd (tl (tl (tl V731))))))) ((and (cons? V731) (and (= lambda (hd V731)) (and (cons? (tl V731)) (and (cons? (tl (tl V731))) (= () (tl (tl (tl V731)))))))) (shen.find-free-vars (cons (hd (tl V731)) V730) (hd (tl (tl V731))))) ((cons? V731) (union (shen.find-free-vars V730 (hd V731)) (shen.find-free-vars V730 (tl V731)))) ((shen.free-variable? V731 V730) (cons V731 ())) (true ()))) +(defun shen.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? (V732 V733) (and (variable? V732) (not (element? V732 V733)))) +(defun shen.free-variable? (V739 V740) (and (variable? V739) (not (element? V739 V740)))) -(defun shen.record-kl (V734 V735) (do (set shen.*userdefs* (adjoin V734 (value shen.*userdefs*))) (put V734 shen.source V735 (value *property-vector*)))) +(defun shen.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 (V736 V737 V738) (let W739 (shen.parameters V738) (let W740 (shen.scan-body V736 (shen.kl-body V737 W739)) (let W741 (cons defun (cons V736 (cons W739 (cons (shen.cond-form W740) ())))) W741)))) +(defun shen.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 (V742) (cond ((= 0 V742) ()) (true (cons (gensym V) (shen.parameters (- V742 1)))))) +(defun shen.parameters (V749) (cond ((= 0 V749) ()) (true (cons (gensym V) (shen.parameters (- V749 1)))))) -(defun shen.cond-form (V745) (cond ((and (cons? V745) (and (cons? (hd V745)) (and (= true (hd (hd V745))) (and (cons? (tl (hd V745))) (= () (tl (tl (hd V745)))))))) (hd (tl (hd V745)))) (true (cons cond V745)))) +(defun shen.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 (V754 V755) (cond ((= () V755) (cons (cons true (cons (cons shen.f-error (cons V754 ())) ())) ())) ((and (cons? V755) (shen.choicepoint? (hd V755))) (shen.choicepoint V754 (gensym Freeze) (gensym Result) (hd V755) (tl V755))) ((and (cons? V755) (and (cons? (hd V755)) (and (= true (hd (hd V755))) (and (cons? (tl (hd V755))) (= () (tl (tl (hd V755)))))))) (cons (hd V755) ())) ((cons? V755) (cons (hd V755) (shen.scan-body V754 (tl V755)))) (true (simple-error "implementation error in shen.scan-body")))) +(defun shen.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? (V762) (cond ((and (cons? V762) (and (cons? (tl V762)) (and (cons? (hd (tl V762))) (and (= shen.choicepoint! (hd (hd (tl V762)))) (and (cons? (tl (hd (tl V762)))) (and (= () (tl (tl (hd (tl V762))))) (= () (tl (tl V762))))))))) true) (true false))) +(defun shen.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 (V778 V779 V780 V781 V782) (cond ((and (cons? V781) (and (cons? (tl V781)) (and (cons? (hd (tl V781))) (and (cons? (tl (hd (tl V781)))) (and (cons? (hd (tl (hd (tl V781))))) (and (= fail-if (hd (hd (tl (hd (tl V781)))))) (and (cons? (tl (hd (tl (hd (tl V781)))))) (and (cons? (tl (tl (hd (tl (hd (tl V781))))))) (and (= () (tl (tl (tl (hd (tl (hd (tl V781)))))))) (and (= () (tl (tl (hd (tl V781))))) (and (= () (tl (tl V781))) (= V778 (hd (tl (hd (tl (hd (tl V781)))))))))))))))))) (cons (cons true (cons (cons let (cons V779 (cons (cons freeze (cons (cons cond (shen.scan-body (hd (tl (hd (tl (hd (tl V781)))))) V782)) ())) (cons (cons if (cons (hd V781) (cons (cons let (cons V780 (cons (hd (tl (tl (hd (tl (hd (tl V781))))))) (cons (cons if (cons (cons (hd (tl (hd (tl (hd (tl V781)))))) (cons V780 ())) (cons (cons thaw (cons V779 ())) (cons V780 ())))) ())))) (cons (cons thaw (cons V779 ())) ())))) ())))) ())) ())) ((and (cons? V781) (and (cons? (tl V781)) (and (cons? (hd (tl V781))) (and (cons? (tl (hd (tl V781)))) (and (= () (tl (tl (hd (tl V781))))) (= () (tl (tl V781)))))))) (cons (cons true (cons (cons let (cons V779 (cons (cons freeze (cons (cons cond (shen.scan-body V778 V782)) ())) (cons (cons if (cons (hd V781) (cons (cons let (cons V780 (cons (hd (tl (hd (tl V781)))) (cons (cons if (cons (cons = (cons V780 (cons (cons fail ()) ()))) (cons (cons thaw (cons V779 ())) (cons V780 ())))) ())))) (cons (cons thaw (cons V779 ())) ())))) ())))) ())) ())) (true (simple-error "implementation error in shen.choicepoint")))) +(defun shen.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 (V784 V785 V786) (cond ((= V784 V786) V785) ((cons? V786) (let W787 (shen.rep-X V784 V785 (hd V786)) (if (= W787 (hd V786)) (cons (hd V786) (shen.rep-X V784 V785 (tl V786))) (cons W787 (tl V786))))) (true V786))) +(defun shen.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.kl-body (V788 V789) (map (lambda Z790 (shen.triple-stack () (fst Z790) V789 (shen.alpha-convert (snd Z790)))) V788)) +(defun shen.kl-body (V795 V796) (map (lambda Z797 (shen.triple-stack () (fst Z797) V796 (shen.alpha-convert (snd Z797)))) V795)) -(defun shen.alpha-convert (V791) (cond ((and (cons? V791) (and (= lambda (hd V791)) (and (cons? (tl V791)) (and (cons? (tl (tl V791))) (= () (tl (tl (tl V791)))))))) (let W792 (gensym Z) (let W793 (cons lambda (cons W792 (cons (shen.beta (hd (tl V791)) W792 (hd (tl (tl V791)))) ()))) (map (lambda Z794 (shen.alpha-convert Z794)) W793)))) ((and (cons? V791) (and (= let (hd V791)) (and (cons? (tl V791)) (and (cons? (tl (tl V791))) (and (cons? (tl (tl (tl V791)))) (= () (tl (tl (tl (tl V791)))))))))) (let W795 (gensym W) (let W796 (cons let (cons W795 (cons (hd (tl (tl V791))) (cons (shen.beta (hd (tl V791)) W795 (hd (tl (tl (tl V791))))) ())))) (map (lambda Z797 (shen.alpha-convert Z797)) W796)))) ((cons? V791) (map (lambda Z798 (shen.alpha-convert Z798)) V791)) (true V791))) +(defun shen.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 (V807 V808 V809 V810) (cond ((and (= () V808) (and (= () V809) (and (cons? V810) (and (= where (hd V810)) (and (cons? (tl V810)) (and (cons? (tl (tl V810))) (= () (tl (tl (tl V810)))))))))) (shen.triple-stack (cons (hd (tl V810)) V807) () () (hd (tl (tl V810))))) ((and (= () V808) (= () V809)) (cons (shen.rectify-test (reverse V807)) (cons V810 ()))) ((and (cons? V808) (and (cons? V809) (variable? (hd V808)))) (shen.triple-stack V807 (tl V808) (tl V809) (shen.beta (hd V808) (hd V809) V810))) ((and (cons? V808) (and (cons? (hd V808)) (and (cons? (tl (hd V808))) (and (cons? (tl (tl (hd V808)))) (and (= () (tl (tl (tl (hd V808))))) (cons? V809)))))) (shen.triple-stack (cons (cons (shen.op-test (hd (hd V808))) (cons (hd V809) ())) V807) (cons (hd (tl (hd V808))) (cons (hd (tl (tl (hd V808)))) (tl V808))) (cons (cons (shen.op1 (hd (hd V808))) (cons (hd V809) ())) (cons (cons (shen.op2 (hd (hd V808))) (cons (hd V809) ())) (tl V809))) (shen.beta (hd V808) (hd V809) V810))) ((and (cons? V808) (cons? V809)) (shen.triple-stack (cons (cons = (cons (hd V808) (cons (hd V809) ()))) V807) (tl V808) (tl V809) V810)) (true (simple-error "implementation error in shen.triple-stack")))) +(defun shen.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.rectify-test (V813) (cond ((= () V813) true) ((and (cons? V813) (= () (tl V813))) (hd V813)) ((and (cons? V813) (cons? (tl V813))) (cons and (cons (hd V813) (cons (shen.rectify-test (tl V813)) ())))) (true (simple-error "implementation error in shen.rectify-test")))) +(defun shen.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.beta (V823 V824 V825) (cond ((= V823 V825) V824) ((and (cons? V825) (and (= lambda (hd V825)) (and (cons? (tl V825)) (and (cons? (tl (tl V825))) (and (= () (tl (tl (tl V825)))) (= V823 (hd (tl V825)))))))) V825) ((and (cons? V825) (and (= let (hd V825)) (and (cons? (tl V825)) (and (cons? (tl (tl V825))) (and (cons? (tl (tl (tl V825)))) (and (= () (tl (tl (tl (tl V825))))) (= V823 (hd (tl V825))))))))) (cons let (cons (hd (tl V825)) (cons (shen.beta (hd (tl V825)) V824 (hd (tl (tl V825)))) (tl (tl (tl V825))))))) ((cons? V825) (map (lambda Z826 (shen.beta V823 V824 Z826)) V825)) (true V825))) +(defun shen.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.op1 (V829) (cond ((= cons V829) hd) ((= @s V829) hdstr) ((= @p V829) fst) ((= @v V829) hdv) (true (simple-error "implementation error in shen.op1")))) +(defun shen.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.op2 (V832) (cond ((= cons V832) tl) ((= @s V832) tlstr) ((= @p V832) snd) ((= @v V832) tlv) (true (simple-error "implementation error in shen.op2")))) +(defun shen.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.op-test (V835) (cond ((= cons V835) cons?) ((= @s V835) shen.+string?) ((= @p V835) tuple?) ((= @v V835) shen.+vector?) (true (simple-error "implementation error in shen.op-test")))) +(defun shen.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.+string? (V836) (cond ((= "" V836) false) (true (string? V836)))) +(defun shen.+string? (V843) (cond ((= "" V843) false) (true (string? V843)))) -(defun shen.+vector? (V837) (cond ((= V837 (vector 0)) false) (true (vector? V837)))) +(defun shen.+vector? (V844) (cond ((= V844 (vector 0)) false) (true (vector? V844)))) -(defun factorise (V840) (cond ((= + V840) (set shen.*factorise?* true)) ((= - V840) (set shen.*factorise?* false)) (true (simple-error "factorise expects a + or a - +(defun factorise (V847) (cond ((= + V847) (set shen.*factorise?* true)) ((= - V847) (set shen.*factorise?* false)) (true (simple-error "factorise expects a + or a - ")))) -(defun shen.factorise-code (V841) (cond ((value shen.*factorise?*) (shen.factor V841)) (true V841))) +(defun shen.factorise-code (V848) (cond ((value shen.*factorise?*) (shen.factor V848)) (true V848))) -(defun shen.factor (V842) (cond ((and (cons? V842) (and (= defun (hd V842)) (and (cons? (tl V842)) (and (cons? (tl (tl V842))) (and (cons? (tl (tl (tl V842)))) (and (cons? (hd (tl (tl (tl V842))))) (and (= cond (hd (hd (tl (tl (tl V842)))))) (= () (tl (tl (tl (tl V842)))))))))))) (cons defun (cons (hd (tl V842)) (cons (hd (tl (tl V842))) (cons (shen.factor-recognisors (tl (hd (tl (tl (tl V842)))))) ()))))) (true V842))) +(defun shen.factor (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-recognisors (V845) (cond ((and (cons? V845) (and (cons? (hd V845)) (and (= true (hd (hd V845))) (and (cons? (tl (hd V845))) (= () (tl (tl (hd V845)))))))) (hd (tl (hd V845)))) ((and (cons? V845) (and (cons? (hd V845)) (and (cons? (hd (hd V845))) (and (= and (hd (hd (hd V845)))) (and (cons? (tl (hd (hd V845)))) (and (cons? (tl (tl (hd (hd V845))))) (and (= () (tl (tl (tl (hd (hd V845)))))) (and (cons? (tl (hd V845))) (= () (tl (tl (hd V845)))))))))))) (let W846 (shen.pivot-on (hd (tl (hd (hd V845)))) V845 ()) (let W847 (fst W846) (if (shen.bad-pivot? W847) (cons if (cons (hd (hd V845)) (cons (hd (tl (hd V845))) (cons (shen.factor-recognisors (tl V845)) ())))) (let W848 (snd W846) (let W849 (shen.factor-recognisors W848) (let W850 (gensym GoTo) (let W851 (reverse (cons (cons true (cons (cons thaw (cons W850 ())) ())) W847)) (let W852 (cons let (cons W850 (cons (cons freeze (cons W849 ())) (cons (cons if (cons (hd (tl (hd (hd V845)))) (cons (shen.factor-selectors (hd (tl (hd (hd V845)))) (shen.factor-recognisors W851)) (cons (cons thaw (cons W850 ())) ())))) ())))) (shen.remove-indirection W852)))))))))) ((and (cons? V845) (and (cons? (hd V845)) (and (cons? (tl (hd V845))) (= () (tl (tl (hd V845))))))) (cons if (cons (hd (hd V845)) (cons (hd (tl (hd V845))) (cons (shen.factor-recognisors (tl V845)) ()))))) (true (simple-error "partial function shen.factor-recognisors")))) +(defun shen.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.bad-pivot? (V857) (cond ((and (cons? V857) (= () (tl V857))) true) (true false))) +(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.remove-indirection (V858) (cond ((and (cons? V858) (and (= let (hd V858)) (and (cons? (tl V858)) (and (cons? (tl (tl V858))) (and (cons? (hd (tl (tl V858)))) (and (= freeze (hd (hd (tl (tl V858))))) (and (cons? (tl (hd (tl (tl V858))))) (and (cons? (hd (tl (hd (tl (tl V858)))))) (and (= thaw (hd (hd (tl (hd (tl (tl V858))))))) (and (cons? (tl (hd (tl (hd (tl (tl V858))))))) (and (= () (tl (tl (hd (tl (hd (tl (tl V858)))))))) (and (= () (tl (tl (hd (tl (tl V858)))))) (and (cons? (tl (tl (tl V858)))) (and (= () (tl (tl (tl (tl V858))))) (symbol? (hd (tl (hd (tl (hd (tl (tl V858)))))))))))))))))))))) (subst (hd (tl (hd (tl (hd (tl (tl V858))))))) (hd (tl V858)) (hd (tl (tl (tl V858)))))) (true V858))) +(defun shen.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.pivot-on (V861 V862 V863) (cond ((and (cons? V862) (and (cons? (hd V862)) (and (cons? (hd (hd V862))) (and (= and (hd (hd (hd V862)))) (and (cons? (tl (hd (hd V862)))) (and (cons? (tl (tl (hd (hd V862))))) (and (= () (tl (tl (tl (hd (hd V862)))))) (and (cons? (tl (hd V862))) (and (= () (tl (tl (hd V862)))) (= V861 (hd (tl (hd (hd V862)))))))))))))) (shen.pivot-on (hd (tl (hd (hd V862)))) (tl V862) (cons (cons (hd (tl (tl (hd (hd V862))))) (tl (hd V862))) V863))) ((and (cons? V862) (and (cons? (hd V862)) (and (cons? (tl (hd V862))) (and (= () (tl (tl (hd V862)))) (= V861 (hd (hd V862))))))) (shen.pivot-on (hd (hd V862)) (tl V862) (cons (cons true (tl (hd V862))) V863))) (true (@p V863 V862)))) +(defun shen.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.factor-selectors (V866 V867) (cond ((and (cons? V866) (and (cons? (tl V866)) (= () (tl (tl V866))))) (let W868 (shen.op (hd V866)) (if (= shen.skip W868) V867 (shen.factor-selectors-h (cons (cons (shen.op1 W868) (tl V866)) (cons (cons (shen.op2 W868) (tl V866)) ())) V867)))) (true V867))) +(defun shen.bad-pivot? (V871) (cond ((and (cons? V871) (= () (tl V871))) true) (true false))) -(defun shen.op (V871) (cond ((= cons? V871) cons) ((= shen.+string? V871) @s) ((= shen.+vector? V871) @v) ((= tuple? V871) @p) (true shen.skip))) +(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.factor-selectors-h (V872 V873) (cond ((= () V872) V873) ((cons? V872) (if (> (occurrences (hd V872) V873) 1) (let W874 (gensym Select) (cons let (cons W874 (cons (hd V872) (cons (shen.factor-selectors-h (tl V872) (subst W874 (hd V872) V873)) ()))))) (shen.factor-selectors-h (tl V872) V873))) (true (simple-error "partial function shen.factor-selectors-h")))) +(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.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.op (V885) (cond ((= cons? V885) cons) ((= shen.+string? V885) @s) ((= shen.+vector? V885) @v) ((= tuple? V885) @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")))) diff --git a/klambda/declarations.kl b/klambda/declarations.kl index bae45af..6cfab7d 100644 --- a/klambda/declarations.kl +++ b/klambda/declarations.kl @@ -50,7 +50,7 @@ (set shen.*optimise* false) -(set *version* "41.2") +(set *version* "42") (set shen.*names* ()) @@ -66,34 +66,34 @@ (set shen.*userdefs* ()) -(defun datatypes () (map (lambda Z5718 (shen.typename Z5718)) (value shen.*alldatatypes*))) +(defun datatypes () (map (lambda Z5759 (shen.typename Z5759)) (value shen.*alldatatypes*))) -(defun included () (map (lambda Z5719 (shen.typename Z5719)) (value shen.*datatypes*))) +(defun included () (map (lambda Z5760 (shen.typename Z5760)) (value shen.*datatypes*))) -(defun shen.typename (V5722) (cond ((cons? V5722) (intern (shen.typename-h (str (hd V5722))))) (true (simple-error "partial function shen.typename")))) +(defun shen.typename (V5763) (cond ((cons? V5763) (intern (shen.typename-h (str (hd V5763))))) (true (simple-error "partial function shen.typename")))) -(defun shen.typename-h (V5723) (cond ((= "#type" V5723) "") ((shen.+string? V5723) (cn (hdstr V5723) (shen.typename-h (tlstr V5723)))) (true (simple-error "partial function shen.typename-h")))) +(defun 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 (V5724) (if (< V5724 0) (value shen.*prolog-memory*) (if (integer? V5724) (set shen.*prolog-memory* V5724) (simple-error "prolog memory expects an integer value +(defun 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 shen.initialise-lambda-tables (V5727) (cond ((= () V5727) ()) ((and (cons? V5727) (cons? (tl V5727))) (let W5728 (put (hd V5727) arity (hd (tl V5727)) (value *property-vector*)) (shen.initialise-arity-table (tl (tl V5727))))) (true (simple-error "implementation error in shen.initialise-arity-table")))) +(defun 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 (V5729) (trap-error (get V5729 arity (value *property-vector*)) (lambda Z5730 -1))) +(defun arity (V5770) (trap-error (get V5770 arity (value *property-vector*)) (lambda Z5771 -1))) -(defun shen.initialise-arity-table (V5733) (cond ((= () V5733) ()) ((and (cons? V5733) (cons? (tl V5733))) (let W5734 (put (hd V5733) arity (hd (tl V5733)) (value *property-vector*)) (shen.initialise-arity-table (tl (tl V5733))))) (true (simple-error "implementation error in shen.initialise-arity-table")))) +(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 systemf (V5735) (let W5736 (get shen shen.external-symbols (value *property-vector*)) (let W5737 (put shen shen.external-symbols (adjoin V5735 W5736) (value *property-vector*)) V5735))) +(defun systemf (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 adjoin (V5738 V5739) (if (element? V5738 V5739) V5739 (cons V5738 V5739))) +(defun adjoin (V5779 V5780) (if (element? V5779 V5780) V5780 (cons V5779 V5780))) (put shen shen.external-symbols (cons ! (cons } (cons { (cons --> (cons <-- (cons && (cons (intern ":") (cons (intern ";") (cons (intern ":=") (cons (intern ",") (cons _ (cons *language* (cons *implementation* (cons *stinput* (cons *stoutput* (cons *home-directory* (cons *version* (cons *maximum-print-sequence-size* (cons *macros* (cons *os* (cons *release* (cons *property-vector* (cons @v (cons @p (cons @s (cons *port* (cons *porters* (cons *hush* (cons <- (cons -> (cons (cons == (cons = (cons >= (cons > (cons ==> (cons /. (cons (cons (cons $ (cons - (cons / (cons * (cons + (cons <= (cons < (cons >> (cons (vector 0) (cons y-or-n? (cons write-to-file (cons write-byte (cons where (cons when (cons version (cons verified (cons variable? (cons var? (cons value (cons vector-> (cons <-vector (cons vector (cons vector? (cons userdefs (cons u! (cons update-lambda-table (cons unspecialise (cons untrack (cons unit (cons unix (cons union (cons unput (cons unprofile (cons undefmacro (cons unabsolute (cons return (cons type (cons tuple? (cons true (cons trap-error (cons tracked (cons track (cons time (cons thaw (cons tc? (cons tc (cons tl (cons tlstr (cons tlv (cons tail (cons systemf (cons synonyms (cons system-S? (cons symbol (cons symbol? (cons string->symbol (cons sum (cons subst (cons string? (cons string->n (cons stream (cons string (cons stinput (cons stoutput (cons step (cons sqts (cons spy (cons specialise (cons snd (cons simple-error (cons set (cons save (cons str (cons run (cons reverse (cons retract (cons remove (cons release (cons read (cons receive (cons read-file (cons read-file-as-bytelist (cons read-file-as-string (cons read-byte (cons read-from-string (cons read-from-string-unprocessed (cons package? (cons put (cons preclude (cons preclude-all-but (cons ps (cons prolog? (cons protect (cons profile-results (cons profile (cons prolog-memory (cons print (cons pr (cons pos (cons porters (cons port (cons package (cons output (cons out (cons os (cons or (cons optimise (cons optimise? (cons open (cons occurrences (cons occurs-check (cons occurs? (cons n->string (cons number? (cons number (cons null (cons nth (cons not (cons nl (cons mode (cons macroexpand (cons maxinferences (cons mapcan (cons map (cons make-string (cons load (cons loaded (cons list (cons lineread (cons limit (cons length (cons let (cons lazy (cons lambda (cons language (cons is (cons intersection (cons inferences (cons intern (cons integer? (cons input (cons input+ (cons included (cons include (cons include-all-but (cons it (cons is (cons is! (cons in (cons in-package (cons internal (cons implementation (cons if (cons hush? (cons hush? (cons head (cons hd (cons hdv (cons hdstr (cons hash (cons get (cons get-time (cons gensym (cons fn (cons function (cons fst (cons freeze (cons fresh (cons fork (cons foreign (cons fix (cons file (cons fail (cons fail-if (cons factorise (cons factorise? (cons findall (cons false (cons enable-type-theory (cons explode (cons external (cons exception (cons eval-kl (cons eval (cons error-to-string (cons error (cons empty? (cons element? (cons do (cons difference (cons destroy (cons defun (cons define (cons defmacro (cons defcc (cons defprolog (cons declare (cons datatype (cons datatypes (cons ctxt (cons cn (cons cons? (cons cons (cons cond (cons concat (cons compile (cons cd (cons cases (cons call (cons close (cons bind (cons bound? (cons boolean? (cons boolean (cons bootstrap (cons (intern "bar!") (cons spy? (cons step? (cons atom? (cons asserta (cons assertz (cons assoc (cons arity (cons append (cons and (cons adjoin (cons <-address (cons address-> (cons absvector? (cons absvector (cons absolute (cons abort ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (value *property-vector*)) -(defun shen.lambda-entry (V5740) (let W5741 (arity V5740) (if (or (= W5741 -1) (= W5741 0)) () (cons V5740 (eval-kl (shen.lambda-function (cons V5740 ()) W5741)))))) +(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.build-lambda-table (V5742) (let W5743 (map (lambda Z5744 (shen.lambda-entry Z5744)) V5742) (set shen.*lambdatable* (cons (cons shen.tuple (lambda Z5745 (shen.tuple Z5745))) (cons (cons shen.pvar (lambda Z5746 (shen.pvar Z5746))) (cons (cons shen.print-prolog-vector (lambda Z5747 (shen.print-prolog-vector Z5747))) (cons (cons shen.print-freshterm (lambda Z5748 (shen.print-freshterm Z5748))) (cons (cons shen.printF (lambda Z5749 (shen.printF Z5749))) W5743)))))))) +(defun shen.build-lambda-table (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)))))))) (shen.build-lambda-table (external shen)) diff --git a/klambda/load.kl b/klambda/load.kl index a359283..b90b24c 100644 --- a/klambda/load.kl +++ b/klambda/load.kl @@ -1,43 +1,43 @@ -(defun load (V893) (let W894 (value shen.*tc*) (let W895 (let W896 (get-time run) (let W897 (shen.load-help W894 (read-file V893)) (let W898 (get-time run) (let W899 (- W898 W896) (let W900 (pr (cn " -run time: " (cn (str W899) " secs -")) (stoutput)) W897))))) (let W901 (if W894 (pr (cn " +(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 " typechecked in " (shen.app (inferences) " inferences " shen.a)) (stoutput)) shen.skip) loaded)))) -(defun shen.load-help (V904 V905) (cond ((= false V904) (shen.eval-and-print V905)) (true (shen.check-eval-and-print V905)))) +(defun shen.load-help (V918 V919) (cond ((= false V918) (shen.eval-and-print V919)) (true (shen.check-eval-and-print V919)))) -(defun shen.eval-and-print (V906) (map (lambda Z907 (pr (shen.app (eval-kl (shen.shen->kl Z907)) " -" shen.s) (stoutput))) V906)) +(defun shen.eval-and-print (V920) (map (lambda Z921 (pr (shen.app (eval-kl (shen.shen->kl Z921)) " +" shen.s) (stoutput))) V920)) -(defun shen.check-eval-and-print (V908) (let W909 (mapcan (lambda Z910 (shen.typetable Z910)) V908) (let W911 (trap-error (shen.assumetypes W909) (lambda Z912 (shen.unwind-types Z912 W909))) (trap-error (shen.work-through V908) (lambda Z913 (shen.unwind-types Z913 W909)))))) +(defun shen.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.typetable (V918) (cond ((and (cons? V918) (and (= define (hd V918)) (and (cons? (tl V918)) (and (cons? (tl (tl V918))) (= { (hd (tl (tl V918)))))))) (cons (hd (tl V918)) (cons (shen.rectify-type (shen.type-F (hd (tl V918)) (tl (tl (tl V918))))) ()))) ((and (cons? V918) (and (= define (hd V918)) (cons? (tl V918)))) (simple-error (cn "missing { in " (shen.app (hd (tl V918)) " +(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)) " " shen.a)))) (true ()))) -(defun shen.type-F (V925 V926) (cond ((and (cons? V926) (= } (hd V926))) ()) ((cons? V926) (cons (hd V926) (shen.type-F V925 (tl V926)))) (true (simple-error (cn "missing } in " (shen.app V925 " +(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 " " shen.a)))))) -(defun shen.assumetypes (V929) (cond ((= () V929) ()) ((and (cons? V929) (cons? (tl V929))) (do (declare (hd V929) (hd (tl V929))) (shen.assumetypes (tl (tl V929))))) (true (simple-error "implementation error in shen.assumetype")))) +(defun shen.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.unwind-types (V934 V935) (cond ((and (cons? V935) (cons? (tl V935))) (do (destroy (hd V935)) (shen.unwind-types V934 (tl (tl V935))))) (true (simple-error (error-to-string V934))))) +(defun shen.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.work-through (V938) (cond ((= () V938) ()) ((and (cons? V938) (and (cons? (tl V938)) (and (cons? (tl (tl V938))) (= (hd (tl V938)) (intern ":"))))) (let W939 (shen.typecheck (hd V938) (hd (tl (tl V938)))) (if (= W939 false) (shen.type-error) (let W940 (eval-kl (shen.shen->kl (hd V938))) (let W941 (pr (shen.app W940 (cn " : " (shen.app (shen.pretty-type W939) " -" shen.r)) shen.s) (stoutput)) (shen.work-through (tl (tl (tl V938))))))))) ((cons? V938) (shen.work-through (cons (hd V938) (cons (intern ":") (cons A (tl V938)))))) (true (simple-error "implementation error in shen.work-through")))) +(defun shen.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.pretty-type (V943) (cond ((and (cons? V943) (and (cons? (hd V943)) (and (= list (hd (hd V943))) (and (cons? (tl (hd V943))) (and (= () (tl (tl (hd V943)))) (and (cons? (tl V943)) (and (= --> (hd (tl V943))) (and (cons? (tl (tl V943))) (and (cons? (hd (tl (tl V943)))) (and (= str (hd (hd (tl (tl V943))))) (and (cons? (tl (hd (tl (tl V943))))) (and (cons? (hd (tl (hd (tl (tl V943)))))) (and (= list (hd (hd (tl (hd (tl (tl V943))))))) (and (cons? (tl (hd (tl (hd (tl (tl V943))))))) (and (= () (tl (tl (hd (tl (hd (tl (tl V943)))))))) (and (cons? (tl (tl (hd (tl (tl V943)))))) (and (= () (tl (tl (tl (hd (tl (tl V943))))))) (and (= () (tl (tl (tl V943)))) (= (hd (tl (hd V943))) (hd (tl (hd (tl (hd (tl (tl V943)))))))))))))))))))))))))) (cons (hd (tl (hd (tl (tl V943))))) (cons ==> (tl (tl (hd (tl (tl V943)))))))) ((cons? V943) (map (lambda Z944 (shen.pretty-type Z944)) V943)) (true V943))) +(defun shen.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.type-error () (simple-error "type error ")) -(defun bootstrap (V945) (let W946 (shen.klfile V945) (let W947 (read-file V945) (let W948 (open W946 out) (let W949 (map (lambda Z950 (shen.partial (shen.shen->kl-h Z950))) W947) (let W951 (shen.write-kl W949 W948) W946)))))) +(defun 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 shen.partial (V952) (cond ((and (cons? V952) (and (= shen.f-error (hd V952)) (and (cons? (tl V952)) (= () (tl (tl V952)))))) (cons simple-error (cons (cn "partial function " (str (hd (tl V952)))) ()))) ((cons? V952) (map (lambda Z953 (shen.partial Z953)) V952)) (true V952))) +(defun shen.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.write-kl (V956 V957) (cond ((= () V956) (close V957)) ((and (cons? V956) (cons? (hd V956))) (shen.write-kl (tl V956) (do (shen.write-kl-h (hd V956) V957) V957))) ((cons? V956) (shen.write-kl (tl V956) V957)) (true (simple-error "partial function shen.write-kl")))) +(defun shen.write-kl (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-h (V960 V961) (cond ((and (cons? V960) (and (= defun (hd V960)) (and (cons? (tl V960)) (and (= fail (hd (tl V960))) (and (cons? (tl (tl V960))) (and (= () (hd (tl (tl V960)))) (and (cons? (tl (tl (tl V960)))) (= () (tl (tl (tl (tl V960)))))))))))) (pr "(defun fail () shen.fail!)" V961)) (true (pr (shen.app V960 " +(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 " -" shen.r) V961)))) +" shen.r) V975)))) -(defun shen.klfile (V962) (cond ((= "" V962) ".kl") ((= ".shen" V962) ".kl") ((shen.+string? V962) (@s (hdstr V962) (shen.klfile (tlstr V962)))) (true (simple-error "partial function shen.klfile")))) +(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")))) diff --git a/klambda/macros.kl b/klambda/macros.kl index 719f80b..79e9a1c 100644 --- a/klambda/macros.kl +++ b/klambda/macros.kl @@ -1,65 +1,65 @@ -(defun macroexpand (V5783) (let W5784 (map (lambda Z5785 (tl Z5785)) (value *macros*)) (shen.macroexpand-h V5783 W5784 W5784))) +(defun macroexpand (V5824) (let W5825 (map (lambda Z5826 (tl Z5826)) (value *macros*)) (shen.macroexpand-h V5824 W5825 W5825))) -(defun shen.macroexpand-h (V5794 V5795 V5796) (if (= () V5795) V5794 (if (cons? V5795) (let W5797 (shen.walk (hd V5795) V5794) (if (= V5794 W5797) (shen.macroexpand-h V5794 (tl V5795) V5796) (shen.macroexpand-h W5797 V5796 V5796))) (simple-error "implementation error in shen.macroexpand-h")))) +(defun shen.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.walk (V5798 V5799) (if (cons? V5799) (V5798 (map (lambda Z5800 (shen.walk V5798 Z5800)) V5799)) (V5798 V5799))) +(defun shen.walk (V5839 V5840) (if (cons? V5840) (V5839 (map (lambda Z5841 (shen.walk V5839 Z5841)) V5840)) (V5839 V5840))) -(defun shen.macros (V5801) (let GoTo5802 (freeze V5801) (if (cons? V5801) (let Select5807 (hd V5801) (let Select5808 (tl V5801) (if (and (= defmacro Select5807) (cons? Select5808)) (shen.process-def (hd Select5808) (tl Select5808)) (if (= defcc Select5807) (shen.yacc->shen Select5808) (if (and (= u! Select5807) (and (cons? Select5808) (= () (tl Select5808)))) (cons protect (cons (shen.make-uppercase (hd Select5808)) ())) (if (and (= error Select5807) (cons? Select5808)) (cons simple-error (cons (shen.mkstr (hd Select5808) (tl Select5808)) ())) (if (and (= output Select5807) (cons? Select5808)) (cons pr (cons (shen.mkstr (hd Select5808) (tl Select5808)) (cons (cons stoutput ()) ()))) (if (and (= pr Select5807) (and (cons? Select5808) (= () (tl Select5808)))) (cons pr (cons (hd Select5808) (cons (cons stoutput ()) ()))) (if (and (= make-string Select5807) (cons? Select5808)) (shen.mkstr (hd Select5808) (tl Select5808)) (if (and (= lineread Select5807) (= () Select5808)) (cons lineread (cons (cons stinput ()) ())) (if (and (= input Select5807) (= () Select5808)) (cons input (cons (cons stinput ()) ())) (if (and (= read Select5807) (= () Select5808)) (cons read (cons (cons stinput ()) ())) (if (and (= input+ Select5807) (cons? Select5808)) (shen.process-input+ V5801) (if (and (= read-byte Select5807) (= () Select5808)) (shen.process-read-byte) (if (= prolog? Select5807) (shen.call-prolog Select5808) (if (and (= defprolog Select5807) (cons? Select5808)) (shen.compile-prolog (hd Select5808) (tl Select5808)) (if (and (= datatype Select5807) (cons? Select5808)) (shen.process-datatype (hd Select5808) (tl Select5808)) (if (= @s Select5807) (shen.process-@s V5801) (if (= synonyms Select5807) (shen.process-synonyms Select5808) (if (and (= nl Select5807) (= () Select5808)) (cons nl (cons 1 ())) (if (= let Select5807) (shen.process-let V5801) (if (= /. Select5807) (shen.process-lambda V5801) (if (= cases Select5807) (shen.process-cases V5801) (if (and (= time Select5807) (and (cons? Select5808) (= () (tl Select5808)))) (shen.process-time (hd Select5808)) (if (and (= put Select5807) (and (cons? Select5808) (and (cons? (tl Select5808)) (and (cons? (tl (tl Select5808))) (= () (tl (tl (tl Select5808)))))))) (cons put (cons (hd Select5808) (cons (hd (tl Select5808)) (cons (hd (tl (tl Select5808))) (cons (cons value (cons *property-vector* ())) ()))))) (if (and (= get Select5807) (and (cons? Select5808) (and (cons? (tl Select5808)) (= () (tl (tl Select5808)))))) (cons get (cons (hd Select5808) (cons (hd (tl Select5808)) (cons (cons value (cons *property-vector* ())) ())))) (if (and (= unput Select5807) (and (cons? Select5808) (and (cons? (tl Select5808)) (= () (tl (tl Select5808)))))) (cons unput (cons (hd Select5808) (cons (hd (tl Select5808)) (cons (cons value (cons *property-vector* ())) ())))) (if (and (= shen.@c Select5807) (and (cons? Select5808) (= () (tl Select5808)))) (shen.rcons_form (hd Select5808)) (let GoTo5803 (freeze (if (and (cons? Select5808) (and (cons? (tl Select5808)) (and (cons? (tl (tl Select5808))) (element? Select5807 (cons @p (cons @v (cons append (cons and (cons or (cons + (cons * (cons do ())))))))))))) (cons Select5807 (cons (hd Select5808) (cons (shen.process-assoc (cons Select5807 (tl Select5808))) ()))) (thaw GoTo5802))) (if (= shen.@ch Select5807) (if (cons? Select5808) (let Select5805 (hd Select5808) (let Select5806 (tl Select5808) (if (and (cons? Select5805) (and (cons? (tl Select5805)) (and (cons? (tl (tl Select5805))) (and (= () (tl (tl (tl Select5805)))) (and (= () Select5806) (= (hd (tl Select5805)) (intern ":"))))))) (shen.cons-form-respect-modes (cons - (cons (cons (hd Select5805) (cons (hd (tl Select5805)) (cons (cons + (tl (tl Select5805))) ()))) ()))) (if (= () Select5806) (shen.cons-form-respect-modes Select5805) (thaw GoTo5803))))) (thaw GoTo5803)) (thaw GoTo5803))))))))))))))))))))))))))))))) (thaw GoTo5802)))) +(defun shen.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.process-input+ (V5809) (let GoTo5810 (freeze (simple-error "partial function shen.process-input+")) (if (cons? V5809) (let Select5815 (tl V5809) (if (= input+ (hd V5809)) (if (cons? Select5815) (let Select5813 (hd Select5815) (let Select5814 (tl Select5815) (if (= () Select5814) (cons shen.input-h+ (cons (shen.rcons_form Select5813) (cons (cons stinput ()) ()))) (if (and (cons? Select5814) (= () (tl Select5814))) (cons shen.input-h+ (cons (shen.rcons_form Select5813) Select5814)) (thaw GoTo5810))))) (thaw GoTo5810)) (thaw GoTo5810))) (thaw GoTo5810)))) +(defun shen.process-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.cons-form-respect-modes (V5816) (let GoTo5817 (freeze V5816) (if (cons? V5816) (let Select5818 (hd V5816) (let Select5819 (tl V5816) (if (and (= + Select5818) (and (cons? Select5819) (= () (tl Select5819)))) (cons + (cons (shen.cons-form-respect-modes (hd Select5819)) ())) (if (and (= - Select5818) (and (cons? Select5819) (= () (tl Select5819)))) (cons - (cons (shen.cons-form-respect-modes (hd Select5819)) ())) (cons cons (cons (shen.cons-form-respect-modes Select5818) (cons (shen.cons-form-respect-modes Select5819) ()))))))) (thaw GoTo5817)))) +(defun shen.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-def (V5820 V5821) (let W5822 (cons X (cons -> (cons X ()))) (let W5823 (eval (cons define (cons V5820 (append V5821 W5822)))) (let W5824 (shen.record-macro V5820 (fn V5820)) V5820)))) +(defun shen.process-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.process-let (V5825) (if (and (cons? V5825) (and (= let (hd V5825)) (and (cons? (tl V5825)) (and (cons? (tl (tl V5825))) (and (cons? (tl (tl (tl V5825)))) (cons? (tl (tl (tl (tl V5825)))))))))) (cons let (cons (hd (tl V5825)) (cons (hd (tl (tl V5825))) (cons (cons let (tl (tl (tl V5825)))) ())))) V5825)) +(defun shen.process-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-@s (V5826) (let GoTo5828 (freeze V5826) (if (cons? V5826) (let Select5835 (tl V5826) (if (= @s (hd V5826)) (if (cons? Select5835) (let Select5833 (hd Select5835) (let Select5834 (tl Select5835) (if (cons? Select5834) (let Select5832 (tl Select5834) (if (cons? Select5832) (cons @s (cons Select5833 (cons (shen.process-@s (cons @s Select5834)) ()))) (if (and (= () Select5832) (string? Select5833)) (let W5827 (explode Select5833) (if (> (length W5827) 1) (shen.process-@s (cons @s (append W5827 Select5834))) V5826)) (thaw GoTo5828)))) (thaw GoTo5828)))) (thaw GoTo5828)) (thaw GoTo5828))) (thaw GoTo5828)))) +(defun shen.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-datatype (V5836 V5837) (let W5838 (shen.intern-type V5836) (let W5839 (compile (lambda Z5840 (shen. Z5840)) (cons W5838 V5837)) W5838))) +(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.intern-type (V5841) (intern (cn (str V5841) "#type"))) +(defun shen.intern-type (V5882) (intern (cn (str V5882) "#type"))) -(defun shen.process-synonyms (V5842) (shen.synonyms-h (set shen.*synonyms* (append V5842 (value shen.*synonyms*))))) +(defun shen.process-synonyms (V5883) (shen.synonyms-h (set shen.*synonyms* (append V5883 (value shen.*synonyms*))))) -(defun shen.synonyms-h (V5843) (let W5844 (map (lambda Z5845 (shen.curry-type Z5845)) V5843) (let W5846 (eval (cons define (cons shen.demod (shen.compile-synonyms W5844)))) synonyms))) +(defun shen.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.compile-synonyms (V5849) (if (= () V5849) (let W5850 (gensym X) (cons W5850 (cons -> (cons W5850 ())))) (if (and (cons? V5849) (cons? (tl V5849))) (cons (shen.rcons_form (hd V5849)) (cons -> (cons (shen.rcons_form (hd (tl V5849))) (shen.compile-synonyms (tl (tl V5849)))))) (simple-error "synonyms requires an even number of arguments +(defun shen.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.process-lambda (V5851) (let GoTo5852 (freeze V5851) (if (cons? V5851) (let Select5859 (tl V5851) (if (= /. (hd V5851)) (if (cons? Select5859) (let Select5857 (hd Select5859) (let Select5858 (tl Select5859) (if (cons? Select5858) (let Select5856 (tl Select5858) (if (cons? Select5856) (cons lambda (cons Select5857 (cons (shen.process-lambda (cons /. Select5858)) ()))) (if (= () Select5856) (if (variable? Select5857) (cons lambda Select5859) (simple-error (shen.app Select5857 " is not a variable -" shen.s))) (thaw GoTo5852)))) (thaw GoTo5852)))) (thaw GoTo5852)) (thaw GoTo5852))) (thaw GoTo5852)))) +(defun shen.process-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-cases (V5862) (let GoTo5863 (freeze V5862) (if (cons? V5862) (let Select5871 (tl V5862) (if (= cases (hd V5862)) (if (cons? Select5871) (let Select5869 (hd Select5871) (let Select5870 (tl Select5871) (if (and (= true Select5869) (cons? Select5870)) (hd Select5870) (let GoTo5866 (freeze (if (= () Select5870) (simple-error "error: odd number of case elements -") (thaw GoTo5863))) (if (cons? Select5870) (let Select5867 (hd Select5870) (let Select5868 (tl Select5870) (if (= () Select5868) (cons if (cons Select5869 (cons Select5867 (cons (cons simple-error (cons "error: cases exhausted" ())) ())))) (cons if (cons Select5869 (cons Select5867 (cons (shen.process-cases (cons cases Select5868)) ()))))))) (thaw GoTo5866)))))) (thaw GoTo5863)) (thaw GoTo5863))) (thaw GoTo5863)))) +(defun shen.process-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-time (V5872) (cons let (cons Start (cons (cons get-time (cons run ())) (cons Result (cons V5872 (cons Finish (cons (cons get-time (cons run ())) (cons Time (cons (cons - (cons Finish (cons Start ()))) (cons Message (cons (cons pr (cons (cons cn (cons " +(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 " run time: " (cons (cons cn (cons (cons str (cons Time ())) (cons " secs " ()))) ()))) (cons (cons stoutput ()) ()))) (cons Result ()))))))))))))) -(defun shen.process-assoc (V5873) (if (and (cons? V5873) (and (cons? (tl V5873)) (and (cons? (tl (tl V5873))) (cons? (tl (tl (tl V5873))))))) (cons (hd V5873) (cons (hd (tl V5873)) (cons (cons (hd V5873) (tl (tl V5873))) ()))) V5873)) +(defun shen.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.make-uppercase (V5874) (intern (shen.mu-h (str V5874)))) +(defun shen.make-uppercase (V5915) (intern (shen.mu-h (str V5915)))) -(defun shen.mu-h (V5875) (if (= "" V5875) "" (if (shen.+string? V5875) (let W5876 (string->n (hdstr V5875)) (let W5877 (- W5876 32) (let W5878 (if (and (>= W5876 97) (<= W5876 122)) (n->string W5877) (hdstr V5875)) (@s W5878 (shen.mu-h (tlstr V5875)))))) (simple-error "partial function shen.mu-h")))) +(defun shen.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.record-macro (V5879 V5880) (set *macros* (shen.update-assoc V5879 V5880 (value *macros*)))) +(defun shen.record-macro (V5920 V5921) (set *macros* (shen.update-assoc V5920 V5921 (value *macros*)))) -(defun shen.update-assoc (V5890 V5891 V5892) (if (= () V5892) (cons (cons V5890 V5891) ()) (let GoTo5893 (freeze (simple-error "implementation error in shen.update-assoc")) (if (cons? V5892) (let Select5894 (hd V5892) (let Select5895 (tl V5892) (if (and (cons? Select5894) (= V5890 (hd Select5894))) (cons (cons (hd Select5894) V5891) Select5895) (cons Select5894 (shen.update-assoc V5890 V5891 Select5895))))) (thaw GoTo5893))))) +(defun shen.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.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 (V5896) (let W5897 (cons shen.prolog-vector ()) (let W5898 (cons @v (cons true (cons 0 (cons (cons vector (cons 0 ())) ())))) (let W5899 0 (let W5900 (cons freeze (cons true ())) (let W5901 (compile (lambda Z5902 (shen. Z5902)) V5896) (let W5903 (shen.received V5896) (let W5904 (gensym V) (let W5905 (gensym L) (let W5906 (gensym K) (let W5907 (gensym C) (let W5908 (cons lambda (cons W5904 (cons (cons lambda (cons W5905 (cons (cons lambda (cons W5906 (cons (cons lambda (cons W5907 (cons (shen.continue W5903 W5901 W5904 W5905 W5906 W5907) ()))) ()))) ()))) ()))) (cons W5908 (cons W5897 (cons W5898 (cons W5899 (cons W5900 ()))))))))))))))))) +(defun shen.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.received (V5911) (let GoTo5912 (freeze ()) (if (cons? V5911) (let Select5913 (hd V5911) (let Select5914 (tl V5911) (if (and (= receive Select5913) (and (cons? Select5914) (= () (tl Select5914)))) Select5914 (union (shen.received Select5913) (shen.received Select5914))))) (thaw GoTo5912)))) +(defun shen.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.prolog-vector () (let W5915 (absvector (value shen.*prolog-memory*)) (let W5916 (address-> W5915 0 shen.print-prolog-vector) (let W5917 (address-> W5915 1 2) W5917)))) +(defun 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 receive (V5918) V5918) +(defun receive (V5959) V5959) -(defun shen.rcons_form (V5919) (if (cons? V5919) (cons cons (cons (shen.rcons_form (hd V5919)) (cons (shen.rcons_form (tl V5919)) ()))) V5919)) +(defun shen.rcons_form (V5960) (if (cons? V5960) (cons cons (cons (shen.rcons_form (hd V5960)) (cons (shen.rcons_form (tl V5960)) ()))) V5960)) -(defun shen.tuple-up (V5920) (if (cons? V5920) (cons @p (cons (hd V5920) (cons (shen.tuple-up (tl V5920)) ()))) V5920)) +(defun shen.tuple-up (V5961) (if (cons? V5961) (cons @p (cons (hd V5961) (cons (shen.tuple-up (tl V5961)) ()))) V5961)) -(defun undefmacro (V5921) (do (set *macros* (remove (assoc V5921 (value *macros*)) (value *macros*))) V5921)) +(defun undefmacro (V5962) (do (set *macros* (remove (assoc V5962 (value *macros*)) (value *macros*))) V5962)) diff --git a/klambda/prolog.kl b/klambda/prolog.kl index 6ddc724..3658fc2 100644 --- a/klambda/prolog.kl +++ b/klambda/prolog.kl @@ -1,202 +1,202 @@ -(defun asserta (V1231) (shen.assert* V1231 shen.top)) +(defun asserta (V1245) (shen.assert* V1245 shen.top)) -(defun assertz (V1232) (shen.assert* V1232 shen.bottom)) +(defun assertz (V1246) (shen.assert* V1246 shen.bottom)) -(defun shen.assert* (V1233 V1234) (cond ((and (cons? V1233) (and (cons? (tl V1233)) (= <-- (hd (tl V1233))))) (let W1235 (shen.predicate (hd V1233)) (let W1236 (shen.terms (hd V1233)) (let W1237 (length W1236) (let W1238 (shen.parameters W1237) (let W1239 (arity W1235) (let W1240 (if (= W1239 -1) (do (eval (shen.create-skeleton W1235 W1238)) (put W1235 shen.dynamic () (value *property-vector*))) shen.skip) (let W1241 (shen.insert-info W1235 W1236 (tl (tl V1233)) V1233 V1234) W1235)))))))) (true (simple-error "partial function shen.assert*")))) +(defun shen.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.predicate (V1244) (cond ((cons? V1244) (hd V1244)) (true V1244))) +(defun shen.predicate (V1258) (cond ((cons? V1258) (hd V1258)) (true V1258))) -(defun shen.terms (V1249) (cond ((cons? V1249) (tl V1249)) (true ()))) +(defun shen.terms (V1263) (cond ((cons? V1263) (tl V1263)) (true ()))) -(defun shen.create-skeleton (V1250 V1251) (cons defprolog (cons V1250 (shen.dynamic-default V1250 V1251)))) +(defun shen.create-skeleton (V1264 V1265) (cons defprolog (cons V1264 (shen.dynamic-default V1264 V1265)))) -(defun shen.dynamic-default (V1252 V1253) (append V1253 (cons <-- (cons (cons shen.call-dynamic (cons (shen.cons-form V1253) (cons (cons get (cons V1252 (cons shen.dynamic ()))) ()))) (cons (intern ";") ()))))) +(defun shen.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.insert-info (V1254 V1255 V1256 V1257 V1258) (let W1259 (gensym shen.g) (let W1260 (eval (append (cons defprolog (cons W1259 ())) (append V1255 (cons <-- V1256)))) (let W1261 (cons (fn W1259) (cons W1259 V1257)) (let W1262 (get V1254 shen.dynamic (value *property-vector*)) (let W1263 (if (= V1258 shen.top) (cons W1261 W1262) (append W1262 (cons W1261 ()))) (put V1254 shen.dynamic W1263 (value *property-vector*)))))))) +(defun shen.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.newname () (let W1264 (value shen.*names*) (let W1265 (if (empty? W1264) (gensym shen.g) (do (set shen.*names* (tl W1264)) (hd W1264))) W1265))) +(defun shen.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.call-dynamic (V1266 V1267 V1268 V1269 V1270 V1271) (let W1272 (if (shen.unlocked? V1269) (let W1273 (shen.lazyderef V1267 V1268) (if (cons? W1273) (let W1274 (shen.lazyderef (hd W1273) V1268) (if (cons? W1274) (let W1275 (hd W1274) (do (shen.incinfs) (shen.callrec W1275 V1266 V1268 V1269 V1270 V1271))) false)) false)) false) (if (= W1272 false) (if (shen.unlocked? V1269) (let W1276 (shen.lazyderef V1267 V1268) (if (cons? W1276) (let W1277 (tl W1276) (do (shen.incinfs) (shen.call-dynamic V1266 W1277 V1268 V1269 V1270 V1271))) false)) false) W1272))) +(defun shen.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.callrec (V1278 V1279 V1280 V1281 V1282 V1283) (cond ((= () V1279) ((((V1278 V1280) V1281) V1282) V1283)) ((cons? V1279) (shen.callrec (V1278 (hd V1279)) (tl V1279) V1280 V1281 V1282 V1283)) (true (simple-error "partial function shen.callrec")))) +(defun 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 retract (V1284) (cond ((and (cons? V1284) (and (cons? (tl V1284)) (= <-- (hd (tl V1284))))) (let W1285 (shen.predicate (hd V1284)) (let W1286 (get W1285 shen.dynamic (value *property-vector*)) (put W1285 shen.dynamic (shen.retract-clause V1284 W1286) (value *property-vector*))))) (true (simple-error "partial function retract")))) +(defun 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 shen.retract-clause (V1292 V1293) (cond ((= () V1293) ()) ((and (cons? V1293) (and (cons? (hd V1293)) (and (cons? (tl (hd V1293))) (= V1292 (tl (tl (hd V1293))))))) (do (set shen.*names* (cons (hd (tl (hd V1293))) (value shen.*names*))) (tl V1293))) ((cons? V1293) (cons (hd V1293) (shen.retract-clause V1292 (tl V1293)))) (true (simple-error "partial function shen.retract-clause")))) +(defun shen.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.compile-prolog (V1294 V1295) (compile (lambda Z1296 (shen. Z1296)) (cons V1294 V1295))) +(defun shen.compile-prolog (V1308 V1309) (compile (lambda Z1310 (shen. Z1310)) (cons V1308 V1309))) -(defun shen. (V1297) (let W1298 (if (cons? V1297) (let W1299 (head V1297) (let W1300 (tail V1297) (let W1301 (shen. W1300) (if (shen.parse-failure? W1301) (shen.parse-failure) (let W1302 (shen.<-out W1301) (let W1303 (shen.in-> W1301) (shen.comb W1303 (let W1304 (shen.prolog-arity-check W1299 W1302) (let W1305 (map (lambda Z1306 (shen.linearise-clause Z1306)) W1302) (shen.horn-clause-procedure W1299 W1305)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W1298) (shen.parse-failure) W1298))) +(defun shen. (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.prolog-arity-check (V1309 V1310) (cond ((and (cons? V1310) (and (cons? (hd V1310)) (and (cons? (tl (hd V1310))) (and (= () (tl (tl (hd V1310)))) (= () (tl V1310)))))) (length (hd (hd V1310)))) ((and (cons? V1310) (and (cons? (hd V1310)) (and (cons? (tl (hd V1310))) (= () (tl (tl (hd V1310))))))) (shen.pac-h V1309 (length (hd (hd V1310))) (tl V1310))) (true (simple-error "partial function shen.prolog-arity-check")))) +(defun shen.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.pac-h (V1315 V1316 V1317) (cond ((= () V1317) V1316) ((and (cons? V1317) (cons? (hd V1317))) (if (= V1316 (length (hd (hd V1317)))) (shen.pac-h V1315 V1316 (tl V1317)) (simple-error (cn "arity error in prolog procedure " (shen.app V1315 " +(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. (V1318) (let W1319 (let W1320 (shen. V1318) (if (shen.parse-failure? W1320) (shen.parse-failure) (let W1321 (shen.<-out W1320) (let W1322 (shen.in-> W1320) (let W1323 (shen. W1322) (if (shen.parse-failure? W1323) (shen.parse-failure) (let W1324 (shen.<-out W1323) (let W1325 (shen.in-> W1323) (shen.comb W1325 (cons W1321 W1324)))))))))) (if (shen.parse-failure? W1319) (let W1326 (let W1327 ( V1318) (if (shen.parse-failure? W1327) (shen.parse-failure) (let W1328 (shen.<-out W1327) (let W1329 (shen.in-> W1327) (shen.comb W1329 (if (empty? W1328) () (simple-error (cn "Prolog syntax error here: - " (shen.app W1328 " - ..." shen.r))))))))) (if (shen.parse-failure? W1326) (shen.parse-failure) W1326)) W1319))) +(defun shen. (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.linearise-clause (V1330) (cond ((and (cons? V1330) (and (cons? (tl V1330)) (= () (tl (tl V1330))))) (shen.lch (shen.linearise (@p (hd V1330) (hd (tl V1330)))))) (true (simple-error "partial function shen.linearise-clause")))) +(defun shen.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.lch (V1331) (cond ((tuple? V1331) (cons (fst V1331) (cons (shen.lchh (snd V1331)) ()))) (true (simple-error "partial function shen.lch")))) +(defun shen.lch (V1345) (cond ((tuple? V1345) (cons (fst V1345) (cons (shen.lchh (snd V1345)) ()))) (true (simple-error "partial function shen.lch")))) -(defun shen.lchh (V1332) (cond ((and (cons? V1332) (and (= where (hd V1332)) (and (cons? (tl V1332)) (and (cons? (hd (tl V1332))) (and (= = (hd (hd (tl V1332)))) (and (cons? (tl (hd (tl V1332)))) (and (cons? (tl (tl (hd (tl V1332))))) (and (= () (tl (tl (tl (hd (tl V1332)))))) (and (cons? (tl (tl V1332))) (= () (tl (tl (tl V1332))))))))))))) (cons (cons (if (value shen.*occurs*) is! is) (tl (hd (tl V1332)))) (shen.lchh (hd (tl (tl V1332)))))) (true V1332))) +(defun shen.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. (V1333) (let W1334 (let W1335 (shen. V1333) (if (shen.parse-failure? W1335) (shen.parse-failure) (let W1336 (shen.<-out W1335) (let W1337 (shen.in-> W1335) (if (shen.hds=? W1337 <--) (let W1338 (tail W1337) (let W1339 (shen. W1338) (if (shen.parse-failure? W1339) (shen.parse-failure) (let W1340 (shen.<-out W1339) (let W1341 (shen.in-> W1339) (let W1342 (shen. W1341) (if (shen.parse-failure? W1342) (shen.parse-failure) (let W1343 (shen.in-> W1342) (shen.comb W1343 (cons W1336 (cons W1340 ()))))))))))) (shen.parse-failure)))))) (if (shen.parse-failure? W1334) (shen.parse-failure) W1334))) +(defun shen. (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. (V1344) (let W1345 (let W1346 (shen. V1344) (if (shen.parse-failure? W1346) (shen.parse-failure) (let W1347 (shen.<-out W1346) (let W1348 (shen.in-> W1346) (let W1349 (shen. W1348) (if (shen.parse-failure? W1349) (shen.parse-failure) (let W1350 (shen.<-out W1349) (let W1351 (shen.in-> W1349) (shen.comb W1351 (cons W1347 W1350)))))))))) (if (shen.parse-failure? W1345) (let W1352 (let W1353 ( V1344) (if (shen.parse-failure? W1353) (shen.parse-failure) (let W1354 (shen.in-> W1353) (shen.comb W1354 ())))) (if (shen.parse-failure? W1352) (shen.parse-failure) W1352)) W1345))) +(defun shen. (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. (V1355) (let W1356 (if (cons? V1355) (let W1357 (head V1355) (let W1358 (tail V1355) (if (and (atom? W1357) (not (shen.prolog-keyword? W1357))) (shen.comb W1358 W1357) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1356) (let W1359 (if (cons? V1355) (let W1360 (head V1355) (let W1361 (tail V1355) (if (= W1360 (intern ":")) (shen.comb W1361 W1360) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1359) (let W1362 (if (shen.ccons? V1355) (let W1363 (head V1355) (let W1364 (tail V1355) (if (shen.hds=? W1363 cons) (let W1365 (tail W1363) (let W1366 (shen. W1365) (if (shen.parse-failure? W1366) (shen.parse-failure) (let W1367 (shen.<-out W1366) (let W1368 (shen.in-> W1366) (let W1369 (shen. W1368) (if (shen.parse-failure? W1369) (shen.parse-failure) (let W1370 (shen.<-out W1369) (let W1371 (shen.in-> W1369) (let W1372 ( W1371) (if (shen.parse-failure? W1372) (shen.parse-failure) (let W1373 (shen.in-> W1372) (shen.comb W1364 (cons cons (cons W1367 (cons W1370 ())))))))))))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1362) (let W1374 (if (shen.ccons? V1355) (let W1375 (head V1355) (let W1376 (tail V1355) (if (shen.hds=? W1375 +) (let W1377 (tail W1375) (let W1378 (shen. W1377) (if (shen.parse-failure? W1378) (shen.parse-failure) (let W1379 (shen.<-out W1378) (let W1380 (shen.in-> W1378) (let W1381 ( W1380) (if (shen.parse-failure? W1381) (shen.parse-failure) (let W1382 (shen.in-> W1381) (shen.comb W1376 (cons shen.+m (cons W1379 ()))))))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1374) (let W1383 (if (shen.ccons? V1355) (let W1384 (head V1355) (let W1385 (tail V1355) (if (shen.hds=? W1384 -) (let W1386 (tail W1384) (let W1387 (shen. W1386) (if (shen.parse-failure? W1387) (shen.parse-failure) (let W1388 (shen.<-out W1387) (let W1389 (shen.in-> W1387) (let W1390 ( W1389) (if (shen.parse-failure? W1390) (shen.parse-failure) (let W1391 (shen.in-> W1390) (shen.comb W1385 (cons shen.-m (cons W1388 ()))))))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1383) (let W1392 (if (shen.ccons? V1355) (let W1393 (head V1355) (let W1394 (tail V1355) (if (shen.hds=? W1393 mode) (let W1395 (tail W1393) (let W1396 (shen. W1395) (if (shen.parse-failure? W1396) (shen.parse-failure) (let W1397 (shen.<-out W1396) (let W1398 (shen.in-> W1396) (if (shen.hds=? W1398 +) (let W1399 (tail W1398) (let W1400 ( W1399) (if (shen.parse-failure? W1400) (shen.parse-failure) (let W1401 (shen.in-> W1400) (shen.comb W1394 (cons shen.+m (cons W1397 ()))))))) (shen.parse-failure))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1392) (let W1402 (if (shen.ccons? V1355) (let W1403 (head V1355) (let W1404 (tail V1355) (if (shen.hds=? W1403 mode) (let W1405 (tail W1403) (let W1406 (shen. W1405) (if (shen.parse-failure? W1406) (shen.parse-failure) (let W1407 (shen.<-out W1406) (let W1408 (shen.in-> W1406) (if (shen.hds=? W1408 -) (let W1409 (tail W1408) (let W1410 ( W1409) (if (shen.parse-failure? W1410) (shen.parse-failure) (let W1411 (shen.in-> W1410) (shen.comb W1404 (cons shen.-m (cons W1407 ()))))))) (shen.parse-failure))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1402) (shen.parse-failure) W1402)) W1392)) W1383)) W1374)) W1362)) W1359)) W1356))) +(defun shen. (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.prolog-keyword? (V1412) (element? V1412 (cons (intern ";") (cons <-- ())))) +(defun shen.prolog-keyword? (V1426) (element? V1426 (cons (intern ";") (cons <-- ())))) -(defun atom? (V1413) (or (symbol? V1413) (or (string? V1413) (or (boolean? V1413) (or (number? V1413) (empty? V1413)))))) +(defun atom? (V1427) (or (symbol? V1427) (or (string? V1427) (or (boolean? V1427) (or (number? V1427) (empty? V1427)))))) -(defun shen. (V1414) (let W1415 (let W1416 (shen. V1414) (if (shen.parse-failure? W1416) (shen.parse-failure) (let W1417 (shen.<-out W1416) (let W1418 (shen.in-> W1416) (shen.comb W1418 W1417))))) (if (shen.parse-failure? W1415) (shen.parse-failure) W1415))) +(defun shen. (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. (V1419) (let W1420 (let W1421 (shen. V1419) (if (shen.parse-failure? W1421) (shen.parse-failure) (let W1422 (shen.<-out W1421) (let W1423 (shen.in-> W1421) (shen.comb W1423 W1422))))) (if (shen.parse-failure? W1420) (shen.parse-failure) W1420))) +(defun shen. (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. (V1424) (let W1425 (let W1426 (shen. V1424) (if (shen.parse-failure? W1426) (shen.parse-failure) (let W1427 (shen.<-out W1426) (let W1428 (shen.in-> W1426) (let W1429 (shen. W1428) (if (shen.parse-failure? W1429) (shen.parse-failure) (let W1430 (shen.<-out W1429) (let W1431 (shen.in-> W1429) (shen.comb W1431 (cons W1427 W1430)))))))))) (if (shen.parse-failure? W1425) (let W1432 (let W1433 ( V1424) (if (shen.parse-failure? W1433) (shen.parse-failure) (let W1434 (shen.in-> W1433) (shen.comb W1434 ())))) (if (shen.parse-failure? W1432) (shen.parse-failure) W1432)) W1425))) +(defun shen. (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. (V1435) (let W1436 (if (shen.hds=? V1435 !) (let W1437 (tail V1435) (shen.comb W1437 !)) (shen.parse-failure)) (if (shen.parse-failure? W1436) (let W1438 (if (shen.ccons? V1435) (let W1439 (head V1435) (let W1440 (tail V1435) (let W1441 (shen. W1439) (if (shen.parse-failure? W1441) (shen.parse-failure) (let W1442 (shen.<-out W1441) (let W1443 (shen.in-> W1441) (let W1444 ( W1443) (if (shen.parse-failure? W1444) (shen.parse-failure) (let W1445 (shen.in-> W1444) (shen.comb W1440 W1442)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W1438) (shen.parse-failure) W1438)) W1436))) +(defun shen. (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. (V1446) (let W1447 (let W1448 (shen. V1446) (if (shen.parse-failure? W1448) (shen.parse-failure) (let W1449 (shen.<-out W1448) (let W1450 (shen.in-> W1448) (let W1451 (shen. W1450) (if (shen.parse-failure? W1451) (shen.parse-failure) (let W1452 (shen.<-out W1451) (let W1453 (shen.in-> W1451) (shen.comb W1453 (cons W1449 W1452)))))))))) (if (shen.parse-failure? W1447) (let W1454 (let W1455 ( V1446) (if (shen.parse-failure? W1455) (shen.parse-failure) (let W1456 (shen.in-> W1455) (shen.comb W1456 ())))) (if (shen.parse-failure? W1454) (shen.parse-failure) W1454)) W1447))) +(defun shen. (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. (V1457) (let W1458 (let W1459 (shen. V1457) (if (shen.parse-failure? W1459) (shen.parse-failure) (let W1460 (shen.<-out W1459) (let W1461 (shen.in-> W1459) (shen.comb W1461 W1460))))) (if (shen.parse-failure? W1458) (let W1462 (if (cons? V1457) (let W1463 (head V1457) (let W1464 (tail V1457) (if (atom? W1463) (shen.comb W1464 W1463) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1462) (let W1465 (if (shen.ccons? V1457) (let W1466 (head V1457) (let W1467 (tail V1457) (let W1468 (shen. W1466) (if (shen.parse-failure? W1468) (shen.parse-failure) (let W1469 (shen.<-out W1468) (let W1470 (shen.in-> W1468) (let W1471 ( W1470) (if (shen.parse-failure? W1471) (shen.parse-failure) (let W1472 (shen.in-> W1471) (shen.comb W1467 W1469)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W1465) (shen.parse-failure) W1465)) W1462)) W1458))) +(defun shen. (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. (V1473) (let W1474 (if (cons? V1473) (let W1475 (head V1473) (let W1476 (tail V1473) (if (= W1475 _) (shen.comb W1476 (gensym Y)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1474) (shen.parse-failure) W1474))) +(defun shen. (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. (V1477) (let W1478 (if (cons? V1477) (let W1479 (head V1477) (let W1480 (tail V1477) (if (shen.semicolon? W1479) (shen.comb W1480 W1479) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1478) (shen.parse-failure) W1478))) +(defun shen. (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.horn-clause-procedure (V1481 V1482) (let W1483 (gensym B) (let W1484 (gensym L) (let W1485 (gensym K) (let W1486 (gensym C) (let W1487 (shen.prolog-parameters V1482) (let W1488 (shen.hascut? V1482) (let W1489 (shen.prolog-fbody V1482 W1487 W1483 W1484 W1485 W1486 W1488) (let W1490 (if W1488 (cons let (cons W1485 (cons (cons + (cons W1485 (cons 1 ()))) (cons W1489 ())))) W1489) (let W1491 (cons define (cons V1481 (append W1487 (append (cons W1483 (cons W1484 (cons W1485 (cons W1486 (cons -> ()))))) (cons W1490 ()))))) W1491)))))))))) +(defun shen.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.hascut? (V1494) (cond ((= ! V1494) true) ((cons? V1494) (or (shen.hascut? (hd V1494)) (shen.hascut? (tl V1494)))) (true false))) +(defun shen.hascut? (V1508) (cond ((= ! V1508) true) ((cons? V1508) (or (shen.hascut? (hd V1508)) (shen.hascut? (tl V1508)))) (true false))) -(defun shen.prolog-parameters (V1499) (cond ((and (cons? V1499) (cons? (hd V1499))) (shen.parameters (length (hd (hd V1499))))) (true (simple-error "partial function shen.prolog-parameters")))) +(defun shen.prolog-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-fbody (V1520 V1521 V1522 V1523 V1524 V1525 V1526) (cond ((and (= () V1520) (= true V1526)) (cons shen.unlock (cons V1523 (cons V1524 ())))) ((and (cons? V1520) (and (cons? (hd V1520)) (and (cons? (tl (hd V1520))) (and (= () (tl (tl (hd V1520)))) (and (= () (tl V1520)) (= false V1526)))))) (let W1527 (shen.continue (hd (hd V1520)) (hd (tl (hd V1520))) V1522 V1523 V1524 V1525) (cons if (cons (cons shen.unlocked? (cons V1523 ())) (cons (shen.compile-head shen.+m (hd (hd V1520)) V1521 V1522 W1527) (cons false ())))))) ((and (cons? V1520) (and (cons? (hd V1520)) (and (cons? (tl (hd V1520))) (= () (tl (tl (hd V1520))))))) (let W1528 (gensym C) (let W1529 (shen.continue (hd (hd V1520)) (hd (tl (hd V1520))) V1522 V1523 V1524 V1525) (cons let (cons W1528 (cons (cons if (cons (cons shen.unlocked? (cons V1523 ())) (cons (shen.compile-head shen.+m (hd (hd V1520)) V1521 V1522 W1529) (cons false ())))) (cons (cons if (cons (cons = (cons W1528 (cons false ()))) (cons (shen.prolog-fbody (tl V1520) V1521 V1522 V1523 V1524 V1525 V1526) (cons W1528 ())))) ()))))))) (true (simple-error "implementation error in shen.prolog-fbody")))) +(defun shen.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.unlock (V1530 V1531) (if (and (shen.locked? V1530) (shen.fits? V1531 V1530)) (shen.openlock V1530) false)) +(defun shen.unlock (V1544 V1545) (if (and (shen.locked? V1544) (shen.fits? V1545 V1544)) (shen.openlock V1544) false)) -(defun shen.locked? (V1532) (not (shen.unlocked? V1532))) +(defun shen.locked? (V1546) (not (shen.unlocked? V1546))) -(defun shen.unlocked? (V1533) (<-address V1533 1)) +(defun shen.unlocked? (V1547) (<-address V1547 1)) -(defun shen.openlock (V1534) (do (address-> V1534 1 true) false)) +(defun shen.openlock (V1548) (do (address-> V1548 1 true) false)) -(defun shen.fits? (V1535 V1536) (= V1535 (<-address V1536 2))) +(defun shen.fits? (V1549 V1550) (= V1549 (<-address V1550 2))) -(defun shen.cut (V1539 V1540 V1541 V1542) (let W1543 (thaw V1542) (if (and (= W1543 false) (shen.unlocked? V1540)) (shen.lock V1541 V1540) W1543))) +(defun shen.cut (V1553 V1554 V1555 V1556) (let W1557 (thaw V1556) (if (and (= W1557 false) (shen.unlocked? V1554)) (shen.lock V1555 V1554) W1557))) -(defun shen.lock (V1544 V1545) (let W1546 (address-> V1545 1 false) (let W1547 (address-> V1545 2 V1544) false))) +(defun shen.lock (V1558 V1559) (let W1560 (address-> V1559 1 false) (let W1561 (address-> V1559 2 V1558) false))) -(defun shen.continue (V1548 V1549 V1550 V1551 V1552 V1553) (let W1554 (shen.extract-vars V1548) (let W1555 (shen.extract-free-vars V1549) (let W1556 (difference W1555 W1554) (let W1557 (cons do (cons (cons shen.incinfs ()) (cons (shen.compile-body V1549 V1550 V1551 V1552 V1553) ()))) (shen.stpart W1556 W1557 V1550)))))) +(defun shen.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.extract-free-vars (V1560) (cond ((and (cons? V1560) (and (= lambda (hd V1560)) (and (cons? (tl V1560)) (and (cons? (tl (tl V1560))) (= () (tl (tl (tl V1560)))))))) (remove (hd (tl V1560)) (shen.extract-free-vars (hd (tl (tl V1560)))))) ((cons? V1560) (union (shen.extract-free-vars (hd V1560)) (shen.extract-free-vars (tl V1560)))) ((variable? V1560) (cons V1560 ())) (true ()))) +(defun shen.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.compile-body (V1577 V1578 V1579 V1580 V1581) (cond ((= () V1577) (cons thaw (cons V1581 ()))) ((and (cons? V1577) (= ! (hd V1577))) (shen.compile-body (cons (cons shen.cut ()) (tl V1577)) V1578 V1579 V1580 V1581)) ((and (cons? V1577) (= () (tl V1577))) (append (shen.deref-calls (hd V1577) V1578) (cons V1578 (cons V1579 (cons V1580 (cons V1581 ())))))) ((cons? V1577) (let W1582 (shen.deref-calls (hd V1577) V1578) (append W1582 (cons V1578 (cons V1579 (cons V1580 (cons (shen.freeze-literals (tl V1577) V1578 V1579 V1580 V1581) ()))))))) (true (simple-error "implementation error in shen.compile-fbody")))) +(defun shen.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.freeze-literals (V1599 V1600 V1601 V1602 V1603) (cond ((= () V1599) V1603) ((and (cons? V1599) (= ! (hd V1599))) (shen.freeze-literals (cons (cons shen.cut ()) (tl V1599)) V1600 V1601 V1602 V1603)) ((cons? V1599) (let W1604 (shen.deref-calls (hd V1599) V1600) (cons freeze (cons (append W1604 (cons V1600 (cons V1601 (cons V1602 (cons (shen.freeze-literals (tl V1599) V1600 V1601 V1602 V1603) ()))))) ())))) (true (simple-error "implementation error in shen.freeze-literals")))) +(defun shen.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.deref-calls (V1609 V1610) (cond ((and (cons? V1609) (= fork (hd V1609))) (cons fork (cons (shen.deref-forked-literals (tl V1609) V1610) ()))) ((cons? V1609) (cons (hd V1609) (map (lambda Z1611 (shen.function-calls Z1611 V1610)) (tl V1609)))) (true (simple-error "implementation error in shen.deref-calls")))) +(defun shen.deref-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-forked-literals (V1618 V1619) (cond ((= () V1618) ()) ((cons? V1618) (cons cons (cons (shen.deref-calls (hd V1618) V1619) (cons (shen.deref-forked-literals (tl V1618) V1619) ())))) (true (simple-error "fork requires a list of literals +(defun shen.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.function-calls (V1622 V1623) (cond ((and (cons? V1622) (and (= cons (hd V1622)) (and (cons? (tl V1622)) (and (cons? (tl (tl V1622))) (= () (tl (tl (tl V1622)))))))) (cons cons (cons (shen.function-calls (hd (tl V1622)) V1623) (cons (shen.function-calls (hd (tl (tl V1622))) V1623) ())))) ((cons? V1622) (shen.deref-terms V1622 V1623 ())) (true V1622))) +(defun shen.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.deref-terms (V1632 V1633 V1634) (cond ((and (cons? V1632) (and (= 0 (hd V1632)) (and (cons? (tl V1632)) (= () (tl (tl V1632)))))) (if (variable? (hd (tl V1632))) (hd (tl V1632)) (simple-error (cn "attempt to optimise a non-variable " (shen.app (hd (tl V1632)) " -" shen.s))))) ((and (cons? V1632) (and (= 1 (hd V1632)) (and (cons? (tl V1632)) (= () (tl (tl V1632)))))) (if (variable? (hd (tl V1632))) (cons shen.lazyderef (cons (hd (tl V1632)) (cons V1633 ()))) (simple-error (cn "attempt to optimise a non-variable " (shen.app (hd (tl V1632)) " -" shen.s))))) ((and (not (element? V1632 V1634)) (variable? V1632)) (cons shen.deref (cons V1632 (cons V1633 ())))) ((and (cons? V1632) (and (= lambda (hd V1632)) (and (cons? (tl V1632)) (and (cons? (tl (tl V1632))) (= () (tl (tl (tl V1632)))))))) (cons lambda (cons (hd (tl V1632)) (cons (shen.deref-terms (hd (tl (tl V1632))) V1633 (cons (hd (tl V1632)) V1634)) ())))) ((cons? V1632) (map (lambda Z1635 (shen.deref-terms Z1635 V1633 V1634)) V1632)) (true V1632))) +(defun shen.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.compile-head (V1653 V1654 V1655 V1656 V1657) (cond ((and (= () V1654) (= () V1655)) V1657) ((and (cons? V1654) (and (cons? (hd V1654)) (and (= shen.+m (hd (hd V1654))) (and (cons? (tl (hd V1654))) (= () (tl (tl (hd V1654)))))))) (shen.compile-head V1653 (cons shen.+m (cons (hd (tl (hd V1654))) (cons V1653 (tl V1654)))) V1655 V1656 V1657)) ((and (cons? V1654) (and (cons? (hd V1654)) (and (= shen.-m (hd (hd V1654))) (and (cons? (tl (hd V1654))) (= () (tl (tl (hd V1654)))))))) (shen.compile-head V1653 (cons shen.-m (cons (hd (tl (hd V1654))) (cons V1653 (tl V1654)))) V1655 V1656 V1657)) ((and (cons? V1654) (= shen.-m (hd V1654))) (shen.compile-head shen.-m (tl V1654) V1655 V1656 V1657)) ((and (cons? V1654) (= shen.+m (hd V1654))) (shen.compile-head shen.+m (tl V1654) V1655 V1656 V1657)) ((and (cons? V1654) (and (cons? V1655) (shen.wildcard? (hd V1654)))) (shen.compile-head V1653 (tl V1654) (tl V1655) V1656 V1657)) ((and (cons? V1654) (variable? (hd V1654))) (shen.variable-case V1653 V1654 V1655 V1656 V1657)) ((and (= shen.-m V1653) (and (cons? V1654) (atom? (hd V1654)))) (shen.atom-case-minus V1654 V1655 V1656 V1657)) ((and (= shen.-m V1653) (and (cons? V1654) (and (cons? (hd V1654)) (and (= cons (hd (hd V1654))) (and (cons? (tl (hd V1654))) (and (cons? (tl (tl (hd V1654)))) (= () (tl (tl (tl (hd V1654))))))))))) (shen.cons-case-minus V1654 V1655 V1656 V1657)) ((and (= shen.+m V1653) (and (cons? V1654) (atom? (hd V1654)))) (shen.atom-case-plus V1654 V1655 V1656 V1657)) ((and (= shen.+m V1653) (and (cons? V1654) (and (cons? (hd V1654)) (and (= cons (hd (hd V1654))) (and (cons? (tl (hd V1654))) (and (cons? (tl (tl (hd V1654)))) (= () (tl (tl (tl (hd V1654))))))))))) (shen.cons-case-plus V1654 V1655 V1656 V1657)) (true (simple-error "implementation error in shen.compile-head")))) +(defun shen.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.variable-case (V1668 V1669 V1670 V1671 V1672) (cond ((and (cons? V1669) (cons? V1670)) (if (variable? (hd V1670)) (shen.compile-head V1668 (tl V1669) (tl V1670) V1671 (subst (hd V1670) (hd V1669) V1672)) (cons let (cons (hd V1669) (cons (hd V1670) (cons (shen.compile-head V1668 (tl V1669) (tl V1670) V1671 V1672) ())))))) (true (simple-error "implementation error in shen.variable-case")))) +(defun shen.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.atom-case-minus (V1681 V1682 V1683 V1684) (cond ((and (cons? V1681) (cons? V1682)) (let W1685 (gensym Tm) (cons let (cons W1685 (cons (cons shen.lazyderef (cons (hd V1682) (cons V1683 ()))) (cons (cons if (cons (cons = (cons W1685 (cons (hd V1681) ()))) (cons (shen.compile-head shen.-m (tl V1681) (tl V1682) V1683 V1684) (cons false ())))) ())))))) (true (simple-error "implementation error in shen.atom-case-minus")))) +(defun shen.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.cons-case-minus (V1694 V1695 V1696 V1697) (cond ((and (cons? V1694) (and (cons? (hd V1694)) (and (= cons (hd (hd V1694))) (and (cons? (tl (hd V1694))) (and (cons? (tl (tl (hd V1694)))) (and (= () (tl (tl (tl (hd V1694))))) (cons? V1695))))))) (let W1698 (gensym Tm) (cons let (cons W1698 (cons (cons shen.lazyderef (cons (hd V1695) (cons V1696 ()))) (cons (cons if (cons (cons cons? (cons W1698 ())) (cons (shen.compile-head shen.-m (cons (hd (tl (hd V1694))) (cons (hd (tl (tl (hd V1694)))) (tl V1694))) (cons (cons hd (cons W1698 ())) (cons (cons tl (cons W1698 ())) (tl V1695))) V1696 V1697) (cons false ())))) ())))))) (true (simple-error "implementation error in shen.cons-case-minus")))) +(defun shen.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.atom-case-plus (V1707 V1708 V1709 V1710) (cond ((and (cons? V1707) (cons? V1708)) (let W1711 (gensym Tm) (let W1712 (gensym GoTo) (cons let (cons W1711 (cons (cons shen.lazyderef (cons (hd V1708) (cons V1709 ()))) (cons W1712 (cons (cons freeze (cons (shen.compile-head shen.+m (tl V1707) (tl V1708) V1709 V1710) ())) (cons (cons if (cons (cons = (cons W1711 (cons (hd V1707) ()))) (cons (cons thaw (cons W1712 ())) (cons (cons if (cons (cons shen.pvar? (cons W1711 ())) (cons (cons shen.bind! (cons W1711 (cons (shen.demode (hd V1707)) (cons V1709 (cons W1712 ()))))) (cons false ())))) ())))) ()))))))))) (true (simple-error "implementation error in shen.atom-case-plus")))) +(defun shen.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.cons-case-plus (V1721 V1722 V1723 V1724) (cond ((and (cons? V1721) (and (cons? (hd V1721)) (and (= cons (hd (hd V1721))) (and (cons? (tl (hd V1721))) (and (cons? (tl (tl (hd V1721)))) (and (= () (tl (tl (tl (hd V1721))))) (cons? V1722))))))) (let W1725 (gensym Tm) (let W1726 (gensym GoTo) (let W1727 (shen.extract-vars (cons (hd (tl (hd V1721))) (hd (tl (tl (hd V1721)))))) (let W1728 (shen.tame (hd V1721)) (let W1729 (shen.extract-vars W1728) (cons let (cons W1725 (cons (cons shen.lazyderef (cons (hd V1722) (cons V1723 ()))) (cons W1726 (cons (shen.goto W1727 (shen.compile-head shen.+m (tl V1721) (tl V1722) V1723 V1724)) (cons (cons if (cons (cons cons? (cons W1725 ())) (cons (shen.compile-head shen.+m (tl (hd V1721)) (cons (cons hd (cons W1725 ())) (cons (cons tl (cons W1725 ())) ())) V1723 (shen.invoke W1726 W1727)) (cons (cons if (cons (cons shen.pvar? (cons W1725 ())) (cons (shen.stpart W1729 (cons shen.bind! (cons W1725 (cons (shen.demode W1728) (cons V1723 (cons (cons freeze (cons (shen.invoke W1726 W1727) ())) ()))))) V1723) (cons false ())))) ())))) ())))))))))))) (true (simple-error "implementation error in shen.cons-case-plus")))) +(defun shen.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.demode (V1730) (cond ((and (cons? V1730) (and (= shen.+m (hd V1730)) (and (cons? (tl V1730)) (= () (tl (tl V1730)))))) (shen.demode (hd (tl V1730)))) ((and (cons? V1730) (and (= shen.-m (hd V1730)) (and (cons? (tl V1730)) (= () (tl (tl V1730)))))) (shen.demode (hd (tl V1730)))) ((cons? V1730) (map (lambda Z1731 (shen.demode Z1731)) V1730)) (true V1730))) +(defun shen.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.tame (V1732) (cond ((shen.wildcard? V1732) (gensym Y)) ((cons? V1732) (map (lambda Z1733 (shen.tame Z1733)) V1732)) (true V1732))) +(defun shen.tame (V1746) (cond ((shen.wildcard? V1746) (gensym Y)) ((cons? V1746) (map (lambda Z1747 (shen.tame Z1747)) V1746)) (true V1746))) -(defun shen.goto (V1734 V1735) (cond ((= () V1734) (cons freeze (cons V1735 ()))) (true (shen.goto-h V1734 V1735)))) +(defun shen.goto (V1748 V1749) (cond ((= () V1748) (cons freeze (cons V1749 ()))) (true (shen.goto-h V1748 V1749)))) -(defun shen.goto-h (V1736 V1737) (cond ((= () V1736) V1737) ((cons? V1736) (cons lambda (cons (hd V1736) (cons (shen.goto-h (tl V1736) V1737) ())))) (true (simple-error "partial function shen.goto-h")))) +(defun shen.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.invoke (V1738 V1739) (cond ((= () V1739) (cons thaw (cons V1738 ()))) (true (cons V1738 V1739)))) +(defun shen.invoke (V1752 V1753) (cond ((= () V1753) (cons thaw (cons V1752 ()))) (true (cons V1752 V1753)))) -(defun shen.wildcard? (V1740) (= V1740 _)) +(defun shen.wildcard? (V1754) (= V1754 _)) -(defun shen.pvar? (V1741) (trap-error (and (absvector? V1741) (= (<-address V1741 0) shen.pvar)) (lambda Z1742 false))) +(defun shen.pvar? (V1755) (trap-error (and (absvector? V1755) (= (<-address V1755 0) shen.pvar)) (lambda Z1756 false))) -(defun shen.lazyderef (V1743 V1744) (if (shen.pvar? V1743) (let W1745 (<-address V1744 (<-address V1743 1)) (if (= W1745 shen.-null-) V1743 (shen.lazyderef W1745 V1744))) V1743)) +(defun shen.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.deref (V1746 V1747) (cond ((cons? V1746) (cons (shen.deref (hd V1746) V1747) (shen.deref (tl V1746) V1747))) (true (if (shen.pvar? V1746) (let W1748 (<-address V1747 (<-address V1746 1)) (if (= W1748 shen.-null-) V1746 (shen.deref W1748 V1747))) V1746)))) +(defun shen.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.bind! (V1749 V1750 V1751 V1752) (let W1753 (shen.bindv V1749 V1750 V1751) (let W1754 (thaw V1752) (if (= W1754 false) (shen.unwind V1749 V1751 W1754) W1754)))) +(defun shen.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.bindv (V1755 V1756 V1757) (address-> V1757 (<-address V1755 1) V1756)) +(defun shen.bindv (V1769 V1770 V1771) (address-> V1771 (<-address V1769 1) V1770)) -(defun shen.unwind (V1758 V1759 V1760) (do (address-> V1759 (<-address V1758 1) shen.-null-) V1760)) +(defun shen.unwind (V1772 V1773 V1774) (do (address-> V1773 (<-address V1772 1) shen.-null-) V1774)) -(defun shen.stpart (V1769 V1770 V1771) (cond ((= () V1769) V1770) ((cons? V1769) (cons let (cons (hd V1769) (cons (cons shen.newpv (cons V1771 ())) (cons (cons shen.gc (cons V1771 (cons (shen.stpart (tl V1769) V1770 V1771) ()))) ()))))) (true (simple-error "implementation error in shen.stpart")))) +(defun shen.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.gc (V1772 V1773) (if (= V1773 false) (let W1774 (shen.ticket-number V1772) (do (shen.decrement-ticket W1774 V1772) V1773)) V1773)) +(defun shen.gc (V1786 V1787) (if (= V1787 false) (let W1788 (shen.ticket-number V1786) (do (shen.decrement-ticket W1788 V1786) V1787)) V1787)) -(defun shen.decrement-ticket (V1775 V1776) (address-> V1776 1 (- V1775 1))) +(defun shen.decrement-ticket (V1789 V1790) (address-> V1790 1 (- V1789 1))) -(defun shen.newpv (V1777) (let W1778 (shen.ticket-number V1777) (let W1779 (shen.make-prolog-variable W1778) (let W1780 (shen.nextticket V1777 W1778) W1779)))) +(defun shen.newpv (V1791) (let W1792 (shen.ticket-number V1791) (let W1793 (shen.make-prolog-variable W1792) (let W1794 (shen.nextticket V1791 W1792) W1793)))) -(defun shen.ticket-number (V1781) (<-address V1781 1)) +(defun shen.ticket-number (V1795) (<-address V1795 1)) -(defun shen.nextticket (V1782 V1783) (let W1784 (address-> V1782 V1783 shen.-null-) (address-> W1784 1 (+ V1783 1)))) +(defun shen.nextticket (V1796 V1797) (let W1798 (address-> V1796 V1797 shen.-null-) (address-> W1798 1 (+ V1797 1)))) -(defun shen.make-prolog-variable (V1785) (address-> (address-> (absvector 2) 0 shen.pvar) 1 V1785)) +(defun shen.make-prolog-variable (V1799) (address-> (address-> (absvector 2) 0 shen.pvar) 1 V1799)) -(defun shen.pvar (V1786) (cn "Var" (shen.app (<-address V1786 1) "" shen.a))) +(defun shen.pvar (V1800) (cn "Var" (shen.app (<-address V1800 1) "" shen.a))) (defun shen.incinfs () (set shen.*infs* (+ 1 (value shen.*infs*)))) -(defun shen.prolog-vector-size (V1787) (if (and (integer? V1787) (> V1787 0)) (set shen.*size-prolog-vector* V1787) (simple-error (cn "prolog vector size: size should be a positive integer; not " (shen.app V1787 "" shen.a))))) +(defun shen.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.lzy=! (V1799 V1800 V1801 V1802) (cond ((= V1799 V1800) (thaw V1802)) ((and (shen.pvar? V1799) (not (shen.occurs-check? V1799 (shen.deref V1800 V1801)))) (shen.bind! V1799 V1800 V1801 V1802)) ((and (shen.pvar? V1800) (not (shen.occurs-check? V1800 (shen.deref V1799 V1801)))) (shen.bind! V1800 V1799 V1801 V1802)) ((and (cons? V1799) (cons? V1800)) (shen.lzy=! (shen.lazyderef (hd V1799) V1801) (shen.lazyderef (hd V1800) V1801) V1801 (freeze (shen.lzy=! (shen.lazyderef (tl V1799) V1801) (shen.lazyderef (tl V1800) V1801) V1801 V1802)))) (true false))) +(defun shen.lzy=! (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= (V1814 V1815 V1816 V1817) (cond ((= V1814 V1815) (thaw V1817)) ((shen.pvar? V1814) (shen.bind! V1814 V1815 V1816 V1817)) ((shen.pvar? V1815) (shen.bind! V1815 V1814 V1816 V1817)) ((and (cons? V1814) (cons? V1815)) (shen.lzy= (shen.lazyderef (hd V1814) V1816) (shen.lazyderef (hd V1815) V1816) V1816 (freeze (shen.lzy= (shen.lazyderef (tl V1814) V1816) (shen.lazyderef (tl V1815) V1816) V1816 V1817)))) (true false))) +(defun shen.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.occurs-check? (V1823 V1824) (cond ((= V1823 V1824) true) ((cons? V1824) (or (shen.occurs-check? V1823 (hd V1824)) (shen.occurs-check? V1823 (tl V1824)))) (true false))) +(defun 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 call (V1825 V1826 V1827 V1828 V1829) ((((V1825 V1826) V1827) V1828) V1829)) +(defun call (V1839 V1840 V1841 V1842 V1843) ((((V1839 V1840) V1841) V1842) V1843)) -(defun return (V1836 V1837 V1838 V1839 V1840) (shen.deref V1836 V1837)) +(defun return (V1850 V1851 V1852 V1853 V1854) (shen.deref V1850 V1851)) -(defun when (V1847 V1848 V1849 V1850 V1851) (if V1847 (thaw V1851) false)) +(defun when (V1861 V1862 V1863 V1864 V1865) (if V1861 (thaw V1865) false)) -(defun is (V1852 V1853 V1854 V1855 V1856 V1857) (shen.lzy= (shen.lazyderef V1852 V1854) (shen.lazyderef V1853 V1854) V1854 V1857)) +(defun is (V1866 V1867 V1868 V1869 V1870 V1871) (shen.lzy= (shen.lazyderef V1866 V1868) (shen.lazyderef V1867 V1868) V1868 V1871)) -(defun is! (V1858 V1859 V1860 V1861 V1862 V1863) (shen.lzy=! (shen.lazyderef V1858 V1860) (shen.lazyderef V1859 V1860) V1860 V1863)) +(defun is! (V1872 V1873 V1874 V1875 V1876 V1877) (shen.lzy=! (shen.lazyderef V1872 V1874) (shen.lazyderef V1873 V1874) V1874 V1877)) -(defun bind (V1868 V1869 V1870 V1871 V1872 V1873) (shen.bind! V1868 V1869 V1870 V1873)) +(defun bind (V1882 V1883 V1884 V1885 V1886 V1887) (shen.bind! V1882 V1883 V1884 V1887)) -(defun var? (V1874 V1875 V1876 V1877 V1878) (if (shen.pvar? (shen.lazyderef V1874 V1875)) (thaw V1878) false)) +(defun var? (V1888 V1889 V1890 V1891 V1892) (if (shen.pvar? (shen.lazyderef V1888 V1889)) (thaw V1892) false)) -(defun shen.print-prolog-vector (V1881) "|prolog vector|") +(defun shen.print-prolog-vector (V1895) "|prolog vector|") -(defun fork (V1900 V1901 V1902 V1903 V1904) (cond ((= () V1900) false) ((cons? V1900) (let W1905 (((((hd V1900) V1901) V1902) V1903) V1904) (if (= W1905 false) (fork (tl V1900) V1901 V1902 V1903 V1904) W1905))) (true (simple-error "fork expects a list of literals +(defun 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 findall (V1906 V1907 V1908 V1909 V1910 V1911 V1912) (if (shen.unlocked? V1910) (let W1913 (shen.newpv V1909) (shen.gc V1909 (do (shen.incinfs) (is W1913 () V1909 V1910 V1911 (freeze (shen.findall-h V1906 V1907 V1908 W1913 V1909 V1910 V1911 V1912)))))) false)) +(defun 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 shen.findall-h (V1914 V1915 V1916 V1917 V1918 V1919 V1920 V1921) (let W1922 (if (shen.unlocked? V1919) (do (shen.incinfs) (call V1915 V1918 V1919 V1920 (freeze (shen.overbind V1914 V1917 V1918 V1919 V1920 V1921)))) false) (if (= W1922 false) (if (shen.unlocked? V1919) (do (shen.incinfs) (is! V1916 V1917 V1918 V1919 V1920 V1921)) false) W1922))) +(defun shen.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.overbind (V1929 V1930 V1931 V1932 V1933 V1934) (do (shen.bindv V1930 (cons (shen.deref V1929 V1931) (shen.lazyderef V1930 V1931)) V1931) false)) +(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 occurs-check (V1937) (cond ((= + V1937) (set shen.*occurs* true)) ((= - V1937) (set shen.*occurs* false)) (true (simple-error "occurs-check expects a + or a -. +(defun occurs-check (V1951) (cond ((= + V1951) (set shen.*occurs* true)) ((= - V1951) (set shen.*occurs* false)) (true (simple-error "occurs-check expects a + or a -. ")))) diff --git a/klambda/reader.kl b/klambda/reader.kl index ba23f33..5eda85b 100644 --- a/klambda/reader.kl +++ b/klambda/reader.kl @@ -1,273 +1,273 @@ -(defun read-file (V2182) (let W2183 (read-file-as-bytelist V2182) (let W2184 (trap-error (compile (lambda Z2185 (shen. Z2185)) W2183) (lambda Z2186 (shen.reader-error (value shen.*residue*)))) (let W2187 (shen.process-sexprs W2184) W2187)))) +(defun 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 shen.reader-error (V2188) (simple-error (shen.proc-nl (cn "reader error near here: " (shen.reader-error-message (value *maximum-print-sequence-size*) 0 V2188))))) +(defun shen.reader-error (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-message (V2196 V2197 V2198) (cond ((= () V2198) "") ((= V2196 V2197) "") ((cons? V2198) (cn (n->string (hd V2198)) (shen.reader-error-message V2196 (+ V2197 1) (tl V2198)))) (true (simple-error "partial function shen.reader-error-message")))) +(defun 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 it () (value shen.*it*)) -(defun read-file-as-bytelist (V2199) (let W2200 (open V2199 in) (let W2201 (read-byte W2200) (let W2202 (shen.read-file-as-bytelist-help W2200 W2201 ()) (let W2203 (close W2200) (reverse W2202)))))) +(defun 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 shen.read-file-as-bytelist-help (V2204 V2205 V2206) (cond ((= -1 V2205) V2206) (true (shen.read-file-as-bytelist-help V2204 (read-byte V2204) (cons V2205 V2206))))) +(defun 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 read-file-as-string (V2207) (let W2208 (open V2207 in) (shen.rfas-h W2208 (read-byte W2208) ""))) +(defun read-file-as-string (V2221) (let W2222 (open V2221 in) (shen.rfas-h W2222 (read-byte W2222) ""))) -(defun shen.rfas-h (V2209 V2210 V2211) (cond ((= -1 V2210) (do (close V2209) V2211)) (true (shen.rfas-h V2209 (read-byte V2209) (cn V2211 (n->string V2210)))))) +(defun 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 input (V2212) (eval-kl (read V2212))) +(defun input (V2226) (eval-kl (read V2226))) -(defun shen.input-h+ (V2213 V2214) (let W2215 (shen.monotype V2213) (let W2216 (read V2214) (if (= false (shen.typecheck W2216 V2213)) (simple-error (cn "type error: " (shen.app W2216 (cn " is not of type " (shen.app V2213 " -" shen.r)) shen.r))) (eval-kl W2216))))) +(defun shen.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.monotype (V2217) (cond ((cons? V2217) (map (lambda Z2218 (shen.monotype Z2218)) V2217)) (true (if (variable? V2217) (simple-error (cn "input+ expects a monotype: not " (shen.app V2217 " -" shen.a))) V2217)))) +(defun 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 lineread (V2219) (shen.read-loop V2219 (shen.my-read-byte V2219) () (lambda Z2220 (shen.return? Z2220)))) +(defun lineread (V2233) (shen.read-loop V2233 (shen.my-read-byte V2233) () (lambda Z2234 (shen.return? Z2234)))) -(defun read-from-string (V2221) (let W2222 (shen.str->bytes V2221) (let W2223 (compile (lambda Z2224 (shen. Z2224)) W2222) (let W2225 (shen.process-sexprs W2223) W2225)))) +(defun read-from-string (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-unprocessed (V2226) (let W2227 (shen.str->bytes V2226) (let W2228 (compile (lambda Z2229 (shen. Z2229)) W2227) W2228))) +(defun read-from-string-unprocessed (V2240) (let W2241 (shen.str->bytes V2240) (let W2242 (compile (lambda Z2243 (shen. Z2243)) W2241) W2242))) -(defun shen.str->bytes (V2230) (cond ((= "" V2230) ()) ((shen.+string? V2230) (cons (string->n (hdstr V2230)) (shen.str->bytes (tlstr V2230)))) (true (simple-error "partial function shen.str->bytes")))) +(defun 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 read (V2231) (hd (shen.read-loop V2231 (shen.my-read-byte V2231) () (lambda Z2232 (shen.whitespace? Z2232))))) +(defun read (V2245) (hd (shen.read-loop V2245 (shen.my-read-byte V2245) () (lambda Z2246 (shen.whitespace? Z2246))))) -(defun shen.my-read-byte (V2233) (if (shen.char-stinput? V2233) (string->n (shen.read-unit-string V2233)) (read-byte V2233))) +(defun shen.my-read-byte (V2247) (if (shen.char-stinput? V2247) (string->n (shen.read-unit-string V2247)) (read-byte V2247))) -(defun shen.read-loop (V2238 V2239 V2240 V2241) (cond ((= 94 V2239) (simple-error "read aborted")) ((= -1 V2239) (if (empty? V2240) (simple-error "error: empty stream") (compile (lambda Z2242 (shen. Z2242)) V2240))) ((= 0 V2239) (shen.read-loop V2238 (shen.my-read-byte V2238) V2240 V2241)) (true (if (V2241 V2239) (let W2243 (shen.try-parse V2240) (if (shen.nothing-doing? W2243) (shen.read-loop V2238 (shen.my-read-byte V2238) (append V2240 (cons V2239 ())) V2241) (do (shen.record-it V2240) W2243))) (shen.read-loop V2238 (shen.my-read-byte V2238) (append V2240 (cons V2239 ())) V2241))))) +(defun shen.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.try-parse (V2244) (let W2245 (trap-error (compile (lambda Z2246 (shen. Z2246)) V2244) (lambda Z2247 shen.i-failed!)) (if (shen.nothing-doing? W2245) shen.i-failed! (shen.process-sexprs W2245)))) +(defun shen.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.nothing-doing? (V2250) (cond ((= shen.i-failed! V2250) true) ((= () V2250) true) (true false))) +(defun shen.nothing-doing? (V2264) (cond ((= shen.i-failed! V2264) true) ((= () V2264) true) (true false))) -(defun shen.record-it (V2251) (set shen.*it* (shen.bytes->string V2251))) +(defun shen.record-it (V2265) (set shen.*it* (shen.bytes->string V2265))) -(defun shen.bytes->string (V2252) (cond ((= () V2252) "") ((cons? V2252) (cn (n->string (hd V2252)) (shen.bytes->string (tl V2252)))) (true (simple-error "partial function shen.bytes->string")))) +(defun shen.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.process-sexprs (V2253) (let W2254 (shen.unpackage¯oexpand V2253) (let W2255 (shen.find-arities W2254) (let W2256 (shen.find-types W2254) (map (lambda Z2257 (shen.process-applications Z2257 W2256)) W2254))))) +(defun shen.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.find-types (V2258) (cond ((and (cons? V2258) (and (cons? (tl V2258)) (= (hd V2258) (intern ":")))) (cons (hd (tl V2258)) (shen.find-types (tl (tl V2258))))) ((cons? V2258) (append (shen.find-types (hd V2258)) (shen.find-types (tl V2258)))) (true ()))) +(defun shen.find-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-arities (V2261) (cond ((and (cons? V2261) (and (= define (hd V2261)) (and (cons? (tl V2261)) (and (cons? (tl (tl V2261))) (= { (hd (tl (tl V2261)))))))) (shen.store-arity (hd (tl V2261)) (shen.find-arity (hd (tl V2261)) 1 (tl (tl (tl V2261)))))) ((and (cons? V2261) (and (= define (hd V2261)) (cons? (tl V2261)))) (shen.store-arity (hd (tl V2261)) (shen.find-arity (hd (tl V2261)) 0 (tl (tl V2261))))) ((cons? V2261) (map (lambda Z2262 (shen.find-arities Z2262)) V2261)) (true shen.skip))) +(defun shen.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.store-arity (V2263 V2264) (let W2265 (arity V2263) (if (= W2265 -1) (shen.execute-store-arity V2263 V2264) (if (= W2265 V2264) shen.skip (if (shen.sysfunc? V2263) (simple-error (shen.app V2263 " is a system function -" shen.a)) (do (pr (cn "changing the arity of " (shen.app V2263 " may cause errors -" shen.a)) (stoutput)) (shen.execute-store-arity V2263 V2264))))))) +(defun shen.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.execute-store-arity (V2266 V2267) (cond ((= 0 V2267) (put V2266 arity 0 (value *property-vector*))) (true (do (put V2266 arity V2267 (value *property-vector*)) (shen.update-lambdatable V2266 V2267))))) +(defun shen.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.update-lambdatable (V2268 V2269) (let W2270 (value shen.*lambdatable*) (let W2271 (eval-kl (shen.lambda-function (cons V2268 ()) V2269)) (let W2272 (shen.assoc-> V2268 W2271 W2270) (let W2273 (set shen.*lambdatable* W2272) W2273))))) +(defun shen.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.lambda-function (V2276 V2277) (cond ((= 0 V2277) shen.skip) ((= 1 V2277) (let W2278 (gensym Y) (cons lambda (cons W2278 (cons (append V2276 (cons W2278 ())) ()))))) (true (let W2279 (gensym Y) (cons lambda (cons W2279 (cons (shen.lambda-function (append V2276 (cons W2279 ())) (- V2277 1)) ()))))))) +(defun shen.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.assoc-> (V2289 V2290 V2291) (cond ((= () V2291) (cons (cons V2289 V2290) ())) ((and (cons? V2291) (and (cons? (hd V2291)) (= V2289 (hd (hd V2291))))) (cons (cons (hd (hd V2291)) V2290) (tl V2291))) ((cons? V2291) (cons (hd V2291) (shen.assoc-> V2289 V2290 (tl V2291)))) (true (simple-error "implementation error in shen.assoc->")))) +(defun shen.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.find-arity (V2306 V2307 V2308) (cond ((and (= 0 V2307) (and (cons? V2308) (= (hd V2308) ->))) 0) ((and (= 0 V2307) (and (cons? V2308) (= (hd V2308) <-))) 0) ((and (= 0 V2307) (cons? V2308)) (+ 1 (shen.find-arity V2306 0 (tl V2308)))) ((and (= 1 V2307) (and (cons? V2308) (= } (hd V2308)))) (shen.find-arity V2306 0 (tl V2308))) ((and (= 1 V2307) (cons? V2308)) (shen.find-arity V2306 1 (tl V2308))) ((= 1 V2307) (simple-error (cn "syntax error in " (shen.app V2306 " definition: missing } -" shen.a)))) (true (simple-error (cn "syntax error in " (shen.app V2306 " definition: missing -> or <- +(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 <- " shen.a)))))) -(defun shen. (V2309) (let W2310 (let W2311 (shen. V2309) (if (shen.parse-failure? W2311) (shen.parse-failure) (let W2312 (shen.in-> W2311) (let W2313 (shen. W2312) (if (shen.parse-failure? W2313) (shen.parse-failure) (let W2314 (shen.<-out W2313) (let W2315 (shen.in-> W2313) (let W2316 (shen. W2315) (if (shen.parse-failure? W2316) (shen.parse-failure) (let W2317 (shen.in-> W2316) (let W2318 (shen. W2317) (if (shen.parse-failure? W2318) (shen.parse-failure) (let W2319 (shen.<-out W2318) (let W2320 (shen.in-> W2318) (shen.comb W2320 (cons (shen.cons-form W2314) W2319)))))))))))))))) (if (shen.parse-failure? W2310) (let W2321 (let W2322 (shen. V2309) (if (shen.parse-failure? W2322) (shen.parse-failure) (let W2323 (shen.in-> W2322) (let W2324 (shen. W2323) (if (shen.parse-failure? W2324) (shen.parse-failure) (let W2325 (shen.<-out W2324) (let W2326 (shen.in-> W2324) (let W2327 (shen. W2326) (if (shen.parse-failure? W2327) (shen.parse-failure) (let W2328 (shen.in-> W2327) (let W2329 (shen. W2328) (if (shen.parse-failure? W2329) (shen.parse-failure) (let W2330 (shen.<-out W2329) (let W2331 (shen.in-> W2329) (shen.comb W2331 (shen.add-sexpr W2325 W2330)))))))))))))))) (if (shen.parse-failure? W2321) (let W2332 (let W2333 (shen. V2309) (if (shen.parse-failure? W2333) (shen.parse-failure) (let W2334 (shen.in-> W2333) (let W2335 (shen. W2334) (if (shen.parse-failure? W2335) (shen.parse-failure) (let W2336 (shen.<-out W2335) (let W2337 (shen.in-> W2335) (shen.comb W2337 (cons { W2336))))))))) (if (shen.parse-failure? W2332) (let W2338 (let W2339 (shen. V2309) (if (shen.parse-failure? W2339) (shen.parse-failure) (let W2340 (shen.in-> W2339) (let W2341 (shen. W2340) (if (shen.parse-failure? W2341) (shen.parse-failure) (let W2342 (shen.<-out W2341) (let W2343 (shen.in-> W2341) (shen.comb W2343 (cons } W2342))))))))) (if (shen.parse-failure? W2338) (let W2344 (let W2345 (shen. V2309) (if (shen.parse-failure? W2345) (shen.parse-failure) (let W2346 (shen.in-> W2345) (let W2347 (shen. W2346) (if (shen.parse-failure? W2347) (shen.parse-failure) (let W2348 (shen.<-out W2347) (let W2349 (shen.in-> W2347) (shen.comb W2349 (cons bar! W2348))))))))) (if (shen.parse-failure? W2344) (let W2350 (let W2351 (shen. V2309) (if (shen.parse-failure? W2351) (shen.parse-failure) (let W2352 (shen.in-> W2351) (let W2353 (shen. W2352) (if (shen.parse-failure? W2353) (shen.parse-failure) (let W2354 (shen.<-out W2353) (let W2355 (shen.in-> W2353) (shen.comb W2355 (cons (intern ";") W2354))))))))) (if (shen.parse-failure? W2350) (let W2356 (let W2357 (shen. V2309) (if (shen.parse-failure? W2357) (shen.parse-failure) (let W2358 (shen.in-> W2357) (let W2359 (shen. W2358) (if (shen.parse-failure? W2359) (shen.parse-failure) (let W2360 (shen.in-> W2359) (let W2361 (shen. W2360) (if (shen.parse-failure? W2361) (shen.parse-failure) (let W2362 (shen.<-out W2361) (let W2363 (shen.in-> W2361) (shen.comb W2363 (cons (intern ":=") W2362)))))))))))) (if (shen.parse-failure? W2356) (let W2364 (let W2365 (shen. V2309) (if (shen.parse-failure? W2365) (shen.parse-failure) (let W2366 (shen.in-> W2365) (let W2367 (shen. W2366) (if (shen.parse-failure? W2367) (shen.parse-failure) (let W2368 (shen.<-out W2367) (let W2369 (shen.in-> W2367) (shen.comb W2369 (cons (intern ":") W2368))))))))) (if (shen.parse-failure? W2364) (let W2370 (let W2371 (shen. V2309) (if (shen.parse-failure? W2371) (shen.parse-failure) (let W2372 (shen.in-> W2371) (let W2373 (shen. W2372) (if (shen.parse-failure? W2373) (shen.parse-failure) (let W2374 (shen.<-out W2373) (let W2375 (shen.in-> W2373) (shen.comb W2375 (cons (intern ",") W2374))))))))) (if (shen.parse-failure? W2370) (let W2376 (let W2377 (shen. V2309) (if (shen.parse-failure? W2377) (shen.parse-failure) (let W2378 (shen.in-> W2377) (let W2379 (shen. W2378) (if (shen.parse-failure? W2379) (shen.parse-failure) (let W2380 (shen.<-out W2379) (let W2381 (shen.in-> W2379) (shen.comb W2381 W2380)))))))) (if (shen.parse-failure? W2376) (let W2382 (let W2383 (shen. V2309) (if (shen.parse-failure? W2383) (shen.parse-failure) (let W2384 (shen.<-out W2383) (let W2385 (shen.in-> W2383) (let W2386 (shen. W2385) (if (shen.parse-failure? W2386) (shen.parse-failure) (let W2387 (shen.<-out W2386) (let W2388 (shen.in-> W2386) (shen.comb W2388 (cons W2384 W2387)))))))))) (if (shen.parse-failure? W2382) (let W2389 (let W2390 (shen. V2309) (if (shen.parse-failure? W2390) (shen.parse-failure) (let W2391 (shen.in-> W2390) (let W2392 (shen. W2391) (if (shen.parse-failure? W2392) (shen.parse-failure) (let W2393 (shen.<-out W2392) (let W2394 (shen.in-> W2392) (shen.comb W2394 W2393)))))))) (if (shen.parse-failure? W2389) (let W2395 (let W2396 ( V2309) (if (shen.parse-failure? W2396) (shen.parse-failure) (let W2397 (shen.in-> W2396) (shen.comb W2397 ())))) (if (shen.parse-failure? W2395) (shen.parse-failure) W2395)) W2389)) W2382)) W2376)) W2370)) W2364)) W2356)) W2350)) W2344)) W2338)) W2332)) W2321)) W2310))) +(defun shen. (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.add-sexpr (V2398 V2399) (cond ((and (cons? V2398) (and (= $ (hd V2398)) (and (cons? (tl V2398)) (= () (tl (tl V2398)))))) (append (explode (hd (tl V2398))) V2399)) (true (cons V2398 V2399)))) +(defun shen.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. (V2400) (let W2401 (if (shen.hds=? V2400 91) (let W2402 (tail V2400) (shen.comb W2402 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2401) (shen.parse-failure) W2401))) +(defun shen. (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. (V2403) (let W2404 (if (shen.hds=? V2403 93) (let W2405 (tail V2403) (shen.comb W2405 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2404) (shen.parse-failure) W2404))) +(defun shen. (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. (V2406) (let W2407 (let W2408 (shen. V2406) (if (shen.parse-failure? W2408) (shen.parse-failure) (let W2409 (shen.<-out W2408) (let W2410 (shen.in-> W2408) (shen.comb W2410 W2409))))) (if (shen.parse-failure? W2407) (shen.parse-failure) W2407))) +(defun shen. (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. (V2411) (let W2412 (let W2413 (shen. V2411) (if (shen.parse-failure? W2413) (shen.parse-failure) (let W2414 (shen.<-out W2413) (let W2415 (shen.in-> W2413) (shen.comb W2415 W2414))))) (if (shen.parse-failure? W2412) (shen.parse-failure) W2412))) +(defun shen. (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.cons-form (V2417) (cond ((= () V2417) ()) ((and (cons? V2417) (and (cons? (tl V2417)) (and (cons? (tl (tl V2417))) (and (= () (tl (tl (tl V2417)))) (= (hd (tl V2417)) bar!))))) (cons cons (cons (hd V2417) (tl (tl V2417))))) ((and (cons? V2417) (and (cons? (tl V2417)) (and (cons? (tl (tl V2417))) (and (cons? (tl (tl (tl V2417)))) (= (hd (tl V2417)) bar!))))) (simple-error "misapplication of | -")) ((cons? V2417) (cons cons (cons (hd V2417) (cons (shen.cons-form (tl V2417)) ())))) (true (simple-error "partial function shen.cons-form")))) +(defun shen.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. (V2418) (let W2419 (if (shen.hds=? V2418 40) (let W2420 (tail V2418) (shen.comb W2420 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2419) (shen.parse-failure) W2419))) +(defun shen. (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. (V2421) (let W2422 (if (shen.hds=? V2421 41) (let W2423 (tail V2421) (shen.comb W2423 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2422) (shen.parse-failure) W2422))) +(defun shen. (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. (V2424) (let W2425 (if (shen.hds=? V2424 123) (let W2426 (tail V2424) (shen.comb W2426 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2425) (shen.parse-failure) W2425))) +(defun shen. (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. (V2427) (let W2428 (if (shen.hds=? V2427 125) (let W2429 (tail V2427) (shen.comb W2429 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2428) (shen.parse-failure) W2428))) +(defun shen. (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. (V2430) (let W2431 (if (shen.hds=? V2430 124) (let W2432 (tail V2430) (shen.comb W2432 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2431) (shen.parse-failure) W2431))) +(defun shen. (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. (V2433) (let W2434 (if (shen.hds=? V2433 59) (let W2435 (tail V2433) (shen.comb W2435 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2434) (shen.parse-failure) W2434))) +(defun shen. (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. (V2436) (let W2437 (if (shen.hds=? V2436 58) (let W2438 (tail V2436) (shen.comb W2438 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2437) (shen.parse-failure) W2437))) +(defun shen. (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. (V2439) (let W2440 (if (shen.hds=? V2439 44) (let W2441 (tail V2439) (shen.comb W2441 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2440) (shen.parse-failure) W2440))) +(defun shen. (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. (V2442) (let W2443 (if (shen.hds=? V2442 61) (let W2444 (tail V2442) (shen.comb W2444 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2443) (shen.parse-failure) W2443))) +(defun shen. (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. (V2445) (let W2446 (let W2447 (shen. V2445) (if (shen.parse-failure? W2447) (shen.parse-failure) (let W2448 (shen.in-> W2447) (shen.comb W2448 shen.skip)))) (if (shen.parse-failure? W2446) (let W2449 (let W2450 (shen. V2445) (if (shen.parse-failure? W2450) (shen.parse-failure) (let W2451 (shen.in-> W2450) (shen.comb W2451 shen.skip)))) (if (shen.parse-failure? W2449) (shen.parse-failure) W2449)) W2446))) +(defun shen. (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. (V2452) (let W2453 (let W2454 (shen. V2452) (if (shen.parse-failure? W2454) (shen.parse-failure) (let W2455 (shen.in-> W2454) (let W2456 (shen. W2455) (if (shen.parse-failure? W2456) (shen.parse-failure) (let W2457 (shen.in-> W2456) (let W2458 (shen. W2457) (if (shen.parse-failure? W2458) (shen.parse-failure) (let W2459 (shen.in-> W2458) (let W2460 (shen. W2459) (if (shen.parse-failure? W2460) (shen.parse-failure) (let W2461 (shen.in-> W2460) (shen.comb W2461 shen.skip))))))))))))) (if (shen.parse-failure? W2453) (shen.parse-failure) W2453))) +(defun shen. (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. (V2462) (let W2463 (if (shen.hds=? V2462 92) (let W2464 (tail V2462) (shen.comb W2464 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2463) (shen.parse-failure) W2463))) +(defun shen. (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. (V2465) (let W2466 (let W2467 (shen. V2465) (if (shen.parse-failure? W2467) (shen.parse-failure) (let W2468 (shen.in-> W2467) (let W2469 (shen. W2468) (if (shen.parse-failure? W2469) (shen.parse-failure) (let W2470 (shen.in-> W2469) (shen.comb W2470 shen.skip))))))) (if (shen.parse-failure? W2466) (let W2471 (let W2472 ( V2465) (if (shen.parse-failure? W2472) (shen.parse-failure) (let W2473 (shen.in-> W2472) (shen.comb W2473 shen.skip)))) (if (shen.parse-failure? W2471) (shen.parse-failure) W2471)) W2466))) +(defun shen. (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. (V2474) (let W2475 (if (cons? V2474) (let W2476 (head V2474) (let W2477 (tail V2474) (if (not (shen.return? W2476)) (shen.comb W2477 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2475) (shen.parse-failure) W2475))) +(defun shen. (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. (V2478) (let W2479 (let W2480 (shen. V2478) (if (shen.parse-failure? W2480) (shen.parse-failure) (let W2481 (shen.in-> W2480) (let W2482 (shen. W2481) (if (shen.parse-failure? W2482) (shen.parse-failure) (let W2483 (shen.in-> W2482) (shen.comb W2483 shen.skip))))))) (if (shen.parse-failure? W2479) (let W2484 (let W2485 (shen. V2478) (if (shen.parse-failure? W2485) (shen.parse-failure) (let W2486 (shen.in-> W2485) (shen.comb W2486 shen.skip)))) (if (shen.parse-failure? W2484) (shen.parse-failure) W2484)) W2479))) +(defun shen. (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. (V2487) (let W2488 (if (cons? V2487) (let W2489 (head V2487) (let W2490 (tail V2487) (if (shen.return? W2489) (shen.comb W2490 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2488) (shen.parse-failure) W2488))) +(defun shen. (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.return? (V2491) (element? V2491 (cons 9 (cons 10 (cons 13 ()))))) +(defun shen.return? (V2505) (element? V2505 (cons 9 (cons 10 (cons 13 ()))))) -(defun shen. (V2492) (let W2493 (let W2494 (shen. V2492) (if (shen.parse-failure? W2494) (shen.parse-failure) (let W2495 (shen.in-> W2494) (let W2496 (shen. W2495) (if (shen.parse-failure? W2496) (shen.parse-failure) (let W2497 (shen.in-> W2496) (let W2498 (shen. W2497) (if (shen.parse-failure? W2498) (shen.parse-failure) (let W2499 (shen.in-> W2498) (shen.comb W2499 shen.skip)))))))))) (if (shen.parse-failure? W2493) (shen.parse-failure) W2493))) +(defun shen. (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. (V2500) (let W2501 (if (shen.hds=? V2500 42) (let W2502 (tail V2500) (shen.comb W2502 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2501) (shen.parse-failure) W2501))) +(defun shen. (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. (V2503) (let W2504 (let W2505 (shen. V2503) (if (shen.parse-failure? W2505) (shen.parse-failure) (let W2506 (shen.in-> W2505) (let W2507 (shen. W2506) (if (shen.parse-failure? W2507) (shen.parse-failure) (let W2508 (shen.in-> W2507) (shen.comb W2508 shen.skip))))))) (if (shen.parse-failure? W2504) (let W2509 (let W2510 (shen. V2503) (if (shen.parse-failure? W2510) (shen.parse-failure) (let W2511 (shen.in-> W2510) (let W2512 (shen. W2511) (if (shen.parse-failure? W2512) (shen.parse-failure) (let W2513 (shen.in-> W2512) (shen.comb W2513 shen.skip))))))) (if (shen.parse-failure? W2509) (let W2514 (if (cons? V2503) (let W2515 (tail V2503) (let W2516 (shen. W2515) (if (shen.parse-failure? W2516) (shen.parse-failure) (let W2517 (shen.in-> W2516) (shen.comb W2517 shen.skip))))) (shen.parse-failure)) (if (shen.parse-failure? W2514) (shen.parse-failure) W2514)) W2509)) W2504))) +(defun shen. (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. (V2518) (let W2519 (let W2520 (shen. V2518) (if (shen.parse-failure? W2520) (shen.parse-failure) (let W2521 (shen.<-out W2520) (let W2522 (shen.in-> W2520) (shen.comb W2522 W2521))))) (if (shen.parse-failure? W2519) (let W2523 (let W2524 (shen. V2518) (if (shen.parse-failure? W2524) (shen.parse-failure) (let W2525 (shen.<-out W2524) (let W2526 (shen.in-> W2524) (shen.comb W2526 W2525))))) (if (shen.parse-failure? W2523) (let W2527 (let W2528 (shen. V2518) (if (shen.parse-failure? W2528) (shen.parse-failure) (let W2529 (shen.<-out W2528) (let W2530 (shen.in-> W2528) (shen.comb W2530 (if (= W2529 "<>") (cons vector (cons 0 ())) (intern W2529))))))) (if (shen.parse-failure? W2527) (shen.parse-failure) W2527)) W2523)) W2519))) +(defun shen. (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. (V2531) (let W2532 (let W2533 (shen. V2531) (if (shen.parse-failure? W2533) (shen.parse-failure) (let W2534 (shen.<-out W2533) (let W2535 (shen.in-> W2533) (let W2536 (shen. W2535) (if (shen.parse-failure? W2536) (shen.parse-failure) (let W2537 (shen.<-out W2536) (let W2538 (shen.in-> W2536) (shen.comb W2538 (cn W2534 W2537)))))))))) (if (shen.parse-failure? W2532) (shen.parse-failure) W2532))) +(defun shen. (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. (V2539) (let W2540 (if (cons? V2539) (let W2541 (head V2539) (let W2542 (tail V2539) (if (shen.alpha? W2541) (shen.comb W2542 (n->string W2541)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2540) (shen.parse-failure) W2540))) +(defun shen. (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.alpha? (V2543) (or (shen.lowercase? V2543) (or (shen.uppercase? V2543) (shen.misc? V2543)))) +(defun shen.alpha? (V2557) (or (shen.lowercase? V2557) (or (shen.uppercase? V2557) (shen.misc? V2557)))) -(defun shen.lowercase? (V2544) (and (>= V2544 97) (<= V2544 122))) +(defun shen.lowercase? (V2558) (and (>= V2558 97) (<= V2558 122))) -(defun shen.uppercase? (V2545) (and (>= V2545 65) (<= V2545 90))) +(defun shen.uppercase? (V2559) (and (>= V2559 65) (<= V2559 90))) -(defun shen.misc? (V2546) (element? V2546 (cons 61 (cons 45 (cons 42 (cons 47 (cons 43 (cons 95 (cons 63 (cons 36 (cons 33 (cons 64 (cons 126 (cons 46 (cons 62 (cons 60 (cons 38 (cons 37 (cons 39 (cons 35 (cons 96 ()))))))))))))))))))))) +(defun shen.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. (V2547) (let W2548 (let W2549 (shen. V2547) (if (shen.parse-failure? W2549) (shen.parse-failure) (let W2550 (shen.<-out W2549) (let W2551 (shen.in-> W2549) (let W2552 (shen. W2551) (if (shen.parse-failure? W2552) (shen.parse-failure) (let W2553 (shen.<-out W2552) (let W2554 (shen.in-> W2552) (shen.comb W2554 (cn W2550 W2553)))))))))) (if (shen.parse-failure? W2548) (let W2555 (let W2556 ( V2547) (if (shen.parse-failure? W2556) (shen.parse-failure) (let W2557 (shen.in-> W2556) (shen.comb W2557 "")))) (if (shen.parse-failure? W2555) (shen.parse-failure) W2555)) W2548))) +(defun shen. (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. (V2558) (let W2559 (let W2560 (shen. V2558) (if (shen.parse-failure? W2560) (shen.parse-failure) (let W2561 (shen.<-out W2560) (let W2562 (shen.in-> W2560) (shen.comb W2562 W2561))))) (if (shen.parse-failure? W2559) (let W2563 (let W2564 (shen. V2558) (if (shen.parse-failure? W2564) (shen.parse-failure) (let W2565 (shen.<-out W2564) (let W2566 (shen.in-> W2564) (shen.comb W2566 W2565))))) (if (shen.parse-failure? W2563) (shen.parse-failure) W2563)) W2559))) +(defun shen. (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. (V2567) (let W2568 (if (cons? V2567) (let W2569 (head V2567) (let W2570 (tail V2567) (if (shen.digit? W2569) (shen.comb W2570 (n->string W2569)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2568) (shen.parse-failure) W2568))) +(defun shen. (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.digit? (V2571) (and (>= V2571 48) (<= V2571 57))) +(defun shen.digit? (V2585) (and (>= V2585 48) (<= V2585 57))) -(defun shen. (V2572) (let W2573 (let W2574 (shen. V2572) (if (shen.parse-failure? W2574) (shen.parse-failure) (let W2575 (shen.in-> W2574) (let W2576 (shen. W2575) (if (shen.parse-failure? W2576) (shen.parse-failure) (let W2577 (shen.<-out W2576) (let W2578 (shen.in-> W2576) (let W2579 (shen. W2578) (if (shen.parse-failure? W2579) (shen.parse-failure) (let W2580 (shen.in-> W2579) (shen.comb W2580 W2577))))))))))) (if (shen.parse-failure? W2573) (shen.parse-failure) W2573))) +(defun shen. (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. (V2581) (let W2582 (if (shen.hds=? V2581 34) (let W2583 (tail V2581) (shen.comb W2583 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2582) (shen.parse-failure) W2582))) +(defun shen. (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. (V2584) (let W2585 (let W2586 (shen. V2584) (if (shen.parse-failure? W2586) (shen.parse-failure) (let W2587 (shen.<-out W2586) (let W2588 (shen.in-> W2586) (let W2589 (shen. W2588) (if (shen.parse-failure? W2589) (shen.parse-failure) (let W2590 (shen.<-out W2589) (let W2591 (shen.in-> W2589) (shen.comb W2591 (cn W2587 W2590)))))))))) (if (shen.parse-failure? W2585) (let W2592 (let W2593 ( V2584) (if (shen.parse-failure? W2593) (shen.parse-failure) (let W2594 (shen.in-> W2593) (shen.comb W2594 "")))) (if (shen.parse-failure? W2592) (shen.parse-failure) W2592)) W2585))) +(defun shen. (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. (V2595) (let W2596 (let W2597 (shen. V2595) (if (shen.parse-failure? W2597) (shen.parse-failure) (let W2598 (shen.<-out W2597) (let W2599 (shen.in-> W2597) (shen.comb W2599 W2598))))) (if (shen.parse-failure? W2596) (let W2600 (let W2601 (shen. V2595) (if (shen.parse-failure? W2601) (shen.parse-failure) (let W2602 (shen.<-out W2601) (let W2603 (shen.in-> W2601) (shen.comb W2603 W2602))))) (if (shen.parse-failure? W2600) (shen.parse-failure) W2600)) W2596))) +(defun shen. (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. (V2604) (let W2605 (let W2606 (shen. V2604) (if (shen.parse-failure? W2606) (shen.parse-failure) (let W2607 (shen.in-> W2606) (let W2608 (shen. W2607) (if (shen.parse-failure? W2608) (shen.parse-failure) (let W2609 (shen.in-> W2608) (let W2610 (shen. W2609) (if (shen.parse-failure? W2610) (shen.parse-failure) (let W2611 (shen.<-out W2610) (let W2612 (shen.in-> W2610) (let W2613 (shen. W2612) (if (shen.parse-failure? W2613) (shen.parse-failure) (let W2614 (shen.in-> W2613) (shen.comb W2614 (n->string W2611))))))))))))))) (if (shen.parse-failure? W2605) (shen.parse-failure) W2605))) +(defun shen. (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. (V2615) (let W2616 (if (cons? V2615) (let W2617 (head V2615) (let W2618 (tail V2615) (if (not (= W2617 34)) (shen.comb W2618 (n->string W2617)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2616) (shen.parse-failure) W2616))) +(defun shen. (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. (V2619) (let W2620 (if (shen.hds=? V2619 99) (let W2621 (tail V2619) (shen.comb W2621 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2620) (shen.parse-failure) W2620))) +(defun shen. (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. (V2622) (let W2623 (if (shen.hds=? V2622 35) (let W2624 (tail V2622) (shen.comb W2624 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2623) (shen.parse-failure) W2623))) +(defun shen. (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. (V2625) (let W2626 (let W2627 (shen. V2625) (if (shen.parse-failure? W2627) (shen.parse-failure) (let W2628 (shen.in-> W2627) (let W2629 (shen. W2628) (if (shen.parse-failure? W2629) (shen.parse-failure) (let W2630 (shen.<-out W2629) (let W2631 (shen.in-> W2629) (shen.comb W2631 (- 0 W2630))))))))) (if (shen.parse-failure? W2626) (let W2632 (let W2633 (shen. V2625) (if (shen.parse-failure? W2633) (shen.parse-failure) (let W2634 (shen.in-> W2633) (let W2635 (shen. W2634) (if (shen.parse-failure? W2635) (shen.parse-failure) (let W2636 (shen.<-out W2635) (let W2637 (shen.in-> W2635) (shen.comb W2637 W2636)))))))) (if (shen.parse-failure? W2632) (let W2638 (let W2639 (shen. V2625) (if (shen.parse-failure? W2639) (shen.parse-failure) (let W2640 (shen.<-out W2639) (let W2641 (shen.in-> W2639) (shen.comb W2641 W2640))))) (if (shen.parse-failure? W2638) (let W2642 (let W2643 (shen. V2625) (if (shen.parse-failure? W2643) (shen.parse-failure) (let W2644 (shen.<-out W2643) (let W2645 (shen.in-> W2643) (shen.comb W2645 W2644))))) (if (shen.parse-failure? W2642) (let W2646 (let W2647 (shen. V2625) (if (shen.parse-failure? W2647) (shen.parse-failure) (let W2648 (shen.<-out W2647) (let W2649 (shen.in-> W2647) (shen.comb W2649 W2648))))) (if (shen.parse-failure? W2646) (shen.parse-failure) W2646)) W2642)) W2638)) W2632)) W2626))) +(defun shen. (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. (V2650) (let W2651 (if (shen.hds=? V2650 45) (let W2652 (tail V2650) (shen.comb W2652 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2651) (shen.parse-failure) W2651))) +(defun shen. (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. (V2653) (let W2654 (if (shen.hds=? V2653 43) (let W2655 (tail V2653) (shen.comb W2655 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2654) (shen.parse-failure) W2654))) +(defun shen. (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. (V2656) (let W2657 (let W2658 (shen. V2656) (if (shen.parse-failure? W2658) (shen.parse-failure) (let W2659 (shen.<-out W2658) (let W2660 (shen.in-> W2658) (shen.comb W2660 (shen.compute-integer W2659)))))) (if (shen.parse-failure? W2657) (shen.parse-failure) W2657))) +(defun shen. (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. (V2661) (let W2662 (let W2663 (shen. V2661) (if (shen.parse-failure? W2663) (shen.parse-failure) (let W2664 (shen.<-out W2663) (let W2665 (shen.in-> W2663) (let W2666 (shen. W2665) (if (shen.parse-failure? W2666) (shen.parse-failure) (let W2667 (shen.<-out W2666) (let W2668 (shen.in-> W2666) (shen.comb W2668 (cons W2664 W2667)))))))))) (if (shen.parse-failure? W2662) (let W2669 (let W2670 (shen. V2661) (if (shen.parse-failure? W2670) (shen.parse-failure) (let W2671 (shen.<-out W2670) (let W2672 (shen.in-> W2670) (shen.comb W2672 (cons W2671 ())))))) (if (shen.parse-failure? W2669) (shen.parse-failure) W2669)) W2662))) +(defun shen. (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. (V2673) (let W2674 (if (cons? V2673) (let W2675 (head V2673) (let W2676 (tail V2673) (if (shen.digit? W2675) (shen.comb W2676 (shen.byte->digit W2675)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2674) (shen.parse-failure) W2674))) +(defun shen. (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.byte->digit (V2677) (- V2677 48)) +(defun shen.byte->digit (V2691) (- V2691 48)) -(defun shen.compute-integer (V2678) (shen.compute-integer-h (reverse V2678) 0)) +(defun shen.compute-integer (V2692) (shen.compute-integer-h (reverse V2692) 0)) -(defun shen.compute-integer-h (V2681 V2682) (cond ((= () V2681) 0) ((cons? V2681) (+ (* (shen.expt 10 V2682) (hd V2681)) (shen.compute-integer-h (tl V2681) (+ V2682 1)))) (true (simple-error "partial function shen.compute-integer-h")))) +(defun shen.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.expt (V2685 V2686) (cond ((= 0 V2686) 1) ((> V2686 0) (* V2685 (shen.expt V2685 (- V2686 1)))) (true (/ (shen.expt V2685 (+ V2686 1)) V2685)))) +(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. (V2687) (let W2688 (let W2689 (shen. V2687) (if (shen.parse-failure? W2689) (shen.parse-failure) (let W2690 (shen.<-out W2689) (let W2691 (shen.in-> W2689) (let W2692 (shen. W2691) (if (shen.parse-failure? W2692) (shen.parse-failure) (let W2693 (shen.in-> W2692) (let W2694 (shen. W2693) (if (shen.parse-failure? W2694) (shen.parse-failure) (let W2695 (shen.<-out W2694) (let W2696 (shen.in-> W2694) (shen.comb W2696 (+ W2690 W2695))))))))))))) (if (shen.parse-failure? W2688) (let W2697 (let W2698 (shen. V2687) (if (shen.parse-failure? W2698) (shen.parse-failure) (let W2699 (shen.in-> W2698) (let W2700 (shen. W2699) (if (shen.parse-failure? W2700) (shen.parse-failure) (let W2701 (shen.<-out W2700) (let W2702 (shen.in-> W2700) (shen.comb W2702 W2701)))))))) (if (shen.parse-failure? W2697) (shen.parse-failure) W2697)) W2688))) +(defun shen. (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. (V2703) (let W2704 (if (shen.hds=? V2703 46) (let W2705 (tail V2703) (shen.comb W2705 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2704) (shen.parse-failure) W2704))) +(defun shen. (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. (V2706) (let W2707 (let W2708 (shen. V2706) (if (shen.parse-failure? W2708) (shen.parse-failure) (let W2709 (shen.<-out W2708) (let W2710 (shen.in-> W2708) (shen.comb W2710 (shen.compute-fraction W2709)))))) (if (shen.parse-failure? W2707) (shen.parse-failure) W2707))) +(defun shen. (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.compute-fraction (V2711) (shen.compute-fraction-h V2711 -1)) +(defun shen.compute-fraction (V2725) (shen.compute-fraction-h V2725 -1)) -(defun shen.compute-fraction-h (V2714 V2715) (cond ((= () V2714) 0) ((cons? V2714) (+ (* (shen.expt 10 V2715) (hd V2714)) (shen.compute-fraction-h (tl V2714) (- V2715 1)))) (true (simple-error "partial function shen.compute-fraction-h")))) +(defun shen.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. (V2716) (let W2717 (let W2718 (shen. V2716) (if (shen.parse-failure? W2718) (shen.parse-failure) (let W2719 (shen.<-out W2718) (let W2720 (shen.in-> W2718) (let W2721 (shen. W2720) (if (shen.parse-failure? W2721) (shen.parse-failure) (let W2722 (shen.in-> W2721) (let W2723 (shen. W2722) (if (shen.parse-failure? W2723) (shen.parse-failure) (let W2724 (shen.<-out W2723) (let W2725 (shen.in-> W2723) (shen.comb W2725 (shen.compute-E W2719 W2724))))))))))))) (if (shen.parse-failure? W2717) (let W2726 (let W2727 (shen. V2716) (if (shen.parse-failure? W2727) (shen.parse-failure) (let W2728 (shen.<-out W2727) (let W2729 (shen.in-> W2727) (let W2730 (shen. W2729) (if (shen.parse-failure? W2730) (shen.parse-failure) (let W2731 (shen.in-> W2730) (let W2732 (shen. W2731) (if (shen.parse-failure? W2732) (shen.parse-failure) (let W2733 (shen.<-out W2732) (let W2734 (shen.in-> W2732) (shen.comb W2734 (shen.compute-E W2728 W2733))))))))))))) (if (shen.parse-failure? W2726) (shen.parse-failure) W2726)) W2717))) +(defun shen. (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. (V2735) (let W2736 (let W2737 (shen. V2735) (if (shen.parse-failure? W2737) (shen.parse-failure) (let W2738 (shen.in-> W2737) (let W2739 (shen. W2738) (if (shen.parse-failure? W2739) (shen.parse-failure) (let W2740 (shen.<-out W2739) (let W2741 (shen.in-> W2739) (shen.comb W2741 W2740)))))))) (if (shen.parse-failure? W2736) (let W2742 (let W2743 (shen. V2735) (if (shen.parse-failure? W2743) (shen.parse-failure) (let W2744 (shen.in-> W2743) (let W2745 (shen. W2744) (if (shen.parse-failure? W2745) (shen.parse-failure) (let W2746 (shen.<-out W2745) (let W2747 (shen.in-> W2745) (shen.comb W2747 (- 0 W2746))))))))) (if (shen.parse-failure? W2742) (let W2748 (let W2749 (shen. V2735) (if (shen.parse-failure? W2749) (shen.parse-failure) (let W2750 (shen.<-out W2749) (let W2751 (shen.in-> W2749) (shen.comb W2751 W2750))))) (if (shen.parse-failure? W2748) (shen.parse-failure) W2748)) W2742)) W2736))) +(defun shen. (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. (V2752) (let W2753 (if (shen.hds=? V2752 101) (let W2754 (tail V2752) (shen.comb W2754 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2753) (shen.parse-failure) W2753))) +(defun shen. (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.compute-E (V2755 V2756) (* V2755 (shen.expt 10 V2756))) +(defun shen.compute-E (V2769 V2770) (* V2769 (shen.expt 10 V2770))) -(defun shen. (V2757) (let W2758 (let W2759 (shen. V2757) (if (shen.parse-failure? W2759) (shen.parse-failure) (let W2760 (shen.in-> W2759) (let W2761 (shen. W2760) (if (shen.parse-failure? W2761) (shen.parse-failure) (let W2762 (shen.in-> W2761) (shen.comb W2762 shen.skip))))))) (if (shen.parse-failure? W2758) (let W2763 (let W2764 (shen. V2757) (if (shen.parse-failure? W2764) (shen.parse-failure) (let W2765 (shen.in-> W2764) (shen.comb W2765 shen.skip)))) (if (shen.parse-failure? W2763) (shen.parse-failure) W2763)) W2758))) +(defun shen. (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. (V2766) (let W2767 (if (cons? V2766) (let W2768 (head V2766) (let W2769 (tail V2766) (if (shen.whitespace? W2768) (shen.comb W2769 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2767) (shen.parse-failure) W2767))) +(defun shen. (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.whitespace? (V2772) (cond ((= 32 V2772) true) ((= 13 V2772) true) ((= 10 V2772) true) ((= 9 V2772) true) (true false))) +(defun shen.whitespace? (V2786) (cond ((= 32 V2786) true) ((= 13 V2786) true) ((= 10 V2786) true) ((= 9 V2786) true) (true false))) -(defun shen.unpackage¯oexpand (V2773) (cond ((= () V2773) ()) ((and (cons? V2773) (shen.packaged? (hd V2773))) (shen.unpackage¯oexpand (append (shen.unpackage (hd V2773)) (tl V2773)))) ((cons? V2773) (let W2774 (macroexpand (hd V2773)) (if (shen.packaged? W2774) (shen.unpackage¯oexpand (cons W2774 (tl V2773))) (cons W2774 (shen.unpackage¯oexpand (tl V2773)))))) (true (simple-error "partial function shen.unpackage¯oexpand")))) +(defun shen.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.packaged? (V2777) (cond ((and (cons? V2777) (and (= package (hd V2777)) (and (cons? (tl V2777)) (cons? (tl (tl V2777)))))) true) (true false))) +(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.unpackage (V2780) (cond ((and (cons? V2780) (and (= package (hd V2780)) (and (cons? (tl V2780)) (and (= null (hd (tl V2780))) (cons? (tl (tl V2780))))))) (tl (tl (tl V2780)))) ((and (cons? V2780) (and (= package (hd V2780)) (and (cons? (tl V2780)) (cons? (tl (tl V2780)))))) (let W2781 (eval (hd (tl (tl V2780)))) (let W2782 (shen.package-symbols (str (hd (tl V2780))) W2781 (tl (tl (tl V2780)))) (let W2783 (shen.record-external (hd (tl V2780)) W2781) (let W2784 (shen.record-internal (hd (tl V2780)) W2781 (tl (tl (tl V2780)))) W2782))))) (true (simple-error "partial function shen.unpackage")))) +(defun shen.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.record-internal (V2785 V2786 V2787) (let W2788 (trap-error (get V2785 shen.internal-symbols (value *property-vector*)) (lambda Z2789 ())) (let W2790 (shen.internal-symbols (str V2785) V2786 V2787) (put V2785 shen.internal-symbols (union W2790 W2788) (value *property-vector*))))) +(defun shen.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.internal-symbols (V2797 V2798 V2799) (cond ((cons? V2799) (union (shen.internal-symbols V2797 V2798 (hd V2799)) (shen.internal-symbols V2797 V2798 (tl V2799)))) ((shen.internal? V2799 V2797 V2798) (cons (shen.intern-in-package V2797 V2799) ())) (true ()))) +(defun shen.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.record-external (V2800 V2801) (let W2802 (trap-error (get V2800 shen.external-symbols (value *property-vector*)) (lambda Z2803 ())) (put V2800 shen.external-symbols (union V2801 W2802) (value *property-vector*)))) +(defun shen.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.package-symbols (V2808 V2809 V2810) (cond ((cons? V2810) (map (lambda Z2811 (shen.package-symbols V2808 V2809 Z2811)) V2810)) ((shen.internal? V2810 V2808 V2809) (shen.intern-in-package V2808 V2810)) (true V2810))) +(defun shen.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.intern-in-package (V2812 V2813) (intern (@s V2812 (@s "." (str V2813))))) +(defun shen.intern-in-package (V2826 V2827) (intern (@s V2826 (@s "." (str V2827))))) -(defun shen.internal? (V2814 V2815 V2816) (and (not (element? V2814 V2816)) (and (not (shen.sng? V2814)) (and (not (shen.dbl? V2814)) (and (symbol? V2814) (and (not (shen.sysfunc? V2814)) (and (not (variable? V2814)) (and (not (shen.internal-to-shen? (str V2814))) (not (shen.internal-to-P? V2815 (str V2814))))))))))) +(defun shen.internal? (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.internal-to-shen? (V2821) (cond ((and (shen.+string? V2821) (and (= "s" (hdstr V2821)) (and (shen.+string? (tlstr V2821)) (and (= "h" (hdstr (tlstr V2821))) (and (shen.+string? (tlstr (tlstr V2821))) (and (= "e" (hdstr (tlstr (tlstr V2821)))) (and (shen.+string? (tlstr (tlstr (tlstr V2821)))) (and (= "n" (hdstr (tlstr (tlstr (tlstr V2821))))) (and (shen.+string? (tlstr (tlstr (tlstr (tlstr V2821))))) (= "." (hdstr (tlstr (tlstr (tlstr (tlstr V2821))))))))))))))) true) (true false))) +(defun shen.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.sysfunc? (V2822) (element? V2822 (get shen shen.external-symbols (value *property-vector*)))) +(defun shen.sysfunc? (V2836) (element? V2836 (get shen shen.external-symbols (value *property-vector*)))) -(defun shen.internal-to-P? (V2830 V2831) (cond ((and (= "" V2830) (and (shen.+string? V2831) (= "." (hdstr V2831)))) true) ((and (shen.+string? V2830) (and (shen.+string? V2831) (= (hdstr V2830) (hdstr V2831)))) (shen.internal-to-P? (tlstr V2830) (tlstr V2831))) (true false))) +(defun shen.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.process-applications (V2834 V2835) (cond ((element? V2834 V2835) V2834) ((and (cons? V2834) (shen.non-application? (hd V2834))) (shen.special-case (hd V2834) V2834 V2835)) ((cons? V2834) (shen.process-application (map (lambda Z2836 (shen.process-applications Z2836 V2835)) V2834) V2835)) (true V2834))) +(defun shen.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.non-application? (V2839) (cond ((= define V2839) true) ((= defun V2839) true) ((= synonyms V2839) true) ((shen.special? V2839) true) ((shen.extraspecial? V2839) true) (true false))) +(defun shen.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.special-case (V2844 V2845 V2846) (cond ((and (= lambda V2844) (and (cons? V2845) (and (= lambda (hd V2845)) (and (cons? (tl V2845)) (and (cons? (tl (tl V2845))) (= () (tl (tl (tl V2845))))))))) (cons lambda (cons (hd (tl V2845)) (cons (shen.process-applications (hd (tl (tl V2845))) V2846) ())))) ((and (= let V2844) (and (cons? V2845) (and (= let (hd V2845)) (and (cons? (tl V2845)) (and (cons? (tl (tl V2845))) (and (cons? (tl (tl (tl V2845)))) (= () (tl (tl (tl (tl V2845))))))))))) (cons let (cons (hd (tl V2845)) (cons (shen.process-applications (hd (tl (tl V2845))) V2846) (cons (shen.process-applications (hd (tl (tl (tl V2845)))) V2846) ()))))) ((and (= defun V2844) (and (cons? V2845) (and (= defun (hd V2845)) (and (cons? (tl V2845)) (and (cons? (tl (tl V2845))) (and (cons? (tl (tl (tl V2845)))) (= () (tl (tl (tl (tl V2845))))))))))) V2845) ((and (= define V2844) (and (cons? V2845) (and (= define (hd V2845)) (and (cons? (tl V2845)) (and (cons? (tl (tl V2845))) (= { (hd (tl (tl V2845))))))))) (cons define (cons (hd (tl V2845)) (cons { (shen.process-after-type (hd (tl V2845)) (tl (tl (tl V2845))) V2846))))) ((and (= define V2844) (and (cons? V2845) (and (= define (hd V2845)) (cons? (tl V2845))))) (cons define (cons (hd (tl V2845)) (map (lambda Z2847 (shen.process-applications Z2847 V2846)) (tl (tl V2845)))))) ((= synonyms V2844) (cons synonyms V2845)) ((and (= type V2844) (and (cons? V2845) (and (= type (hd V2845)) (and (cons? (tl V2845)) (and (cons? (tl (tl V2845))) (= () (tl (tl (tl V2845))))))))) (cons type (cons (shen.process-applications (hd (tl V2845)) V2846) (tl (tl V2845))))) ((and (= input+ V2844) (and (cons? V2845) (and (= input+ (hd V2845)) (and (cons? (tl V2845)) (and (cons? (tl (tl V2845))) (= () (tl (tl (tl V2845))))))))) (cons input+ (cons (hd (tl V2845)) (cons (shen.process-applications (hd (tl (tl V2845))) V2846) ())))) ((and (cons? V2845) (shen.special? (hd V2845))) (cons (hd V2845) (map (lambda Z2848 (shen.process-applications Z2848 V2846)) (tl V2845)))) ((and (cons? V2845) (shen.extraspecial? (hd V2845))) V2845) (true (simple-error "partial function shen.special-case")))) +(defun shen.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.process-after-type (V2851 V2852 V2853) (cond ((and (cons? V2852) (= } (hd V2852))) (cons } (map (lambda Z2854 (shen.process-applications Z2854 V2853)) (tl V2852)))) ((cons? V2852) (cons (hd V2852) (shen.process-after-type V2851 (tl V2852) V2853))) (true (simple-error (cn "missing } in " (shen.app V2851 " +(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 " " shen.a)))))) -(defun shen.process-application (V2855 V2856) (cond ((cons? V2855) (let W2857 (arity (hd V2855)) (let W2858 (length (tl V2855)) (if (element? V2855 V2856) V2855 (if (shen.shen-call? (hd V2855)) V2855 (if (shen.foreign? V2855) (shen.unpack-foreign V2855) (if (shen.fn-call? V2855) (shen.fn-call V2855) (if (shen.zero-place? V2855) V2855 (if (shen.undefined-f? (hd V2855) W2857) (shen.simple-curry (cons (cons fn (cons (hd V2855) ())) (tl V2855))) (if (variable? (hd V2855)) (shen.simple-curry V2855) (if (shen.application? (hd V2855)) (shen.simple-curry V2855) (if (shen.partial-application*? (hd V2855) W2857 W2858) (shen.lambda-function V2855 (- W2857 W2858)) (if (shen.overapplication? (hd V2855) W2857 W2858) (shen.simple-curry (cons (cons fn (cons (hd V2855) ())) (tl V2855))) V2855))))))))))))) (true (simple-error "partial function shen.process-application")))) +(defun shen.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.unpack-foreign (V2859) (cond ((and (cons? V2859) (and (cons? (hd V2859)) (and (= foreign (hd (hd V2859))) (and (cons? (tl (hd V2859))) (= () (tl (tl (hd V2859)))))))) (cons (hd (tl (hd V2859))) (tl V2859))) (true (simple-error "partial function shen.unpack-foreign")))) +(defun shen.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.foreign? (V2862) (cond ((and (cons? V2862) (and (cons? (hd V2862)) (and (= foreign (hd (hd V2862))) (and (cons? (tl (hd V2862))) (= () (tl (tl (hd V2862)))))))) true) (true false))) +(defun shen.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.zero-place? (V2865) (cond ((and (cons? V2865) (= () (tl V2865))) true) (true false))) +(defun shen.zero-place? (V2879) (cond ((and (cons? V2879) (= () (tl V2879))) true) (true false))) -(defun shen.shen-call? (V2866) (and (symbol? V2866) (shen.internal-to-shen? (str V2866)))) +(defun shen.shen-call? (V2880) (and (symbol? V2880) (shen.internal-to-shen? (str V2880)))) -(defun shen.application? (V2871) (cond ((and (cons? V2871) (and (= protect (hd V2871)) (and (cons? (tl V2871)) (= () (tl (tl V2871)))))) false) ((and (cons? V2871) (and (= foreign (hd V2871)) (and (cons? (tl V2871)) (= () (tl (tl V2871)))))) false) (true (cons? V2871)))) +(defun shen.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.undefined-f? (V2876 V2877) (cond ((= -1 V2877) (and (shen.lowercase-symbol? V2876) (not (element? V2876 (external shen))))) (true false))) +(defun shen.undefined-f? (V2890 V2891) (cond ((= -1 V2891) (and (shen.lowercase-symbol? V2890) (not (element? V2890 (external shen))))) (true false))) -(defun shen.lowercase-symbol? (V2878) (and (symbol? V2878) (not (variable? V2878)))) +(defun shen.lowercase-symbol? (V2892) (and (symbol? V2892) (not (variable? V2892)))) -(defun shen.simple-curry (V2879) (cond ((and (cons? V2879) (and (cons? (tl V2879)) (= () (tl (tl V2879))))) V2879) ((and (cons? V2879) (and (cons? (tl V2879)) (cons? (tl (tl V2879))))) (shen.simple-curry (cons (cons (hd V2879) (cons (hd (tl V2879)) ())) (tl (tl V2879))))) (true V2879))) +(defun 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 function (V2880) (fn V2880)) +(defun function (V2894) (fn V2894)) -(defun fn (V2881) (cond ((= (arity V2881) 0) (V2881)) (true (let W2882 (assoc V2881 (value shen.*lambdatable*)) (if (empty? W2882) (simple-error (cn "fn: " (shen.app V2881 " is undefined -" shen.a))) (tl W2882)))))) +(defun 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 shen.fn-call? (V2885) (cond ((and (cons? V2885) (and (= fn (hd V2885)) (and (cons? (tl V2885)) (= () (tl (tl V2885)))))) true) ((and (cons? V2885) (and (= function (hd V2885)) (and (cons? (tl V2885)) (= () (tl (tl V2885)))))) true) (true false))) +(defun shen.fn-call? (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 (V2886) (cond ((and (cons? V2886) (and (= function (hd V2886)) (and (cons? (tl V2886)) (= () (tl (tl V2886)))))) (shen.fn-call (cons fn (tl V2886)))) ((and (cons? V2886) (and (= fn (hd V2886)) (and (cons? (tl V2886)) (= () (tl (tl V2886)))))) (let W2887 (arity (hd (tl V2886))) (if (= W2887 -1) V2886 (if (= W2887 0) (tl V2886) (shen.lambda-function (tl V2886) W2887))))) (true (simple-error "partial function shen.fn-call")))) +(defun shen.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.partial-application*? (V2888 V2889 V2890) (let W2891 (> V2889 V2890) (let W2892 (if (and W2891 (and (shen.loading?) (not (element? V2888 (cons + (cons - ())))))) (pr (cn "partial application of " (shen.app V2888 " -" shen.a)) (stoutput)) shen.skip) W2891))) +(defun shen.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.loading? () (value shen.*loading?*)) -(defun shen.overapplication? (V2897 V2898 V2899) (cond ((= -1 V2898) false) (true (let W2900 (< V2898 V2899) (let W2901 (if (and W2900 (shen.loading?)) (pr (shen.app V2897 (cn " might not like " (shen.app V2899 (cn " argument" (shen.app (if (= V2899 1) "" "s") " -" shen.a)) shen.a)) shen.a) (stoutput)) shen.skip) W2900))))) +(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))))) diff --git a/klambda/sequent.kl b/klambda/sequent.kl index 30101b5..d5a16c8 100644 --- a/klambda/sequent.kl +++ b/klambda/sequent.kl @@ -1,102 +1,102 @@ -(defun shen. (V3019) (let W3020 (if (cons? V3019) (let W3021 (head V3019) (let W3022 (tail V3019) (let W3023 (shen. W3022) (if (shen.parse-failure? W3023) (shen.parse-failure) (let W3024 (shen.<-out W3023) (let W3025 (shen.in-> W3023) (shen.comb W3025 (let W3026 (shen.rules->prolog W3021 W3024) (shen.remember-datatype W3021 (fn W3021)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W3020) (shen.parse-failure) W3020))) +(defun shen. (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.remember-datatype (V3027 V3028) (do (set shen.*datatypes* (shen.assoc-> V3027 V3028 (value shen.*datatypes*))) (do (set shen.*alldatatypes* (shen.assoc-> V3027 V3028 (value shen.*alldatatypes*))) V3027))) +(defun shen.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. (V3029) (let W3030 (let W3031 (shen. V3029) (if (shen.parse-failure? W3031) (shen.parse-failure) (let W3032 (shen.<-out W3031) (let W3033 (shen.in-> W3031) (let W3034 (shen. W3033) (if (shen.parse-failure? W3034) (shen.parse-failure) (let W3035 (shen.<-out W3034) (let W3036 (shen.in-> W3034) (shen.comb W3036 (append W3032 W3035)))))))))) (if (shen.parse-failure? W3030) (let W3037 (let W3038 ( V3029) (if (shen.parse-failure? W3038) (shen.parse-failure) (let W3039 (shen.<-out W3038) (let W3040 (shen.in-> W3038) (shen.comb W3040 (if (empty? W3039) () (simple-error (cn "datatype syntax error here: - " (shen.app W3039 " - ..." shen.r))))))))) (if (shen.parse-failure? W3037) (shen.parse-failure) W3037)) W3030))) +(defun shen. (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. (V3041) (let W3042 (let W3043 (shen. V3041) (if (shen.parse-failure? W3043) (shen.parse-failure) (let W3044 (shen.<-out W3043) (let W3045 (shen.in-> W3043) (shen.comb W3045 W3044))))) (if (shen.parse-failure? W3042) (let W3046 (let W3047 (shen. V3041) (if (shen.parse-failure? W3047) (shen.parse-failure) (let W3048 (shen.<-out W3047) (let W3049 (shen.in-> W3047) (shen.comb W3049 W3048))))) (if (shen.parse-failure? W3046) (shen.parse-failure) W3046)) W3042))) +(defun shen. (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. (V3050) (let W3051 (let W3052 (shen. V3050) (if (shen.parse-failure? W3052) (shen.parse-failure) (let W3053 (shen.<-out W3052) (let W3054 (shen.in-> W3052) (let W3055 (shen. W3054) (if (shen.parse-failure? W3055) (shen.parse-failure) (let W3056 (shen.<-out W3055) (let W3057 (shen.in-> W3055) (let W3058 (shen. W3057) (if (shen.parse-failure? W3058) (shen.parse-failure) (let W3059 (shen.in-> W3058) (let W3060 (shen. W3059) (if (shen.parse-failure? W3060) (shen.parse-failure) (let W3061 (shen.<-out W3060) (let W3062 (shen.in-> W3060) (let W3063 (shen. W3062) (if (shen.parse-failure? W3063) (shen.parse-failure) (let W3064 (shen.in-> W3063) (shen.comb W3064 (cons (cons W3053 (cons W3056 (cons W3061 ()))) ())))))))))))))))))))) (if (shen.parse-failure? W3051) (shen.parse-failure) W3051))) +(defun shen. (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. (V3065) (let W3066 (let W3067 (shen. V3065) (if (shen.parse-failure? W3067) (shen.parse-failure) (let W3068 (shen.<-out W3067) (let W3069 (shen.in-> W3067) (let W3070 (shen. W3069) (if (shen.parse-failure? W3070) (shen.parse-failure) (let W3071 (shen.<-out W3070) (let W3072 (shen.in-> W3070) (let W3073 (shen. W3072) (if (shen.parse-failure? W3073) (shen.parse-failure) (let W3074 (shen.in-> W3073) (let W3075 (shen. W3074) (if (shen.parse-failure? W3075) (shen.parse-failure) (let W3076 (shen.<-out W3075) (let W3077 (shen.in-> W3075) (let W3078 (shen. W3077) (if (shen.parse-failure? W3078) (shen.parse-failure) (let W3079 (shen.in-> W3078) (shen.comb W3079 (shen.lr-rule W3068 W3071 (cons () (cons W3076 ())))))))))))))))))))))) (if (shen.parse-failure? W3066) (shen.parse-failure) W3066))) +(defun shen. (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. (V3080) (let W3081 (let W3082 (shen. V3080) (if (shen.parse-failure? W3082) (shen.parse-failure) (let W3083 (shen.<-out W3082) (let W3084 (shen.in-> W3082) (let W3085 (shen. W3084) (if (shen.parse-failure? W3085) (shen.parse-failure) (let W3086 (shen.in-> W3085) (let W3087 (shen. W3086) (if (shen.parse-failure? W3087) (shen.parse-failure) (let W3088 (shen.<-out W3087) (let W3089 (shen.in-> W3087) (shen.comb W3089 (cons (cons () (cons W3083 ())) W3088))))))))))))) (if (shen.parse-failure? W3081) (let W3090 (let W3091 (shen. V3080) (if (shen.parse-failure? W3091) (shen.parse-failure) (let W3092 (shen.<-out W3091) (let W3093 (shen.in-> W3091) (let W3094 (shen. W3093) (if (shen.parse-failure? W3094) (shen.parse-failure) (let W3095 (shen.in-> W3094) (shen.comb W3095 (cons (cons () (cons W3092 ())) ()))))))))) (if (shen.parse-failure? W3090) (shen.parse-failure) W3090)) W3081))) +(defun shen. (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. (V3096) (let W3097 (let W3098 (shen. V3096) (if (shen.parse-failure? W3098) (shen.parse-failure) (let W3099 (shen.<-out W3098) (let W3100 (shen.in-> W3098) (if (shen.hds=? W3100 >>) (let W3101 (tail W3100) (let W3102 (shen. W3101) (if (shen.parse-failure? W3102) (shen.parse-failure) (let W3103 (shen.<-out W3102) (let W3104 (shen.in-> W3102) (shen.comb W3104 (cons W3099 (cons W3103 ())))))))) (shen.parse-failure)))))) (if (shen.parse-failure? W3097) (let W3105 (let W3106 (shen. V3096) (if (shen.parse-failure? W3106) (shen.parse-failure) (let W3107 (shen.<-out W3106) (let W3108 (shen.in-> W3106) (shen.comb W3108 (cons () (cons W3107 ()))))))) (if (shen.parse-failure? W3105) (shen.parse-failure) W3105)) W3097))) +(defun shen. (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. (V3109) (let W3110 (let W3111 (shen. V3109) (if (shen.parse-failure? W3111) (shen.parse-failure) (let W3112 (shen.<-out W3111) (let W3113 (shen.in-> W3111) (let W3114 (shen. W3113) (if (shen.parse-failure? W3114) (shen.parse-failure) (let W3115 (shen.in-> W3114) (let W3116 (shen. W3115) (if (shen.parse-failure? W3116) (shen.parse-failure) (let W3117 (shen.<-out W3116) (let W3118 (shen.in-> W3116) (shen.comb W3118 (cons W3112 W3117))))))))))))) (if (shen.parse-failure? W3110) (let W3119 (let W3120 ( V3109) (if (shen.parse-failure? W3120) (shen.parse-failure) (let W3121 (shen.in-> W3120) (shen.comb W3121 ())))) (if (shen.parse-failure? W3119) (shen.parse-failure) W3119)) W3110))) +(defun shen. (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. (V3122) (let W3123 (if (shen.hds=? V3122 !) (let W3124 (tail V3122) (shen.comb W3124 !)) (shen.parse-failure)) (if (shen.parse-failure? W3123) (let W3125 (let W3126 (shen. V3122) (if (shen.parse-failure? W3126) (shen.parse-failure) (let W3127 (shen.<-out W3126) (let W3128 (shen.in-> W3126) (if (shen.hds=? W3128 >>) (let W3129 (tail W3128) (let W3130 (shen. W3129) (if (shen.parse-failure? W3130) (shen.parse-failure) (let W3131 (shen.<-out W3130) (let W3132 (shen.in-> W3130) (shen.comb W3132 (cons W3127 (cons W3131 ())))))))) (shen.parse-failure)))))) (if (shen.parse-failure? W3125) (let W3133 (let W3134 (shen. V3122) (if (shen.parse-failure? W3134) (shen.parse-failure) (let W3135 (shen.<-out W3134) (let W3136 (shen.in-> W3134) (shen.comb W3136 (cons () (cons W3135 ()))))))) (if (shen.parse-failure? W3133) (shen.parse-failure) W3133)) W3125)) W3123))) +(defun shen. (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. (V3137) (let W3138 (let W3139 (shen. V3137) (if (shen.parse-failure? W3139) (shen.parse-failure) (let W3140 (shen.<-out W3139) (let W3141 (shen.in-> W3139) (let W3142 (shen. W3141) (if (shen.parse-failure? W3142) (shen.parse-failure) (let W3143 (shen.in-> W3142) (let W3144 (shen. W3143) (if (shen.parse-failure? W3144) (shen.parse-failure) (let W3145 (shen.<-out W3144) (let W3146 (shen.in-> W3144) (shen.comb W3146 (cons W3140 W3145))))))))))))) (if (shen.parse-failure? W3138) (let W3147 (let W3148 (shen. V3137) (if (shen.parse-failure? W3148) (shen.parse-failure) (let W3149 (shen.<-out W3148) (let W3150 (shen.in-> W3148) (shen.comb W3150 (cons W3149 ())))))) (if (shen.parse-failure? W3147) (let W3151 (let W3152 ( V3137) (if (shen.parse-failure? W3152) (shen.parse-failure) (let W3153 (shen.in-> W3152) (shen.comb W3153 ())))) (if (shen.parse-failure? W3151) (shen.parse-failure) W3151)) W3147)) W3138))) +(defun shen. (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. (V3154) (let W3155 (if (cons? V3154) (let W3156 (head V3154) (let W3157 (tail V3154) (if (= W3156 (intern ",")) (shen.comb W3157 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3155) (shen.parse-failure) W3155))) +(defun shen. (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. (V3158) (let W3159 (let W3160 (shen. V3158) (if (shen.parse-failure? W3160) (shen.parse-failure) (let W3161 (shen.<-out W3160) (let W3162 (shen.in-> W3160) (let W3163 (shen. W3162) (if (shen.parse-failure? W3163) (shen.parse-failure) (let W3164 (shen.in-> W3163) (let W3165 (shen. W3164) (if (shen.parse-failure? W3165) (shen.parse-failure) (let W3166 (shen.<-out W3165) (let W3167 (shen.in-> W3165) (shen.comb W3167 (cons (shen.curry W3161) (cons (intern ":") (cons (shen.rectify-type W3166) ()))))))))))))))) (if (shen.parse-failure? W3159) (let W3168 (let W3169 (shen. V3158) (if (shen.parse-failure? W3169) (shen.parse-failure) (let W3170 (shen.<-out W3169) (let W3171 (shen.in-> W3169) (shen.comb W3171 W3170))))) (if (shen.parse-failure? W3168) (shen.parse-failure) W3168)) W3159))) +(defun shen. (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. (V3172) (let W3173 (if (cons? V3172) (let W3174 (head V3172) (let W3175 (tail V3172) (if (= W3174 (intern ":")) (shen.comb W3175 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3173) (shen.parse-failure) W3173))) +(defun shen. (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. (V3176) (let W3177 (let W3178 (shen. V3176) (if (shen.parse-failure? W3178) (shen.parse-failure) (let W3179 (shen.<-out W3178) (let W3180 (shen.in-> W3178) (let W3181 (shen. W3180) (if (shen.parse-failure? W3181) (shen.parse-failure) (let W3182 (shen.<-out W3181) (let W3183 (shen.in-> W3181) (shen.comb W3183 (cons W3179 W3182)))))))))) (if (shen.parse-failure? W3177) (let W3184 (let W3185 ( V3176) (if (shen.parse-failure? W3185) (shen.parse-failure) (let W3186 (shen.in-> W3185) (shen.comb W3186 ())))) (if (shen.parse-failure? W3184) (shen.parse-failure) W3184)) W3177))) +(defun shen. (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. (V3187) (let W3188 (if (shen.hds=? V3187 if) (let W3189 (tail V3187) (if (cons? W3189) (let W3190 (head W3189) (let W3191 (tail W3189) (shen.comb W3191 (cons if (cons W3190 ()))))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W3188) (let W3192 (if (shen.hds=? V3187 let) (let W3193 (tail V3187) (if (cons? W3193) (let W3194 (head W3193) (let W3195 (tail W3193) (if (cons? W3195) (let W3196 (head W3195) (let W3197 (tail W3195) (shen.comb W3197 (cons let (cons W3194 (cons W3196 ())))))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W3192) (let W3198 (if (shen.hds=? V3187 ctxt) (let W3199 (tail V3187) (if (cons? W3199) (let W3200 (head W3199) (let W3201 (tail W3199) (if (variable? W3200) (shen.comb W3201 (cons ctxt (cons W3200 ()))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W3198) (let W3202 (if (shen.hds=? V3187 sqts) (let W3203 (tail V3187) (if (cons? W3203) (let W3204 (head W3203) (let W3205 (tail W3203) (if (variable? W3204) (shen.comb W3205 (cons sqts (cons W3204 ()))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W3202) (shen.parse-failure) W3202)) W3198)) W3192)) W3188))) +(defun shen. (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.lr-rule (V3212 V3213 V3214) (cond ((and (cons? V3214) (and (= () (hd V3214)) (and (cons? (tl V3214)) (= () (tl (tl V3214)))))) (let W3215 (gensym P) (let W3216 (cons (tl V3214) (cons W3215 ())) (let W3217 (cons (shen.coll-formulae V3213) (cons W3215 ())) (let W3218 (cons V3212 (cons (cons W3217 ()) (cons W3216 ()))) (let W3219 (cons V3212 (cons V3213 (cons V3214 ()))) (cons W3219 (cons W3218 ())))))))) (true (simple-error "implementation error in shen.lr-rule")))) +(defun shen.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.coll-formulae (V3222) (cond ((= () V3222) ()) ((and (cons? V3222) (and (cons? (hd V3222)) (and (= () (hd (hd V3222))) (and (cons? (tl (hd V3222))) (= () (tl (tl (hd V3222)))))))) (cons (hd (tl (hd V3222))) (shen.coll-formulae (tl V3222)))) (true (simple-error "implementation error in shen.coll-formulae")))) +(defun shen.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. (V3223) (let W3224 (if (cons? V3223) (let W3225 (head V3223) (let W3226 (tail V3223) (if (not (shen.key-in-sequent-calculus? W3225)) (shen.comb W3226 (macroexpand W3225)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3224) (shen.parse-failure) W3224))) +(defun shen. (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.key-in-sequent-calculus? (V3227) (or (element? V3227 (cons >> (cons (intern ";") (cons (intern ",") (cons (intern ":") (cons <-- ())))))) (or (shen.sng? V3227) (shen.dbl? V3227)))) +(defun shen.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. (V3228) (let W3229 (let W3230 (shen. V3228) (if (shen.parse-failure? W3230) (shen.parse-failure) (let W3231 (shen.<-out W3230) (let W3232 (shen.in-> W3230) (shen.comb W3232 W3231))))) (if (shen.parse-failure? W3229) (shen.parse-failure) W3229))) +(defun shen. (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. (V3233) (let W3234 (if (cons? V3233) (let W3235 (head V3233) (let W3236 (tail V3233) (if (shen.dbl? W3235) (shen.comb W3236 W3235) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3234) (shen.parse-failure) W3234))) +(defun shen. (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. (V3237) (let W3238 (if (cons? V3237) (let W3239 (head V3237) (let W3240 (tail V3237) (if (shen.sng? W3239) (shen.comb W3240 W3239) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3238) (shen.parse-failure) W3238))) +(defun shen. (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.sng? (V3241) (and (symbol? V3241) (shen.sng-h? (str V3241)))) +(defun shen.sng? (V3255) (and (symbol? V3255) (shen.sng-h? (str V3255)))) -(defun shen.sng-h? (V3244) (cond ((= "___" V3244) true) ((and (shen.+string? V3244) (= "_" (hdstr V3244))) (shen.sng-h? (tlstr V3244))) (true false))) +(defun shen.sng-h? (V3258) (cond ((= "___" V3258) true) ((and (shen.+string? V3258) (= "_" (hdstr V3258))) (shen.sng-h? (tlstr V3258))) (true false))) -(defun shen.dbl? (V3245) (and (symbol? V3245) (shen.dbl-h? (str V3245)))) +(defun shen.dbl? (V3259) (and (symbol? V3259) (shen.dbl-h? (str V3259)))) -(defun shen.dbl-h? (V3248) (cond ((= "===" V3248) true) ((and (shen.+string? V3248) (= "=" (hdstr V3248))) (shen.dbl-h? (tlstr V3248))) (true false))) +(defun shen.dbl-h? (V3262) (cond ((= "===" V3262) true) ((and (shen.+string? V3262) (= "=" (hdstr V3262))) (shen.dbl-h? (tlstr V3262))) (true false))) -(defun shen.rules->prolog (V3249 V3250) (let W3251 (mapcan (lambda Z3252 (shen.rule->clause Z3252)) V3250) (let W3253 (cons defprolog (cons V3249 W3251)) (eval W3253)))) +(defun shen.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.rule->clause (V3254) (cond ((and (cons? V3254) (and (cons? (tl V3254)) (and (cons? (tl (tl V3254))) (and (cons? (hd (tl (tl V3254)))) (and (cons? (tl (hd (tl (tl V3254))))) (and (= () (tl (tl (hd (tl (tl V3254)))))) (= () (tl (tl (tl V3254)))))))))) (let W3255 (shen.extract-vars (hd (tl (hd (tl (tl V3254)))))) (append (shen.rule->head (hd (tl (hd (tl (tl V3254)))))) (append (cons <-- ()) (shen.rule->body W3255 Assumptions (hd V3254) (hd (tl V3254)) (hd (hd (tl (tl V3254))))))))) (true (simple-error "partial function shen.rule->clause")))) +(defun shen.rule->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->head (V3256) (cons (shen.macro-@ch V3256) (cons Assumptions ()))) +(defun shen.rule->head (V3270) (cons (shen.macro-@ch V3270) (cons Assumptions ()))) -(defun shen.macro-@ch (V3257) (cons shen.@ch (cons V3257 ()))) +(defun shen.macro-@ch (V3271) (cons shen.@ch (cons V3271 ()))) -(defun shen.macro-@c (V3258) (cons shen.@c (cons V3258 ()))) +(defun shen.macro-@c (V3272) (cons shen.@c (cons V3272 ()))) -(defun shen.rule->body (V3259 V3260 V3261 V3262 V3263) (cond ((= () V3263) (shen.side-conditions->goals () V3259 V3260 V3261 V3262)) ((and (= () V3262) (and (cons? V3263) (= () (tl V3263)))) (let W3264 (shen.passive-variables (hd V3263) V3259) (let W3265 (shen.remove-bystanders V3259 (hd V3263)) (cons (shen.specialise-member (hd V3263) V3260 W3265 W3264) (shen.side-conditions->goals () V3259 V3260 V3261 ()))))) ((cons? V3263) (let W3266 (gensym NewAssumptions) (let W3267 (shen.passive-variables (hd V3263) V3259) (let W3268 (shen.remove-bystanders V3259 (hd V3263)) (cons (shen.specialise-consume (hd V3263) V3260 W3268 W3267 W3266) (shen.rule->body (append V3259 W3267) W3266 V3261 V3262 (tl V3263))))))) (true (simple-error "partial function shen.rule->body")))) +(defun shen.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.specialise-member (V3269 V3270 V3271 V3272) (let W3273 (gensym shen.member) (let W3274 (shen.member-clause W3273 V3269 V3271 V3272) (cons W3273 (cons V3270 (append V3271 V3272)))))) +(defun shen.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.remove-bystanders (V3277 V3278) (cond ((= () V3277) ()) ((and (cons? V3277) (shen.occurs-check? (hd V3277) V3278)) (cons (hd V3277) (shen.remove-bystanders (tl V3277) V3278))) ((cons? V3277) (shen.remove-bystanders (tl V3277) V3278)) (true (simple-error "partial function shen.remove-bystanders")))) +(defun shen.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.member-clause (V3279 V3280 V3281 V3282) (let W3283 (shen.nvars (length V3282)) (let W3284 (append (cons (cons - (cons (cons cons (cons (shen.macro-@ch V3280) (cons _ ()))) ())) ()) (append V3281 (append W3283 (append (cons <-- ()) (append (shen.passive-bind V3282 W3283) (cons (intern ";") ())))))) (let W3285 (let W3286 (gensym Hypotheses) (let W3287 (append V3281 V3282) (let W3288 (append (cons (cons - (cons (cons cons (cons _ (cons W3286 ()))) ())) ()) W3287) (let W3289 (cons (cons V3279 (cons W3286 W3287)) ()) (append W3288 (append (cons <-- ()) (append W3289 (cons (intern ";") ())))))))) (let W3290 (cons defprolog (cons V3279 (append W3284 W3285))) (eval W3290)))))) +(defun shen.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.nvars (V3291) (cond ((= 0 V3291) ()) (true (cons (gensym NewV) (shen.nvars (- V3291 1)))))) +(defun shen.nvars (V3305) (cond ((= 0 V3305) ()) (true (cons (gensym NewV) (shen.nvars (- V3305 1)))))) -(defun shen.passive-bind (V3292 V3293) (cond ((and (= () V3292) (= () V3293)) ()) ((and (cons? V3292) (cons? V3293)) (cons (cons bind (cons (hd V3293) (cons (hd V3292) ()))) (shen.passive-bind (tl V3292) (tl V3293)))) (true (simple-error "partial function shen.passive-bind")))) +(defun shen.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.specialise-consume (V3294 V3295 V3296 V3297 V3298) (let W3299 (gensym shen.consume) (let W3300 (shen.consume-clause W3299 V3294 V3296 V3297 V3298) (cons W3299 (cons V3295 (cons V3298 (append V3296 V3297))))))) +(defun shen.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.consume-clause (V3301 V3302 V3303 V3304 V3305) (let W3306 (shen.nvars (length V3304)) (let W3307 (gensym Assumption) (let W3308 (cons (cons - (cons (cons cons (cons (shen.macro-@ch V3302) (cons W3307 ()))) ())) (cons V3305 (append V3303 (append W3306 (append (cons <-- ()) (append (shen.passive-bind V3304 W3306) (cons (cons bind (cons V3305 (cons W3307 ()))) (cons (intern ";") ())))))))) (let W3309 (let W3310 (gensym Hypotheses) (let W3311 (append V3303 V3304) (let W3312 (gensym Assumptions) (let W3313 (cons (cons - (cons (cons cons (cons W3307 (cons W3310 ()))) ())) (cons (cons cons (cons W3312 (cons V3305 ()))) W3311)) (let W3314 (cons (cons bind (cons W3312 (cons W3307 ()))) (cons (cons V3301 (cons W3310 (cons V3305 W3311))) ())) (append W3313 (append (cons <-- ()) (append W3314 (cons (intern ";") ()))))))))) (let W3315 (cons defprolog (cons V3301 (append W3308 W3309))) (eval W3315))))))) +(defun shen.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.passive-variables (V3316 V3317) (difference (shen.extract-vars V3316) V3317)) +(defun shen.passive-variables (V3330 V3331) (difference (shen.extract-vars V3330) V3331)) -(defun shen.side-conditions->goals (V3322 V3323 V3324 V3325 V3326) (cond ((= () V3325) (shen.premises->goals V3322 V3324 V3326)) ((and (cons? V3325) (and (cons? (hd V3325)) (and (= if (hd (hd V3325))) (and (cons? (tl (hd V3325))) (= () (tl (tl (hd V3325)))))))) (cons (cons when (tl (hd V3325))) (shen.side-conditions->goals V3322 V3323 V3324 (tl V3325) V3326))) ((and (cons? V3325) (and (cons? (hd V3325)) (and (= let (hd (hd V3325))) (and (cons? (tl (hd V3325))) (and (cons? (tl (tl (hd V3325)))) (= () (tl (tl (tl (hd V3325)))))))))) (if (element? (hd (tl (hd V3325))) V3323) (cons (cons is! (tl (hd V3325))) (shen.side-conditions->goals V3322 V3323 V3324 (tl V3325) V3326)) (cons (cons bind (tl (hd V3325))) (shen.side-conditions->goals V3322 (cons (hd (tl (hd V3325))) V3323) V3324 (tl V3325) V3326)))) ((and (cons? V3325) (and (cons? (hd V3325)) (and (= ctxt (hd (hd V3325))) (and (cons? (tl (hd V3325))) (= () (tl (tl (hd V3325)))))))) (if (element? (hd (tl (hd V3325))) V3323) (shen.side-conditions->goals (cons (hd (tl (hd V3325))) V3322) V3323 V3324 (tl V3325) V3326) (cons (cons bind (cons (hd (tl (hd V3325))) (cons V3324 ()))) (shen.side-conditions->goals (cons (hd (tl (hd V3325))) V3322) (cons (hd (tl (hd V3325))) V3323) (hd (tl (hd V3325))) (tl V3325) V3326)))) ((and (cons? V3325) (and (cons? (hd V3325)) (and (= sqts (hd (hd V3325))) (and (cons? (tl (hd V3325))) (= () (tl (tl (hd V3325)))))))) (shen.side-conditions->goals V3322 V3323 V3324 (tl V3325) V3326)) (true (simple-error "partial function shen.side-conditions->goals")))) +(defun shen.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.premises->goals (V3331 V3332 V3333) (cond ((= () V3333) (cons (intern ";") ())) ((and (cons? V3333) (= ! (hd V3333))) (cons ! (shen.premises->goals V3331 V3332 (tl V3333)))) ((and (cons? V3333) (= fail (hd V3333))) (cons (cons when (cons false ())) (shen.premises->goals V3331 V3332 (tl V3333)))) ((and (cons? V3333) (and (cons? (hd V3333)) (and (cons? (tl (hd V3333))) (= () (tl (tl (hd V3333))))))) (cons (cons shen.system-S (cons (shen.macro-@c (hd (tl (hd V3333)))) (cons (shen.construct-context V3331 (hd (hd V3333)) V3332) ()))) (shen.premises->goals V3331 V3332 (tl V3333)))) (true (simple-error "partial function shen.premises->goals")))) +(defun shen.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.construct-context (V3337 V3338 V3339) (cond ((= () V3338) V3339) ((and (cons? V3338) (and (= () (tl V3338)) (element? (hd V3338) V3337))) (hd V3338)) ((cons? V3338) (cons cons (cons (shen.macro-@c (hd V3338)) (cons (shen.construct-context V3337 (tl V3338) V3339) ())))) (true (simple-error "partial function shen.construct-context")))) +(defun 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 preclude (V3340) (let W3341 (map (lambda Z3342 (shen.intern-type Z3342)) V3340) (let W3343 (value shen.*datatypes*) (let W3344 (shen.remove-datatypes W3341 W3343) (let W3345 (set shen.*datatypes* W3344) (shen.show-datatypes W3345)))))) +(defun 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 shen.remove-datatypes (V3350 V3351) (cond ((= () V3350) V3351) ((cons? V3350) (shen.remove-datatypes (tl V3350) (shen.unassoc (hd V3350) V3351))) (true (simple-error "implementation error in shen.remove-datatypes")))) +(defun shen.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.show-datatypes (V3352) (map (lambda Z3353 (hd Z3353)) V3352)) +(defun shen.show-datatypes (V3366) (map (lambda Z3367 (hd Z3367)) V3366)) -(defun include (V3354) (let W3355 (map (lambda Z3356 (shen.intern-type Z3356)) V3354) (let W3357 (map (lambda Z3358 (shen.remember-datatype Z3358 (fn Z3358))) W3355) (let W3359 (value shen.*datatypes*) (shen.show-datatypes W3359))))) +(defun 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 preclude-all-but (V3360) (let W3361 (set shen.*datatypes* ()) (let W3362 (map (lambda Z3363 (shen.intern-type Z3363)) V3360) (let W3364 (map (lambda Z3365 (shen.remember-datatype Z3365 (fn Z3365))) W3362) (shen.show-datatypes (value shen.*datatypes*)))))) +(defun 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 include-all-but (V3366) (let W3367 (map (lambda Z3368 (shen.intern-type Z3368)) V3366) (let W3369 (value shen.*alldatatypes*) (let W3370 (set shen.*datatypes* (shen.remove-datatypes W3367 W3369)) (shen.show-datatypes W3370))))) +(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))))) diff --git a/klambda/sys.kl b/klambda/sys.kl index e732b95..d4a65b0 100644 --- a/klambda/sys.kl +++ b/klambda/sys.kl @@ -1,16 +1,16 @@ -(defun thaw (V3430) (V3430)) +(defun thaw (V3444) (V3444)) -(defun eval (V3431) (eval-kl (shen.shen->kl (shen.process-applications (macroexpand V3431) (shen.find-types V3431))))) +(defun eval (V3445) (eval-kl (shen.shen->kl (shen.process-applications (macroexpand V3445) (shen.find-types V3445))))) -(defun external (V3432) (cond ((= null V3432) ()) (true (trap-error (get V3432 shen.external-symbols (value *property-vector*)) (lambda Z3433 (simple-error (cn "package " (shen.app V3432 " does not exist. +(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. ;" shen.a)))))))) -(defun internal (V3434) (cond ((= null V3434) ()) (true (trap-error (get V3434 shen.internal-symbols (value *property-vector*)) (lambda Z3435 (simple-error (cn "package " (shen.app V3434 " does not exist. +(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. ;" shen.a)))))))) -(defun fail-if (V3436 V3437) (if (V3436 V3437) (fail) V3437)) +(defun fail-if (V3450 V3451) (if (V3450 V3451) (fail) V3451)) -(defun @s (V3438 V3439) (cn V3438 V3439)) +(defun @s (V3452 V3453) (cn V3452 V3453)) (defun tc? () (value shen.*tc*)) @@ -20,191 +20,191 @@ (defun tracked () (value shen.*tracking*)) -(defun ps (V3440) (trap-error (get V3440 shen.source (value *property-vector*)) (lambda Z3441 (simple-error (shen.app V3440 " not found. +(defun ps (V3454) (trap-error (get V3454 shen.source (value *property-vector*)) (lambda Z3455 (simple-error (shen.app V3454 " not found. " shen.a))))) (defun stinput () (value *stinput*)) -(defun vector (V3442) (let W3443 (absvector (+ V3442 1)) (let W3444 (address-> W3443 0 V3442) (let W3445 (if (= V3442 0) W3444 (shen.fillvector W3444 1 V3442 (fail))) W3445)))) +(defun 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 shen.fillvector (V3447 V3448 V3449 V3450) (cond ((= V3448 V3449) (address-> V3447 V3449 V3450)) (true (shen.fillvector (address-> V3447 V3448 V3450) (+ 1 V3448) V3449 V3450)))) +(defun 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 vector? (V3451) (and (absvector? V3451) (trap-error (>= (<-address V3451 0) 0) (lambda Z3452 false)))) +(defun vector? (V3465) (and (absvector? V3465) (trap-error (>= (<-address V3465 0) 0) (lambda Z3466 false)))) -(defun vector-> (V3453 V3454 V3455) (if (= V3454 0) (simple-error "cannot access 0th element of a vector -") (address-> V3453 V3454 V3455))) +(defun vector-> (V3467 V3468 V3469) (if (= V3468 0) (simple-error "cannot access 0th element of a vector +") (address-> V3467 V3468 V3469))) -(defun <-vector (V3456 V3457) (if (= V3457 0) (simple-error "cannot access 0th element of a vector -") (let W3458 (<-address V3456 V3457) (if (= W3458 (fail)) (simple-error "vector element not found -") W3458)))) +(defun <-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 shen.posint? (V3459) (and (integer? V3459) (>= V3459 0))) +(defun shen.posint? (V3473) (and (integer? V3473) (>= V3473 0))) -(defun limit (V3460) (<-address V3460 0)) +(defun limit (V3474) (<-address V3474 0)) -(defun symbol? (V3461) (cond ((or (boolean? V3461) (or (number? V3461) (or (string? V3461) (or (cons? V3461) (or (empty? V3461) (vector? V3461)))))) false) ((element? V3461 (cons { (cons } (cons (intern ":") (cons (intern ";") (cons (intern ",") ())))))) true) (true (trap-error (let W3462 (str V3461) (shen.analyse-symbol? W3462)) (lambda Z3463 false))))) +(defun 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 shen.analyse-symbol? (V3466) (cond ((shen.+string? V3466) (and (shen.alpha? (string->n (hdstr V3466))) (shen.alphanums? (tlstr V3466)))) (true (simple-error "implementation error in shen.analyse-symbol?")))) +(defun shen.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.alphanums? (V3469) (cond ((= "" V3469) true) ((shen.+string? V3469) (let W3470 (string->n (hdstr V3469)) (and (or (shen.alpha? W3470) (shen.digit? W3470)) (shen.alphanums? (tlstr V3469))))) (true (simple-error "implementation error in shen.alphanums?")))) +(defun 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 variable? (V3471) (cond ((or (boolean? V3471) (or (number? V3471) (string? V3471))) false) (true (trap-error (let W3472 (str V3471) (shen.analyse-variable? W3472)) (lambda Z3473 false))))) +(defun 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 shen.analyse-variable? (V3476) (cond ((shen.+string? V3476) (and (shen.uppercase? (string->n (hdstr V3476))) (shen.alphanums? (tlstr V3476)))) (true (simple-error "implementation error in shen.analyse-variable?")))) +(defun 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 gensym (V3477) (concat V3477 (set shen.*gensym* (+ 1 (value shen.*gensym*))))) +(defun gensym (V3491) (concat V3491 (set shen.*gensym* (+ 1 (value shen.*gensym*))))) -(defun concat (V3478 V3479) (intern (cn (str V3478) (str V3479)))) +(defun concat (V3492 V3493) (intern (cn (str V3492) (str V3493)))) -(defun @p (V3480 V3481) (let W3482 (absvector 3) (let W3483 (address-> W3482 0 shen.tuple) (let W3484 (address-> W3482 1 V3480) (let W3485 (address-> W3482 2 V3481) W3482))))) +(defun @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 fst (V3486) (<-address V3486 1)) +(defun fst (V3500) (<-address V3500 1)) -(defun snd (V3487) (<-address V3487 2)) +(defun snd (V3501) (<-address V3501 2)) -(defun tuple? (V3488) (trap-error (and (absvector? V3488) (= shen.tuple (<-address V3488 0))) (lambda Z3489 false))) +(defun tuple? (V3502) (trap-error (and (absvector? V3502) (= shen.tuple (<-address V3502 0))) (lambda Z3503 false))) -(defun append (V3494 V3495) (cond ((= () V3494) V3495) ((cons? V3494) (cons (hd V3494) (append (tl V3494) V3495))) (true (simple-error "attempt to append a non-list")))) +(defun 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 @v (V3496 V3497) (let W3498 (limit V3497) (let W3499 (vector (+ W3498 1)) (let W3500 (vector-> W3499 1 V3496) (if (= W3498 0) W3500 (shen.@v-help V3497 1 W3498 W3500)))))) +(defun @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 shen.@v-help (V3502 V3503 V3504 V3505) (cond ((= V3503 V3504) (shen.copyfromvector V3502 V3505 V3504 (+ V3504 1))) (true (shen.@v-help V3502 (+ V3503 1) V3504 (shen.copyfromvector V3502 V3505 V3503 (+ V3503 1)))))) +(defun shen.@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.copyfromvector (V3506 V3507 V3508 V3509) (trap-error (vector-> V3507 V3509 (<-vector V3506 V3508)) (lambda Z3510 V3507))) +(defun shen.copyfromvector (V3520 V3521 V3522 V3523) (trap-error (vector-> V3521 V3523 (<-vector V3520 V3522)) (lambda Z3524 V3521))) -(defun hdv (V3511) (trap-error (<-vector V3511 1) (lambda Z3512 (simple-error "hdv needs a non-empty vector as an argument +(defun hdv (V3525) (trap-error (<-vector V3525 1) (lambda Z3526 (simple-error "hdv needs a non-empty vector as an argument ")))) -(defun tlv (V3513) (let W3514 (limit V3513) (if (= W3514 0) (simple-error "cannot take the tail of the empty vector -") (if (= W3514 1) (vector 0) (let W3515 (vector (- W3514 1)) (shen.tlv-help V3513 2 W3514 (vector (- W3514 1)))))))) +(defun 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 shen.tlv-help (V3517 V3518 V3519 V3520) (cond ((= V3518 V3519) (shen.copyfromvector V3517 V3520 V3519 (- V3519 1))) (true (shen.tlv-help V3517 (+ V3518 1) V3519 (shen.copyfromvector V3517 V3520 V3518 (- V3518 1)))))) +(defun 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 assoc (V3532 V3533) (cond ((= () V3533) ()) ((and (cons? V3533) (and (cons? (hd V3533)) (= V3532 (hd (hd V3533))))) (hd V3533)) ((cons? V3533) (assoc V3532 (tl V3533))) (true (simple-error "attempt to search a non-list with assoc +(defun 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 boolean? (V3536) (cond ((= true V3536) true) ((= false V3536) true) (true false))) +(defun boolean? (V3550) (cond ((= true V3550) true) ((= false V3550) true) (true false))) -(defun nl (V3537) (cond ((= 0 V3537) 0) (true (do (pr " -" (stoutput)) (nl (- V3537 1)))))) +(defun nl (V3551) (cond ((= 0 V3551) 0) (true (do (pr " +" (stoutput)) (nl (- V3551 1)))))) -(defun difference (V3544 V3545) (cond ((= () V3544) ()) ((cons? V3544) (if (element? (hd V3544) V3545) (difference (tl V3544) V3545) (cons (hd V3544) (difference (tl V3544) V3545)))) (true (simple-error "attempt to find the difference with a non-list +(defun 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 do (V3546 V3547) V3547) +(defun do (V3560 V3561) V3561) -(defun element? (V3559 V3560) (cond ((= () V3560) false) ((and (cons? V3560) (= V3559 (hd V3560))) true) ((cons? V3560) (element? V3559 (tl V3560))) (true (simple-error "attempt to find an element in a non-list +(defun 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 empty? (V3563) (cond ((= () V3563) true) (true false))) +(defun empty? (V3577) (cond ((= () V3577) true) (true false))) -(defun fix (V3564 V3565) (shen.fix-help V3564 V3565 (V3564 V3565))) +(defun fix (V3578 V3579) (shen.fix-help V3578 V3579 (V3578 V3579))) -(defun shen.fix-help (V3571 V3572 V3573) (cond ((= V3572 V3573) V3573) (true (shen.fix-help V3571 V3573 (V3571 V3573))))) +(defun shen.fix-help (V3585 V3586 V3587) (cond ((= V3586 V3587) V3587) (true (shen.fix-help V3585 V3587 (V3585 V3587))))) -(defun put (V3574 V3575 V3576 V3577) (let W3578 (hash V3574 (limit V3577)) (let W3579 (trap-error (<-vector V3577 W3578) (lambda Z3580 ())) (let W3581 (vector-> V3577 W3578 (shen.change-pointer-value V3574 V3575 V3576 W3579)) V3576)))) +(defun 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 unput (V3582 V3583 V3584) (let W3585 (hash V3582 (limit V3584)) (let W3586 (trap-error (<-vector V3584 W3585) (lambda Z3587 ())) (let W3588 (vector-> V3584 W3585 (shen.remove-pointer V3582 V3583 W3586)) V3582)))) +(defun 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.remove-pointer (V3599 V3600 V3601) (cond ((= () V3601) ()) ((and (cons? V3601) (and (cons? (hd V3601)) (and (cons? (hd (hd V3601))) (and (cons? (tl (hd (hd V3601)))) (and (= () (tl (tl (hd (hd V3601))))) (and (= V3600 (hd (tl (hd (hd V3601))))) (= V3599 (hd (hd (hd V3601)))))))))) (tl V3601)) ((cons? V3601) (cons (hd V3601) (shen.remove-pointer V3599 V3600 (tl V3601)))) (true (simple-error "implementation error in shen.remove-pointer")))) +(defun 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 shen.change-pointer-value (V3614 V3615 V3616 V3617) (cond ((= () V3617) (cons (cons (cons V3614 (cons V3615 ())) V3616) ())) ((and (cons? V3617) (and (cons? (hd V3617)) (and (cons? (hd (hd V3617))) (and (cons? (tl (hd (hd V3617)))) (and (= () (tl (tl (hd (hd V3617))))) (and (= V3615 (hd (tl (hd (hd V3617))))) (= V3614 (hd (hd (hd V3617)))))))))) (cons (cons (hd (hd V3617)) V3616) (tl V3617))) ((cons? V3617) (cons (hd V3617) (shen.change-pointer-value V3614 V3615 V3616 (tl V3617)))) (true (simple-error "implementation error in shen.change-pointer-value")))) +(defun 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 get (V3618 V3619 V3620) (let W3621 (hash V3618 (limit V3620)) (let W3622 (trap-error (<-vector V3620 W3621) (lambda Z3623 (simple-error (shen.app V3618 (cn " has no attributes: " (shen.app V3619 " -" shen.s)) shen.a)))) (let W3624 (assoc (cons V3618 (cons V3619 ())) W3622) (if (empty? W3624) (simple-error (cn "attribute " (shen.app V3619 (cn " not found for " (shen.app V3618 " -" shen.s)) shen.s))) (tl W3624)))))) +(defun 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 hash (V3625 V3626) (let W3627 (shen.mod (shen.hashkey V3625) V3626) (if (= W3627 0) 1 W3627))) +(defun hash (V3639 V3640) (let W3641 (shen.mod (shen.hashkey V3639) V3640) (if (= W3641 0) 1 W3641))) -(defun shen.hashkey (V3628) (let W3629 (map (lambda Z3630 (string->n Z3630)) (explode V3628)) (shen.prodbutzero W3629 1))) +(defun shen.hashkey (V3642) (let W3643 (map (lambda Z3644 (string->n Z3644)) (explode V3642)) (shen.prodbutzero W3643 1))) -(defun shen.prodbutzero (V3631 V3632) (cond ((= () V3631) V3632) ((and (cons? V3631) (= 0 (hd V3631))) (shen.prodbutzero (tl V3631) V3632)) ((cons? V3631) (if (> V3632 10000000000) (shen.prodbutzero (tl V3631) (+ V3632 (hd V3631))) (shen.prodbutzero (tl V3631) (* V3632 (hd V3631))))) (true (simple-error "partial function shen.prodbutzero")))) +(defun shen.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.mod (V3633 V3634) (shen.modh V3633 (shen.multiples V3633 (cons V3634 ())))) +(defun shen.mod (V3647 V3648) (shen.modh V3647 (shen.multiples V3647 (cons V3648 ())))) -(defun shen.multiples (V3639 V3640) (cond ((and (cons? V3640) (> (hd V3640) V3639)) (tl V3640)) ((cons? V3640) (shen.multiples V3639 (cons (* 2 (hd V3640)) V3640))) (true (simple-error "implementation error in shen.multiples")))) +(defun shen.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.modh (V3647 V3648) (cond ((= 0 V3647) 0) ((= () V3648) V3647) ((and (cons? V3648) (> (hd V3648) V3647)) (if (empty? (tl V3648)) V3647 (shen.modh V3647 (tl V3648)))) ((cons? V3648) (shen.modh (- V3647 (hd V3648)) V3648)) (true (simple-error "implementation error in shen.modh")))) +(defun 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 sum (V3651) (cond ((= () V3651) 0) ((cons? V3651) (+ (hd V3651) (sum (tl V3651)))) (true (simple-error "attempt to sum a non-list +(defun sum (V3665) (cond ((= () V3665) 0) ((cons? V3665) (+ (hd V3665) (sum (tl V3665)))) (true (simple-error "attempt to sum a non-list ")))) -(defun head (V3656) (cond ((cons? V3656) (hd V3656)) (true (simple-error "head expects a non-empty list +(defun head (V3670) (cond ((cons? V3670) (hd V3670)) (true (simple-error "head expects a non-empty list ")))) -(defun tail (V3661) (cond ((cons? V3661) (tl V3661)) (true (simple-error "tail expects a non-empty list +(defun tail (V3675) (cond ((cons? V3675) (tl V3675)) (true (simple-error "tail expects a non-empty list ")))) -(defun hdstr (V3662) (pos V3662 0)) +(defun hdstr (V3676) (pos V3676 0)) -(defun intersection (V3669 V3670) (cond ((= () V3669) ()) ((cons? V3669) (if (element? (hd V3669) V3670) (cons (hd V3669) (intersection (tl V3669) V3670)) (intersection (tl V3669) V3670))) (true (simple-error "attempt to find the intersection with a non-list +(defun 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 reverse (V3671) (shen.reverse-help V3671 ())) +(defun reverse (V3685) (shen.reverse-help V3685 ())) -(defun shen.reverse-help (V3676 V3677) (cond ((= () V3676) V3677) ((cons? V3676) (shen.reverse-help (tl V3676) (cons (hd V3676) V3677))) (true (simple-error "attempt to reverse a non-list +(defun 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 union (V3682 V3683) (cond ((= () V3682) V3683) ((cons? V3682) (if (element? (hd V3682) V3683) (union (tl V3682) V3683) (cons (hd V3682) (union (tl V3682) V3683)))) (true (simple-error "attempt to find the union with a non-list +(defun 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 y-or-n? (V3684) (let W3685 (pr (shen.proc-nl V3684) (stoutput)) (let W3686 (pr " (y/n) " (stoutput)) (let W3687 (shen.app (read (stinput)) "" shen.s) (if (= "y" W3687) true (if (= "n" W3687) false (do (pr "please answer y or n -" (stoutput)) (y-or-n? V3684)))))))) +(defun 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 not (V3688) (if V3688 false true)) +(defun not (V3702) (if V3702 false true)) (defun abort () (simple-error "")) -(defun subst (V3694 V3695 V3696) (cond ((= V3695 V3696) V3694) ((cons? V3696) (cons (subst V3694 V3695 (hd V3696)) (subst V3694 V3695 (tl V3696)))) (true V3696))) +(defun subst (V3708 V3709 V3710) (cond ((= V3709 V3710) V3708) ((cons? V3710) (cons (subst V3708 V3709 (hd V3710)) (subst V3708 V3709 (tl V3710)))) (true V3710))) -(defun explode (V3697) (shen.explode-h (shen.app V3697 "" shen.a))) +(defun explode (V3711) (shen.explode-h (shen.app V3711 "" shen.a))) -(defun shen.explode-h (V3700) (cond ((= "" V3700) ()) ((shen.+string? V3700) (cons (hdstr V3700) (shen.explode-h (tlstr V3700)))) (true (simple-error "implementation error in explode-h")))) +(defun 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 cd (V3701) (set *home-directory* (if (= V3701 "") "" (shen.app V3701 "/" shen.a)))) +(defun cd (V3715) (set *home-directory* (if (= V3715 "") "" (shen.app V3715 "/" shen.a)))) -(defun map (V3702 V3703) (shen.map-h V3702 V3703 ())) +(defun map (V3716 V3717) (shen.map-h V3716 V3717 ())) -(defun shen.map-h (V3704 V3705 V3706) (cond ((= () V3705) (reverse V3706)) ((cons? V3705) (shen.map-h V3704 (tl V3705) (cons (V3704 (hd V3705)) V3706))) (true (simple-error "partial function shen.map-h")))) +(defun shen.map-h (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 length (V3707) (shen.length-h V3707 0)) +(defun length (V3721) (shen.length-h V3721 0)) -(defun shen.length-h (V3712 V3713) (cond ((= () V3712) V3713) (true (shen.length-h (tl V3712) (+ V3713 1))))) +(defun shen.length-h (V3726 V3727) (cond ((= () V3726) V3727) (true (shen.length-h (tl V3726) (+ V3727 1))))) -(defun occurrences (V3719 V3720) (cond ((= V3719 V3720) 1) ((cons? V3720) (+ (occurrences V3719 (hd V3720)) (occurrences V3719 (tl V3720)))) (true 0))) +(defun occurrences (V3733 V3734) (cond ((= V3733 V3734) 1) ((cons? V3734) (+ (occurrences V3733 (hd V3734)) (occurrences V3733 (tl V3734)))) (true 0))) -(defun nth (V3725 V3726) (cond ((and (= 1 V3725) (cons? V3726)) (hd V3726)) ((cons? V3726) (nth (- V3725 1) (tl V3726))) (true (simple-error (cn "nth applied to " (shen.app V3725 (cn ", " (shen.app V3726 " +(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 " " shen.a)) shen.a)))))) -(defun integer? (V3727) (and (number? V3727) (let W3728 (shen.abs V3727) (shen.integer-test? W3728 (shen.magless W3728 1))))) +(defun integer? (V3741) (and (number? V3741) (let W3742 (shen.abs V3741) (shen.integer-test? W3742 (shen.magless W3742 1))))) -(defun shen.abs (V3729) (if (> V3729 0) V3729 (- 0 V3729))) +(defun shen.abs (V3743) (if (> V3743 0) V3743 (- 0 V3743))) -(defun shen.magless (V3730 V3731) (let W3732 (* V3731 2) (if (> W3732 V3730) V3731 (shen.magless V3730 W3732)))) +(defun shen.magless (V3744 V3745) (let W3746 (* V3745 2) (if (> W3746 V3744) V3745 (shen.magless V3744 W3746)))) -(defun shen.integer-test? (V3736 V3737) (cond ((= 0 V3736) true) ((> 1 V3736) false) (true (let W3738 (- V3736 V3737) (if (> 0 W3738) (integer? V3736) (shen.integer-test? W3738 V3737)))))) +(defun 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 mapcan (V3745 V3746) (cond ((= () V3746) ()) ((cons? V3746) (append (V3745 (hd V3746)) (mapcan V3745 (tl V3746)))) (true (simple-error "attempt to mapcan over a non-list +(defun 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 == (V3752 V3753) (cond ((= V3752 V3753) true) (true false))) +(defun == (V3766 V3767) (cond ((= V3766 V3767) true) (true false))) -(defun bound? (V3754) (and (symbol? V3754) (let W3755 (trap-error (value V3754) (lambda Z3756 shen.this-symbol-is-unbound)) (if (= W3755 shen.this-symbol-is-unbound) false true)))) +(defun 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 shen.string->bytes (V3757) (cond ((= "" V3757) ()) (true (cons (string->n (pos V3757 0)) (shen.string->bytes (tlstr V3757)))))) +(defun shen.string->bytes (V3771) (cond ((= "" V3771) ()) (true (cons (string->n (pos V3771 0)) (shen.string->bytes (tlstr V3771)))))) -(defun maxinferences (V3758) (if (< V3758 0) (value shen.*maxinferences*) (if (integer? V3758) (set shen.*maxinferences* V3758) (simple-error "maxinferences expects an integer value +(defun maxinferences (V3772) (if (< V3772 0) (value shen.*maxinferences*) (if (integer? V3772) (set shen.*maxinferences* V3772) (simple-error "maxinferences expects an integer value ")))) (defun inferences () (value shen.*infs*)) -(defun protect (V3759) V3759) +(defun protect (V3773) V3773) (defun stoutput () (value *stoutput*)) -(defun string->symbol (V3760) (let W3761 (intern V3760) (if (symbol? W3761) W3761 (simple-error (cn "cannot intern " (shen.app V3760 " to a symbol" shen.s)))))) +(defun 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 optimise (V3764) (cond ((= + V3764) (set shen.*optimise* true)) ((= - V3764) (set shen.*optimise* false)) (true (simple-error "optimise expects a + or a -. +(defun optimise (V3778) (cond ((= + V3778) (set shen.*optimise* true)) ((= - V3778) (set shen.*optimise* false)) (true (simple-error "optimise expects a + or a -. ")))) (defun os () (value *os*)) @@ -221,7 +221,7 @@ (defun release () (value *release*)) -(defun package? (V3765) (cond ((= null V3765) true) (true (trap-error (do (external V3765) true) (lambda Z3766 false))))) +(defun package? (V3779) (cond ((= null V3779) true) (true (trap-error (do (external V3779) true) (lambda Z3780 false))))) (defun fail () shen.fail!)(defun userdefs () (value shen.*userdefs*)) @@ -231,31 +231,31 @@ (defun system-S? () (value shen.*shen-type-theory-enabled?*)) -(defun enable-type-theory (V3769) (cond ((= + V3769) (set shen.*shen-type-theory-enabled?* true)) ((= - V3769) (set shen.*shen-type-theory-enabled?* false)) (true (simple-error "enable-type-theory expects a + or a - +(defun 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 shen.hush (V3772) (cond ((= + V3772) (set *hush* true)) ((= - V3772) (set *hush* false)) (true (simple-error "hush 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 tc (V3775) (cond ((= + V3775) (set shen.*tc* true)) ((= - V3775) (set shen.*tc* false)) (true (simple-error "tc expects a + or -")))) +(defun tc (V3789) (cond ((= + V3789) (set shen.*tc* true)) ((= - V3789) (set shen.*tc* false)) (true (simple-error "tc expects a + or -")))) -(defun destroy (V3776) (do (set shen.*sigf* (shen.unassoc V3776 (value shen.*sigf*))) V3776)) +(defun destroy (V3790) (do (set shen.*sigf* (shen.unassoc V3790 (value shen.*sigf*))) V3790)) -(defun shen.unassoc (V3786 V3787) (cond ((= () V3787) ()) ((and (cons? V3787) (and (cons? (hd V3787)) (= V3786 (hd (hd V3787))))) (tl V3787)) ((cons? V3787) (cons (hd V3787) (shen.unassoc V3786 (tl V3787)))) (true (simple-error "implementation error in shen.unassoc")))) +(defun 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 in-package (V3788) (if (package? V3788) (set shen.*package* V3788) (simple-error (cn "package " (shen.app V3788 " does not exist +(defun in-package (V3802) (if (package? V3802) (set shen.*package* V3802) (simple-error (cn "package " (shen.app V3802 " does not exist " shen.a))))) -(defun write-to-file (V3789 V3790) (let W3791 (open V3789 out) (let W3792 (if (string? V3790) V3790 (shen.app V3790 "" shen.s)) (let W3793 (pr W3792 W3791) (let W3794 (close W3791) V3790))))) +(defun 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 fresh () (shen.freshterm (gensym shen.t))) -(defun update-lambda-table (V3795 V3796) (let W3797 (put V3795 arity V3796 (value *property-vector*)) (let W3798 (shen.lambda-entry V3795) (let W3799 (set shen.*lambdatable* (cons W3798 (value shen.*lambdatable*))) V3795)))) +(defun 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 specialise (V3802 V3803) (cond ((= 0 V3803) (do (set shen.*special* (remove V3802 (value shen.*special*))) (do (set shen.*extraspecial* (remove V3802 (value shen.*extraspecial*))) V3802))) ((= 1 V3803) (do (set shen.*special* (adjoin V3802 (value shen.*special*))) (do (set shen.*extraspecial* (remove V3802 (value shen.*extraspecial*))) V3802))) ((= 2 V3803) (do (set shen.*special* (remove V3802 (value shen.*special*))) (do (set shen.*extraspecial* (adjoin V3802 (value shen.*extraspecial*))) V3802))) (true (simple-error "specialise requires values of 0, 1 or 2 +(defun 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 absolute (V3804) (set *absolute* (cons V3804 (value *absolute*)))) +(defun absolute (V3818) (set *absolute* (cons V3818 (value *absolute*)))) -(defun unabsolute (V3805) (set *absolute* (remove V3805 (value *absolute*)))) +(defun unabsolute (V3819) (set *absolute* (remove V3819 (value *absolute*)))) diff --git a/klambda/t-star.kl b/klambda/t-star.kl index 0c6d2a6..de1b34e 100644 --- a/klambda/t-star.kl +++ b/klambda/t-star.kl @@ -1,104 +1,104 @@ -(defun shen.typecheck (V4434 V4435) (let W4436 (shen.extract-vars V4435) (let W4437 (shen.rectify-type V4435) (let W4438 (shen.curry V4434) (((((lambda Z4439 (lambda Z4440 (lambda Z4441 (lambda Z4442 (let W4443 (shen.newpv Z4439) (shen.gc Z4439 (do (shen.incinfs) (shen.insert-prolog-variables (receive (shen.deref W4436 Z4439)) (receive (shen.deref W4437 Z4439)) W4443 Z4439 Z4440 Z4441 (freeze (shen.toplevel-forms (receive (shen.deref W4438 Z4439)) W4443 Z4439 Z4440 Z4441 (freeze (return W4443 Z4439 Z4440 Z4441 Z4442)))))))))))) (shen.prolog-vector)) (@v true (@v 0 (vector 0)))) 0) (freeze true)))))) +(defun shen.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.insert-prolog-variables (V4444 V4445 V4446 V4447 V4448 V4449 V4450) (let W4451 (if (shen.unlocked? V4448) (let W4452 (shen.lazyderef V4444 V4447) (if (= W4452 ()) (do (shen.incinfs) (is! V4445 V4446 V4447 V4448 V4449 V4450)) false)) false) (if (= W4451 false) (if (shen.unlocked? V4448) (let W4453 (shen.lazyderef V4444 V4447) (if (cons? W4453) (let W4454 (hd W4453) (let W4455 (tl W4453) (let W4456 (shen.newpv V4447) (shen.gc V4447 (do (shen.incinfs) (shen.insert-prolog-variables W4455 (subst (shen.deref W4456 V4447) W4454 V4445) V4446 V4447 V4448 V4449 V4450)))))) false)) false) W4451))) +(defun shen.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.toplevel-forms (V4457 V4458 V4459 V4460 V4461 V4462) (let W4463 (+ V4461 1) (let W4464 (if (shen.unlocked? V4460) (let W4465 (shen.lazyderef V4457 V4459) (if (cons? W4465) (let W4466 (shen.lazyderef (hd W4465) V4459) (if (= W4466 define) (let W4467 (shen.lazyderef (tl W4465) V4459) (if (cons? W4467) (let W4468 (hd W4467) (let W4469 (tl W4467) (do (shen.incinfs) (when (shen.type-theory-enabled?) V4459 V4460 W4463 (freeze (shen.cut V4459 V4460 W4463 (freeze (shen.signal-def (value shen.*spy*) W4468 V4459 V4460 W4463 (freeze (shen.t* (cons define (cons W4468 W4469)) V4458 V4459 V4460 W4463 V4462)))))))))) false)) false)) false)) false) (if (= W4464 false) (let W4470 (if (shen.unlocked? V4460) (do (shen.incinfs) (shen.system-S (cons V4457 (cons (intern ":") (cons V4458 ()))) () V4459 V4460 W4463 V4462)) false) (if (= W4470 false) (shen.unlock V4460 W4463) W4470)) W4464)))) +(defun shen.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.signal-def (V4471 V4472 V4473 V4474 V4475 V4476) (let W4477 (if (shen.unlocked? V4474) (let W4478 (shen.lazyderef V4471 V4473) (if (= W4478 false) (do (shen.incinfs) (thaw V4476)) false)) false) (if (= W4477 false) (if (shen.unlocked? V4474) (let W4479 (shen.lazyderef V4471 V4473) (if (= W4479 true) (let W4480 (shen.newpv V4473) (shen.gc V4473 (do (shen.incinfs) (is W4480 (pr (cn " -typechecking (fn " (shen.app (shen.deref V4472 V4473) ") -" shen.a)) (stoutput)) V4473 V4474 V4475 V4476)))) false)) false) W4477))) +(defun shen.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.rectify-type (V4481) (shen.demodulate (shen.curry-type V4481))) +(defun shen.rectify-type (V4495) (shen.demodulate (shen.curry-type V4495))) -(defun shen.demodulate (V4482) (trap-error (let W4483 (shen.walk (lambda Z4484 (shen.demod Z4484)) V4482) (if (= W4483 V4482) V4482 (shen.demodulate W4483))) (lambda Z4485 V4482))) +(defun shen.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.curry-type (V4486) (cond ((and (cons? V4486) (and (cons? (tl V4486)) (and (= --> (hd (tl V4486))) (and (cons? (tl (tl V4486))) (and (cons? (tl (tl (tl V4486)))) (= --> (hd (tl (tl (tl V4486)))))))))) (shen.curry-type (cons (hd V4486) (cons --> (cons (tl (tl V4486)) ()))))) ((and (cons? V4486) (and (cons? (hd V4486)) (and (= list (hd (hd V4486))) (and (cons? (tl (hd V4486))) (and (= () (tl (tl (hd V4486)))) (and (cons? (tl V4486)) (and (= ==> (hd (tl V4486))) (and (cons? (tl (tl V4486))) (= () (tl (tl (tl V4486)))))))))))) (shen.curry-type (cons (hd V4486) (cons --> (cons (cons str (cons (hd V4486) (tl (tl V4486)))) ()))))) ((and (cons? V4486) (and (cons? (tl V4486)) (and (= * (hd (tl V4486))) (and (cons? (tl (tl V4486))) (and (cons? (tl (tl (tl V4486)))) (= * (hd (tl (tl (tl V4486)))))))))) (shen.curry-type (cons (hd V4486) (cons * (cons (tl (tl V4486)) ()))))) ((cons? V4486) (map (lambda Z4487 (shen.curry-type Z4487)) V4486)) (true V4486))) +(defun shen.curry-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 (V4488) (cond ((and (cons? V4488) (and (= define (hd V4488)) (cons? (tl V4488)))) V4488) ((and (cons? V4488) (and (= type (hd V4488)) (and (cons? (tl V4488)) (and (cons? (tl (tl V4488))) (= () (tl (tl (tl V4488)))))))) (cons type (cons (shen.curry (hd (tl V4488))) (tl (tl V4488))))) ((and (cons? V4488) (shen.special? (hd V4488))) (cons (hd V4488) (map (lambda Z4489 (shen.curry Z4489)) (tl V4488)))) ((and (cons? V4488) (shen.extraspecial? (hd V4488))) V4488) ((and (cons? V4488) (and (cons? (tl V4488)) (cons? (tl (tl V4488))))) (shen.curry (cons (cons (hd V4488) (cons (hd (tl V4488)) ())) (tl (tl V4488))))) ((and (cons? V4488) (and (cons? (tl V4488)) (= () (tl (tl V4488))))) (cons (shen.curry (hd V4488)) (cons (shen.curry (hd (tl V4488))) ()))) (true V4488))) +(defun shen.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.special? (V4490) (element? V4490 (value shen.*special*))) +(defun shen.special? (V4504) (element? V4504 (value shen.*special*))) -(defun shen.extraspecial? (V4491) (element? V4491 (value shen.*extraspecial*))) +(defun shen.extraspecial? (V4505) (element? V4505 (value shen.*extraspecial*))) -(defun shen.system-S (V4492 V4493 V4494 V4495 V4496 V4497) (let W4498 (+ V4496 1) (let W4499 (if (shen.unlocked? V4495) (do (shen.incinfs) (when (shen.maxinfexceeded?) V4494 V4495 W4498 V4497)) false) (if (= W4499 false) (let W4500 (if (shen.unlocked? V4495) (let W4501 (shen.lazyderef V4492 V4494) (if (cons? W4501) (let W4502 (hd W4501) (let W4503 (shen.lazyderef (tl W4501) V4494) (if (cons? W4503) (let W4504 (hd W4503) (let W4505 (shen.lazyderef (tl W4503) V4494) (if (cons? W4505) (let W4506 (hd W4505) (let W4507 (shen.lazyderef (tl W4505) V4494) (if (= W4507 ()) (do (shen.incinfs) (when (= (shen.deref W4504 V4494) (intern ":")) V4494 V4495 W4498 (freeze (when (shen.type-theory-enabled?) V4494 V4495 W4498 (freeze (shen.cut V4494 V4495 W4498 (freeze (shen.system-S-h W4502 W4506 V4493 V4494 V4495 W4498 V4497)))))))) false))) false))) false))) false)) false) (if (= W4500 false) (let W4508 (if (shen.unlocked? V4495) (do (shen.incinfs) (when (value shen.*spy*) V4494 V4495 W4498 (freeze (shen.show V4492 V4493 V4494 V4495 W4498 V4497)))) false) (if (= W4508 false) (let W4509 (if (shen.unlocked? V4495) (do (shen.incinfs) (shen.search-user-datatypes V4492 V4493 (value shen.*datatypes*) V4494 V4495 W4498 V4497)) false) (if (= W4509 false) (shen.unlock V4495 W4498) W4509)) W4508)) W4500)) W4499)))) +(defun shen.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.show (V4516 V4517 V4518 V4519 V4520 V4521) (do (shen.line) (do (shen.show-p (shen.deref V4516 V4518)) (do (nl 2) (do (shen.show-assumptions (shen.deref V4517 V4518) 1) (do (shen.pause-for-user) false)))))) +(defun shen.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.line () (let W4522 (inferences) (pr (cn "____________________________________________________________ " (shen.app W4522 (cn " inference" (shen.app (if (= 1 W4522) "" "s") " +(defun shen.line () (let W4536 (inferences) (pr (cn "____________________________________________________________ " (shen.app W4536 (cn " inference" (shen.app (if (= 1 W4536) "" "s") " ?- " shen.a)) shen.a)) (stoutput)))) -(defun shen.show-p (V4523) (cond ((and (cons? V4523) (and (cons? (tl V4523)) (and (cons? (tl (tl V4523))) (and (= () (tl (tl (tl V4523)))) (= (hd (tl V4523)) (intern ":")))))) (do (shen.prterm (hd V4523)) (do (pr " : " (stoutput)) (pr (shen.app (hd (tl (tl V4523))) "" shen.r) (stoutput))))) (true (shen.prterm V4523)))) +(defun shen.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.prterm (V4524) (cond ((and (cons? V4524) (and (= cons (hd V4524)) (and (cons? (tl V4524)) (and (cons? (tl (tl V4524))) (= () (tl (tl (tl V4524)))))))) (do (pr "[" (stoutput)) (do (shen.prterm (hd (tl V4524))) (do (shen.prtl (hd (tl (tl V4524)))) (pr "]" (stoutput)))))) ((cons? V4524) (do (pr "(" (stoutput)) (do (shen.prterm (hd V4524)) (do (map (lambda Z4525 (do (pr " " (stoutput)) (shen.prterm Z4525))) (tl V4524)) (pr ")" (stoutput)))))) (true (print V4524)))) +(defun shen.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.prtl (V4526) (cond ((= () V4526) "") ((and (cons? V4526) (and (= cons (hd V4526)) (and (cons? (tl V4526)) (and (cons? (tl (tl V4526))) (= () (tl (tl (tl V4526)))))))) (do (pr " " (stoutput)) (do (shen.prterm (hd (tl V4526))) (shen.prtl (hd (tl (tl V4526))))))) (true (do (pr " | " (stoutput)) (shen.prterm V4526))))) +(defun shen.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.show-assumptions (V4533 V4534) (cond ((= () V4533) (pr " -> " (stoutput))) ((cons? V4533) (do (pr (shen.app V4534 ". " shen.a) (stoutput)) (do (shen.show-p (hd V4533)) (do (nl 1) (shen.show-assumptions (tl V4533) (+ V4534 1)))))) (true (simple-error "implementation error in shen.show-assumptions")))) +(defun shen.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.pause-for-user () (let W4535 (read-byte (stinput)) (if (= W4535 94) (simple-error "input aborted +(defun shen.pause-for-user () (let W4549 (read-byte (stinput)) (if (= W4549 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 (V4536 V4537 V4538 V4539 V4540 V4541 V4542) (let W4543 (+ V4541 1) (let W4544 (if (shen.unlocked? V4540) (do (shen.incinfs) (when (value shen.*spy*) V4539 V4540 W4543 (freeze (shen.show (cons V4536 (cons (intern ":") (cons V4537 ()))) V4538 V4539 V4540 W4543 V4542)))) false) (if (= W4544 false) (let W4545 (if (shen.unlocked? V4540) (do (shen.incinfs) (when (not (cons? (shen.lazyderef V4536 V4539))) V4539 V4540 W4543 (freeze (shen.primitive V4536 V4537 V4539 V4540 W4543 V4542)))) false) (if (= W4545 false) (let W4546 (if (shen.unlocked? V4540) (do (shen.incinfs) (shen.by-hypothesis V4536 V4537 V4538 V4539 V4540 W4543 V4542)) false) (if (= W4546 false) (let W4547 (if (shen.unlocked? V4540) (let W4548 (shen.lazyderef V4536 V4539) (if (cons? W4548) (let W4549 (hd W4548) (let W4550 (shen.lazyderef (tl W4548) V4539) (if (= W4550 ()) (do (shen.incinfs) (shen.lookupsig W4549 (cons --> (cons V4537 ())) V4539 V4540 W4543 V4542)) false))) false)) false) (if (= W4547 false) (let W4551 (if (shen.unlocked? V4540) (let W4552 (shen.lazyderef V4536 V4539) (if (cons? W4552) (let W4553 (shen.lazyderef (hd W4552) V4539) (if (= W4553 fn) (let W4554 (shen.lazyderef (tl W4552) V4539) (if (cons? W4554) (let W4555 (hd W4554) (let W4556 (shen.lazyderef (tl W4554) V4539) (if (= W4556 ()) (do (shen.incinfs) (when (= (arity (shen.deref W4555 V4539)) 0) V4539 V4540 W4543 (freeze (shen.cut V4539 V4540 W4543 (freeze (shen.system-S-h (cons W4555 ()) V4537 V4538 V4539 V4540 W4543 V4542)))))) false))) false)) false)) false)) false) (if (= W4551 false) (let W4557 (if (shen.unlocked? V4540) (let W4558 (shen.lazyderef V4536 V4539) (if (cons? W4558) (let W4559 (shen.lazyderef (hd W4558) V4539) (if (= W4559 fn) (let W4560 (shen.lazyderef (tl W4558) V4539) (if (cons? W4560) (let W4561 (hd W4560) (let W4562 (shen.lazyderef (tl W4560) V4539) (if (= W4562 ()) (do (shen.incinfs) (shen.lookupsig W4561 V4537 V4539 V4540 W4543 V4542)) false))) false)) false)) false)) false) (if (= W4557 false) (let W4563 (if (shen.unlocked? V4540) (let W4564 (shen.lazyderef V4536 V4539) (if (cons? W4564) (let W4565 (hd W4564) (let W4566 (shen.lazyderef (tl W4564) V4539) (if (cons? W4566) (let W4567 (hd W4566) (let W4568 (shen.lazyderef (tl W4566) V4539) (if (= W4568 ()) (let W4569 (shen.newpv V4539) (shen.gc V4539 (do (shen.incinfs) (when (not (cons? (shen.lazyderef W4565 V4539))) V4539 V4540 W4543 (freeze (shen.lookupsig W4565 (cons W4569 (cons --> (cons V4537 ()))) V4539 V4540 W4543 (freeze (shen.system-S-h W4567 W4569 V4538 V4539 V4540 W4543 V4542)))))))) false))) false))) false)) false) (if (= W4563 false) (let W4570 (if (shen.unlocked? V4540) (let W4571 (shen.lazyderef V4536 V4539) (if (cons? W4571) (let W4572 (hd W4571) (let W4573 (shen.lazyderef (tl W4571) V4539) (if (cons? W4573) (let W4574 (hd W4573) (let W4575 (shen.lazyderef (tl W4573) V4539) (if (= W4575 ()) (let W4576 (shen.newpv V4539) (shen.gc V4539 (do (shen.incinfs) (shen.system-S-h W4572 (cons W4576 (cons --> (cons V4537 ()))) V4538 V4539 V4540 W4543 (freeze (shen.system-S-h W4574 W4576 V4538 V4539 V4540 W4543 V4542)))))) false))) false))) false)) false) (if (= W4570 false) (let W4577 (if (shen.unlocked? V4540) (let W4578 (shen.lazyderef V4536 V4539) (if (cons? W4578) (let W4579 (shen.lazyderef (hd W4578) V4539) (if (= W4579 cons) (let W4580 (shen.lazyderef (tl W4578) V4539) (if (cons? W4580) (let W4581 (hd W4580) (let W4582 (shen.lazyderef (tl W4580) V4539) (if (cons? W4582) (let W4583 (hd W4582) (let W4584 (shen.lazyderef (tl W4582) V4539) (if (= W4584 ()) (let W4585 (shen.lazyderef V4537 V4539) (let W4586 (lambda Z4587 (do (shen.incinfs) (shen.system-S-h W4581 Z4587 V4538 V4539 V4540 W4543 (freeze (shen.system-S-h W4583 (cons list (cons Z4587 ())) V4538 V4539 V4540 W4543 V4542))))) (if (cons? W4585) (let W4588 (shen.lazyderef (hd W4585) V4539) (let W4589 (freeze (let W4590 (shen.lazyderef (tl W4585) V4539) (let W4591 (lambda Z4592 (W4586 Z4592)) (if (cons? W4590) (let W4593 (hd W4590) (let W4594 (shen.lazyderef (tl W4590) V4539) (let W4595 (freeze (W4591 W4593)) (if (= W4594 ()) (thaw W4595) (if (shen.pvar? W4594) (shen.bind! W4594 () V4539 W4595) false))))) (if (shen.pvar? W4590) (let W4596 (shen.newpv V4539) (shen.gc V4539 (shen.bind! W4590 (cons W4596 ()) V4539 (freeze (W4591 W4596))))) false))))) (if (= W4588 list) (thaw W4589) (if (shen.pvar? W4588) (shen.bind! W4588 list V4539 W4589) false)))) (if (shen.pvar? W4585) (let W4597 (shen.newpv V4539) (shen.gc V4539 (shen.bind! W4585 (cons list (cons W4597 ())) V4539 (freeze (W4586 W4597))))) false)))) false))) false))) false)) false)) false)) false) (if (= W4577 false) (let W4598 (if (shen.unlocked? V4540) (let W4599 (shen.lazyderef V4536 V4539) (if (cons? W4599) (let W4600 (shen.lazyderef (hd W4599) V4539) (if (= W4600 @p) (let W4601 (shen.lazyderef (tl W4599) V4539) (if (cons? W4601) (let W4602 (hd W4601) (let W4603 (shen.lazyderef (tl W4601) V4539) (if (cons? W4603) (let W4604 (hd W4603) (let W4605 (shen.lazyderef (tl W4603) V4539) (if (= W4605 ()) (let W4606 (shen.lazyderef V4537 V4539) (let W4607 (lambda Z4608 (lambda Z4609 (do (shen.incinfs) (shen.system-S-h W4602 Z4608 V4538 V4539 V4540 W4543 (freeze (shen.system-S-h W4604 Z4609 V4538 V4539 V4540 W4543 V4542)))))) (if (cons? W4606) (let W4610 (hd W4606) (let W4611 (shen.lazyderef (tl W4606) V4539) (let W4612 (lambda Z4613 ((W4607 W4610) Z4613)) (if (cons? W4611) (let W4614 (shen.lazyderef (hd W4611) V4539) (let W4615 (freeze (let W4616 (shen.lazyderef (tl W4611) V4539) (let W4617 (lambda Z4618 (W4612 Z4618)) (if (cons? W4616) (let W4619 (hd W4616) (let W4620 (shen.lazyderef (tl W4616) V4539) (let W4621 (freeze (W4617 W4619)) (if (= W4620 ()) (thaw W4621) (if (shen.pvar? W4620) (shen.bind! W4620 () V4539 W4621) false))))) (if (shen.pvar? W4616) (let W4622 (shen.newpv V4539) (shen.gc V4539 (shen.bind! W4616 (cons W4622 ()) V4539 (freeze (W4617 W4622))))) false))))) (if (= W4614 *) (thaw W4615) (if (shen.pvar? W4614) (shen.bind! W4614 * V4539 W4615) false)))) (if (shen.pvar? W4611) (let W4623 (shen.newpv V4539) (shen.gc V4539 (shen.bind! W4611 (cons * (cons W4623 ())) V4539 (freeze (W4612 W4623))))) false))))) (if (shen.pvar? W4606) (let W4624 (shen.newpv V4539) (shen.gc V4539 (let W4625 (shen.newpv V4539) (shen.gc V4539 (shen.bind! W4606 (cons W4624 (cons * (cons W4625 ()))) V4539 (freeze ((W4607 W4624) W4625))))))) false)))) false))) false))) false)) false)) false)) false) (if (= W4598 false) (let W4626 (if (shen.unlocked? V4540) (let W4627 (shen.lazyderef V4536 V4539) (if (cons? W4627) (let W4628 (shen.lazyderef (hd W4627) V4539) (if (= W4628 @v) (let W4629 (shen.lazyderef (tl W4627) V4539) (if (cons? W4629) (let W4630 (hd W4629) (let W4631 (shen.lazyderef (tl W4629) V4539) (if (cons? W4631) (let W4632 (hd W4631) (let W4633 (shen.lazyderef (tl W4631) V4539) (if (= W4633 ()) (let W4634 (shen.lazyderef V4537 V4539) (let W4635 (lambda Z4636 (do (shen.incinfs) (shen.system-S-h W4630 Z4636 V4538 V4539 V4540 W4543 (freeze (shen.system-S-h W4632 (cons vector (cons Z4636 ())) V4538 V4539 V4540 W4543 V4542))))) (if (cons? W4634) (let W4637 (shen.lazyderef (hd W4634) V4539) (let W4638 (freeze (let W4639 (shen.lazyderef (tl W4634) V4539) (let W4640 (lambda Z4641 (W4635 Z4641)) (if (cons? W4639) (let W4642 (hd W4639) (let W4643 (shen.lazyderef (tl W4639) V4539) (let W4644 (freeze (W4640 W4642)) (if (= W4643 ()) (thaw W4644) (if (shen.pvar? W4643) (shen.bind! W4643 () V4539 W4644) false))))) (if (shen.pvar? W4639) (let W4645 (shen.newpv V4539) (shen.gc V4539 (shen.bind! W4639 (cons W4645 ()) V4539 (freeze (W4640 W4645))))) false))))) (if (= W4637 vector) (thaw W4638) (if (shen.pvar? W4637) (shen.bind! W4637 vector V4539 W4638) false)))) (if (shen.pvar? W4634) (let W4646 (shen.newpv V4539) (shen.gc V4539 (shen.bind! W4634 (cons vector (cons W4646 ())) V4539 (freeze (W4635 W4646))))) false)))) false))) false))) false)) false)) false)) false) (if (= W4626 false) (let W4647 (if (shen.unlocked? V4540) (let W4648 (shen.lazyderef V4536 V4539) (if (cons? W4648) (let W4649 (shen.lazyderef (hd W4648) V4539) (if (= W4649 @s) (let W4650 (shen.lazyderef (tl W4648) V4539) (if (cons? W4650) (let W4651 (hd W4650) (let W4652 (shen.lazyderef (tl W4650) V4539) (if (cons? W4652) (let W4653 (hd W4652) (let W4654 (shen.lazyderef (tl W4652) V4539) (if (= W4654 ()) (let W4655 (shen.lazyderef V4537 V4539) (let W4656 (freeze (do (shen.incinfs) (shen.system-S-h W4651 string V4538 V4539 V4540 W4543 (freeze (shen.system-S-h W4653 string V4538 V4539 V4540 W4543 V4542))))) (if (= W4655 string) (thaw W4656) (if (shen.pvar? W4655) (shen.bind! W4655 string V4539 W4656) false)))) false))) false))) false)) false)) false)) false) (if (= W4647 false) (let W4657 (if (shen.unlocked? V4540) (let W4658 (shen.lazyderef V4536 V4539) (if (cons? W4658) (let W4659 (shen.lazyderef (hd W4658) V4539) (if (= W4659 lambda) (let W4660 (shen.lazyderef (tl W4658) V4539) (if (cons? W4660) (let W4661 (hd W4660) (let W4662 (shen.lazyderef (tl W4660) V4539) (if (cons? W4662) (let W4663 (hd W4662) (let W4664 (shen.lazyderef (tl W4662) V4539) (if (= W4664 ()) (let W4665 (shen.lazyderef V4537 V4539) (let W4666 (lambda Z4667 (lambda Z4668 (let W4669 (shen.newpv V4539) (shen.gc V4539 (let W4670 (shen.newpv V4539) (shen.gc V4539 (do (shen.incinfs) (bind W4670 (shen.freshterm (shen.lazyderef W4661 V4539)) V4539 V4540 W4543 (freeze (bind W4669 (shen.beta (shen.lazyderef W4661 V4539) (shen.deref W4670 V4539) (shen.deref W4663 V4539)) V4539 V4540 W4543 (freeze (shen.system-S-h W4669 Z4668 (cons (cons W4670 (cons (intern ":") (cons Z4667 ()))) V4538) V4539 V4540 W4543 V4542)))))))))))) (if (cons? W4665) (let W4671 (hd W4665) (let W4672 (shen.lazyderef (tl W4665) V4539) (let W4673 (lambda Z4674 ((W4666 W4671) Z4674)) (if (cons? W4672) (let W4675 (shen.lazyderef (hd W4672) V4539) (let W4676 (freeze (let W4677 (shen.lazyderef (tl W4672) V4539) (let W4678 (lambda Z4679 (W4673 Z4679)) (if (cons? W4677) (let W4680 (hd W4677) (let W4681 (shen.lazyderef (tl W4677) V4539) (let W4682 (freeze (W4678 W4680)) (if (= W4681 ()) (thaw W4682) (if (shen.pvar? W4681) (shen.bind! W4681 () V4539 W4682) false))))) (if (shen.pvar? W4677) (let W4683 (shen.newpv V4539) (shen.gc V4539 (shen.bind! W4677 (cons W4683 ()) V4539 (freeze (W4678 W4683))))) false))))) (if (= W4675 -->) (thaw W4676) (if (shen.pvar? W4675) (shen.bind! W4675 --> V4539 W4676) false)))) (if (shen.pvar? W4672) (let W4684 (shen.newpv V4539) (shen.gc V4539 (shen.bind! W4672 (cons --> (cons W4684 ())) V4539 (freeze (W4673 W4684))))) false))))) (if (shen.pvar? W4665) (let W4685 (shen.newpv V4539) (shen.gc V4539 (let W4686 (shen.newpv V4539) (shen.gc V4539 (shen.bind! W4665 (cons W4685 (cons --> (cons W4686 ()))) V4539 (freeze ((W4666 W4685) W4686))))))) false)))) false))) false))) false)) false)) false)) false) (if (= W4657 false) (let W4687 (if (shen.unlocked? V4540) (let W4688 (shen.lazyderef V4536 V4539) (if (cons? W4688) (let W4689 (shen.lazyderef (hd W4688) V4539) (if (= W4689 let) (let W4690 (shen.lazyderef (tl W4688) V4539) (if (cons? W4690) (let W4691 (hd W4690) (let W4692 (shen.lazyderef (tl W4690) V4539) (if (cons? W4692) (let W4693 (hd W4692) (let W4694 (shen.lazyderef (tl W4692) V4539) (if (cons? W4694) (let W4695 (hd W4694) (let W4696 (shen.lazyderef (tl W4694) V4539) (if (= W4696 ()) (let W4697 (shen.newpv V4539) (shen.gc V4539 (let W4698 (shen.newpv V4539) (shen.gc V4539 (let W4699 (shen.newpv V4539) (shen.gc V4539 (do (shen.incinfs) (shen.system-S-h W4693 W4699 V4538 V4539 V4540 W4543 (freeze (bind W4698 (shen.freshterm (shen.lazyderef W4691 V4539)) V4539 V4540 W4543 (freeze (bind W4697 (shen.beta (shen.lazyderef W4691 V4539) (shen.lazyderef W4698 V4539) (shen.lazyderef W4695 V4539)) V4539 V4540 W4543 (freeze (shen.system-S-h W4697 V4537 (cons (cons W4698 (cons (intern ":") (cons W4699 ()))) V4538) V4539 V4540 W4543 V4542)))))))))))))) false))) false))) false))) false)) false)) false)) false) (if (= W4687 false) (let W4700 (if (shen.unlocked? V4540) (let W4701 (shen.lazyderef V4536 V4539) (if (cons? W4701) (let W4702 (shen.lazyderef (hd W4701) V4539) (if (= W4702 open) (let W4703 (shen.lazyderef (tl W4701) V4539) (if (cons? W4703) (let W4704 (hd W4703) (let W4705 (shen.lazyderef (tl W4703) V4539) (if (cons? W4705) (let W4706 (hd W4705) (let W4707 (shen.lazyderef (tl W4705) V4539) (if (= W4707 ()) (let W4708 (shen.lazyderef V4537 V4539) (let W4709 (lambda Z4710 (do (shen.incinfs) (is! W4706 Z4710 V4539 V4540 W4543 (freeze (when (element? (shen.lazyderef Z4710 V4539) (cons in (cons out ()))) V4539 V4540 W4543 (freeze (shen.system-S-h W4704 string V4538 V4539 V4540 W4543 V4542))))))) (if (cons? W4708) (let W4711 (shen.lazyderef (hd W4708) V4539) (let W4712 (freeze (let W4713 (shen.lazyderef (tl W4708) V4539) (let W4714 (lambda Z4715 (W4709 Z4715)) (if (cons? W4713) (let W4716 (hd W4713) (let W4717 (shen.lazyderef (tl W4713) V4539) (let W4718 (freeze (W4714 W4716)) (if (= W4717 ()) (thaw W4718) (if (shen.pvar? W4717) (shen.bind! W4717 () V4539 W4718) false))))) (if (shen.pvar? W4713) (let W4719 (shen.newpv V4539) (shen.gc V4539 (shen.bind! W4713 (cons W4719 ()) V4539 (freeze (W4714 W4719))))) false))))) (if (= W4711 stream) (thaw W4712) (if (shen.pvar? W4711) (shen.bind! W4711 stream V4539 W4712) false)))) (if (shen.pvar? W4708) (let W4720 (shen.newpv V4539) (shen.gc V4539 (shen.bind! W4708 (cons stream (cons W4720 ())) V4539 (freeze (W4709 W4720))))) false)))) false))) false))) false)) false)) false)) false) (if (= W4700 false) (let W4721 (if (shen.unlocked? V4540) (let W4722 (shen.lazyderef V4536 V4539) (if (cons? W4722) (let W4723 (shen.lazyderef (hd W4722) V4539) (if (= W4723 type) (let W4724 (shen.lazyderef (tl W4722) V4539) (if (cons? W4724) (let W4725 (hd W4724) (let W4726 (shen.lazyderef (tl W4724) V4539) (if (cons? W4726) (let W4727 (hd W4726) (let W4728 (shen.lazyderef (tl W4726) V4539) (if (= W4728 ()) (do (shen.incinfs) (shen.cut V4539 V4540 W4543 (freeze (is! (shen.rectify-type (shen.deref W4727 V4539)) V4537 V4539 V4540 W4543 (freeze (shen.system-S-h W4725 V4537 V4538 V4539 V4540 W4543 V4542)))))) false))) false))) false)) false)) false)) false) (if (= W4721 false) (let W4729 (if (shen.unlocked? V4540) (let W4730 (shen.lazyderef V4536 V4539) (if (cons? W4730) (let W4731 (shen.lazyderef (hd W4730) V4539) (if (= W4731 shen.input-h+) (let W4732 (shen.lazyderef (tl W4730) V4539) (if (cons? W4732) (let W4733 (hd W4732) (let W4734 (shen.lazyderef (tl W4732) V4539) (if (cons? W4734) (let W4735 (hd W4734) (let W4736 (shen.lazyderef (tl W4734) V4539) (if (= W4736 ()) (do (shen.incinfs) (is V4537 (shen.rectify-type (shen.rdecons (shen.deref W4733 V4539))) V4539 V4540 W4543 (freeze (shen.system-S-h W4735 (cons stream (cons in ())) V4538 V4539 V4540 W4543 V4542)))) false))) false))) false)) false)) false)) false) (if (= W4729 false) (let W4737 (if (shen.unlocked? V4540) (let W4738 (shen.lazyderef V4536 V4539) (if (cons? W4738) (let W4739 (shen.lazyderef (hd W4738) V4539) (if (= W4739 set) (let W4740 (shen.lazyderef (tl W4738) V4539) (if (cons? W4740) (let W4741 (hd W4740) (let W4742 (shen.lazyderef (tl W4740) V4539) (if (cons? W4742) (let W4743 (hd W4742) (let W4744 (shen.lazyderef (tl W4742) V4539) (if (= W4744 ()) (do (shen.incinfs) (shen.system-S-h W4741 symbol V4538 V4539 V4540 W4543 (freeze (shen.system-S-h (cons value (cons W4741 ())) V4537 V4538 V4539 V4540 W4543 (freeze (shen.system-S-h W4743 V4537 V4538 V4539 V4540 W4543 V4542)))))) false))) false))) false)) false)) false)) false) (if (= W4737 false) (let W4745 (if (shen.unlocked? V4540) (let W4746 (shen.newpv V4539) (shen.gc V4539 (do (shen.incinfs) (shen.l-rules V4538 W4746 false V4539 V4540 W4543 (freeze (shen.cut V4539 V4540 W4543 (freeze (shen.system-S-h V4536 V4537 W4746 V4539 V4540 W4543 V4542)))))))) false) (if (= W4745 false) (let W4747 (if (shen.unlocked? V4540) (do (shen.incinfs) (shen.search-user-datatypes (cons V4536 (cons (intern ":") (cons V4537 ()))) V4538 (value shen.*datatypes*) V4539 V4540 W4543 V4542)) false) (if (= W4747 false) (shen.unlock V4540 W4543) W4747)) W4745)) W4737)) W4729)) W4721)) W4700)) W4687)) W4657)) W4647)) W4626)) W4598)) W4577)) W4570)) W4563)) W4557)) W4551)) W4547)) W4546)) W4545)) W4544)))) +(defun shen.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.rdecons (V4748) (cond ((and (cons? V4748) (and (= cons (hd V4748)) (and (cons? (tl V4748)) (and (cons? (tl (tl V4748))) (= () (tl (tl (tl V4748)))))))) (cons (shen.rdecons (hd (tl V4748))) (shen.rdecons (hd (tl (tl V4748)))))) ((cons? V4748) (cons (shen.rdecons (hd V4748)) (shen.rdecons (tl V4748)))) (true V4748))) +(defun shen.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.primitive (V4749 V4750 V4751 V4752 V4753 V4754) (let W4755 (if (shen.unlocked? V4752) (let W4756 (shen.lazyderef V4750 V4751) (let W4757 (freeze (do (shen.incinfs) (when (number? (shen.lazyderef V4749 V4751)) V4751 V4752 V4753 V4754))) (if (= W4756 number) (thaw W4757) (if (shen.pvar? W4756) (shen.bind! W4756 number V4751 W4757) false)))) false) (if (= W4755 false) (let W4758 (if (shen.unlocked? V4752) (let W4759 (shen.lazyderef V4750 V4751) (let W4760 (freeze (do (shen.incinfs) (when (boolean? (shen.lazyderef V4749 V4751)) V4751 V4752 V4753 V4754))) (if (= W4759 boolean) (thaw W4760) (if (shen.pvar? W4759) (shen.bind! W4759 boolean V4751 W4760) false)))) false) (if (= W4758 false) (let W4761 (if (shen.unlocked? V4752) (let W4762 (shen.lazyderef V4750 V4751) (let W4763 (freeze (do (shen.incinfs) (when (string? (shen.lazyderef V4749 V4751)) V4751 V4752 V4753 V4754))) (if (= W4762 string) (thaw W4763) (if (shen.pvar? W4762) (shen.bind! W4762 string V4751 W4763) false)))) false) (if (= W4761 false) (let W4764 (if (shen.unlocked? V4752) (let W4765 (shen.lazyderef V4750 V4751) (let W4766 (freeze (do (shen.incinfs) (when (symbol? (shen.lazyderef V4749 V4751)) V4751 V4752 V4753 V4754))) (if (= W4765 symbol) (thaw W4766) (if (shen.pvar? W4765) (shen.bind! W4765 symbol V4751 W4766) false)))) false) (if (= W4764 false) (if (shen.unlocked? V4752) (let W4767 (shen.lazyderef V4749 V4751) (if (= W4767 ()) (let W4768 (shen.lazyderef V4750 V4751) (let W4769 (lambda Z4770 (do (shen.incinfs) (thaw V4754))) (if (cons? W4768) (let W4771 (shen.lazyderef (hd W4768) V4751) (let W4772 (freeze (let W4773 (shen.lazyderef (tl W4768) V4751) (let W4774 (lambda Z4775 (W4769 Z4775)) (if (cons? W4773) (let W4776 (hd W4773) (let W4777 (shen.lazyderef (tl W4773) V4751) (let W4778 (freeze (W4774 W4776)) (if (= W4777 ()) (thaw W4778) (if (shen.pvar? W4777) (shen.bind! W4777 () V4751 W4778) false))))) (if (shen.pvar? W4773) (let W4779 (shen.newpv V4751) (shen.gc V4751 (shen.bind! W4773 (cons W4779 ()) V4751 (freeze (W4774 W4779))))) false))))) (if (= W4771 list) (thaw W4772) (if (shen.pvar? W4771) (shen.bind! W4771 list V4751 W4772) false)))) (if (shen.pvar? W4768) (let W4780 (shen.newpv V4751) (shen.gc V4751 (shen.bind! W4768 (cons list (cons W4780 ())) V4751 (freeze (W4769 W4780))))) false)))) false)) false) W4764)) W4761)) W4758)) W4755))) +(defun shen.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.by-hypothesis (V4781 V4782 V4783 V4784 V4785 V4786 V4787) (let W4788 (if (shen.unlocked? V4785) (let W4789 (shen.lazyderef V4783 V4784) (if (cons? W4789) (let W4790 (shen.lazyderef (hd W4789) V4784) (if (cons? W4790) (let W4791 (hd W4790) (let W4792 (shen.lazyderef (tl W4790) V4784) (if (cons? W4792) (let W4793 (hd W4792) (let W4794 (shen.lazyderef (tl W4792) V4784) (if (cons? W4794) (let W4795 (hd W4794) (let W4796 (shen.lazyderef (tl W4794) V4784) (if (= W4796 ()) (do (shen.incinfs) (when (= (shen.deref W4793 V4784) (intern ":")) V4784 V4785 V4786 (freeze (when (= (shen.deref V4781 V4784) (shen.deref W4791 V4784)) V4784 V4785 V4786 (freeze (is! V4782 W4795 V4784 V4785 V4786 V4787)))))) false))) false))) false))) false)) false)) false) (if (= W4788 false) (if (shen.unlocked? V4785) (let W4797 (shen.lazyderef V4783 V4784) (if (cons? W4797) (let W4798 (tl W4797) (do (shen.incinfs) (shen.by-hypothesis V4781 V4782 W4798 V4784 V4785 V4786 V4787))) false)) false) W4788))) +(defun shen.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.lookupsig (V4799 V4800 V4801 V4802 V4803 V4804) (if (shen.unlocked? V4802) (do (shen.incinfs) (shen.sigf (assoc V4799 (value shen.*sigf*)) V4800 V4801 V4802 V4803 V4804)) false)) +(defun shen.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.sigf (V4819 V4820 V4821 V4822 V4823 V4824) (cond ((cons? V4819) ((((((tl V4819) V4820) V4821) V4822) V4823) V4824)) (true false))) +(defun shen.sigf (V4833 V4834 V4835 V4836 V4837 V4838) (cond ((cons? V4833) ((((((tl V4833) V4834) V4835) V4836) V4837) V4838)) (true false))) -(defun shen.freshterm (V4825) (let W4826 (absvector 3) (let W4827 (address-> W4826 0 shen.print-freshterm) (let W4828 (address-> W4827 1 V4825) (let W4829 (address-> W4828 2 (set shen.*gensym* (+ 1 (value shen.*gensym*)))) W4829))))) +(defun shen.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.print-freshterm (V4830) (cn "&&" (shen.app (<-address V4830 1) "" shen.a))) +(defun shen.print-freshterm (V4844) (cn "&&" (shen.app (<-address V4844 1) "" shen.a))) -(defun shen.search-user-datatypes (V4831 V4832 V4833 V4834 V4835 V4836 V4837) (let W4838 (if (shen.unlocked? V4835) (let W4839 (shen.lazyderef V4833 V4834) (if (cons? W4839) (let W4840 (shen.lazyderef (hd W4839) V4834) (if (cons? W4840) (let W4841 (tl W4840) (do (shen.incinfs) (call (((shen.deref W4841 V4834) (shen.deref V4831 V4834)) (shen.deref V4832 V4834)) V4834 V4835 V4836 V4837))) false)) false)) false) (if (= W4838 false) (if (shen.unlocked? V4835) (let W4842 (shen.lazyderef V4833 V4834) (if (cons? W4842) (let W4843 (tl W4842) (do (shen.incinfs) (shen.search-user-datatypes V4831 V4832 W4843 V4834 V4835 V4836 V4837))) false)) false) W4838))) +(defun shen.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.l-rules (V4844 V4845 V4846 V4847 V4848 V4849 V4850) (let W4851 (+ V4849 1) (let W4852 (if (shen.unlocked? V4848) (let W4853 (shen.lazyderef V4844 V4847) (if (= W4853 ()) (let W4854 (shen.lazyderef V4846 V4847) (if (= W4854 true) (do (shen.incinfs) (shen.cut V4847 V4848 W4851 (freeze (bind V4845 () V4847 V4848 W4851 V4850)))) false)) false)) false) (if (= W4852 false) (let W4855 (if (shen.unlocked? V4848) (let W4856 (shen.lazyderef V4844 V4847) (if (cons? W4856) (let W4857 (shen.lazyderef (hd W4856) V4847) (if (cons? W4857) (let W4858 (shen.lazyderef (hd W4857) V4847) (if (cons? W4858) (let W4859 (shen.lazyderef (hd W4858) V4847) (if (= W4859 cons) (let W4860 (shen.lazyderef (tl W4858) V4847) (if (cons? W4860) (let W4861 (hd W4860) (let W4862 (shen.lazyderef (tl W4860) V4847) (if (cons? W4862) (let W4863 (hd W4862) (let W4864 (shen.lazyderef (tl W4862) V4847) (if (= W4864 ()) (let W4865 (shen.lazyderef (tl W4857) V4847) (if (cons? W4865) (let W4866 (hd W4865) (let W4867 (shen.lazyderef (tl W4865) V4847) (if (cons? W4867) (let W4868 (shen.lazyderef (hd W4867) V4847) (if (cons? W4868) (let W4869 (shen.lazyderef (hd W4868) V4847) (if (= W4869 list) (let W4870 (shen.lazyderef (tl W4868) V4847) (if (cons? W4870) (let W4871 (hd W4870) (let W4872 (shen.lazyderef (tl W4870) V4847) (if (= W4872 ()) (let W4873 (shen.lazyderef (tl W4867) V4847) (if (= W4873 ()) (let W4874 (tl W4856) (do (shen.incinfs) (when (= (shen.deref W4866 V4847) (intern ":")) V4847 V4848 W4851 (freeze (shen.cut V4847 V4848 W4851 (freeze (shen.l-rules (cons (cons W4861 (cons W4866 (cons W4871 ()))) (cons (cons W4863 (cons W4866 (cons (cons list (cons W4871 ())) ()))) W4874)) V4845 true V4847 V4848 W4851 V4850))))))) false)) false))) false)) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W4855 false) (let W4875 (if (shen.unlocked? V4848) (let W4876 (shen.lazyderef V4844 V4847) (if (cons? W4876) (let W4877 (shen.lazyderef (hd W4876) V4847) (if (cons? W4877) (let W4878 (shen.lazyderef (hd W4877) V4847) (if (cons? W4878) (let W4879 (shen.lazyderef (hd W4878) V4847) (if (= W4879 @p) (let W4880 (shen.lazyderef (tl W4878) V4847) (if (cons? W4880) (let W4881 (hd W4880) (let W4882 (shen.lazyderef (tl W4880) V4847) (if (cons? W4882) (let W4883 (hd W4882) (let W4884 (shen.lazyderef (tl W4882) V4847) (if (= W4884 ()) (let W4885 (shen.lazyderef (tl W4877) V4847) (if (cons? W4885) (let W4886 (hd W4885) (let W4887 (shen.lazyderef (tl W4885) V4847) (if (cons? W4887) (let W4888 (shen.lazyderef (hd W4887) V4847) (if (cons? W4888) (let W4889 (hd W4888) (let W4890 (shen.lazyderef (tl W4888) V4847) (if (cons? W4890) (let W4891 (shen.lazyderef (hd W4890) V4847) (if (= W4891 *) (let W4892 (shen.lazyderef (tl W4890) V4847) (if (cons? W4892) (let W4893 (hd W4892) (let W4894 (shen.lazyderef (tl W4892) V4847) (if (= W4894 ()) (let W4895 (shen.lazyderef (tl W4887) V4847) (if (= W4895 ()) (let W4896 (tl W4876) (do (shen.incinfs) (when (= (shen.deref W4886 V4847) (intern ":")) V4847 V4848 W4851 (freeze (shen.cut V4847 V4848 W4851 (freeze (shen.l-rules (cons (cons W4881 (cons W4886 (cons W4889 ()))) (cons (cons W4883 (cons W4886 (cons W4893 ()))) W4896)) V4845 true V4847 V4848 W4851 V4850))))))) false)) false))) false)) false)) false))) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W4875 false) (let W4897 (if (shen.unlocked? V4848) (let W4898 (shen.lazyderef V4844 V4847) (if (cons? W4898) (let W4899 (shen.lazyderef (hd W4898) V4847) (if (cons? W4899) (let W4900 (shen.lazyderef (hd W4899) V4847) (if (cons? W4900) (let W4901 (shen.lazyderef (hd W4900) V4847) (if (= W4901 @s) (let W4902 (shen.lazyderef (tl W4900) V4847) (if (cons? W4902) (let W4903 (hd W4902) (let W4904 (shen.lazyderef (tl W4902) V4847) (if (cons? W4904) (let W4905 (hd W4904) (let W4906 (shen.lazyderef (tl W4904) V4847) (if (= W4906 ()) (let W4907 (shen.lazyderef (tl W4899) V4847) (if (cons? W4907) (let W4908 (hd W4907) (let W4909 (shen.lazyderef (tl W4907) V4847) (if (cons? W4909) (let W4910 (shen.lazyderef (hd W4909) V4847) (if (= W4910 string) (let W4911 (shen.lazyderef (tl W4909) V4847) (if (= W4911 ()) (let W4912 (tl W4898) (do (shen.incinfs) (when (= (shen.deref W4908 V4847) (intern ":")) V4847 V4848 W4851 (freeze (shen.cut V4847 V4848 W4851 (freeze (shen.l-rules (cons (cons W4903 (cons W4908 (cons string ()))) (cons (cons W4905 (cons W4908 (cons string ()))) W4912)) V4845 true V4847 V4848 W4851 V4850))))))) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W4897 false) (let W4913 (if (shen.unlocked? V4848) (let W4914 (shen.lazyderef V4844 V4847) (if (cons? W4914) (let W4915 (shen.lazyderef (hd W4914) V4847) (if (cons? W4915) (let W4916 (shen.lazyderef (hd W4915) V4847) (if (cons? W4916) (let W4917 (shen.lazyderef (hd W4916) V4847) (if (= W4917 @v) (let W4918 (shen.lazyderef (tl W4916) V4847) (if (cons? W4918) (let W4919 (hd W4918) (let W4920 (shen.lazyderef (tl W4918) V4847) (if (cons? W4920) (let W4921 (hd W4920) (let W4922 (shen.lazyderef (tl W4920) V4847) (if (= W4922 ()) (let W4923 (shen.lazyderef (tl W4915) V4847) (if (cons? W4923) (let W4924 (hd W4923) (let W4925 (shen.lazyderef (tl W4923) V4847) (if (cons? W4925) (let W4926 (shen.lazyderef (hd W4925) V4847) (if (cons? W4926) (let W4927 (shen.lazyderef (hd W4926) V4847) (if (= W4927 vector) (let W4928 (shen.lazyderef (tl W4926) V4847) (if (cons? W4928) (let W4929 (hd W4928) (let W4930 (shen.lazyderef (tl W4928) V4847) (if (= W4930 ()) (let W4931 (shen.lazyderef (tl W4925) V4847) (if (= W4931 ()) (let W4932 (tl W4914) (do (shen.incinfs) (when (= (shen.deref W4924 V4847) (intern ":")) V4847 V4848 W4851 (freeze (shen.cut V4847 V4848 W4851 (freeze (shen.l-rules (cons (cons W4919 (cons W4924 (cons W4929 ()))) (cons (cons W4921 (cons W4924 (cons (cons vector (cons W4929 ())) ()))) W4932)) V4845 true V4847 V4848 W4851 V4850))))))) false)) false))) false)) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W4913 false) (let W4933 (if (shen.unlocked? V4848) (let W4934 (shen.lazyderef V4844 V4847) (if (cons? W4934) (let W4935 (hd W4934) (let W4936 (tl W4934) (let W4937 (shen.lazyderef V4845 V4847) (let W4938 (lambda Z4939 (lambda Z4940 (do (shen.incinfs) (bind Z4939 W4935 V4847 V4848 W4851 (freeze (shen.l-rules W4936 Z4940 V4846 V4847 V4848 W4851 V4850)))))) (if (cons? W4937) (let W4941 (hd W4937) (let W4942 (tl W4937) ((W4938 W4941) W4942))) (if (shen.pvar? W4937) (let W4943 (shen.newpv V4847) (shen.gc V4847 (let W4944 (shen.newpv V4847) (shen.gc V4847 (shen.bind! W4937 (cons W4943 W4944) V4847 (freeze ((W4938 W4943) W4944))))))) false)))))) false)) false) (if (= W4933 false) (shen.unlock V4848 W4851) W4933)) W4913)) W4897)) W4875)) W4855)) W4852)))) +(defun shen.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.t* (V4945 V4946 V4947 V4948 V4949 V4950) (let W4951 (+ V4949 1) (let W4952 (if (shen.unlocked? V4948) (let W4953 (shen.lazyderef V4945 V4947) (if (cons? W4953) (let W4954 (shen.lazyderef (hd W4953) V4947) (if (= W4954 define) (let W4955 (shen.lazyderef (tl W4953) V4947) (if (cons? W4955) (let W4956 (hd W4955) (let W4957 (tl W4955) (let W4958 (shen.newpv V4947) (shen.gc V4947 (let W4959 (shen.newpv V4947) (shen.gc V4947 (let W4960 (shen.newpv V4947) (shen.gc V4947 (let W4961 (shen.newpv V4947) (shen.gc V4947 (do (shen.incinfs) (shen.cut V4947 V4948 W4951 (freeze (bind W4958 (shen.sigxrules (cons W4956 W4957)) V4947 V4948 W4951 (freeze (bind W4961 (fst (shen.lazyderef W4958 V4947)) V4947 V4948 W4951 (freeze (bind W4959 (snd (shen.lazyderef W4958 V4947)) V4947 V4948 W4951 (freeze (bind W4960 (shen.freshen-sig (shen.deref W4961 V4947)) V4947 V4948 W4951 (freeze (shen.t*-rules W4956 W4959 W4960 1 V4947 V4948 W4951 (freeze (is W4961 V4946 V4947 V4948 W4951 V4950)))))))))))))))))))))))) false)) false)) false)) false) (if (= W4952 false) (shen.unlock V4948 W4951) W4952)))) +(defun shen.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.sigxrules (V4962) (compile (lambda Z4963 (shen. Z4963)) V4962)) +(defun shen.sigxrules (V4976) (compile (lambda Z4977 (shen. Z4977)) V4976)) -(defun shen. (V4964) (let W4965 (if (cons? V4964) (let W4966 (tail V4964) (if (shen.hds=? W4966 {) (let W4967 (tail W4966) (let W4968 (shen. W4967) (if (shen.parse-failure? W4968) (shen.parse-failure) (let W4969 (shen.<-out W4968) (let W4970 (shen.in-> W4968) (if (shen.hds=? W4970 }) (let W4971 (tail W4970) (let W4972 (shen. W4971) (if (shen.parse-failure? W4972) (shen.parse-failure) (let W4973 (shen.<-out W4972) (let W4974 (shen.in-> W4972) (shen.comb W4974 (let W4975 (shen.rectify-type W4969) (@p W4975 W4973)))))))) (shen.parse-failure))))))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W4965) (shen.parse-failure) W4965))) +(defun shen. (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.freshen-sig (V4976) (let W4977 (shen.extract-vars V4976) (let W4978 (map (lambda Z4979 (cons Z4979 (shen.freshterm (concat & Z4979)))) W4977) (shen.freshen-type W4978 V4976)))) +(defun shen.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.freshen-type (V4980 V4981) (cond ((= () V4980) V4981) ((and (cons? V4980) (cons? (hd V4980))) (shen.freshen-type (tl V4980) (subst (tl (hd V4980)) (hd (hd V4980)) V4981))) (true (simple-error "partial function shen.freshen-type")))) +(defun shen.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. (V4982) (let W4983 (let W4984 (shen. V4982) (if (shen.parse-failure? W4984) (shen.parse-failure) (let W4985 (shen.<-out W4984) (let W4986 (shen.in-> W4984) (let W4987 (shen. W4986) (if (shen.parse-failure? W4987) (shen.parse-failure) (let W4988 (shen.<-out W4987) (let W4989 (shen.in-> W4987) (shen.comb W4989 (cons W4985 W4988)))))))))) (if (shen.parse-failure? W4983) (let W4990 (let W4991 (shen. V4982) (if (shen.parse-failure? W4991) (shen.parse-failure) (let W4992 (shen.<-out W4991) (let W4993 (shen.in-> W4991) (shen.comb W4993 (cons W4992 ())))))) (if (shen.parse-failure? W4990) (shen.parse-failure) W4990)) W4983))) +(defun shen. (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. (V4994) (let W4995 (let W4996 (shen. V4994) (if (shen.parse-failure? W4996) (shen.parse-failure) (let W4997 (shen.<-out W4996) (let W4998 (shen.in-> W4996) (if (shen.hds=? W4998 ->) (let W4999 (tail W4998) (if (cons? W4999) (let W5000 (head W4999) (let W5001 (tail W4999) (if (shen.hds=? W5001 where) (let W5002 (tail W5001) (if (cons? W5002) (let W5003 (head W5002) (let W5004 (tail W5002) (shen.comb W5004 (@p W4997 (cons where (cons W5003 (cons W5000 ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W4995) (let W5005 (let W5006 (shen. V4994) (if (shen.parse-failure? W5006) (shen.parse-failure) (let W5007 (shen.<-out W5006) (let W5008 (shen.in-> W5006) (if (shen.hds=? W5008 <-) (let W5009 (tail W5008) (if (cons? W5009) (let W5010 (head W5009) (let W5011 (tail W5009) (if (shen.hds=? W5011 where) (let W5012 (tail W5011) (if (cons? W5012) (let W5013 (head W5012) (let W5014 (tail W5012) (shen.comb W5014 (@p W5007 (shen.correct (cons where (cons W5013 (cons W5010 ())))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5005) (let W5015 (let W5016 (shen. V4994) (if (shen.parse-failure? W5016) (shen.parse-failure) (let W5017 (shen.<-out W5016) (let W5018 (shen.in-> W5016) (if (shen.hds=? W5018 <-) (let W5019 (tail W5018) (if (cons? W5019) (let W5020 (head W5019) (let W5021 (tail W5019) (shen.comb W5021 (@p W5017 (shen.correct W5020))))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5015) (let W5022 (let W5023 (shen. V4994) (if (shen.parse-failure? W5023) (shen.parse-failure) (let W5024 (shen.<-out W5023) (let W5025 (shen.in-> W5023) (if (shen.hds=? W5025 ->) (let W5026 (tail W5025) (if (cons? W5026) (let W5027 (head W5026) (let W5028 (tail W5026) (shen.comb W5028 (@p W5024 W5027)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5022) (shen.parse-failure) W5022)) W5015)) W5005)) W4995))) +(defun shen. (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.correct (V5029) (cond ((and (cons? V5029) (and (= where (hd V5029)) (and (cons? (tl V5029)) (and (cons? (tl (tl V5029))) (and (cons? (hd (tl (tl V5029)))) (and (= fail-if (hd (hd (tl (tl V5029))))) (and (cons? (tl (hd (tl (tl V5029))))) (and (cons? (tl (tl (hd (tl (tl V5029)))))) (and (= () (tl (tl (tl (hd (tl (tl V5029))))))) (= () (tl (tl (tl V5029))))))))))))) (cons where (cons (cons and (cons (hd (tl V5029)) (cons (cons not (cons (tl (hd (tl (tl V5029)))) ())) ()))) (tl (tl (hd (tl (tl V5029)))))))) ((and (cons? V5029) (and (= where (hd V5029)) (and (cons? (tl V5029)) (and (cons? (tl (tl V5029))) (= () (tl (tl (tl V5029)))))))) (cons where (cons (cons and (cons (hd (tl V5029)) (cons (cons not (cons (cons == (cons (hd (tl (tl V5029))) (cons (cons fail ()) ()))) ())) ()))) (tl (tl V5029))))) ((and (cons? V5029) (and (= fail-if (hd V5029)) (and (cons? (tl V5029)) (and (cons? (tl (tl V5029))) (= () (tl (tl (tl V5029)))))))) (cons where (cons (cons not (cons (tl V5029) ())) (tl (tl V5029))))) (true (cons where (cons (cons not (cons (cons == (cons V5029 (cons (cons fail ()) ()))) ())) (cons V5029 ())))))) +(defun shen.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.t*-rules (V5030 V5031 V5032 V5033 V5034 V5035 V5036 V5037) (let W5038 (+ V5036 1) (let W5039 (if (shen.unlocked? V5035) (let W5040 (shen.lazyderef V5031 V5034) (if (= W5040 ()) (do (shen.incinfs) (thaw V5037)) false)) false) (if (= W5039 false) (let W5041 (if (shen.unlocked? V5035) (let W5042 (shen.lazyderef V5031 V5034) (if (cons? W5042) (let W5043 (hd W5042) (let W5044 (tl W5042) (let W5045 (shen.newpv V5034) (shen.gc V5034 (do (shen.incinfs) (bind W5045 (shen.freshen-rule (shen.deref W5043 V5034)) V5034 V5035 W5038 (freeze (shen.t*-rule V5030 V5033 (fst (shen.lazyderef W5045 V5034)) (snd (shen.lazyderef W5045 V5034)) V5032 V5034 V5035 W5038 (freeze (shen.cut V5034 V5035 W5038 (freeze (shen.t*-rules V5030 W5044 V5032 (+ V5033 1) V5034 V5035 W5038 V5037)))))))))))) false)) false) (if (= W5041 false) (shen.unlock V5035 W5038) W5041)) W5039)))) +(defun shen.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.freshen-rule (V5046) (cond ((tuple? V5046) (let W5047 (shen.extract-vars (fst V5046)) (let W5048 (map (lambda Z5049 (cons Z5049 (shen.freshterm Z5049))) W5047) (@p (shen.freshen W5048 (fst V5046)) (shen.freshen W5048 (snd V5046)))))) (true (simple-error "partial function shen.freshen-rule")))) +(defun shen.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.freshen (V5050 V5051) (cond ((= () V5050) V5051) ((and (cons? V5050) (cons? (hd V5050))) (shen.freshen (tl V5050) (shen.beta (hd (hd V5050)) (tl (hd V5050)) V5051))) (true (simple-error "partial function shen.freshen")))) +(defun shen.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*-rule (V5052 V5053 V5054 V5055 V5056 V5057 V5058 V5059 V5060) (let W5061 (if (shen.unlocked? V5058) (do (shen.incinfs) (shen.t*-rule-h V5054 V5055 V5056 V5057 V5058 V5059 V5060)) false) (if (= W5061 false) (if (shen.unlocked? V5058) (let W5062 (shen.newpv V5057) (shen.gc V5057 (do (shen.incinfs) (bind W5062 (simple-error (cn "type error in rule " (shen.app V5053 (cn " of " (shen.app V5052 " -" shen.a)) shen.a))) V5057 V5058 V5059 V5060)))) false) W5061))) +(defun shen.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.t*-rule-h (V5063 V5064 V5065 V5066 V5067 V5068 V5069) (let W5070 (+ V5068 1) (let W5071 (if (shen.unlocked? V5067) (let W5072 (shen.lazyderef V5063 V5066) (if (= W5072 ()) (let W5073 (shen.lazyderef V5065 V5066) (if (cons? W5073) (let W5074 (shen.lazyderef (hd W5073) V5066) (if (= W5074 -->) (let W5075 (shen.lazyderef (tl W5073) V5066) (if (cons? W5075) (let W5076 (hd W5075) (let W5077 (shen.lazyderef (tl W5075) V5066) (if (= W5077 ()) (do (shen.incinfs) (shen.cut V5066 V5067 W5070 (freeze (shen.t*-correct V5064 W5076 () V5066 V5067 W5070 V5069)))) false))) false)) false)) false)) false)) false) (if (= W5071 false) (let W5078 (if (shen.unlocked? V5067) (let W5079 (shen.newpv V5066) (shen.gc V5066 (let W5080 (shen.newpv V5066) (shen.gc V5066 (let W5081 (shen.newpv V5066) (shen.gc V5066 (do (shen.incinfs) (shen.p-hyps (shen.freshterms V5063) W5079 V5066 V5067 W5070 (freeze (shen.t*-integrity V5063 V5065 W5079 W5080 V5066 V5067 W5070 (freeze (shen.cut V5066 V5067 W5070 (freeze (shen.myassume V5063 V5065 W5081 V5066 V5067 W5070 (freeze (shen.t*-correct V5064 W5080 W5081 V5066 V5067 W5070 V5069)))))))))))))))) false) (if (= W5078 false) (shen.unlock V5067 W5070) W5078)) W5071)))) +(defun shen.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.myassume (V5082 V5083 V5084 V5085 V5086 V5087 V5088) (let W5089 (if (shen.unlocked? V5086) (let W5090 (shen.lazyderef V5082 V5085) (if (= W5090 ()) (let W5091 (shen.lazyderef V5084 V5085) (let W5092 (freeze (do (shen.incinfs) (thaw V5088))) (if (= W5091 ()) (thaw W5092) (if (shen.pvar? W5091) (shen.bind! W5091 () V5085 W5092) false)))) false)) false) (if (= W5089 false) (if (shen.unlocked? V5086) (let W5093 (shen.lazyderef V5082 V5085) (if (cons? W5093) (let W5094 (hd W5093) (let W5095 (tl W5093) (let W5096 (shen.lazyderef V5083 V5085) (if (cons? W5096) (let W5097 (hd W5096) (let W5098 (shen.lazyderef (tl W5096) V5085) (if (cons? W5098) (let W5099 (shen.lazyderef (hd W5098) V5085) (if (= W5099 -->) (let W5100 (shen.lazyderef (tl W5098) V5085) (if (cons? W5100) (let W5101 (hd W5100) (let W5102 (shen.lazyderef (tl W5100) V5085) (if (= W5102 ()) (let W5103 (shen.lazyderef V5084 V5085) (let W5104 (lambda Z5105 (lambda Z5106 (lambda Z5107 (lambda Z5108 (do (shen.incinfs) (is! W5097 Z5107 V5085 V5086 V5087 (freeze (is! W5094 Z5105 V5085 V5086 V5087 (freeze (bind Z5106 (intern ":") V5085 V5086 V5087 (freeze (shen.myassume W5095 W5101 Z5108 V5085 V5086 V5087 V5088)))))))))))) (if (cons? W5103) (let W5109 (shen.lazyderef (hd W5103) V5085) (let W5110 (lambda Z5111 (lambda Z5112 (lambda Z5113 (let W5114 (tl W5103) ((((W5104 Z5111) Z5112) Z5113) W5114))))) (if (cons? W5109) (let W5115 (hd W5109) (let W5116 (shen.lazyderef (tl W5109) V5085) (let W5117 (lambda Z5118 (lambda Z5119 (((W5110 W5115) Z5118) Z5119))) (if (cons? W5116) (let W5120 (hd W5116) (let W5121 (shen.lazyderef (tl W5116) V5085) (let W5122 (lambda Z5123 ((W5117 W5120) Z5123)) (if (cons? W5121) (let W5124 (hd W5121) (let W5125 (shen.lazyderef (tl W5121) V5085) (let W5126 (freeze (W5122 W5124)) (if (= W5125 ()) (thaw W5126) (if (shen.pvar? W5125) (shen.bind! W5125 () V5085 W5126) false))))) (if (shen.pvar? W5121) (let W5127 (shen.newpv V5085) (shen.gc V5085 (shen.bind! W5121 (cons W5127 ()) V5085 (freeze (W5122 W5127))))) false))))) (if (shen.pvar? W5116) (let W5128 (shen.newpv V5085) (shen.gc V5085 (let W5129 (shen.newpv V5085) (shen.gc V5085 (shen.bind! W5116 (cons W5128 (cons W5129 ())) V5085 (freeze ((W5117 W5128) W5129))))))) false))))) (if (shen.pvar? W5109) (let W5130 (shen.newpv V5085) (shen.gc V5085 (let W5131 (shen.newpv V5085) (shen.gc V5085 (let W5132 (shen.newpv V5085) (shen.gc V5085 (shen.bind! W5109 (cons W5130 (cons W5131 (cons W5132 ()))) V5085 (freeze (((W5110 W5130) W5131) W5132))))))))) false)))) (if (shen.pvar? W5103) (let W5133 (shen.newpv V5085) (shen.gc V5085 (let W5134 (shen.newpv V5085) (shen.gc V5085 (let W5135 (shen.newpv V5085) (shen.gc V5085 (let W5136 (shen.newpv V5085) (shen.gc V5085 (shen.bind! W5103 (cons (cons W5133 (cons W5134 (cons W5135 ()))) W5136) V5085 (freeze ((((W5104 W5133) W5134) W5135) W5136))))))))))) false)))) false))) false)) false)) false))) false)))) false)) false) W5089))) +(defun shen.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.freshterms (V5139) (cond ((= () V5139) ()) ((and (cons? V5139) (cons? (hd V5139))) (shen.freshterms (append (hd V5139) (tl V5139)))) ((and (cons? V5139) (shen.freshterm? (hd V5139))) (adjoin (hd V5139) (shen.freshterms (tl V5139)))) ((cons? V5139) (shen.freshterms (tl V5139))) (true (simple-error "partial function shen.freshterms")))) +(defun shen.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.p-hyps (V5140 V5141 V5142 V5143 V5144 V5145) (let W5146 (if (shen.unlocked? V5143) (let W5147 (shen.lazyderef V5140 V5142) (if (= W5147 ()) (let W5148 (shen.lazyderef V5141 V5142) (let W5149 (freeze (do (shen.incinfs) (thaw V5145))) (if (= W5148 ()) (thaw W5149) (if (shen.pvar? W5148) (shen.bind! W5148 () V5142 W5149) false)))) false)) false) (if (= W5146 false) (if (shen.unlocked? V5143) (let W5150 (shen.lazyderef V5140 V5142) (if (cons? W5150) (let W5151 (hd W5150) (let W5152 (tl W5150) (let W5153 (shen.lazyderef V5141 V5142) (let W5154 (lambda Z5155 (lambda Z5156 (lambda Z5157 (lambda Z5158 (do (shen.incinfs) (bind Z5155 W5151 V5142 V5143 V5144 (freeze (bind Z5156 (intern ":") V5142 V5143 V5144 (freeze (shen.p-hyps W5152 Z5158 V5142 V5143 V5144 V5145)))))))))) (if (cons? W5153) (let W5159 (shen.lazyderef (hd W5153) V5142) (let W5160 (lambda Z5161 (lambda Z5162 (lambda Z5163 (let W5164 (tl W5153) ((((W5154 Z5161) Z5162) Z5163) W5164))))) (if (cons? W5159) (let W5165 (hd W5159) (let W5166 (shen.lazyderef (tl W5159) V5142) (let W5167 (lambda Z5168 (lambda Z5169 (((W5160 W5165) Z5168) Z5169))) (if (cons? W5166) (let W5170 (hd W5166) (let W5171 (shen.lazyderef (tl W5166) V5142) (let W5172 (lambda Z5173 ((W5167 W5170) Z5173)) (if (cons? W5171) (let W5174 (hd W5171) (let W5175 (shen.lazyderef (tl W5171) V5142) (let W5176 (freeze (W5172 W5174)) (if (= W5175 ()) (thaw W5176) (if (shen.pvar? W5175) (shen.bind! W5175 () V5142 W5176) false))))) (if (shen.pvar? W5171) (let W5177 (shen.newpv V5142) (shen.gc V5142 (shen.bind! W5171 (cons W5177 ()) V5142 (freeze (W5172 W5177))))) false))))) (if (shen.pvar? W5166) (let W5178 (shen.newpv V5142) (shen.gc V5142 (let W5179 (shen.newpv V5142) (shen.gc V5142 (shen.bind! W5166 (cons W5178 (cons W5179 ())) V5142 (freeze ((W5167 W5178) W5179))))))) false))))) (if (shen.pvar? W5159) (let W5180 (shen.newpv V5142) (shen.gc V5142 (let W5181 (shen.newpv V5142) (shen.gc V5142 (let W5182 (shen.newpv V5142) (shen.gc V5142 (shen.bind! W5159 (cons W5180 (cons W5181 (cons W5182 ()))) V5142 (freeze (((W5160 W5180) W5181) W5182))))))))) false)))) (if (shen.pvar? W5153) (let W5183 (shen.newpv V5142) (shen.gc V5142 (let W5184 (shen.newpv V5142) (shen.gc V5142 (let W5185 (shen.newpv V5142) (shen.gc V5142 (let W5186 (shen.newpv V5142) (shen.gc V5142 (shen.bind! W5153 (cons (cons W5183 (cons W5184 (cons W5185 ()))) W5186) V5142 (freeze ((((W5154 W5183) W5184) W5185) W5186))))))))))) false)))))) false)) false) W5146))) +(defun shen.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.t*-correct (V5187 V5188 V5189 V5190 V5191 V5192 V5193) (let W5194 (+ V5192 1) (let W5195 (if (shen.unlocked? V5191) (let W5196 (shen.lazyderef V5187 V5190) (if (cons? W5196) (let W5197 (shen.lazyderef (hd W5196) V5190) (if (= W5197 where) (let W5198 (shen.lazyderef (tl W5196) V5190) (if (cons? W5198) (let W5199 (hd W5198) (let W5200 (shen.lazyderef (tl W5198) V5190) (if (cons? W5200) (let W5201 (hd W5200) (let W5202 (shen.lazyderef (tl W5200) V5190) (if (= W5202 ()) (let W5203 (shen.newpv V5190) (shen.gc V5190 (do (shen.incinfs) (shen.cut V5190 V5191 W5194 (freeze (bind W5203 (shen.curry W5199) V5190 V5191 W5194 (freeze (shen.system-S-h W5203 boolean V5189 V5190 V5191 W5194 (freeze (shen.cut V5190 V5191 W5194 (freeze (shen.t*-correct W5201 V5188 (cons (cons W5203 (cons (intern ":") (cons verified ()))) V5189) V5190 V5191 W5194 V5193)))))))))))) false))) false))) false)) false)) false)) false) (if (= W5195 false) (let W5204 (if (shen.unlocked? V5191) (do (shen.incinfs) (shen.system-S-h (shen.curry V5187) V5188 V5189 V5190 V5191 W5194 V5193)) false) (if (= W5204 false) (shen.unlock V5191 W5194) W5204)) W5195)))) +(defun shen.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.t*-integrity (V5205 V5206 V5207 V5208 V5209 V5210 V5211 V5212) (let W5213 (if (shen.unlocked? V5210) (let W5214 (shen.lazyderef V5205 V5209) (if (= W5214 ()) (do (shen.incinfs) (is! V5206 V5208 V5209 V5210 V5211 V5212)) false)) false) (if (= W5213 false) (if (shen.unlocked? V5210) (let W5215 (shen.lazyderef V5205 V5209) (if (cons? W5215) (let W5216 (hd W5215) (let W5217 (tl W5215) (let W5218 (shen.lazyderef V5206 V5209) (if (cons? W5218) (let W5219 (hd W5218) (let W5220 (shen.lazyderef (tl W5218) V5209) (if (cons? W5220) (let W5221 (shen.lazyderef (hd W5220) V5209) (if (= W5221 -->) (let W5222 (shen.lazyderef (tl W5220) V5209) (if (cons? W5222) (let W5223 (hd W5222) (let W5224 (shen.lazyderef (tl W5222) V5209) (if (= W5224 ()) (do (shen.incinfs) (shen.system-S-h W5216 W5219 V5207 V5209 V5210 V5211 (freeze (shen.t*-integrity W5217 W5223 V5207 V5208 V5209 V5210 V5211 V5212)))) false))) false)) false)) false))) false)))) false)) false) W5213))) +(defun shen.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.freshterm? (V5225) (and (absvector? V5225) (and (not (string? V5225)) (= (<-address V5225 0) shen.print-freshterm)))) +(defun shen.freshterm? (V5239) (and (absvector? V5239) (and (not (string? V5239)) (= (<-address V5239 0) shen.print-freshterm)))) diff --git a/klambda/toplevel.kl b/klambda/toplevel.kl index 4730661..ee72195 100644 --- a/klambda/toplevel.kl +++ b/klambda/toplevel.kl @@ -1,6 +1,6 @@ (defun shen.shen () (do (shen.credits) (shen.loop))) -(defun shen.loop () (do (shen.initialise_environment) (do (shen.prompt) (do (trap-error (shen.read-evaluate-print) (lambda Z5248 (do (pr (error-to-string Z5248) (stoutput)) (nl 0)))) (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.credits () (do (pr " Shen, www.shenlanguage.org, copyright (C) 2010-2024, Mark Tarver @@ -15,32 +15,32 @@ Shen, www.shenlanguage.org, copyright (C) 2010-2024, Mark Tarver (" (shen.app (length (value shen.*history*)) "+) " shen.a)) (stoutput)) (pr (cn " (" (shen.app (length (value shen.*history*)) "-) " shen.a)) (stoutput)))) -(defun shen.read-evaluate-print () (let W5249 (value shen.*package*) (let W5250 (shen.package-user-input W5249 (lineread (stinput))) (let W5251 (shen.update-history) (shen.evaluate-lineread W5250 W5251 (value shen.*tc*)))))) +(defun shen.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.package-user-input (V5252 V5253) (cond ((= null V5252) V5253) (true (let W5254 (str V5252) (let W5255 (external V5252) (map (lambda Z5256 (shen.pui-h W5254 W5255 Z5256)) V5253)))))) +(defun shen.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.pui-h (V5261 V5262 V5263) (cond ((and (cons? V5263) (and (= fn (hd V5263)) (and (cons? (tl V5263)) (= () (tl (tl V5263)))))) (if (shen.internal? (hd (tl V5263)) V5261 V5262) (cons fn (cons (shen.intern-in-package V5261 (hd (tl V5263))) ())) V5263)) ((cons? V5263) (if (shen.internal? (hd V5263) V5261 V5262) (cons (shen.intern-in-package V5261 (hd V5263)) (map (lambda Z5264 (shen.pui-h V5261 V5262 Z5264)) (tl V5263))) (if (cons? (hd V5263)) (map (lambda Z5265 (shen.pui-h V5261 V5262 Z5265)) V5263) (cons (hd V5263) (map (lambda Z5266 (shen.pui-h V5261 V5262 Z5266)) (tl V5263)))))) (true V5263))) +(defun shen.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.update-history () (set shen.*history* (cons (shen.trim-it (it)) (value shen.*history*)))) -(defun shen.trim-it (V5267) (cond ((and (shen.+string? V5267) (shen.whitespace? (string->n (hdstr V5267)))) (shen.trim-it (tlstr V5267))) (true V5267))) +(defun shen.trim-it (V5281) (cond ((and (shen.+string? V5281) (shen.whitespace? (string->n (hdstr V5281)))) (shen.trim-it (tlstr V5281))) (true V5281))) -(defun shen.evaluate-lineread (V5286 V5287 V5288) (cond ((and (cons? V5286) (and (= () (tl V5286)) (and (cons? V5287) (and (shen.+string? (hd V5287)) (and (= "!" (hdstr (hd V5287))) (and (shen.+string? (tlstr (hd V5287))) (and (= "!" (hdstr (tlstr (hd V5287)))) (cons? (tl V5287))))))))) (let W5289 (read-from-string (hd (tl V5287))) (let W5290 (set shen.*history* (cons (hd (tl V5287)) (tl V5287))) (let W5291 (pr (shen.app (hd (tl V5287)) " -" shen.a) (stoutput)) (shen.evaluate-lineread W5289 W5290 V5288))))) ((and (cons? V5286) (and (= () (tl V5286)) (and (cons? V5287) (and (shen.+string? (hd V5287)) (= "!" (hdstr (hd V5287))))))) (let W5292 (if (= (tlstr (hd V5287)) "") () (hd (read-from-string (tlstr (hd V5287))))) (let W5293 (shen.use-history W5292 (tlstr (hd V5287)) (tl V5287)) (let W5294 (pr (shen.app W5293 " -" shen.a) (stoutput)) (let W5295 (read-from-string W5293) (let W5296 (set shen.*history* (cons W5293 (tl V5287))) (shen.evaluate-lineread W5295 W5296 V5288))))))) ((and (cons? V5286) (and (= () (tl V5286)) (and (cons? V5287) (and (shen.+string? (hd V5287)) (= "%" (hdstr (hd V5287))))))) (let W5297 (if (= (tlstr (hd V5287)) "") () (hd (read-from-string (tlstr (hd V5287))))) (let W5298 (shen.peek-history W5297 (tlstr (hd V5287)) (tl V5287)) (let W5299 (set shen.*history* (tl V5287)) (abort))))) ((= true V5288) (shen.check-eval-and-print V5286)) ((= false V5288) (shen.eval-and-print V5286)) (true (simple-error "implementation error in shen.evaluate-lineread")))) +(defun shen.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.use-history (V5300 V5301 V5302) (if (integer? V5300) (nth (+ 1 V5300) (reverse V5302)) (if (symbol? V5300) (shen.string-match V5301 V5302) (simple-error "! expects a number or a symbol +(defun shen.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.peek-history (V5303 V5304 V5305) (if (integer? V5303) (pr (cn " -" (shen.app (nth (+ 1 V5303) (reverse V5305)) "" shen.a)) (stoutput)) (if (or (= V5304 "") (symbol? V5303)) (shen.recursive-string-match 0 V5304 (reverse V5305)) (simple-error "% expects a number or a symbol +(defun shen.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.string-match (V5315 V5316) (cond ((= () V5316) (simple-error " -input not found")) ((and (cons? V5316) (shen.string-prefix? V5315 (hd V5316))) (hd V5316)) ((cons? V5316) (shen.string-match V5315 (tl V5316))) (true (simple-error "implementation error in shen.string-match")))) +(defun shen.string-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-prefix? (V5324 V5325) (cond ((= "" V5324) true) ((and (shen.+string? V5324) (shen.whitespace? (string->n (hdstr V5324)))) (shen.string-prefix? (tlstr V5324) V5325)) ((and (shen.+string? V5325) (shen.whitespace? (string->n (hdstr V5325)))) (shen.string-prefix? V5324 (tlstr V5325))) ((and (shen.+string? V5325) (= "(" (hdstr V5325))) (shen.string-prefix? V5324 (tlstr V5325))) ((and (shen.+string? V5324) (and (shen.+string? V5325) (= (hdstr V5324) (hdstr V5325)))) (shen.string-prefix? (tlstr V5324) (tlstr V5325))) (true false))) +(defun shen.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.recursive-string-match (V5336 V5337 V5338) (cond ((= () V5338) shen.skip) ((cons? V5338) (do (if (shen.string-prefix? V5337 (hd V5338)) (pr (shen.app V5336 (cn ". " (shen.app (hd V5338) " -" shen.a)) shen.a) (stoutput)) shen.skip) (shen.recursive-string-match (+ V5336 1) V5337 (tl V5338)))) (true (simple-error "implementation error in shen.recursive-string-match")))) +(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")))) diff --git a/klambda/track.kl b/klambda/track.kl index 5522a98..000d804 100644 --- a/klambda/track.kl +++ b/klambda/track.kl @@ -1,66 +1,66 @@ -(defun shen.f-error (V5370) (do (pr (cn "partial function " (shen.app V5370 "; -" shen.a)) (stoutput)) (do (if (and (not (shen.tracked? V5370)) (y-or-n? (cn "track " (shen.app V5370 "? " shen.a)))) (shen.track-function (ps V5370)) shen.ok) (simple-error "aborted")))) +(defun shen.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.tracked? (V5371) (element? V5371 (value shen.*tracking*))) +(defun shen.tracked? (V5385) (element? V5385 (value shen.*tracking*))) -(defun track (V5372) (let W5373 (ps V5372) (shen.track-function W5373))) +(defun track (V5386) (let W5387 (ps V5386) (shen.track-function W5387))) -(defun shen.track-function (V5376) (cond ((and (cons? V5376) (and (= defun (hd V5376)) (and (cons? (tl V5376)) (and (cons? (tl (tl V5376))) (and (cons? (tl (tl (tl V5376)))) (= () (tl (tl (tl (tl V5376)))))))))) (let W5377 (cons defun (cons (hd (tl V5376)) (cons (hd (tl (tl V5376))) (cons (shen.insert-tracking-code (hd (tl V5376)) (hd (tl (tl V5376))) (hd (tl (tl (tl V5376))))) ())))) (let W5378 (eval-kl W5377) (let W5379 (set shen.*tracking* (adjoin (hd (tl V5376)) (value shen.*tracking*))) (hd (tl V5376)))))) (true (simple-error "implementation error in shen.track-function")))) +(defun shen.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.insert-tracking-code (V5380 V5381 V5382) (cons do (cons (cons set (cons shen.*call* (cons (cons + (cons (cons value (cons shen.*call* ())) (cons 1 ()))) ()))) (cons (cons do (cons (cons shen.input-track (cons (cons value (cons shen.*call* ())) (cons V5380 (cons (shen.cons-form (shen.prolog-track V5382 V5381)) ())))) (cons (cons do (cons (cons shen.terpri-or-read-char ()) (cons (cons let (cons Result (cons V5382 (cons (cons do (cons (cons shen.output-track (cons (cons value (cons shen.*call* ())) (cons V5380 (cons Result ())))) (cons (cons do (cons (cons set (cons shen.*call* (cons (cons - (cons (cons value (cons shen.*call* ())) (cons 1 ()))) ()))) (cons (cons do (cons (cons shen.terpri-or-read-char ()) (cons Result ()))) ()))) ()))) ())))) ()))) ()))) ())))) +(defun shen.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.prolog-track (V5383 V5384) (cond ((= (occurrences shen.incinfs V5383) 0) V5384) (true (shen.vector-dereference V5384 (shen.vector-parameter V5384))))) +(defun shen.prolog-track (V5397 V5398) (cond ((= (occurrences shen.incinfs V5397) 0) V5398) (true (shen.vector-dereference V5398 (shen.vector-parameter V5398))))) -(defun shen.vector-parameter (V5387) (cond ((= () V5387) ()) ((and (cons? V5387) (and (cons? (tl V5387)) (and (cons? (tl (tl V5387))) (and (cons? (tl (tl (tl V5387)))) (= () (tl (tl (tl (tl V5387))))))))) (hd V5387)) ((cons? V5387) (shen.vector-parameter (tl V5387))) (true (simple-error "partial function shen.vector-parameter")))) +(defun shen.vector-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-dereference (V5390 V5391) (cond ((= () V5391) V5390) ((and (cons? V5390) (and (cons? (tl V5390)) (and (cons? (tl (tl V5390))) (and (cons? (tl (tl (tl V5390)))) (= () (tl (tl (tl (tl V5390))))))))) V5390) ((cons? V5390) (cons (cons shen.deref (cons (hd V5390) (cons V5391 ()))) (shen.vector-dereference (tl V5390) V5391))) (true (simple-error "partial function shen.vector-dereference")))) +(defun 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 step (V5394) (cond ((= + V5394) (set shen.*step* true)) ((= - V5394) (set shen.*step* false)) (true (simple-error "step expects a + or a -. +(defun step (V5408) (cond ((= + V5408) (set shen.*step* true)) ((= - V5408) (set shen.*step* false)) (true (simple-error "step expects a + or a -. ")))) (defun step? () (value shen.*step*)) -(defun spy (V5397) (cond ((= + V5397) (set shen.*spy* true)) ((= - V5397) (set shen.*spy* false)) (true (simple-error "spy expects a + or a -. +(defun spy (V5411) (cond ((= + V5411) (set shen.*spy* true)) ((= - V5411) (set shen.*spy* false)) (true (simple-error "spy expects a + or a -. ")))) (defun spy? () (value shen.*spy*)) (defun shen.terpri-or-read-char () (if (value shen.*step*) (shen.check-byte (read-byte (value *stinput*))) (nl 1))) -(defun shen.check-byte (V5400) (cond ((= 94 V5400) (simple-error "aborted")) (true true))) +(defun shen.check-byte (V5414) (cond ((= 94 V5414) (simple-error "aborted")) (true true))) -(defun shen.input-track (V5401 V5402 V5403) (do (pr (cn " -" (shen.app (shen.spaces V5401) (cn "<" (shen.app V5401 (cn "> Inputs to " (shen.app V5402 (cn " -" (shen.app (shen.spaces V5401) "" shen.a)) shen.a)) shen.a)) shen.a)) (stoutput)) (shen.recursively-print V5403))) +(defun shen.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.recursively-print (V5406) (cond ((= () V5406) (pr " ==>" (stoutput))) ((cons? V5406) (do (print (hd V5406)) (do (pr ", " (stoutput)) (shen.recursively-print (tl V5406))))) (true (simple-error "implementation error in shen.recursively-print")))) +(defun shen.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.spaces (V5407) (cond ((= 0 V5407) "") (true (cn " " (shen.spaces (- V5407 1)))))) +(defun shen.spaces (V5421) (cond ((= 0 V5421) "") (true (cn " " (shen.spaces (- V5421 1)))))) -(defun shen.output-track (V5408 V5409 V5410) (pr (cn " -" (shen.app (shen.spaces V5408) (cn "<" (shen.app V5408 (cn "> Output from " (shen.app V5409 (cn " -" (shen.app (shen.spaces V5408) (cn "==> " (shen.app V5410 "" shen.s)) shen.a)) shen.a)) shen.a)) shen.a)) (stoutput))) +(defun 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 untrack (V5411) (do (set shen.*tracking* (remove V5411 (value shen.*tracking*))) (do (trap-error (eval (ps V5411)) (lambda Z5412 V5411)) V5411))) +(defun untrack (V5425) (do (set shen.*tracking* (remove V5425 (value shen.*tracking*))) (do (trap-error (eval (ps V5425)) (lambda Z5426 V5425)) V5425))) -(defun remove (V5413 V5414) (shen.remove-h V5413 V5414 ())) +(defun remove (V5427 V5428) (shen.remove-h V5427 V5428 ())) -(defun shen.remove-h (V5424 V5425 V5426) (cond ((= () V5425) (reverse V5426)) ((and (cons? V5425) (= V5424 (hd V5425))) (shen.remove-h (hd V5425) (tl V5425) V5426)) ((cons? V5425) (shen.remove-h V5424 (tl V5425) (cons (hd V5425) V5426))) (true (simple-error "implementation error in shen.remove-h")))) +(defun 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 profile (V5427) (do (set shen.*profiled* (cons V5427 (value shen.*profiled*))) (shen.profile-help (ps V5427)))) +(defun profile (V5441) (do (set shen.*profiled* (cons V5441 (value shen.*profiled*))) (shen.profile-help (ps V5441)))) -(defun shen.profile-help (V5430) (cond ((and (cons? V5430) (and (= defun (hd V5430)) (and (cons? (tl V5430)) (and (cons? (tl (tl V5430))) (and (cons? (tl (tl (tl V5430)))) (= () (tl (tl (tl (tl V5430)))))))))) (let W5431 (gensym shen.f) (let W5432 (cons defun (cons (hd (tl V5430)) (cons (hd (tl (tl V5430))) (cons (shen.profile-func (hd (tl V5430)) (hd (tl (tl V5430))) (cons W5431 (hd (tl (tl V5430))))) ())))) (let W5433 (cons defun (cons W5431 (cons (hd (tl (tl V5430))) (cons (subst W5431 (hd (tl V5430)) (hd (tl (tl (tl V5430))))) ())))) (let W5434 (eval-kl W5432) (let W5435 (eval-kl W5433) (hd (tl V5430)))))))) (true (simple-error "Cannot profile. +(defun 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 unprofile (V5436) (do (set shen.*profiled* (remove V5436 (value shen.*profiled*))) (trap-error (eval (ps V5436)) (lambda Z5437 V5436)))) +(defun unprofile (V5450) (do (set shen.*profiled* (remove V5450 (value shen.*profiled*))) (trap-error (eval (ps V5450)) (lambda Z5451 V5450)))) -(defun shen.profiled? (V5438) (element? V5438 (value shen.*profiled*))) +(defun shen.profiled? (V5452) (element? V5452 (value shen.*profiled*))) -(defun shen.profile-func (V5439 V5440 V5441) (cons let (cons Start (cons (cons get-time (cons run ())) (cons (cons let (cons Result (cons V5441 (cons (cons let (cons Finish (cons (cons - (cons (cons get-time (cons run ())) (cons Start ()))) (cons (cons let (cons Record (cons (cons shen.put-profile (cons V5439 (cons (cons + (cons (cons shen.get-profile (cons V5439 ())) (cons Finish ()))) ()))) (cons Result ())))) ())))) ())))) ()))))) +(defun 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 profile-results (V5442) (let W5443 (shen.get-profile V5442) (let W5444 (shen.put-profile V5442 0) (@p V5442 W5443)))) +(defun profile-results (V5456) (let W5457 (shen.get-profile V5456) (let W5458 (shen.put-profile V5456 0) (@p V5456 W5457)))) -(defun shen.get-profile (V5445) (trap-error (get V5445 profile (value *property-vector*)) (lambda Z5446 0))) +(defun shen.get-profile (V5459) (trap-error (get V5459 profile (value *property-vector*)) (lambda Z5460 0))) -(defun shen.put-profile (V5447 V5448) (put V5447 profile V5448 (value *property-vector*))) +(defun shen.put-profile (V5461 V5462) (put V5461 profile V5462 (value *property-vector*))) diff --git a/klambda/types.kl b/klambda/types.kl index d23a10e..123bbed 100644 --- a/klambda/types.kl +++ b/klambda/types.kl @@ -1,13 +1,13 @@ -(defun declare (V5483 V5484) (let W5485 (shen.rectify-type V5484) (let W5486 (((((lambda Z5487 (lambda Z5488 (lambda Z5489 (lambda Z5490 (do (shen.incinfs) (shen.variancy (receive (shen.deref V5483 Z5487)) (receive (shen.deref W5485 Z5487)) Z5487 Z5488 Z5489 Z5490)))))) (shen.prolog-vector)) (@v true (@v 0 (vector 0)))) 0) (freeze true)) (let W5491 (eval-kl (shen.prolog-abstraction V5484)) (let W5492 (set shen.*sigf* (shen.assoc-> V5483 W5491 (value shen.*sigf*))) V5483))))) +(defun 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 shen.variancy (V5493 V5494 V5495 V5496 V5497 V5498) (if (shen.unlocked? V5496) (let W5499 (shen.newpv V5495) (shen.gc V5495 (do (shen.incinfs) (shen.system-S-h (cons fn (cons V5493 ())) W5499 () V5495 V5496 V5497 (freeze (shen.variants? V5493 W5499 V5494 V5495 V5496 V5497 V5498)))))) false)) +(defun shen.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.variants? (V5500 V5501 V5502 V5503 V5504 V5505 V5506) (let W5507 (if (shen.unlocked? V5504) (do (shen.incinfs) (is! V5501 V5502 V5503 V5504 V5505 V5506)) false) (if (= W5507 false) (if (shen.unlocked? V5504) (let W5508 (shen.newpv V5503) (shen.gc V5503 (do (shen.incinfs) (is W5508 (pr (cn "warning: changing the type of " (shen.app (shen.deref V5500 V5503) " may create errors -" shen.a)) (stoutput)) V5503 V5504 V5505 V5506)))) false) W5507))) +(defun shen.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.prolog-abstraction (V5509) (let W5510 (gensym B) (let W5511 (gensym L) (let W5512 (gensym Key) (let W5513 (gensym C) (let W5514 (gensym V) (let W5515 (shen.extract-vars V5509) (cons lambda (cons W5514 (cons (cons lambda (cons W5510 (cons (cons lambda (cons W5511 (cons (cons lambda (cons W5512 (cons (cons lambda (cons W5513 (cons (shen.stpart W5515 (cons is! (cons W5514 (cons (shen.rcons_form V5509) (cons W5510 (cons W5511 (cons W5512 (cons W5513 ()))))))) W5510) ()))) ()))) ()))) ()))) ())))))))))) +(defun shen.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.demod (V5516) V5516) +(defun shen.demod (V5557) V5557) (declare abort (cons --> (cons A ()))) diff --git a/klambda/writer.kl b/klambda/writer.kl index bddb318..61f713e 100644 --- a/klambda/writer.kl +++ b/klambda/writer.kl @@ -1,52 +1,52 @@ -(defun print (V5561) (let W5562 (shen.insert V5561 "~S") (let W5563 (pr W5562 (stoutput)) V5561))) +(defun print (V5602) (let W5603 (shen.insert V5602 "~S") (let W5604 (pr W5603 (stoutput)) V5602))) -(defun pr (V5564 V5565) (if (value *hush*) V5564 (if (shen.char-stoutput? V5565) (shen.write-string V5564 V5565) (shen.write-chars V5564 V5565 (shen.string->byte V5564 0) 1)))) +(defun 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 shen.string->byte (V5566 V5567) (trap-error (string->n (pos V5566 V5567)) (lambda Z5568 shen.eos))) +(defun shen.string->byte (V5607 V5608) (trap-error (string->n (pos V5607 V5608)) (lambda Z5609 shen.eos))) -(defun shen.write-chars (V5569 V5570 V5571 V5572) (cond ((= shen.eos V5571) V5569) (true (shen.write-chars V5569 V5570 (do (write-byte V5571 V5570) (shen.string->byte V5569 V5572)) (+ V5572 1))))) +(defun shen.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.mkstr (V5573 V5574) (cond ((string? V5573) (shen.mkstr-l (shen.proc-nl V5573) V5574)) (true (shen.mkstr-r (cons shen.proc-nl (cons V5573 ())) V5574)))) +(defun shen.mkstr (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-l (V5579 V5580) (cond ((= () V5580) V5579) ((cons? V5580) (shen.mkstr-l (shen.insert-l (hd V5580) V5579) (tl V5580))) (true (simple-error "implementation error in shen.mkstr-l")))) +(defun shen.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.insert-l (V5587 V5588) (cond ((= "" V5588) "") ((and (shen.+string? V5588) (and (= "~" (hdstr V5588)) (and (shen.+string? (tlstr V5588)) (= "A" (hdstr (tlstr V5588)))))) (cons shen.app (cons V5587 (cons (tlstr (tlstr V5588)) (cons shen.a ()))))) ((and (shen.+string? V5588) (and (= "~" (hdstr V5588)) (and (shen.+string? (tlstr V5588)) (= "R" (hdstr (tlstr V5588)))))) (cons shen.app (cons V5587 (cons (tlstr (tlstr V5588)) (cons shen.r ()))))) ((and (shen.+string? V5588) (and (= "~" (hdstr V5588)) (and (shen.+string? (tlstr V5588)) (= "S" (hdstr (tlstr V5588)))))) (cons shen.app (cons V5587 (cons (tlstr (tlstr V5588)) (cons shen.s ()))))) ((shen.+string? V5588) (shen.factor-cn (cons cn (cons (hdstr V5588) (cons (shen.insert-l V5587 (tlstr V5588)) ()))))) ((and (cons? V5588) (and (= cn (hd V5588)) (and (cons? (tl V5588)) (and (cons? (tl (tl V5588))) (= () (tl (tl (tl V5588)))))))) (cons cn (cons (hd (tl V5588)) (cons (shen.insert-l V5587 (hd (tl (tl V5588)))) ())))) ((and (cons? V5588) (and (= shen.app (hd V5588)) (and (cons? (tl V5588)) (and (cons? (tl (tl V5588))) (and (cons? (tl (tl (tl V5588)))) (= () (tl (tl (tl (tl V5588)))))))))) (cons shen.app (cons (hd (tl V5588)) (cons (shen.insert-l V5587 (hd (tl (tl V5588)))) (tl (tl (tl V5588))))))) (true (simple-error "implementation error in shen.insert-l")))) +(defun shen.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.factor-cn (V5589) (cond ((and (cons? V5589) (and (= cn (hd V5589)) (and (cons? (tl V5589)) (and (cons? (tl (tl V5589))) (and (cons? (hd (tl (tl V5589)))) (and (= cn (hd (hd (tl (tl V5589))))) (and (cons? (tl (hd (tl (tl V5589))))) (and (cons? (tl (tl (hd (tl (tl V5589)))))) (and (= () (tl (tl (tl (hd (tl (tl V5589))))))) (and (= () (tl (tl (tl V5589)))) (and (string? (hd (tl V5589))) (string? (hd (tl (hd (tl (tl V5589))))))))))))))))) (cons cn (cons (cn (hd (tl V5589)) (hd (tl (hd (tl (tl V5589)))))) (tl (tl (hd (tl (tl V5589)))))))) (true V5589))) +(defun shen.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.proc-nl (V5592) (cond ((= "" V5592) "") ((and (shen.+string? V5592) (and (= "~" (hdstr V5592)) (and (shen.+string? (tlstr V5592)) (= "%" (hdstr (tlstr V5592)))))) (cn (n->string 10) (shen.proc-nl (tlstr (tlstr V5592))))) ((shen.+string? V5592) (cn (hdstr V5592) (shen.proc-nl (tlstr V5592)))) (true (simple-error "implementation error in shen.proc-nl")))) +(defun shen.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.mkstr-r (V5597 V5598) (cond ((= () V5598) V5597) ((cons? V5598) (shen.mkstr-r (cons shen.insert (cons (hd V5598) (cons V5597 ()))) (tl V5598))) (true (simple-error "implementation error in shen.mkstr-r")))) +(defun shen.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.insert (V5599 V5600) (shen.insert-h V5599 V5600 "")) +(defun shen.insert (V5640 V5641) (shen.insert-h V5640 V5641 "")) -(defun shen.insert-h (V5609 V5610 V5611) (cond ((= "" V5610) V5611) ((and (shen.+string? V5610) (and (= "~" (hdstr V5610)) (and (shen.+string? (tlstr V5610)) (= "A" (hdstr (tlstr V5610)))))) (cn V5611 (shen.app V5609 (tlstr (tlstr V5610)) shen.a))) ((and (shen.+string? V5610) (and (= "~" (hdstr V5610)) (and (shen.+string? (tlstr V5610)) (= "R" (hdstr (tlstr V5610)))))) (cn V5611 (shen.app V5609 (tlstr (tlstr V5610)) shen.r))) ((and (shen.+string? V5610) (and (= "~" (hdstr V5610)) (and (shen.+string? (tlstr V5610)) (= "S" (hdstr (tlstr V5610)))))) (cn V5611 (shen.app V5609 (tlstr (tlstr V5610)) shen.s))) ((shen.+string? V5610) (shen.insert-h V5609 (tlstr V5610) (cn V5611 (hdstr V5610)))) (true (simple-error "implementation error in shen.insert-h")))) +(defun shen.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.app (V5612 V5613 V5614) (cn (shen.arg->str V5612 V5614) V5613)) +(defun shen.app (V5653 V5654 V5655) (cn (shen.arg->str V5653 V5655) V5654)) -(defun shen.arg->str (V5618 V5619) (cond ((= V5618 (fail)) "...") ((shen.list? V5618) (shen.list->str V5618 V5619)) ((string? V5618) (shen.str->str V5618 V5619)) ((absvector? V5618) (shen.vector->str V5618 V5619)) (true (shen.atom->str V5618)))) +(defun shen.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.list->str (V5620 V5621) (cond ((= shen.r V5621) (@s "(" (@s (shen.iter-list V5620 shen.r (shen.maxseq)) ")"))) (true (@s "[" (@s (shen.iter-list V5620 V5621 (shen.maxseq)) "]"))))) +(defun shen.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.maxseq () (value *maximum-print-sequence-size*)) -(defun shen.iter-list (V5632 V5633 V5634) (cond ((= () V5632) "") ((= 0 V5634) "... etc") ((and (cons? V5632) (= () (tl V5632))) (shen.arg->str (hd V5632) V5633)) ((cons? V5632) (@s (shen.arg->str (hd V5632) V5633) (@s " " (shen.iter-list (tl V5632) V5633 (- V5634 1))))) (true (@s "|" (@s " " (shen.arg->str V5632 V5633)))))) +(defun shen.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.str->str (V5637 V5638) (cond ((= shen.a V5638) V5637) (true (@s (n->string 34) (@s V5637 (n->string 34)))))) +(defun shen.str->str (V5678 V5679) (cond ((= shen.a V5679) V5678) (true (@s (n->string 34) (@s V5678 (n->string 34)))))) -(defun shen.vector->str (V5639 V5640) (if (shen.print-vector? V5639) ((fn (<-address V5639 0)) V5639) (if (vector? V5639) (@s "<" (@s (shen.iter-vector V5639 1 V5640 (shen.maxseq)) ">")) (@s "<" (@s "<" (@s (shen.iter-vector V5639 0 V5640 (shen.maxseq)) ">>")))))) +(defun shen.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.print-vector? (V5641) (let W5642 (<-address V5641 0) (if (= W5642 shen.tuple) true (if (= W5642 shen.pvar) true (if (not (number? W5642)) (shen.fbound? W5642) false))))) +(defun shen.print-vector? (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.fbound? (V5643) (not (= (arity V5643) -1))) +(defun shen.fbound? (V5684) (not (= (arity V5684) -1))) -(defun shen.tuple (V5644) (cn "(@p " (shen.app (<-address V5644 1) (cn " " (shen.app (<-address V5644 2) ")" shen.s)) shen.s))) +(defun shen.tuple (V5685) (cn "(@p " (shen.app (<-address V5685 1) (cn " " (shen.app (<-address V5685 2) ")" shen.s)) shen.s))) -(defun shen.iter-vector (V5651 V5652 V5653 V5654) (cond ((= 0 V5654) "... etc") (true (let W5655 (trap-error (<-address V5651 V5652) (lambda Z5656 shen.out-of-bounds)) (let W5657 (trap-error (<-address V5651 (+ V5652 1)) (lambda Z5658 shen.out-of-bounds)) (if (= W5655 shen.out-of-bounds) "" (if (= W5657 shen.out-of-bounds) (shen.arg->str W5655 V5653) (@s (shen.arg->str W5655 V5653) (@s " " (shen.iter-vector V5651 (+ V5652 1) V5653 (- V5654 1))))))))))) +(defun shen.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.atom->str (V5659) (trap-error (str V5659) (lambda Z5660 (shen.funexstring)))) +(defun shen.atom->str (V5700) (trap-error (str V5700) (lambda Z5701 (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? (V5661) (or (empty? V5661) (cons? V5661))) +(defun shen.list? (V5702) (or (empty? V5702) (cons? V5702))) diff --git a/lib/StLib/PROVENANCE.md b/lib/StLib/PROVENANCE.md index 2b9ef28..c4814fd 100644 --- a/lib/StLib/PROVENANCE.md +++ b/lib/StLib/PROVENANCE.md @@ -1,7 +1,7 @@ # Provenance of the vendored standard-library sources (lib/StLib) -These are the **Shen sources** of the Shen standard library for the S41.2 -(2026-07-11 refresh) kernel. Tarver's refresh no longer ships the standard +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 @@ -10,14 +10,13 @@ shen-lua does the equivalent at boot — see `boot.lua` `load_stdlib` and ## Canonical source - **Mirror**: `pyrex41/shen-upstream` — the designated mirror of Mark Tarver's - shenlanguage.org uploads (private repo; formerly `pyrex41/shen-s41.1`, old - URLs redirect). - - Tag: `s41.2-pristine-20260711` - - Commit: `11fc51bdf53a4dcb505adeec6ec8352754cbe50f` -- **Upstream origin** (what the mirror imported): Mark Tarver's `S41.2.zip`. - - URL: https://www.shenlanguage.org/Download/S41.2.zip - - Last-Modified: 2026-07-11 - - Zip SHA-256: `51becbfd60fa8c93c3f8ae5b20b948eaa84c4b1d14ad2f5d2a056002a53ee836` + 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`). diff --git a/lua_interop.lua b/lua_interop.lua index a36f88e..6c5a982 100644 --- a/lua_interop.lua +++ b/lua_interop.lua @@ -257,7 +257,7 @@ end -- Shen-LEVEL registration of name/arity: the `arity` property plus the -- shen.*lambdatable* entry that (fn name) and Shen's evaluator consult. -- --- The S41.2 (2026-07-11 refresh) kernel dropped shen.set-lambda-form-entry +-- 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) diff --git a/prims.lua b/prims.lua index 1936ac6..690ad94 100644 --- a/prims.lua +++ b/prims.lua @@ -557,7 +557,7 @@ function P.install_native_prolog() -- vectors are used sequentially (never nested in one inference), so a global -- ticket-indexed stack is safe. -- - -- RESIDUAL RISK (validated empirically: 41.1 and 41.2 suites 134/134 + the typecheck + -- RESIDUAL RISK (validated empirically: 42 and 42 suites 134/134 + the typecheck -- inference count is byte-identical with and without pooling, so no exercised -- unification path is perturbed): recycling reuses the table OBJECT, not just -- the ticket. This is unsafe only if a reclaimed-ticket pvar object is still @@ -625,7 +625,7 @@ end -- Native overrides of the hottest GENERAL-purpose kernel functions (the -- officially-recommended "overwrite" peephole track; see Shen PortDeveloperNotes -- and shen-cl's overwrite.lsp). Installed after the kernel loads, overriding the --- compiled-KL defuns in F. A 41.1-suite call-frequency profile (bench/callfreq.lua) +-- compiled-KL defuns in F. A 42-suite call-frequency profile (bench/callfreq.lua) -- showed these are called millions of times each, and -- crucially -- their -- compiled-KL bodies re-dispatch through F["="]/F["cons?"]/F["hd"]/F["tl"] on -- every iteration. The native bodies call the Lua `equal`/`is_cons`/`cons` @@ -943,7 +943,7 @@ function P.install_native_stdlib() return h end - -- fn (reader.kl): the 41.2 shen->kl translator compiles every call to a + -- 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* @@ -1295,7 +1295,7 @@ P.load_chunk = load_chunk -- the echo depth (P.LOADPR_DEPTH) and the native pr drops load's own -- standard-output chatter at that depth. P.CHUNK_DEPTH counts the eval-kl -- chunk nesting maintained by compile_and_load below. Unlike -q/*hush* --- (which on the 41.2 kernel gates pr itself, i.e. ALL standard output), +-- (which on the 42 kernel gates pr itself, i.e. ALL standard output), -- hush-load leaves user (output ...)/pr from inside loaded forms alive. P.CHUNK_DEPTH = 0 P.LOADPR_DEPTH = nil diff --git a/repl.lua b/repl.lua index 9de1d74..df70889 100644 --- a/repl.lua +++ b/repl.lua @@ -289,7 +289,7 @@ 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 S41.2 + -- 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.) if P.F["version"] == nil then P.load_kernel(opts.verbose) end diff --git a/shen-0.10.0-1.rockspec b/shen-0.10.0-1.rockspec index d32ede5..fa63f82 100644 --- a/shen-0.10.0-1.rockspec +++ b/shen-0.10.0-1.rockspec @@ -8,13 +8,13 @@ source = { } description = { - summary = "A speed-focused LuaJIT port of the Shen language (kernel 41.2)", + summary = "A speed-focused LuaJIT port of the Shen language (kernel 42)", 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 41.2 KLambda sources are bundled and compiled on first boot, then +the Shen 42 KLambda sources are bundled and compiled on first boot, then served from a bytecode cache. ]], homepage = "https://github.com/pyrex41/shen-lua", @@ -45,7 +45,7 @@ build = { install = { bin = { shen = "bin/shen" }, }, - -- The vendored Shen 41.2 KLambda kernel sources, compiled on boot. + -- The vendored Shen 42 KLambda kernel sources, compiled on boot. -- They land in the rock directory -- (/lib/luarocks/rocks-5.1/shen//klambda); boot.lua's -- find_kldir() derives that path from its own install location. diff --git a/shen-0.10.1-1.rockspec b/shen-0.10.1-1.rockspec index 3b0ede5..ce45c76 100644 --- a/shen-0.10.1-1.rockspec +++ b/shen-0.10.1-1.rockspec @@ -8,16 +8,16 @@ source = { } description = { - summary = "A speed-focused LuaJIT port of the Shen language (kernel 41.2)", + summary = "A speed-focused LuaJIT port of the Shen language (kernel 42)", 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 41.2 KLambda sources are bundled and compiled on first boot, then +the Shen 42 KLambda sources are bundled and compiled on first boot, then served from a bytecode cache. -0.10.1 is a patch over 0.10.0 (same kernel 41.2): a warm FASL-cache `(load)` +0.10.1 is a patch over 0.10.0 (same kernel 42): a warm FASL-cache `(load)` hit now re-emits each top-level form's value echo, so `(load FILE)` stdout no longer depends on cache state and matches the other ports (pyrex41/shen-lua#40). ]], @@ -49,7 +49,7 @@ build = { install = { bin = { shen = "bin/shen" }, }, - -- The vendored Shen 41.2 KLambda kernel sources, compiled on boot. + -- The vendored Shen 42 KLambda kernel sources, compiled on boot. -- They land in the rock directory -- (/lib/luarocks/rocks-5.1/shen//klambda); boot.lua's -- find_kldir() derives that path from its own install location. diff --git a/shen-0.9.0-1.rockspec b/shen-0.9.0-1.rockspec index 772e21c..d24014b 100644 --- a/shen-0.9.0-1.rockspec +++ b/shen-0.9.0-1.rockspec @@ -7,18 +7,18 @@ source = { tag = "v0.9.0", } --- NOTE: this rockspec pins tag v0.9.0, which bundles the Shen 41.1 kernel. --- For kernel 41.2 use shen-0.10.0-1.rockspec (tag v0.10.0) or later. +-- NOTE: this rockspec pins tag v0.9.0, which bundles the Shen 42 kernel. +-- For kernel 42 use shen-0.10.0-1.rockspec (tag v0.10.0) or later. description = { - summary = "A speed-focused LuaJIT port of the Shen language (kernel 41.1)", + summary = "A speed-focused LuaJIT port of the Shen language (kernel 42)", 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 41.1 KLambda sources are bundled and compiled on first boot, then -served from a bytecode cache. NOTE: this version bundles kernel 41.1; for -kernel 41.2 install shen 0.10.0 or later. +the Shen 42 KLambda sources are bundled and compiled on first boot, then +served from a bytecode cache. NOTE: this version bundles kernel 42; for +kernel 42 install shen 0.10.0 or later. ]], homepage = "https://github.com/pyrex41/shen-lua", license = "BSD-3-Clause (Shen kernel: BSD)", @@ -48,7 +48,7 @@ build = { install = { bin = { shen = "bin/shen" }, }, - -- The vendored Shen 41.2 KLambda kernel sources, compiled on boot. + -- The vendored Shen 42 KLambda kernel sources, compiled on boot. -- They land in the rock directory -- (/lib/luarocks/rocks-5.1/shen//klambda); boot.lua's -- find_kldir() derives that path from its own install location. diff --git a/shen-scm-1.rockspec b/shen-scm-1.rockspec index 1bbfad9..a09fd59 100644 --- a/shen-scm-1.rockspec +++ b/shen-scm-1.rockspec @@ -8,13 +8,13 @@ source = { } description = { - summary = "A speed-focused LuaJIT port of the Shen language (kernel 41.2)", + summary = "A speed-focused LuaJIT port of the Shen language (kernel 42)", 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 41.2 KLambda sources are bundled and compiled on first boot, then +the Shen 42 KLambda sources are bundled and compiled on first boot, then served from a bytecode cache. ]], homepage = "https://github.com/pyrex41/shen-lua", @@ -45,7 +45,7 @@ build = { install = { bin = { shen = "bin/shen" }, }, - -- The vendored Shen 41.2 KLambda kernel sources, compiled on boot. + -- The vendored Shen 42 KLambda kernel 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. diff --git a/shen.lua b/shen.lua index fe57d54..1511806 100644 --- a/shen.lua +++ b/shen.lua @@ -26,7 +26,7 @@ shen.runtime = R -- and run (shen.initialise). Idempotent. opts: -- quiet = true -> hush anything printed DURING boot (banner/echo); -- *hush* is restored afterwards. For a permanently --- silent session do shen.eval("(hush +)") — in 41.2 the +-- silent session do shen.eval("(hush +)") — in 42 the -- *hush* global gates `pr` itself, i.e. ALL output. -- verbose = true -> log each kernel file to stderr as it loads -- hush_load = true -> silence ONLY what (load ...) itself prints (the diff --git a/test/cli_spec.lua b/test/cli_spec.lua index da4484e..7c456c5 100644 --- a/test/cli_spec.lua +++ b/test/cli_spec.lua @@ -17,7 +17,7 @@ -- used to diverge: -q produced a zero-byte file; fixed in #22.) -- * the three output modes a batch/golden runner picks between (issue #46): -- default (echo + program output), -q (nothing at all — *hush* gates pr --- itself on 41.2), --hush-load / SHEN_HUSH_LOAD=1 (load's echo dropped, +-- itself on 42), --hush-load / SHEN_HUSH_LOAD=1 (load's echo dropped, -- the program's own (output ...) kept), including that --hush-load output -- is byte-identical cold and on a warm fasl hit; -- * shen.boot{hush_load = true}, the embedder spelling of that mode. @@ -296,7 +296,7 @@ end -- --hush-load / SHEN_HUSH_LOAD=1 (pyrex41/shen-lua#46 item 3). -- -- A batch or golden-suite runner wants the loaded program's own output and --- nothing else. `-q` cannot give it that: on the 41.2 kernel *hush* gates `pr` +-- nothing else. `-q` cannot give it that: on the 42 kernel *hush* gates `pr` -- itself, so -q silences the program too (the run comes back EMPTY — that is -- the "-q unusable for golden runners" report). --hush-load silences only what -- `load` itself writes: the per-form value/type echo, `loaded`, and the diff --git a/test/prolog_semantics_spec.lua b/test/prolog_semantics_spec.lua index 6e0b313..d9e0c2b 100644 --- a/test/prolog_semantics_spec.lua +++ b/test/prolog_semantics_spec.lua @@ -10,7 +10,7 @@ -- kernel Prolog directly. -- -- Every expectation below was MEASURED on shen-go, shen-cl and shen-rust --- (pinned checkouts, kernel 41.2) and was byte-identical on all three. The +-- (pinned checkouts, kernel 42) and was byte-identical on all three. The -- probe methodology is urdr's four-port portability spike, -- spikes/m1-prolog-portability: results are rendered by a printer defined -- here, never by a port's own value writer, so runtime variable naming and diff --git a/tests/README b/tests/README index a0bc6a3..8f2f751 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 e6a5cd3..63fe906 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 e822130..0a6737a 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 5290336..4435083 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 868d269..f1409d1 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 b3bb02f..8eca70e 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 61ddc98..1311d66 100644
--- a/tests/call.shen
+++ b/tests/call.shen
@@ -1,14 +1,15 @@
-(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 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
diff --git a/tests/cartprod.shen b/tests/cartprod.shen
index 56e36e4..7fb0983 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 0e62859..2d2e323 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 9b7e314..7a9c2b8 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 4598a21..29ddcb7 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 708491d..8a5eed2 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 39f92df..2b3e1b5 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 3711d16..3d3ce17 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 61a0a53..479b22e 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 d91ebf2..90e700e 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/findall.shen b/tests/findall.shen
index 53f1e9a..45f2c18 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 3079a5d..34edffd 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 00a51b6..256b0b4 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 a14add0..e850223 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 fb6b860..2561c9b 100644
--- a/tests/kerneltests.shen
+++ b/tests/kerneltests.shen
@@ -1,255 +1,255 @@
-(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)
-
+(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
diff --git a/tests/lisp.shen b/tests/lisp.shen
index 70cedaf..95329ea 100644
--- a/tests/lisp.shen
+++ b/tests/lisp.shen
@@ -1,65 +1,66 @@
-(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;
-
-
-
-
+(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
diff --git a/tests/metaprog.shen b/tests/metaprog.shen
index 6976d99..9427f39 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 b8588ad..2700b37 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 fa6d578..c0ea4c0 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 386ff46..a273b3a 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 933739d..ce688ab 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 65381ec..d26b1a3 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 8e3d567..44f5a29 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
new file mode 100644
index 0000000..0527c21
--- /dev/null
+++ b/tests/n queens.kl	
@@ -0,0 +1,16 @@
+(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 6493fc5..b7634c9 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 3ea5148..2cdae7b 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 32c3706..e0bd91a 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 1da7b5b..19e8573 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
new file mode 100644
index 0000000..f085aee
--- /dev/null
+++ b/tests/parsetest.shen
@@ -0,0 +1,2 @@
+a b c [ d e ] "ddd
+\\
diff --git a/tests/powerset.shen b/tests/powerset.shen
index b7aceee..4494265 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 fc443f4..8122921 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 bb3e479..f6f3fd5 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 72bee81..44405d8 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 7c4ad92..7fa22a0 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 fb785aa..d318f33 100644
--- a/tests/propcalcprolog.shen
+++ b/tests/propcalcprolog.shen
@@ -1,14 +1,15 @@
-(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 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
diff --git a/tests/proplog version 1.shen b/tests/proplog version 1.shen
index 009aa6d..740ffff 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 41cf66b..99f381b 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 08eca63..4ad1c26 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 926b6b0..dc51f66 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 8e915c5..86c32aa 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 5291be1..24c8ea9 100644
--- a/tests/secd1.shen
+++ b/tests/secd1.shen
@@ -1,48 +1,49 @@
-(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))
-
+(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
diff --git a/tests/semantic net.shen b/tests/semantic net.shen
index bac64d1..6696ceb 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 d4e2d59..0f3150e 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 01f32a2..dcc2e4f 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 d521f3d..1001166 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 3a97617..d0c480e 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 b7dde61..aafba32 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 e0f2c40..473e134 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 bf44a4d..14b8583 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 1c648e6..3b2fdfe 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 d3781fd..283c97e 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 ce3f023..2777427 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 1dda0f5..88f835d 100644
--- a/typecheck_native.lua
+++ b/typecheck_native.lua
@@ -180,7 +180,7 @@ local function harvest_init_sigs(src)
   return total > 0 and total == got
 end
 
--- Refreshed-kernel (S41.2 2026-07-11) signature harvest, from types.kl.
+-- Refreshed-kernel (S42 2026-07-11) signature harvest, from types.kl.
 -- The refresh dropped init.kl/shen.initialise-signedfuncs; the 161 kernel
 -- signatures now live as top-level (declare NAME TYPEFORM) forms in types.kl,
 -- where TYPEFORM is the same rcons tree — e.g. (cons (cons list (cons A ()))
@@ -334,7 +334,7 @@ function M.install(Pmod, Emod)
     local dirs = {
       P.KLDIR,                                        -- boot's resolved dir
       (os.getenv("SHEN_KL_DIR") or "klambda") .. "/",
-      "../cl-source/ShenOSKernel-41.2/klambda/",      -- boot's other candidate
+      "../cl-source/ShenOSKernel-42/klambda/",      -- boot's other candidate
     }
     for _, d in ipairs(dirs) do
       local fh = d and io.open(d .. name .. ".kl", "r")