diff --git a/CHANGELOG.md b/CHANGELOG.md index 17ddb31..a3fb958 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,18 @@ Notable changes to shen-lua. Release notes for earlier versions are under ### Changed +- **Kernel: ShenOSKernel 43.1 at upstream `ec16a9f`** (the 43.1 release plus + shen-sources#117): `shen.by-hypothesis` and `shen.search-user-datatypes` + dereference the checked term once per call through new `-h` predicates, and + fail at once on an empty list. Vendored byte-identical from + `ShenOSKernel-43.1-ec16a9f.tar.gz` (SHA-256 `060066a8…9baacd`); `(version)` + is still `"43.1"`. The native typechecker follows it without falling back: + `typecheck_native.lua` accepts the new `shen.search-user-datatypes` + fingerprint (the hand port already fails on an empty list), and the driver + translator compiles the `(= (shen.lazyderef Hyp B) ())` guard in + `shen.by-hypothesis` as an arena comparison. eqterm still fires in + `shen.by-hypothesis-h`. + - **Kernel: ShenOSKernel 43.1** (community `Shen-Language/shen-sources`); vendored wholesale from the verified `shen-43.1` release. The public `char-stream?`, `read-unit-string`, and `write-string` interfaces are diff --git a/klambda/PROVENANCE.md b/klambda/PROVENANCE.md index e7d30fd..00db29f 100644 --- a/klambda/PROVENANCE.md +++ b/klambda/PROVENANCE.md @@ -1,9 +1,20 @@ # Provenance of the vendored KLambda kernel -## Current: ShenOSKernel 43.1 (community `shen-sources` line) +## Current: ShenOSKernel 43.1 at upstream `ec16a9f` (community `shen-sources` line) + +The 23 `.kl` files are vendored **byte-identical** from the kernel built at upstream +`Shen-Language/shen-sources` master `ec16a9f`: the 43.1 release plus the type checker's +deref-once change (shen-sources#117, with its empty-list guard). The kernel test suite +under `../tests/` is unchanged from 43.1 and identical to that build's. + +- **Build**: `ShenOSKernel-43.1-ec16a9f.tar.gz`, unmodified upstream sources built with + the repo's `make klambda`/`make release`, from + https://github.com/pyrex41/shen-sources/releases/tag/upstream-ec16a9f + - SHA-256: `060066a8f84d9a2f7d41cb3b37b986a8d4653279752b739b5063cd648d9baacd` +- `(version)` still reports `"43.1"`. + +The record of the original 43.1 import follows. -All 23 official `.kl` files and the kernel test suite under `../tests/` are vendored -**byte-identical** from the ShenOSKernel 43.1 release. - **Repository**: [`Shen-Language/shen-sources`](https://github.com/Shen-Language/shen-sources) - Tag: `shen-43.1` diff --git a/klambda/README.md b/klambda/README.md index 27b607e..99d9b2b 100644 --- a/klambda/README.md +++ b/klambda/README.md @@ -2,7 +2,8 @@ These are the KLambda sources of **ShenOSKernel 43.1** (community [`shen-sources`](https://github.com/Shen-Language/shen-sources) release -`shen-43.1`), vendored byte-identical so that `shen-lua` is self-contained: +`shen-43.1`, as built at upstream master `ec16a9f`, which adds shen-sources#117), +vendored byte-identical so that `shen-lua` is self-contained: you can `git clone` and run without a separate kernel checkout. See [PROVENANCE.md](PROVENANCE.md) for the exact source, checksum and the lineage note (this replaced Tarver's S42.0 kernel). The public character stream diff --git a/klambda/extension-expand-dynamic.kl b/klambda/extension-expand-dynamic.kl index e942c0e..96708a4 100644 --- a/klambda/extension-expand-dynamic.kl +++ b/klambda/extension-expand-dynamic.kl @@ -3,21 +3,21 @@ BSD 3-Clause License: http://opensource.org/licenses/BSD-3-Clause" (defun shen.x.expand-dynamic.initialise () (set shen.x.expand-dynamic.*arities* ())) -(defun shen.x.expand-dynamic.expand-dynamic (V7449) (cond ((= () V7449) ()) ((and (cons? V7449) (and (cons? (hd V7449)) (and (= declare (hd (hd V7449))) (and (cons? (tl (hd V7449))) (and (cons? (tl (tl (hd V7449)))) (= () (tl (tl (tl (hd V7449)))))))))) (cons (shen.x.expand-dynamic.expand-declare (hd V7449)) (shen.x.expand-dynamic.expand-dynamic (tl V7449)))) ((and (cons? V7449) (and (cons? (hd V7449)) (and (= shen.initialise-arity-table (hd (hd V7449))) (and (cons? (tl (hd V7449))) (= () (tl (tl (hd V7449)))))))) (do (set shen.x.expand-dynamic.*arities* (eval-kl (hd (tl (hd V7449))))) (cons (hd V7449) (shen.x.expand-dynamic.expand-dynamic (tl V7449))))) ((and (cons? V7449) (and (cons? (hd V7449)) (and (= shen.build-lambda-table (hd (hd V7449))) (and (cons? (tl (hd V7449))) (and (cons? (hd (tl (hd V7449)))) (and (= external (hd (hd (tl (hd V7449))))) (and (cons? (tl (hd (tl (hd V7449))))) (and (= shen (hd (tl (hd (tl (hd V7449)))))) (and (= () (tl (tl (hd (tl (hd V7449)))))) (= () (tl (tl (hd V7449))))))))))))) (let W7450 X (append (shen.x.expand-dynamic.expand-lambda-entries (cons shen.tuple (cons 1 (cons shen.pvar (cons 1 (cons shen.dictionary (cons 1 (cons shen.print-prolog-vector (cons 1 (cons shen.print-freshterm (cons 1 (cons shen.printF (cons 1 (value shen.x.expand-dynamic.*arities*)))))))))))))) (shen.x.expand-dynamic.expand-dynamic (tl V7449))))) ((cons? V7449) (cons (hd V7449) (shen.x.expand-dynamic.expand-dynamic (tl V7449)))) (true (shen.f-error shen.x.expand-dynamic.expand-dynamic)))) +(defun shen.x.expand-dynamic.expand-dynamic (V7477) (cond ((= () V7477) ()) ((and (cons? V7477) (and (cons? (hd V7477)) (and (= declare (hd (hd V7477))) (and (cons? (tl (hd V7477))) (and (cons? (tl (tl (hd V7477)))) (= () (tl (tl (tl (hd V7477)))))))))) (cons (shen.x.expand-dynamic.expand-declare (hd V7477)) (shen.x.expand-dynamic.expand-dynamic (tl V7477)))) ((and (cons? V7477) (and (cons? (hd V7477)) (and (= shen.initialise-arity-table (hd (hd V7477))) (and (cons? (tl (hd V7477))) (= () (tl (tl (hd V7477)))))))) (do (set shen.x.expand-dynamic.*arities* (eval-kl (hd (tl (hd V7477))))) (cons (hd V7477) (shen.x.expand-dynamic.expand-dynamic (tl V7477))))) ((and (cons? V7477) (and (cons? (hd V7477)) (and (= shen.build-lambda-table (hd (hd V7477))) (and (cons? (tl (hd V7477))) (and (cons? (hd (tl (hd V7477)))) (and (= external (hd (hd (tl (hd V7477))))) (and (cons? (tl (hd (tl (hd V7477))))) (and (= shen (hd (tl (hd (tl (hd V7477)))))) (and (= () (tl (tl (hd (tl (hd V7477)))))) (= () (tl (tl (hd V7477))))))))))))) (let W7478 X (append (shen.x.expand-dynamic.expand-lambda-entries (cons shen.tuple (cons 1 (cons shen.pvar (cons 1 (cons shen.dictionary (cons 1 (cons shen.print-prolog-vector (cons 1 (cons shen.print-freshterm (cons 1 (cons shen.printF (cons 1 (value shen.x.expand-dynamic.*arities*)))))))))))))) (shen.x.expand-dynamic.expand-dynamic (tl V7477))))) ((cons? V7477) (cons (hd V7477) (shen.x.expand-dynamic.expand-dynamic (tl V7477)))) (true (shen.f-error shen.x.expand-dynamic.expand-dynamic)))) -(defun shen.x.expand-dynamic.functions-with-lambdas (V7451) (cond ((= () V7451) ()) ((and (cons? V7451) (cons? (tl V7451))) (cons (hd V7451) (shen.x.expand-dynamic.functions-with-lambdas (tl (tl V7451))))) (true (shen.f-error shen.x.expand-dynamic.functions-with-lambdas)))) +(defun shen.x.expand-dynamic.functions-with-lambdas (V7479) (cond ((= () V7479) ()) ((and (cons? V7479) (cons? (tl V7479))) (cons (hd V7479) (shen.x.expand-dynamic.functions-with-lambdas (tl (tl V7479))))) (true (shen.f-error shen.x.expand-dynamic.functions-with-lambdas)))) -(defun shen.x.expand-dynamic.expand-declare (V7452) (cond ((and (cons? V7452) (and (= declare (hd V7452)) (and (cons? (tl V7452)) (and (cons? (tl (tl V7452))) (= () (tl (tl (tl V7452)))))))) (let W7453 (eval-kl (hd (tl (tl V7452)))) (let W7454 (shen.prolog-abstraction W7453) (let W7455 (cons set (cons shen.*sigf* (cons (cons shen.assoc-> (cons (hd (tl V7452)) (cons W7454 (cons (cons value (cons shen.*sigf* ())) ())))) ()))) W7455)))) (true (shen.f-error shen.x.expand-dynamic.expand-declare)))) +(defun shen.x.expand-dynamic.expand-declare (V7480) (cond ((and (cons? V7480) (and (= declare (hd V7480)) (and (cons? (tl V7480)) (and (cons? (tl (tl V7480))) (= () (tl (tl (tl V7480)))))))) (let W7481 (eval-kl (hd (tl (tl V7480)))) (let W7482 (shen.prolog-abstraction W7481) (let W7483 (cons set (cons shen.*sigf* (cons (cons shen.assoc-> (cons (hd (tl V7480)) (cons W7482 (cons (cons value (cons shen.*sigf* ())) ())))) ()))) W7483)))) (true (shen.f-error shen.x.expand-dynamic.expand-declare)))) -(defun shen.x.expand-dynamic.expand-lambda-entries (V7456) (cond ((= () V7456) ()) ((and (cons? V7456) (cons? (tl V7456))) (append (shen.x.expand-dynamic.expand-lambda-form-entry (hd V7456) (hd (tl V7456))) (shen.x.expand-dynamic.expand-lambda-entries (tl (tl V7456))))) (true (simple-error (cn "expand-lambda-entries: got unexpected " (shen.app V7456 "" shen.a)))))) +(defun shen.x.expand-dynamic.expand-lambda-entries (V7484) (cond ((= () V7484) ()) ((and (cons? V7484) (cons? (tl V7484))) (append (shen.x.expand-dynamic.expand-lambda-form-entry (hd V7484) (hd (tl V7484))) (shen.x.expand-dynamic.expand-lambda-entries (tl (tl V7484))))) (true (simple-error (cn "expand-lambda-entries: got unexpected " (shen.app V7484 "" shen.a)))))) -(defun shen.x.expand-dynamic.expand-lambda-form-entry (V7465 V7466) (cond ((= package V7465) ()) ((= receive V7465) ()) ((= list V7465) ()) ((= foreign V7465) ()) (true (if (= V7466 -1) () (if (= V7466 0) () (cons (cons shen.set-lambda-form-entry (cons (cons cons (cons V7465 (cons (shen.lambda-function (cons V7465 ()) V7466) ()))) ())) ())))))) +(defun shen.x.expand-dynamic.expand-lambda-form-entry (V7493 V7494) (cond ((= package V7493) ()) ((= receive V7493) ()) ((= list V7493) ()) ((= foreign V7493) ()) (true (if (= V7494 -1) () (if (= V7494 0) () (cons (cons shen.set-lambda-form-entry (cons (cons cons (cons V7493 (cons (shen.lambda-function (cons V7493 ()) V7494) ()))) ())) ())))))) -(defun shen.x.expand-dynamic.split-defuns-h (V7467 V7468) (cond ((and (cons? V7467) (and (cons? (hd V7467)) (and (= defun (hd (hd V7467))) (tuple? V7468)))) (shen.x.expand-dynamic.split-defuns-h (tl V7467) (@p (cons (hd V7467) (fst V7468)) (snd V7468)))) ((and (cons? V7467) (tuple? V7468)) (shen.x.expand-dynamic.split-defuns-h (tl V7467) (@p (fst V7468) (cons (hd V7467) (snd V7468))))) ((and (= () V7467) (tuple? V7468)) (@p (reverse (fst V7468)) (reverse (snd V7468)))) (true (shen.f-error shen.x.expand-dynamic.split-defuns-h)))) +(defun shen.x.expand-dynamic.split-defuns-h (V7495 V7496) (cond ((and (cons? V7495) (and (cons? (hd V7495)) (and (= defun (hd (hd V7495))) (tuple? V7496)))) (shen.x.expand-dynamic.split-defuns-h (tl V7495) (@p (cons (hd V7495) (fst V7496)) (snd V7496)))) ((and (cons? V7495) (tuple? V7496)) (shen.x.expand-dynamic.split-defuns-h (tl V7495) (@p (fst V7496) (cons (hd V7495) (snd V7496))))) ((and (= () V7495) (tuple? V7496)) (@p (reverse (fst V7496)) (reverse (snd V7496)))) (true (shen.f-error shen.x.expand-dynamic.split-defuns-h)))) -(defun shen.x.expand-dynamic.split-defuns (V7469) (shen.x.expand-dynamic.split-defuns-h V7469 (@p () ()))) +(defun shen.x.expand-dynamic.split-defuns (V7497) (shen.x.expand-dynamic.split-defuns-h V7497 (@p () ()))) -(defun shen.x.expand-dynamic.wrap-in-defun (V7470 V7471 V7472) (cons defun (cons V7470 (cons V7471 (cons (shen.x.expand-dynamic.to-single-expression V7470 V7472) ()))))) +(defun shen.x.expand-dynamic.wrap-in-defun (V7498 V7499 V7500) (cons defun (cons V7498 (cons V7499 (cons (shen.x.expand-dynamic.to-single-expression V7498 V7500) ()))))) -(defun shen.x.expand-dynamic.to-single-expression (V7477 V7478) (cond ((and (cons? V7478) (= () (tl V7478))) (hd V7478)) ((cons? V7478) (cons do (cons (hd V7478) (cons (shen.x.expand-dynamic.to-single-expression V7477 (tl V7478)) ())))) (true (simple-error (cn "to-single-expression: got empty list of expressions: " (shen.app V7477 "" shen.a)))))) +(defun shen.x.expand-dynamic.to-single-expression (V7505 V7506) (cond ((and (cons? V7506) (= () (tl V7506))) (hd V7506)) ((cons? V7506) (cons do (cons (hd V7506) (cons (shen.x.expand-dynamic.to-single-expression V7505 (tl V7506)) ())))) (true (simple-error (cn "to-single-expression: got empty list of expressions: " (shen.app V7505 "" shen.a)))))) diff --git a/klambda/extension-features.kl b/klambda/extension-features.kl index aa227aa..558d45b 100644 --- a/klambda/extension-features.kl +++ b/klambda/extension-features.kl @@ -1,11 +1,11 @@ "Copyright (c) 2019 Bruno Deferrari. BSD 3-Clause License: http://opensource.org/licenses/BSD-3-Clause" -(defun shen.x.features.cond-expand-macro (V7285) (cond ((and (cons? V7285) (and (= shen.x.features.cond-expand (hd V7285)) (= () (tl V7285)))) (simple-error "Unfulfilled shen.x.features.cond-expand clause.")) ((and (cons? V7285) (and (= shen.x.features.cond-expand (hd V7285)) (and (cons? (tl V7285)) (and (= true (hd (tl V7285))) (and (cons? (tl (tl V7285))) (= () (tl (tl (tl V7285))))))))) (hd (tl (tl V7285)))) ((and (cons? V7285) (and (= shen.x.features.cond-expand (hd V7285)) (and (cons? (tl V7285)) (and (cons? (hd (tl V7285))) (and (= and (hd (hd (tl V7285)))) (and (= () (tl (hd (tl V7285)))) (cons? (tl (tl V7285))))))))) (hd (tl (tl V7285)))) ((and (cons? V7285) (and (= shen.x.features.cond-expand (hd V7285)) (and (cons? (tl V7285)) (and (cons? (hd (tl V7285))) (and (= and (hd (hd (tl V7285)))) (and (cons? (tl (hd (tl V7285)))) (cons? (tl (tl V7285))))))))) (cons shen.x.features.cond-expand (cons (hd (tl (hd (tl V7285)))) (cons (cons shen.x.features.cond-expand (cons (cons and (tl (tl (hd (tl V7285))))) (tl (tl V7285)))) (tl (tl (tl V7285))))))) ((and (cons? V7285) (and (= shen.x.features.cond-expand (hd V7285)) (and (cons? (tl V7285)) (and (cons? (hd (tl V7285))) (and (= or (hd (hd (tl V7285)))) (and (= () (tl (hd (tl V7285)))) (cons? (tl (tl V7285))))))))) (cons shen.x.features.cond-expand (tl (tl (tl V7285))))) ((and (cons? V7285) (and (= shen.x.features.cond-expand (hd V7285)) (and (cons? (tl V7285)) (and (cons? (hd (tl V7285))) (and (= or (hd (hd (tl V7285)))) (and (cons? (tl (hd (tl V7285)))) (cons? (tl (tl V7285))))))))) (cons shen.x.features.cond-expand (cons (hd (tl (hd (tl V7285)))) (cons (hd (tl (tl V7285))) (cons true (cons (cons shen.x.features.cond-expand (cons (cons or (tl (tl (hd (tl V7285))))) (tl (tl V7285)))) ())))))) ((and (cons? V7285) (and (= shen.x.features.cond-expand (hd V7285)) (and (cons? (tl V7285)) (and (cons? (hd (tl V7285))) (and (= not (hd (hd (tl V7285)))) (and (cons? (tl (hd (tl V7285)))) (and (= () (tl (tl (hd (tl V7285))))) (cons? (tl (tl V7285)))))))))) (cons shen.x.features.cond-expand (cons (hd (tl (hd (tl V7285)))) (cons (cons shen.x.features.cond-expand (tl (tl (tl V7285)))) (cons true (cons (hd (tl (tl V7285))) ())))))) ((and (cons? V7285) (and (= shen.x.features.cond-expand (hd V7285)) (and (cons? (tl V7285)) (and (cons? (tl (tl V7285))) (element? (hd (tl V7285)) (value shen.x.features.*features*)))))) (hd (tl (tl V7285)))) ((and (cons? V7285) (and (= shen.x.features.cond-expand (hd V7285)) (and (cons? (tl V7285)) (cons? (tl (tl V7285)))))) (cons shen.x.features.cond-expand (tl (tl (tl V7285))))) (true V7285))) +(defun shen.x.features.cond-expand-macro (V7313) (cond ((and (cons? V7313) (and (= shen.x.features.cond-expand (hd V7313)) (= () (tl V7313)))) (simple-error "Unfulfilled shen.x.features.cond-expand clause.")) ((and (cons? V7313) (and (= shen.x.features.cond-expand (hd V7313)) (and (cons? (tl V7313)) (and (= true (hd (tl V7313))) (and (cons? (tl (tl V7313))) (= () (tl (tl (tl V7313))))))))) (hd (tl (tl V7313)))) ((and (cons? V7313) (and (= shen.x.features.cond-expand (hd V7313)) (and (cons? (tl V7313)) (and (cons? (hd (tl V7313))) (and (= and (hd (hd (tl V7313)))) (and (= () (tl (hd (tl V7313)))) (cons? (tl (tl V7313))))))))) (hd (tl (tl V7313)))) ((and (cons? V7313) (and (= shen.x.features.cond-expand (hd V7313)) (and (cons? (tl V7313)) (and (cons? (hd (tl V7313))) (and (= and (hd (hd (tl V7313)))) (and (cons? (tl (hd (tl V7313)))) (cons? (tl (tl V7313))))))))) (cons shen.x.features.cond-expand (cons (hd (tl (hd (tl V7313)))) (cons (cons shen.x.features.cond-expand (cons (cons and (tl (tl (hd (tl V7313))))) (tl (tl V7313)))) (tl (tl (tl V7313))))))) ((and (cons? V7313) (and (= shen.x.features.cond-expand (hd V7313)) (and (cons? (tl V7313)) (and (cons? (hd (tl V7313))) (and (= or (hd (hd (tl V7313)))) (and (= () (tl (hd (tl V7313)))) (cons? (tl (tl V7313))))))))) (cons shen.x.features.cond-expand (tl (tl (tl V7313))))) ((and (cons? V7313) (and (= shen.x.features.cond-expand (hd V7313)) (and (cons? (tl V7313)) (and (cons? (hd (tl V7313))) (and (= or (hd (hd (tl V7313)))) (and (cons? (tl (hd (tl V7313)))) (cons? (tl (tl V7313))))))))) (cons shen.x.features.cond-expand (cons (hd (tl (hd (tl V7313)))) (cons (hd (tl (tl V7313))) (cons true (cons (cons shen.x.features.cond-expand (cons (cons or (tl (tl (hd (tl V7313))))) (tl (tl V7313)))) ())))))) ((and (cons? V7313) (and (= shen.x.features.cond-expand (hd V7313)) (and (cons? (tl V7313)) (and (cons? (hd (tl V7313))) (and (= not (hd (hd (tl V7313)))) (and (cons? (tl (hd (tl V7313)))) (and (= () (tl (tl (hd (tl V7313))))) (cons? (tl (tl V7313)))))))))) (cons shen.x.features.cond-expand (cons (hd (tl (hd (tl V7313)))) (cons (cons shen.x.features.cond-expand (tl (tl (tl V7313)))) (cons true (cons (hd (tl (tl V7313))) ())))))) ((and (cons? V7313) (and (= shen.x.features.cond-expand (hd V7313)) (and (cons? (tl V7313)) (and (cons? (tl (tl V7313))) (element? (hd (tl V7313)) (value shen.x.features.*features*)))))) (hd (tl (tl V7313)))) ((and (cons? V7313) (and (= shen.x.features.cond-expand (hd V7313)) (and (cons? (tl V7313)) (cons? (tl (tl V7313)))))) (cons shen.x.features.cond-expand (tl (tl (tl V7313))))) (true V7313))) (defun shen.x.features.current () (value shen.x.features.*features*)) -(defun shen.x.features.initialise (V7286) (do (declare shen.x.features.initialise (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ())))) (do (declare shen.x.features.current (cons --> (cons (cons list (cons symbol ())) ()))) (do (declare shen.x.features.add (cons symbol (cons --> (cons (cons list (cons symbol ())) ())))) (let W7287 (trap-error (value shen.x.features.*features*) (lambda Z7288 (do (set shen.x.features.*features* ()) (do (shen.set-lambda-form-entry (cons shen.x.features.cond-expand-macro (lambda Z7289 (shen.x.features.cond-expand-macro Z7289)))) (shen.record-macro shen.x.features.cond-expand-macro (lambda Z7290 (shen.x.features.cond-expand-macro Z7290))))))) (let W7291 (shen.x.features.current) (let W7292 (set shen.x.features.*features* V7286) W7291))))))) +(defun shen.x.features.initialise (V7314) (do (declare shen.x.features.initialise (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ())))) (do (declare shen.x.features.current (cons --> (cons (cons list (cons symbol ())) ()))) (do (declare shen.x.features.add (cons symbol (cons --> (cons (cons list (cons symbol ())) ())))) (let W7315 (trap-error (value shen.x.features.*features*) (lambda Z7316 (do (set shen.x.features.*features* ()) (do (shen.set-lambda-form-entry (cons shen.x.features.cond-expand-macro (lambda Z7317 (shen.x.features.cond-expand-macro Z7317)))) (shen.record-macro shen.x.features.cond-expand-macro (lambda Z7318 (shen.x.features.cond-expand-macro Z7318))))))) (let W7319 (shen.x.features.current) (let W7320 (set shen.x.features.*features* V7314) W7319))))))) -(defun shen.x.features.add (V7293) (let W7294 (shen.x.features.current) (let W7295 (set shen.x.features.*features* (adjoin V7293 W7294)) W7294))) +(defun shen.x.features.add (V7321) (let W7322 (shen.x.features.current) (let W7323 (set shen.x.features.*features* (adjoin V7321 W7322)) W7322))) diff --git a/klambda/extension-launcher.kl b/klambda/extension-launcher.kl index eb110ed..012ad2d 100644 --- a/klambda/extension-launcher.kl +++ b/klambda/extension-launcher.kl @@ -1,12 +1,12 @@ "Copyright (c) 2019 Bruno Deferrari. BSD 3-Clause License: http://opensource.org/licenses/BSD-3-Clause" -(defun shen.x.launcher.quiet-load (V7309) (let W7310 (read-file V7309) (map (lambda Z7311 (eval Z7311)) W7310))) +(defun shen.x.launcher.quiet-load (V7337) (let W7338 (read-file V7337) (map (lambda Z7339 (eval Z7339)) W7338))) (defun shen.x.launcher.version-string () (shen.app (version) (cn " " (shen.app (cons port (cons (cons (language) (cons (port) ())) (cons implementation (cons (cons (implementation) (cons (release) ())) ())))) " " shen.r)) shen.a)) -(defun shen.x.launcher.help-text (V7312) (cn "Usage: " (shen.app V7312 " [--version] [--help] [] +(defun shen.x.launcher.help-text (V7340) (cn "Usage: " (shen.app V7340 " [--version] [--help] [] commands: repl @@ -31,27 +31,27 @@ commands: Launches the interactive REPL after evaluating all the previous expresions." shen.a))) -(defun shen.x.launcher.execute-all (V7313) (cond ((= () V7313) (cons success ())) ((cons? V7313) (do (thaw (hd V7313)) (shen.x.launcher.execute-all (tl V7313)))) (true (shen.f-error shen.x.launcher.execute-all)))) +(defun shen.x.launcher.execute-all (V7341) (cond ((= () V7341) (cons success ())) ((cons? V7341) (do (thaw (hd V7341)) (shen.x.launcher.execute-all (tl V7341)))) (true (shen.f-error shen.x.launcher.execute-all)))) -(defun shen.x.launcher.eval-string (V7314) (eval (head (read-from-string V7314)))) +(defun shen.x.launcher.eval-string (V7342) (eval (head (read-from-string V7342)))) -(defun shen.x.launcher.eval-flag-map (V7317) (cond ((= "-e" V7317) "--eval") ((= "-l" V7317) "--load") ((= "-q" V7317) "--quiet") ((= "-s" V7317) "--set") ((= "-r" V7317) "--repl") (true false))) +(defun shen.x.launcher.eval-flag-map (V7345) (cond ((= "-e" V7345) "--eval") ((= "-l" V7345) "--load") ((= "-q" V7345) "--quiet") ((= "-s" V7345) "--set") ((= "-r" V7345) "--repl") (true false))) -(defun shen.x.launcher.eval-command-h (V7322 V7323) (cond ((= () V7322) (shen.x.launcher.execute-all (reverse V7323))) ((and (cons? V7322) (and (= "--eval" (hd V7322)) (cons? (tl V7322)))) (shen.x.launcher.eval-command-h (tl (tl V7322)) (cons (freeze (pr (shen.app (shen.x.launcher.eval-string (hd (tl V7322))) " -" shen.a) (stoutput))) V7323))) ((and (cons? V7322) (and (= "--load" (hd V7322)) (cons? (tl V7322)))) (shen.x.launcher.eval-command-h (tl (tl V7322)) (cons (freeze (load (hd (tl V7322)))) V7323))) ((and (cons? V7322) (= "--quiet" (hd V7322))) (shen.x.launcher.eval-command-h (tl V7322) (cons (freeze (set *hush* true)) V7323))) ((and (cons? V7322) (and (= "--set" (hd V7322)) (and (cons? (tl V7322)) (cons? (tl (tl V7322)))))) (shen.x.launcher.eval-command-h (tl (tl (tl V7322))) (cons (freeze (set (shen.x.launcher.eval-string (hd (tl V7322))) (shen.x.launcher.eval-string (hd (tl (tl V7322)))))) V7323))) ((and (cons? V7322) (= "--repl" (hd V7322))) (do (shen.x.launcher.eval-command-h () V7323) (cons launch-repl (tl V7322)))) (true (let Freeze7325 (freeze (cond ((cons? V7322) (cons error (cons (cn "Invalid eval argument: " (shen.app (hd V7322) "" shen.a)) ()))) (true (shen.f-error shen.x.launcher.eval-command-h)))) (if (cons? V7322) (let Result7326 (let W7324 (shen.x.launcher.eval-flag-map (hd V7322)) (if (= false W7324) (fail) (shen.x.launcher.eval-command-h (cons W7324 (tl V7322)) V7323))) (if (= Result7326 (fail)) (thaw Freeze7325) Result7326)) (thaw Freeze7325)))))) +(defun shen.x.launcher.eval-command-h (V7350 V7351) (cond ((= () V7350) (shen.x.launcher.execute-all (reverse V7351))) ((and (cons? V7350) (and (= "--eval" (hd V7350)) (cons? (tl V7350)))) (shen.x.launcher.eval-command-h (tl (tl V7350)) (cons (freeze (pr (shen.app (shen.x.launcher.eval-string (hd (tl V7350))) " +" shen.a) (stoutput))) V7351))) ((and (cons? V7350) (and (= "--load" (hd V7350)) (cons? (tl V7350)))) (shen.x.launcher.eval-command-h (tl (tl V7350)) (cons (freeze (load (hd (tl V7350)))) V7351))) ((and (cons? V7350) (= "--quiet" (hd V7350))) (shen.x.launcher.eval-command-h (tl V7350) (cons (freeze (set *hush* true)) V7351))) ((and (cons? V7350) (and (= "--set" (hd V7350)) (and (cons? (tl V7350)) (cons? (tl (tl V7350)))))) (shen.x.launcher.eval-command-h (tl (tl (tl V7350))) (cons (freeze (set (shen.x.launcher.eval-string (hd (tl V7350))) (shen.x.launcher.eval-string (hd (tl (tl V7350)))))) V7351))) ((and (cons? V7350) (= "--repl" (hd V7350))) (do (shen.x.launcher.eval-command-h () V7351) (cons launch-repl (tl V7350)))) (true (let Freeze7353 (freeze (cond ((cons? V7350) (cons error (cons (cn "Invalid eval argument: " (shen.app (hd V7350) "" shen.a)) ()))) (true (shen.f-error shen.x.launcher.eval-command-h)))) (if (cons? V7350) (let Result7354 (let W7352 (shen.x.launcher.eval-flag-map (hd V7350)) (if (= false W7352) (fail) (shen.x.launcher.eval-command-h (cons W7352 (tl V7350)) V7351))) (if (= Result7354 (fail)) (thaw Freeze7353) Result7354)) (thaw Freeze7353)))))) -(defun shen.x.launcher.eval-command (V7327) (shen.x.launcher.eval-command-h V7327 ())) +(defun shen.x.launcher.eval-command (V7355) (shen.x.launcher.eval-command-h V7355 ())) -(defun shen.x.launcher.script-command (V7328 V7329) (do (set *argv* (cons V7328 V7329)) (do (shen.x.launcher.quiet-load V7328) (cons success ())))) +(defun shen.x.launcher.script-command (V7356 V7357) (do (set *argv* (cons V7356 V7357)) (do (shen.x.launcher.quiet-load V7356) (cons success ())))) -(defun shen.x.launcher.launch-shen (V7330) (cond ((and (cons? V7330) (= () (tl V7330))) (cons launch-repl ())) ((and (cons? V7330) (and (cons? (tl V7330)) (= "--help" (hd (tl V7330))))) (cons show-help (cons (shen.x.launcher.help-text (hd V7330)) ()))) ((and (cons? V7330) (and (cons? (tl V7330)) (= "--version" (hd (tl V7330))))) (cons success (cons (shen.x.launcher.version-string) ()))) ((and (cons? V7330) (and (cons? (tl V7330)) (= "repl" (hd (tl V7330))))) (cons launch-repl (tl (tl V7330)))) ((and (cons? V7330) (and (cons? (tl V7330)) (and (= "script" (hd (tl V7330))) (cons? (tl (tl V7330)))))) (shen.x.launcher.script-command (hd (tl (tl V7330))) (tl (tl (tl V7330))))) ((and (cons? V7330) (and (cons? (tl V7330)) (= "eval" (hd (tl V7330))))) (shen.x.launcher.eval-command (tl (tl V7330)))) ((and (cons? V7330) (cons? (tl V7330))) (cons unknown-arguments V7330)) (true (shen.f-error shen.x.launcher.launch-shen)))) +(defun shen.x.launcher.launch-shen (V7358) (cond ((and (cons? V7358) (= () (tl V7358))) (cons launch-repl ())) ((and (cons? V7358) (and (cons? (tl V7358)) (= "--help" (hd (tl V7358))))) (cons show-help (cons (shen.x.launcher.help-text (hd V7358)) ()))) ((and (cons? V7358) (and (cons? (tl V7358)) (= "--version" (hd (tl V7358))))) (cons success (cons (shen.x.launcher.version-string) ()))) ((and (cons? V7358) (and (cons? (tl V7358)) (= "repl" (hd (tl V7358))))) (cons launch-repl (tl (tl V7358)))) ((and (cons? V7358) (and (cons? (tl V7358)) (and (= "script" (hd (tl V7358))) (cons? (tl (tl V7358)))))) (shen.x.launcher.script-command (hd (tl (tl V7358))) (tl (tl (tl V7358))))) ((and (cons? V7358) (and (cons? (tl V7358)) (= "eval" (hd (tl V7358))))) (shen.x.launcher.eval-command (tl (tl V7358)))) ((and (cons? V7358) (cons? (tl V7358))) (cons unknown-arguments V7358)) (true (shen.f-error shen.x.launcher.launch-shen)))) -(defun shen.x.launcher.default-handle-result (V7333) (cond ((and (cons? V7333) (and (= success (hd V7333)) (= () (tl V7333)))) shen.x.launcher.done) ((and (cons? V7333) (and (= success (hd V7333)) (and (cons? (tl V7333)) (= () (tl (tl V7333)))))) (pr (shen.app (hd (tl V7333)) " -" shen.a) (stoutput))) ((and (cons? V7333) (and (= error (hd V7333)) (and (cons? (tl V7333)) (= () (tl (tl V7333)))))) (pr (cn "ERROR: " (shen.app (hd (tl V7333)) " -" shen.a)) (stoutput))) ((and (cons? V7333) (= launch-repl (hd V7333))) (shen.repl)) ((and (cons? V7333) (and (= show-help (hd V7333)) (and (cons? (tl V7333)) (= () (tl (tl V7333)))))) (pr (shen.app (hd (tl V7333)) " -" shen.a) (stoutput))) ((and (cons? V7333) (and (= unknown-arguments (hd V7333)) (and (cons? (tl V7333)) (cons? (tl (tl V7333)))))) (pr (cn "ERROR: Invalid argument: " (shen.app (hd (tl (tl V7333))) (cn " -Try `" (shen.app (hd (tl V7333)) " --help' for more information. +(defun shen.x.launcher.default-handle-result (V7361) (cond ((and (cons? V7361) (and (= success (hd V7361)) (= () (tl V7361)))) shen.x.launcher.done) ((and (cons? V7361) (and (= success (hd V7361)) (and (cons? (tl V7361)) (= () (tl (tl V7361)))))) (pr (shen.app (hd (tl V7361)) " +" shen.a) (stoutput))) ((and (cons? V7361) (and (= error (hd V7361)) (and (cons? (tl V7361)) (= () (tl (tl V7361)))))) (pr (cn "ERROR: " (shen.app (hd (tl V7361)) " +" shen.a)) (stoutput))) ((and (cons? V7361) (= launch-repl (hd V7361))) (shen.repl)) ((and (cons? V7361) (and (= show-help (hd V7361)) (and (cons? (tl V7361)) (= () (tl (tl V7361)))))) (pr (shen.app (hd (tl V7361)) " +" shen.a) (stoutput))) ((and (cons? V7361) (and (= unknown-arguments (hd V7361)) (and (cons? (tl V7361)) (cons? (tl (tl V7361)))))) (pr (cn "ERROR: Invalid argument: " (shen.app (hd (tl (tl V7361))) (cn " +Try `" (shen.app (hd (tl V7361)) " --help' for more information. " shen.a)) shen.a)) (stoutput))) (true (shen.f-error shen.x.launcher.default-handle-result)))) -(defun shen.x.launcher.main (V7334) (shen.x.launcher.default-handle-result (shen.x.launcher.launch-shen V7334))) +(defun shen.x.launcher.main (V7362) (shen.x.launcher.default-handle-result (shen.x.launcher.launch-shen V7362))) diff --git a/klambda/extension-namespaces.kl b/klambda/extension-namespaces.kl index 25996d2..0c6c59b 100644 --- a/klambda/extension-namespaces.kl +++ b/klambda/extension-namespaces.kl @@ -1,31 +1,31 @@ "Copyright (c) 2026 Bruno Deferrari. All rights reserved. BSD 3-Clause License: http://opensource.org/licenses/BSD-3-Clause" -(defun shen.x.namespaces.initialise () (shen.register-source-form shen.x.namespace (lambda Z7503 (shen.x.namespaces.expand Z7503)))) +(defun shen.x.namespaces.initialise () (shen.register-source-form shen.x.namespace (lambda Z7531 (shen.x.namespaces.expand Z7531)))) -(defun shen.x.namespaces.expand (V7504) (cond ((and (cons? V7504) (and (= shen.x.namespace (hd V7504)) (and (cons? (tl V7504)) (shen.x.namespaces.name? (hd (tl V7504)))))) (shen.x.namespaces.header (hd (tl V7504)) (tl (tl V7504)) () ())) (true (simple-error (cn "invalid namespace: " (shen.app V7504 " +(defun shen.x.namespaces.expand (V7532) (cond ((and (cons? V7532) (and (= shen.x.namespace (hd V7532)) (and (cons? (tl V7532)) (shen.x.namespaces.name? (hd (tl V7532)))))) (shen.x.namespaces.header (hd (tl V7532)) (tl (tl V7532)) () ())) (true (simple-error (cn "invalid namespace: " (shen.app V7532 " " shen.s)))))) -(defun shen.x.namespaces.header (V7509 V7510 V7511 V7512) (cond ((and (cons? V7510) (and (cons? (hd V7510)) (and (= use (hd (hd V7510))) (and (cons? (tl (hd V7510))) (= () (tl (tl (hd V7510)))))))) (shen.x.namespaces.header V7509 (tl V7510) (shen.x.namespaces.add-use (hd (tl (hd V7510))) (hd (tl (hd V7510))) V7511) V7512)) ((and (cons? V7510) (and (cons? (hd V7510)) (and (= use (hd (hd V7510))) (and (cons? (tl (hd V7510))) (and (cons? (tl (tl (hd V7510)))) (and (= => (hd (tl (tl (hd V7510))))) (and (cons? (tl (tl (tl (hd V7510))))) (= () (tl (tl (tl (tl (hd V7510))))))))))))) (shen.x.namespaces.header V7509 (tl V7510) (shen.x.namespaces.add-use (hd (tl (hd V7510))) (hd (tl (tl (tl (hd V7510))))) V7511) V7512)) ((and (cons? V7510) (and (cons? (hd V7510)) (and (= externals (hd (hd V7510))) (and (cons? (tl (hd V7510))) (= () (tl (tl (hd V7510)))))))) (shen.x.namespaces.header V7509 (tl V7510) V7511 (union (shen.x.namespaces.external-symbols (eval (hd (tl (hd V7510))))) V7512))) ((and (cons? V7510) (and (cons? (hd V7510)) (element? (hd (hd V7510)) (cons use (cons externals ()))))) (simple-error (cn "invalid namespace directive: " (shen.app (hd V7510) " -" shen.s)))) (true (let W7513 (shen.x.namespaces.qualify-list (shen.x.namespaces.body-forms V7510) (str V7509) V7511 V7512) (do (shen.record-external V7509 V7512) (do (shen.record-internal V7509 () (snd W7513)) (fst W7513))))))) +(defun shen.x.namespaces.header (V7537 V7538 V7539 V7540) (cond ((and (cons? V7538) (and (cons? (hd V7538)) (and (= use (hd (hd V7538))) (and (cons? (tl (hd V7538))) (= () (tl (tl (hd V7538)))))))) (shen.x.namespaces.header V7537 (tl V7538) (shen.x.namespaces.add-use (hd (tl (hd V7538))) (hd (tl (hd V7538))) V7539) V7540)) ((and (cons? V7538) (and (cons? (hd V7538)) (and (= use (hd (hd V7538))) (and (cons? (tl (hd V7538))) (and (cons? (tl (tl (hd V7538)))) (and (= => (hd (tl (tl (hd V7538))))) (and (cons? (tl (tl (tl (hd V7538))))) (= () (tl (tl (tl (tl (hd V7538))))))))))))) (shen.x.namespaces.header V7537 (tl V7538) (shen.x.namespaces.add-use (hd (tl (hd V7538))) (hd (tl (tl (tl (hd V7538))))) V7539) V7540)) ((and (cons? V7538) (and (cons? (hd V7538)) (and (= externals (hd (hd V7538))) (and (cons? (tl (hd V7538))) (= () (tl (tl (hd V7538)))))))) (shen.x.namespaces.header V7537 (tl V7538) V7539 (union (shen.x.namespaces.external-symbols (eval (hd (tl (hd V7538))))) V7540))) ((and (cons? V7538) (and (cons? (hd V7538)) (element? (hd (hd V7538)) (cons use (cons externals ()))))) (simple-error (cn "invalid namespace directive: " (shen.app (hd V7538) " +" shen.s)))) (true (let W7541 (shen.x.namespaces.qualify-list (shen.x.namespaces.body-forms V7538) (str V7537) V7539 V7540) (do (shen.record-external V7537 V7540) (do (shen.record-internal V7537 () (snd W7541)) (fst W7541))))))) -(defun shen.x.namespaces.add-use (V7516 V7517 V7518) (cond ((and (shen.x.namespaces.name? V7516) (and (shen.x.namespaces.name? V7517) (empty? (assoc V7517 V7518)))) (cons (cons V7517 V7516) V7518)) (true (simple-error (cn "invalid or duplicate namespace use: " (shen.app V7516 (cn " => " (shen.app V7517 " +(defun shen.x.namespaces.add-use (V7544 V7545 V7546) (cond ((and (shen.x.namespaces.name? V7544) (and (shen.x.namespaces.name? V7545) (empty? (assoc V7545 V7546)))) (cons (cons V7545 V7544) V7546)) (true (simple-error (cn "invalid or duplicate namespace use: " (shen.app V7544 (cn " => " (shen.app V7545 " " shen.s)) shen.s)))))) -(defun shen.x.namespaces.body-forms (V7521) (cond ((and (cons? V7521) (and (cons? (hd V7521)) (element? (hd (hd V7521)) (cons use (cons externals ()))))) (simple-error (cn "namespace directive after body: " (shen.app (hd (hd V7521)) " -" shen.s)))) ((cons? V7521) (cons (hd V7521) (shen.x.namespaces.body-forms (tl V7521)))) ((= () V7521) ()) (true (shen.f-error shen.x.namespaces.body-forms)))) +(defun shen.x.namespaces.body-forms (V7549) (cond ((and (cons? V7549) (and (cons? (hd V7549)) (element? (hd (hd V7549)) (cons use (cons externals ()))))) (simple-error (cn "namespace directive after body: " (shen.app (hd (hd V7549)) " +" shen.s)))) ((cons? V7549) (cons (hd V7549) (shen.x.namespaces.body-forms (tl V7549)))) ((= () V7549) ()) (true (shen.f-error shen.x.namespaces.body-forms)))) -(defun shen.x.namespaces.name? (V7522) (and (symbol? V7522) (not (variable? V7522)))) +(defun shen.x.namespaces.name? (V7550) (and (symbol? V7550) (not (variable? V7550)))) -(defun shen.x.namespaces.external-symbols (V7523) (cond ((= () V7523) ()) ((and (cons? V7523) (shen.x.namespaces.name? (hd V7523))) (cons (hd V7523) (shen.x.namespaces.external-symbols (tl V7523)))) (true (simple-error (cn "externals expects a list of non-variable symbols: " (shen.app V7523 " +(defun shen.x.namespaces.external-symbols (V7551) (cond ((= () V7551) ()) ((and (cons? V7551) (shen.x.namespaces.name? (hd V7551))) (cons (hd V7551) (shen.x.namespaces.external-symbols (tl V7551)))) (true (simple-error (cn "externals expects a list of non-variable symbols: " (shen.app V7551 " " shen.s)))))) -(defun shen.x.namespaces.qualify (V7536 V7537 V7538 V7539) (cond ((and (cons? V7536) (and (= with-externals (hd V7536)) (and (cons? (tl V7536)) (and (cons? (tl (tl V7536))) (= () (tl (tl (tl V7536)))))))) (shen.x.namespaces.qualify (hd (tl (tl V7536))) V7537 V7538 (union (shen.x.namespaces.external-symbols (eval (hd (tl V7536)))) V7539))) ((and (cons? V7536) (= with-externals (hd V7536))) (simple-error (cn "invalid with-externals: " (shen.app (tl V7536) " -" shen.s)))) ((cons? V7536) (shen.x.namespaces.qualify-list V7536 V7537 V7538 V7539)) ((shen.internal? V7536 V7537 V7539) (let W7540 (shen.x.namespaces.import-name V7536 V7538) (if (cons? W7540) (@p (tl W7540) ()) (@p (shen.intern-in-package V7537 V7536) (cons V7536 ()))))) (true (@p V7536 ())))) +(defun shen.x.namespaces.qualify (V7564 V7565 V7566 V7567) (cond ((and (cons? V7564) (and (= with-externals (hd V7564)) (and (cons? (tl V7564)) (and (cons? (tl (tl V7564))) (= () (tl (tl (tl V7564)))))))) (shen.x.namespaces.qualify (hd (tl (tl V7564))) V7565 V7566 (union (shen.x.namespaces.external-symbols (eval (hd (tl V7564)))) V7567))) ((and (cons? V7564) (= with-externals (hd V7564))) (simple-error (cn "invalid with-externals: " (shen.app (tl V7564) " +" shen.s)))) ((cons? V7564) (shen.x.namespaces.qualify-list V7564 V7565 V7566 V7567)) ((shen.internal? V7564 V7565 V7567) (let W7568 (shen.x.namespaces.import-name V7564 V7566) (if (cons? W7568) (@p (tl W7568) ()) (@p (shen.intern-in-package V7565 V7564) (cons V7564 ()))))) (true (@p V7564 ())))) -(defun shen.x.namespaces.qualify-list (V7541 V7542 V7543 V7544) (cond ((cons? V7541) (let W7545 (shen.x.namespaces.qualify (hd V7541) V7542 V7543 V7544) (let W7546 (shen.x.namespaces.qualify-list (tl V7541) V7542 V7543 V7544) (@p (cons (fst W7545) (fst W7546)) (union (snd W7545) (snd W7546)))))) (true (shen.x.namespaces.qualify V7541 V7542 V7543 V7544)))) +(defun shen.x.namespaces.qualify-list (V7569 V7570 V7571 V7572) (cond ((cons? V7569) (let W7573 (shen.x.namespaces.qualify (hd V7569) V7570 V7571 V7572) (let W7574 (shen.x.namespaces.qualify-list (tl V7569) V7570 V7571 V7572) (@p (cons (fst W7573) (fst W7574)) (union (snd W7573) (snd W7574)))))) (true (shen.x.namespaces.qualify V7569 V7570 V7571 V7572)))) -(defun shen.x.namespaces.import-name (V7549 V7550) (cond ((= () V7550) ()) ((and (cons? V7550) (cons? (hd V7550))) (let W7551 (shen.x.namespaces.import-name V7549 (tl V7550)) (let W7552 (shen.x.namespaces.member-after (str (hd (hd V7550))) (str V7549)) (if (and (string? W7552) (or (empty? W7551) (shen.internal-to-P? (str (hd W7551)) (str (hd (hd V7550)))))) (cons (hd (hd V7550)) (shen.intern-in-package (str (tl (hd V7550))) (intern W7552))) W7551)))) (true (shen.f-error shen.x.namespaces.import-name)))) +(defun shen.x.namespaces.import-name (V7577 V7578) (cond ((= () V7578) ()) ((and (cons? V7578) (cons? (hd V7578))) (let W7579 (shen.x.namespaces.import-name V7577 (tl V7578)) (let W7580 (shen.x.namespaces.member-after (str (hd (hd V7578))) (str V7577)) (if (and (string? W7580) (or (empty? W7579) (shen.internal-to-P? (str (hd W7579)) (str (hd (hd V7578)))))) (cons (hd (hd V7578)) (shen.intern-in-package (str (tl (hd V7578))) (intern W7580))) W7579)))) (true (shen.f-error shen.x.namespaces.import-name)))) -(defun shen.x.namespaces.member-after (V7558 V7559) (cond ((and (= "" V7558) (and (shen.+string? V7559) (and (= "." (hdstr V7559)) (not (= (tlstr V7559) ""))))) (tlstr V7559)) ((and (shen.+string? V7558) (and (shen.+string? V7559) (= (hdstr V7558) (hdstr V7559)))) (shen.x.namespaces.member-after (tlstr V7558) (tlstr V7559))) (true false))) +(defun shen.x.namespaces.member-after (V7586 V7587) (cond ((and (= "" V7586) (and (shen.+string? V7587) (and (= "." (hdstr V7587)) (not (= (tlstr V7587) ""))))) (tlstr V7587)) ((and (shen.+string? V7586) (and (shen.+string? V7587) (= (hdstr V7586) (hdstr V7587)))) (shen.x.namespaces.member-after (tlstr V7586) (tlstr V7587))) (true false))) diff --git a/klambda/extension-programmable-pattern-matching.kl b/klambda/extension-programmable-pattern-matching.kl index 4c0f8d6..baf912e 100644 --- a/klambda/extension-programmable-pattern-matching.kl +++ b/klambda/extension-programmable-pattern-matching.kl @@ -1,36 +1,36 @@ "Copyright (c) 2019 Bruno Deferrari. All rights reserved. BSD 3-Clause License: http://opensource.org/licenses/BSD-3-Clause" -(defun shen.x.programmable-pattern-matching.apply-pattern-handlers (V7376 V7377 V7378 V7379 V7380) (cond ((= () V7376) (fail)) (true (let Freeze7381 (freeze (cond ((cons? V7376) (shen.x.programmable-pattern-matching.apply-pattern-handlers (tl V7376) V7377 V7378 V7379 V7380)) (true (shen.f-error shen.x.programmable-pattern-matching.apply-pattern-handlers)))) (if (cons? V7376) (let Result7382 (((((hd V7376) V7377) V7378) V7379) V7380) (if (= Result7382 (fail)) (thaw Freeze7381) Result7382)) (thaw Freeze7381)))))) +(defun shen.x.programmable-pattern-matching.apply-pattern-handlers (V7404 V7405 V7406 V7407 V7408) (cond ((= () V7404) (fail)) (true (let Freeze7409 (freeze (cond ((cons? V7404) (shen.x.programmable-pattern-matching.apply-pattern-handlers (tl V7404) V7405 V7406 V7407 V7408)) (true (shen.f-error shen.x.programmable-pattern-matching.apply-pattern-handlers)))) (if (cons? V7404) (let Result7410 (((((hd V7404) V7405) V7406) V7407) V7408) (if (= Result7410 (fail)) (thaw Freeze7409) Result7410)) (thaw Freeze7409)))))) (defun shen.x.programmable-pattern-matching.make-stack () (address-> (absvector 1) 0 ())) -(defun shen.x.programmable-pattern-matching.push (V7383 V7384) (address-> V7383 0 (cons V7384 (<-address V7383 0)))) +(defun shen.x.programmable-pattern-matching.push (V7411 V7412) (address-> V7411 0 (cons V7412 (<-address V7411 0)))) -(defun shen.x.programmable-pattern-matching.pop-all (V7385) (let W7386 (<-address V7385 0) (let W7387 (address-> V7385 0 ()) W7386))) +(defun shen.x.programmable-pattern-matching.pop-all (V7413) (let W7414 (<-address V7413 0) (let W7415 (address-> V7413 0 ()) W7414))) -(defun shen.x.programmable-pattern-matching.surface-pattern (V7388) (cond ((and (cons? V7388) (and (= cons (hd V7388)) (and (cons? (tl V7388)) (and (cons? (tl (tl V7388))) (= () (tl (tl (tl V7388)))))))) (cons (shen.x.programmable-pattern-matching.surface-pattern (hd (tl V7388))) (shen.x.programmable-pattern-matching.surface-pattern-tail (hd (tl (tl V7388)))))) (true (let W7389 (shen.x.programmable-pattern-matching.surface-application V7388) (if (= W7389 (fail)) V7388 W7389))))) +(defun shen.x.programmable-pattern-matching.surface-pattern (V7416) (cond ((and (cons? V7416) (and (= cons (hd V7416)) (and (cons? (tl V7416)) (and (cons? (tl (tl V7416))) (= () (tl (tl (tl V7416)))))))) (cons (shen.x.programmable-pattern-matching.surface-pattern (hd (tl V7416))) (shen.x.programmable-pattern-matching.surface-pattern-tail (hd (tl (tl V7416)))))) (true (let W7417 (shen.x.programmable-pattern-matching.surface-application V7416) (if (= W7417 (fail)) V7416 W7417))))) -(defun shen.x.programmable-pattern-matching.surface-pattern-tail (V7390) (cond ((= () V7390) ()) ((and (cons? V7390) (and (= cons (hd V7390)) (and (cons? (tl V7390)) (and (cons? (tl (tl V7390))) (= () (tl (tl (tl V7390)))))))) (cons (shen.x.programmable-pattern-matching.surface-pattern (hd (tl V7390))) (shen.x.programmable-pattern-matching.surface-pattern-tail (hd (tl (tl V7390)))))) (true V7390))) +(defun shen.x.programmable-pattern-matching.surface-pattern-tail (V7418) (cond ((= () V7418) ()) ((and (cons? V7418) (and (= cons (hd V7418)) (and (cons? (tl V7418)) (and (cons? (tl (tl V7418))) (= () (tl (tl (tl V7418)))))))) (cons (shen.x.programmable-pattern-matching.surface-pattern (hd (tl V7418))) (shen.x.programmable-pattern-matching.surface-pattern-tail (hd (tl (tl V7418)))))) (true V7418))) -(defun shen.x.programmable-pattern-matching.surface-application (V7393) (cond ((and (cons? V7393) (and (cons? (hd V7393)) (and (= fn (hd (hd V7393))) (and (cons? (tl (hd V7393))) (and (= () (tl (tl (hd V7393)))) (and (cons? (tl V7393)) (= () (tl (tl V7393))))))))) (cons (hd (tl (hd V7393))) (cons (shen.x.programmable-pattern-matching.surface-pattern (hd (tl V7393))) ()))) ((and (cons? V7393) (and (cons? (tl V7393)) (= () (tl (tl V7393))))) (let W7394 (shen.x.programmable-pattern-matching.surface-application (hd V7393)) (if (= W7394 (fail)) (fail) (append W7394 (cons (shen.x.programmable-pattern-matching.surface-pattern (hd (tl V7393))) ()))))) (true (fail)))) +(defun shen.x.programmable-pattern-matching.surface-application (V7421) (cond ((and (cons? V7421) (and (cons? (hd V7421)) (and (= fn (hd (hd V7421))) (and (cons? (tl (hd V7421))) (and (= () (tl (tl (hd V7421)))) (and (cons? (tl V7421)) (= () (tl (tl V7421))))))))) (cons (hd (tl (hd V7421))) (cons (shen.x.programmable-pattern-matching.surface-pattern (hd (tl V7421))) ()))) ((and (cons? V7421) (and (cons? (tl V7421)) (= () (tl (tl V7421))))) (let W7422 (shen.x.programmable-pattern-matching.surface-application (hd V7421)) (if (= W7422 (fail)) (fail) (append W7422 (cons (shen.x.programmable-pattern-matching.surface-pattern (hd (tl V7421))) ()))))) (true (fail)))) -(defun shen.x.programmable-pattern-matching.compile-pattern (V7395 V7396 V7397) (let W7398 (shen.x.programmable-pattern-matching.surface-pattern V7395) (let W7399 (shen.x.programmable-pattern-matching.make-stack) (let W7400 Self$$7907$$ (let W7401 (lambda Z7402 shen.x.programmable-pattern-matching.ignored) (let W7403 (lambda Z7404 (lambda Z7405 (shen.x.programmable-pattern-matching.push W7399 Z7404))) (let W7406 (shen.x.programmable-pattern-matching.apply-pattern-handlers V7396 W7400 W7401 W7403 W7398) (if (= W7406 (fail)) (thaw V7397) (cons @p (cons shen.custom-pattern (cons (shen.x.programmable-pattern-matching.compile-pattern-h W7398 (reverse (shen.x.programmable-pattern-matching.pop-all W7399))) ()))))))))))) +(defun shen.x.programmable-pattern-matching.compile-pattern (V7423 V7424 V7425) (let W7426 (shen.x.programmable-pattern-matching.surface-pattern V7423) (let W7427 (shen.x.programmable-pattern-matching.make-stack) (let W7428 Self$$7907$$ (let W7429 (lambda Z7430 shen.x.programmable-pattern-matching.ignored) (let W7431 (lambda Z7432 (lambda Z7433 (shen.x.programmable-pattern-matching.push W7427 Z7432))) (let W7434 (shen.x.programmable-pattern-matching.apply-pattern-handlers V7424 W7428 W7429 W7431 W7426) (if (= W7434 (fail)) (thaw V7425) (cons @p (cons shen.custom-pattern (cons (shen.x.programmable-pattern-matching.compile-pattern-h W7426 (reverse (shen.x.programmable-pattern-matching.pop-all W7427))) ()))))))))))) -(defun shen.x.programmable-pattern-matching.compile-pattern-h (V7407 V7408) (cond ((cons? V7407) (let W7409 (map (lambda Z7410 (if (element? Z7410 V7408) (shen.compile-pattern-fragment Z7410) Z7410)) (tl V7407)) (cons (hd V7407) W7409))) (true (shen.f-error shen.x.programmable-pattern-matching.compile-pattern-h)))) +(defun shen.x.programmable-pattern-matching.compile-pattern-h (V7435 V7436) (cond ((cons? V7435) (let W7437 (map (lambda Z7438 (if (element? Z7438 V7436) (shen.compile-pattern-fragment Z7438) Z7438)) (tl V7435)) (cons (hd V7435) W7437))) (true (shen.f-error shen.x.programmable-pattern-matching.compile-pattern-h)))) -(defun shen.x.programmable-pattern-matching.reduce (V7411 V7412) (cond ((tuple? V7411) (let W7413 (shen.x.programmable-pattern-matching.surface-pattern (fst V7411)) (let W7414 (shen.x.programmable-pattern-matching.make-stack) (let W7415 (shen.x.programmable-pattern-matching.make-stack) (let W7416 (lambda Z7417 (shen.x.programmable-pattern-matching.push W7414 Z7417)) (let W7418 (lambda Z7419 (lambda Z7420 (shen.x.programmable-pattern-matching.push W7415 (@p Z7419 Z7420)))) (let W7421 (shen.x.programmable-pattern-matching.apply-pattern-handlers V7412 (snd V7411) W7416 W7418 W7413) (if (= W7421 (fail)) (fail) (@p (reverse (shen.x.programmable-pattern-matching.pop-all W7414)) (reverse (shen.x.programmable-pattern-matching.pop-all W7415))))))))))) (true (shen.f-error shen.x.programmable-pattern-matching.reduce)))) +(defun shen.x.programmable-pattern-matching.reduce (V7439 V7440) (cond ((tuple? V7439) (let W7441 (shen.x.programmable-pattern-matching.surface-pattern (fst V7439)) (let W7442 (shen.x.programmable-pattern-matching.make-stack) (let W7443 (shen.x.programmable-pattern-matching.make-stack) (let W7444 (lambda Z7445 (shen.x.programmable-pattern-matching.push W7442 Z7445)) (let W7446 (lambda Z7447 (lambda Z7448 (shen.x.programmable-pattern-matching.push W7443 (@p Z7447 Z7448)))) (let W7449 (shen.x.programmable-pattern-matching.apply-pattern-handlers V7440 (snd V7439) W7444 W7446 W7441) (if (= W7449 (fail)) (fail) (@p (reverse (shen.x.programmable-pattern-matching.pop-all W7442)) (reverse (shen.x.programmable-pattern-matching.pop-all W7443))))))))))) (true (shen.f-error shen.x.programmable-pattern-matching.reduce)))) -(defun shen.x.programmable-pattern-matching.initialise () (do (declare shen.x.programmable-pattern-matching.register-handler (cons symbol (cons --> (cons symbol ())))) (do (declare shen.x.programmable-pattern-matching.unregister-handler (cons symbol (cons --> (cons symbol ())))) (do (set shen.*custom-pattern-compiler* (lambda Z7422 (lambda Z7423 (shen.x.programmable-pattern-matching.compile-pattern Z7422 (value shen.x.programmable-pattern-matching.*pattern-handlers*) Z7423)))) (do (set shen.*custom-pattern-reducer* (lambda Z7424 (shen.x.programmable-pattern-matching.reduce Z7424 (value shen.x.programmable-pattern-matching.*pattern-handlers*)))) (do (set shen.x.programmable-pattern-matching.*pattern-handlers* ()) (do (set shen.x.programmable-pattern-matching.*pattern-handlers-reg* ()) shen.x.programmable-pattern-matching.done))))))) +(defun shen.x.programmable-pattern-matching.initialise () (do (declare shen.x.programmable-pattern-matching.register-handler (cons symbol (cons --> (cons symbol ())))) (do (declare shen.x.programmable-pattern-matching.unregister-handler (cons symbol (cons --> (cons symbol ())))) (do (set shen.*custom-pattern-compiler* (lambda Z7450 (lambda Z7451 (shen.x.programmable-pattern-matching.compile-pattern Z7450 (value shen.x.programmable-pattern-matching.*pattern-handlers*) Z7451)))) (do (set shen.*custom-pattern-reducer* (lambda Z7452 (shen.x.programmable-pattern-matching.reduce Z7452 (value shen.x.programmable-pattern-matching.*pattern-handlers*)))) (do (set shen.x.programmable-pattern-matching.*pattern-handlers* ()) (do (set shen.x.programmable-pattern-matching.*pattern-handlers-reg* ()) shen.x.programmable-pattern-matching.done))))))) -(defun shen.x.programmable-pattern-matching.register-handler (V7425) (cond ((element? V7425 (value shen.x.programmable-pattern-matching.*pattern-handlers-reg*)) V7425) (true (do (set shen.x.programmable-pattern-matching.*pattern-handlers-reg* (cons V7425 (value shen.x.programmable-pattern-matching.*pattern-handlers-reg*))) (do (set shen.x.programmable-pattern-matching.*pattern-handlers* (cons (fn V7425) (value shen.x.programmable-pattern-matching.*pattern-handlers*))) V7425))))) +(defun shen.x.programmable-pattern-matching.register-handler (V7453) (cond ((element? V7453 (value shen.x.programmable-pattern-matching.*pattern-handlers-reg*)) V7453) (true (do (set shen.x.programmable-pattern-matching.*pattern-handlers-reg* (cons V7453 (value shen.x.programmable-pattern-matching.*pattern-handlers-reg*))) (do (set shen.x.programmable-pattern-matching.*pattern-handlers* (cons (fn V7453) (value shen.x.programmable-pattern-matching.*pattern-handlers*))) V7453))))) -(defun shen.x.programmable-pattern-matching.findpos (V7426 V7427) (shen.x.programmable-pattern-matching.findpos-h V7426 V7427 1)) +(defun shen.x.programmable-pattern-matching.findpos (V7454 V7455) (shen.x.programmable-pattern-matching.findpos-h V7454 V7455 1)) -(defun shen.x.programmable-pattern-matching.findpos-h (V7435 V7436 V7437) (cond ((= () V7436) (simple-error (shen.app V7435 " is not a pattern handler -" shen.a))) ((and (cons? V7436) (= V7435 (hd V7436))) V7437) ((cons? V7436) (shen.x.programmable-pattern-matching.findpos-h V7435 (tl V7436) (+ V7437 1))) (true (shen.f-error shen.x.programmable-pattern-matching.findpos-h)))) +(defun shen.x.programmable-pattern-matching.findpos-h (V7463 V7464 V7465) (cond ((= () V7464) (simple-error (shen.app V7463 " is not a pattern handler +" shen.a))) ((and (cons? V7464) (= V7463 (hd V7464))) V7465) ((cons? V7464) (shen.x.programmable-pattern-matching.findpos-h V7463 (tl V7464) (+ V7465 1))) (true (shen.f-error shen.x.programmable-pattern-matching.findpos-h)))) -(defun shen.x.programmable-pattern-matching.remove-nth (V7442 V7443) (cond ((not (and (integer? V7442) (> V7442 0))) V7443) ((= () V7443) ()) ((and (= 1 V7442) (cons? V7443)) (tl V7443)) ((cons? V7443) (cons (hd V7443) (shen.x.programmable-pattern-matching.remove-nth (- V7442 1) (tl V7443)))) (true (shen.f-error shen.x.programmable-pattern-matching.remove-nth)))) +(defun shen.x.programmable-pattern-matching.remove-nth (V7470 V7471) (cond ((not (and (integer? V7470) (> V7470 0))) V7471) ((= () V7471) ()) ((and (= 1 V7470) (cons? V7471)) (tl V7471)) ((cons? V7471) (cons (hd V7471) (shen.x.programmable-pattern-matching.remove-nth (- V7470 1) (tl V7471)))) (true (shen.f-error shen.x.programmable-pattern-matching.remove-nth)))) -(defun shen.x.programmable-pattern-matching.unregister-handler (V7444) (let W7445 (value shen.x.programmable-pattern-matching.*pattern-handlers-reg*) (let W7446 (shen.x.programmable-pattern-matching.findpos V7444 W7445) (let W7447 (set shen.x.programmable-pattern-matching.*pattern-handlers-reg* (remove V7444 W7445)) (let W7448 (set shen.x.programmable-pattern-matching.*pattern-handlers* (shen.x.programmable-pattern-matching.remove-nth W7446 (value shen.x.programmable-pattern-matching.*pattern-handlers*))) V7444))))) +(defun shen.x.programmable-pattern-matching.unregister-handler (V7472) (let W7473 (value shen.x.programmable-pattern-matching.*pattern-handlers-reg*) (let W7474 (shen.x.programmable-pattern-matching.findpos V7472 W7473) (let W7475 (set shen.x.programmable-pattern-matching.*pattern-handlers-reg* (remove V7472 W7473)) (let W7476 (set shen.x.programmable-pattern-matching.*pattern-handlers* (shen.x.programmable-pattern-matching.remove-nth W7474 (value shen.x.programmable-pattern-matching.*pattern-handlers*))) V7472))))) diff --git a/klambda/extension-type-annotations.kl b/klambda/extension-type-annotations.kl index 1fb39c1..a7371f5 100644 --- a/klambda/extension-type-annotations.kl +++ b/klambda/extension-type-annotations.kl @@ -1,17 +1,17 @@ "Copyright (c) 2026 Bruno Deferrari. All rights reserved. BSD 3-Clause License: http://opensource.org/licenses/BSD-3-Clause" -(defun shen.x.type-annotations.annotate-kl (V7577) (cond ((and (cons? V7577) (and (= defun (hd V7577)) (and (cons? (tl V7577)) (and (cons? (tl (tl V7577))) (and (cons? (tl (tl (tl V7577)))) (= () (tl (tl (tl (tl V7577)))))))))) (let W7578 (shen.x.type-annotations.function-type (hd (tl V7577))) (let W7579 (shen.x.type-annotations.type-table W7578 (hd (tl (tl V7577)))) (cons defun (cons (hd (tl V7577)) (cons (hd (tl (tl V7577))) (cons (shen.x.type-annotations.annotate (hd (tl (tl V7577))) W7579 (hd (tl (tl (tl V7577))))) ()))))))) (true (shen.x.type-annotations.annotate () () V7577)))) +(defun shen.x.type-annotations.annotate-kl (V7605) (cond ((and (cons? V7605) (and (= defun (hd V7605)) (and (cons? (tl V7605)) (and (cons? (tl (tl V7605))) (and (cons? (tl (tl (tl V7605)))) (= () (tl (tl (tl (tl V7605)))))))))) (let W7606 (shen.x.type-annotations.function-type (hd (tl V7605))) (let W7607 (shen.x.type-annotations.type-table W7606 (hd (tl (tl V7605)))) (cons defun (cons (hd (tl V7605)) (cons (hd (tl (tl V7605))) (cons (shen.x.type-annotations.annotate (hd (tl (tl V7605))) W7607 (hd (tl (tl (tl V7605))))) ()))))))) (true (shen.x.type-annotations.annotate () () V7605)))) -(defun shen.x.type-annotations.function-type (V7584) (cond ((cons? V7584) false) ((not (symbol? V7584)) false) (true (let W7585 (((((lambda Z7586 (lambda Z7587 (lambda Z7588 (lambda Z7589 (let W7590 (shen.newpv Z7586) (shen.gc Z7586 (do (shen.incinfs) (shen.lookupsig (receive (shen.deref V7584 Z7586)) W7590 Z7586 Z7587 Z7588 (freeze (return W7590 Z7586 Z7587 Z7588 Z7589)))))))))) (shen.prolog-vector)) (@v true (@v 0 (vector 0)))) 0) (freeze true)) (if (= W7585 false) false (fst (shen.x.type-annotations.reify-type W7585 ()))))))) +(defun shen.x.type-annotations.function-type (V7612) (cond ((cons? V7612) false) ((not (symbol? V7612)) false) (true (let W7613 (((((lambda Z7614 (lambda Z7615 (lambda Z7616 (lambda Z7617 (let W7618 (shen.newpv Z7614) (shen.gc Z7614 (do (shen.incinfs) (shen.lookupsig (receive (shen.deref V7612 Z7614)) W7618 Z7614 Z7615 Z7616 (freeze (return W7618 Z7614 Z7615 Z7616 Z7617)))))))))) (shen.prolog-vector)) (@v true (@v 0 (vector 0)))) 0) (freeze true)) (if (= W7613 false) false (fst (shen.x.type-annotations.reify-type W7613 ()))))))) -(defun shen.x.type-annotations.reify-type (V7591 V7592) (cond ((cons? V7591) (let W7593 (shen.x.type-annotations.reify-type (hd V7591) V7592) (let W7594 (shen.x.type-annotations.reify-type (tl V7591) (snd W7593)) (@p (cons (fst W7593) (fst W7594)) (snd W7594))))) ((shen.pvar? V7591) (let W7595 (<-address V7591 1) (let W7596 (assoc W7595 V7592) (if (empty? W7596) (let W7597 (gensym A) (@p W7597 (cons (cons W7595 W7597) V7592))) (@p (tl W7596) V7592))))) (true (@p V7591 V7592)))) +(defun shen.x.type-annotations.reify-type (V7619 V7620) (cond ((cons? V7619) (let W7621 (shen.x.type-annotations.reify-type (hd V7619) V7620) (let W7622 (shen.x.type-annotations.reify-type (tl V7619) (snd W7621)) (@p (cons (fst W7621) (fst W7622)) (snd W7622))))) ((shen.pvar? V7619) (let W7623 (<-address V7619 1) (let W7624 (assoc W7623 V7620) (if (empty? W7624) (let W7625 (gensym A) (@p W7625 (cons (cons W7623 W7625) V7620))) (@p (tl W7624) V7620))))) (true (@p V7619 V7620)))) -(defun shen.x.type-annotations.type-table (V7602 V7603) (cond ((and (cons? V7602) (and (cons? (tl V7602)) (and (= --> (hd (tl V7602))) (and (cons? (tl (tl V7602))) (and (= () (tl (tl (tl V7602)))) (cons? V7603)))))) (if (variable? (hd V7602)) (shen.x.type-annotations.type-table (hd (tl (tl V7602))) (tl V7603)) (cons (cons (hd V7603) (hd V7602)) (shen.x.type-annotations.type-table (hd (tl (tl V7602))) (tl V7603))))) (true ()))) +(defun shen.x.type-annotations.type-table (V7630 V7631) (cond ((and (cons? V7630) (and (cons? (tl V7630)) (and (= --> (hd (tl V7630))) (and (cons? (tl (tl V7630))) (and (= () (tl (tl (tl V7630)))) (cons? V7631)))))) (if (variable? (hd V7630)) (shen.x.type-annotations.type-table (hd (tl (tl V7630))) (tl V7631)) (cons (cons (hd V7631) (hd V7630)) (shen.x.type-annotations.type-table (hd (tl (tl V7630))) (tl V7631))))) (true ()))) -(defun shen.x.type-annotations.annotate (V7604 V7605 V7606) (cond ((and (cons? V7606) (and (= type (hd V7606)) (and (cons? (tl V7606)) (and (cons? (tl (tl V7606))) (= () (tl (tl (tl V7606)))))))) V7606) ((and (cons? V7606) (and (= let (hd V7606)) (and (cons? (tl V7606)) (and (cons? (tl (tl V7606))) (and (cons? (tl (tl (tl V7606)))) (= () (tl (tl (tl (tl V7606)))))))))) (cons let (cons (hd (tl V7606)) (cons (shen.x.type-annotations.annotate V7604 V7605 (hd (tl (tl V7606)))) (cons (shen.x.type-annotations.annotate (cons (hd (tl V7606)) V7604) V7605 (hd (tl (tl (tl V7606))))) ()))))) ((and (cons? V7606) (and (= lambda (hd V7606)) (and (cons? (tl V7606)) (and (cons? (tl (tl V7606))) (= () (tl (tl (tl V7606)))))))) (cons lambda (cons (hd (tl V7606)) (cons (shen.x.type-annotations.annotate (cons (hd (tl V7606)) V7604) V7605 (hd (tl (tl V7606)))) ())))) ((and (cons? V7606) (= cond (hd V7606))) (cons cond (shen.x.type-annotations.annotate-cases V7604 V7605 (tl V7606)))) ((cons? V7606) (let W7607 (shen.x.type-annotations.function-type (hd V7606)) (let W7608 (shen.x.type-annotations.type-table W7607 (tl V7606)) (cons (hd V7606) (map (lambda Z7609 (shen.x.type-annotations.annotate V7604 (append V7605 W7608) Z7609)) (tl V7606)))))) (true (let W7610 (assoc V7606 V7605) (if (cons? W7610) (cons type (cons V7606 (cons (tl W7610) ()))) (if (element? V7606 V7604) V7606 (shen.x.type-annotations.atom-type V7606))))))) +(defun shen.x.type-annotations.annotate (V7632 V7633 V7634) (cond ((and (cons? V7634) (and (= type (hd V7634)) (and (cons? (tl V7634)) (and (cons? (tl (tl V7634))) (= () (tl (tl (tl V7634)))))))) V7634) ((and (cons? V7634) (and (= let (hd V7634)) (and (cons? (tl V7634)) (and (cons? (tl (tl V7634))) (and (cons? (tl (tl (tl V7634)))) (= () (tl (tl (tl (tl V7634)))))))))) (cons let (cons (hd (tl V7634)) (cons (shen.x.type-annotations.annotate V7632 V7633 (hd (tl (tl V7634)))) (cons (shen.x.type-annotations.annotate (cons (hd (tl V7634)) V7632) V7633 (hd (tl (tl (tl V7634))))) ()))))) ((and (cons? V7634) (and (= lambda (hd V7634)) (and (cons? (tl V7634)) (and (cons? (tl (tl V7634))) (= () (tl (tl (tl V7634)))))))) (cons lambda (cons (hd (tl V7634)) (cons (shen.x.type-annotations.annotate (cons (hd (tl V7634)) V7632) V7633 (hd (tl (tl V7634)))) ())))) ((and (cons? V7634) (= cond (hd V7634))) (cons cond (shen.x.type-annotations.annotate-cases V7632 V7633 (tl V7634)))) ((cons? V7634) (let W7635 (shen.x.type-annotations.function-type (hd V7634)) (let W7636 (shen.x.type-annotations.type-table W7635 (tl V7634)) (cons (hd V7634) (map (lambda Z7637 (shen.x.type-annotations.annotate V7632 (append V7633 W7636) Z7637)) (tl V7634)))))) (true (let W7638 (assoc V7634 V7633) (if (cons? W7638) (cons type (cons V7634 (cons (tl W7638) ()))) (if (element? V7634 V7632) V7634 (shen.x.type-annotations.atom-type V7634))))))) -(defun shen.x.type-annotations.annotate-cases (V7619 V7620 V7621) (cond ((= () V7621) ()) ((and (cons? V7621) (and (cons? (hd V7621)) (and (cons? (tl (hd V7621))) (= () (tl (tl (hd V7621))))))) (cons (cons (shen.x.type-annotations.annotate V7619 V7620 (hd (hd V7621))) (cons (shen.x.type-annotations.annotate V7619 V7620 (hd (tl (hd V7621)))) ())) (shen.x.type-annotations.annotate-cases V7619 V7620 (tl V7621)))) (true V7621))) +(defun shen.x.type-annotations.annotate-cases (V7647 V7648 V7649) (cond ((= () V7649) ()) ((and (cons? V7649) (and (cons? (hd V7649)) (and (cons? (tl (hd V7649))) (= () (tl (tl (hd V7649))))))) (cons (cons (shen.x.type-annotations.annotate V7647 V7648 (hd (hd V7649))) (cons (shen.x.type-annotations.annotate V7647 V7648 (hd (tl (hd V7649)))) ())) (shen.x.type-annotations.annotate-cases V7647 V7648 (tl V7649)))) (true V7649))) -(defun shen.x.type-annotations.atom-type (V7622) (if (string? V7622) (cons type (cons V7622 (cons string ()))) (if (number? V7622) (cons type (cons V7622 (cons number ()))) (if (boolean? V7622) (cons type (cons V7622 (cons boolean ()))) (if (symbol? V7622) (cons type (cons V7622 (cons symbol ()))) V7622))))) +(defun shen.x.type-annotations.atom-type (V7650) (if (string? V7650) (cons type (cons V7650 (cons string ()))) (if (number? V7650) (cons type (cons V7650 (cons number ()))) (if (boolean? V7650) (cons type (cons V7650 (cons boolean ()))) (if (symbol? V7650) (cons type (cons V7650 (cons symbol ()))) V7650))))) diff --git a/klambda/init.kl b/klambda/init.kl index 783e414..3a3599d 100644 --- a/klambda/init.kl +++ b/klambda/init.kl @@ -1,6 +1,6 @@ (defun shen.initialise-environment () (do (set shen.*history* ()) (do (set shen.*tc* false) (do (set *property-vector* (shen.dict 20000)) (do (set *macros* (cons (cons shen.macros (lambda X (shen.macros X))) ())) (do (set shen.*source-form-handlers* ()) (do (set shen.*gensym* 0) (do (set shen.*tracking* ()) (do (set shen.*profiled* ()) (do (set shen.*special* (cons @p (cons @s (cons @v (cons cons (cons lambda (cons let (cons where (cons set (cons open (cons shen.input-h+ (cons type ())))))))))))) (do (set shen.*extraspecial* ()) (do (set shen.*spy* false) (do (set shen.*datatypes* ()) (do (set shen.*alldatatypes* ()) (do (set shen.*shen-type-theory-enabled?* true) (do (set shen.*package* null) (do (set shen.*synonyms* ()) (do (set shen.*occurs* true) (do (set shen.*factorise?* false) (do (set shen.*maxinferences* 1000000) (do (set *maximum-print-sequence-size* 20) (do (set shen.*call* 0) (do (set shen.*infs* 0) (do (set *hush* false) (do (set shen.*optimise* false) (do (set *version* "43.1") (do (set shen.*names* ()) (do (set shen.*step* false) (do (set shen.*it* "") (do (set shen.*residue* ()) (do (set *absolute* ()) (do (set shen.*prolog-memory* 1000) (do (set shen.*loading?* false) (do (set shen.*userdefs* ()) (do (set shen.*demodulation-function* (lambda X X)) (do (set shen.*custom-pattern-compiler* false) (do (set shen.*custom-pattern-reducer* false) (do (if (not (bound? *home-directory*)) (set *home-directory* "") shen.skip) (do (if (not (bound? *sterror*)) (set *sterror* (value *stoutput*)) shen.skip) (do (prolog-memory 10000) (do (set shen.*loading?* false) (do (shen.initialise-arity-table (cons abort (cons 0 (cons absolute (cons 1 (cons absvector? (cons 1 (cons absvector (cons 1 (cons address-> (cons 3 (cons adjoin (cons 2 (cons and (cons 2 (cons append (cons 2 (cons arity (cons 1 (cons assoc (cons 2 (cons atom? (cons 1 (cons boolean? (cons 1 (cons bootstrap (cons 1 (cons bound? (cons 1 (cons bind (cons 6 (cons call (cons 5 (cons cd (cons 1 (cons char-stream? (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 read-unit-string (cons 1 (cons receive (cons 1 (cons release (cons 0 (cons shen.register-source-form (cons 2 (cons shen.unregister-source-form (cons 1 (cons remove (cons 2 (cons reverse (cons 1 (cons set (cons 2 (cons simple-error (cons 1 (cons snd (cons 1 (cons specialise (cons 2 (cons spy (cons 1 (cons 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-string (cons 2 (cons write-to-file (cons 2 (cons y-or-n? (cons 1 (cons + (cons 2 (cons * (cons 2 (cons / (cons 2 (cons - (cons 2 (cons == (cons 2 (cons (cons 1 (cons (cons 1 (cons (cons 1 (cons @p (cons 2 (cons @v (cons 2 (cons @s (cons 2 ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (do (put shen shen.external-symbols (cons ! (cons } (cons { (cons --> (cons <-- (cons && (cons (intern ":") (cons (intern ";") (cons (intern ":=") (cons (intern ",") (cons _ (cons *language* (cons *implementation* (cons *stinput* (cons *sterror* (cons *stoutput* (cons *home-directory* (cons *version* (cons *maximum-print-sequence-size* (cons *macros* (cons *os* (cons *release* (cons *property-vector* (cons @v (cons @p (cons @s (cons *port* (cons *porters* (cons *hush* (cons <- (cons -> (cons (cons == (cons = (cons >= (cons > (cons ==> (cons /. (cons (cons (cons $ (cons - (cons / (cons * (cons + (cons <= (cons < (cons >> (cons (vector 0) (cons y-or-n? (cons write-string (cons write-to-file (cons write-byte (cons where (cons when (cons warn (cons version (cons verified (cons variable? (cons var? (cons value (cons vector-> (cons <-vector (cons vector (cons vector? (cons 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 sterror (cons stoutput (cons step (cons sqts (cons spy (cons specialise (cons snd (cons simple-error (cons set (cons save (cons str (cons run (cons reverse (cons retract (cons remove (cons release (cons read (cons receive (cons read-file (cons read-file-as-bytelist (cons read-file-as-string (cons read-byte (cons read-from-string (cons read-from-string-unprocessed (cons read-unit-string (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 inline (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 char-stream? (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*)) (set shen.*empty-absvector* (absvector 0))))))))))))))))))))))))))))))))))))))))))))) -(defun shen.initialise-signedfuncs () (do (set shen.*sigf* ()) (do (set shen.*sigf* (shen.assoc-> shen.register-source-form (lambda V6045 (lambda B6041 (lambda L6042 (lambda Key6043 (lambda C6044 (let A (shen.newpv B6041) (shen.gc B6041 (let B (shen.newpv B6041) (shen.gc B6041 (is! V6045 (cons symbol (cons --> (cons (cons (cons A (cons --> (cons (cons list (cons B ())) ()))) (cons --> (cons symbol ()))) ()))) B6041 L6042 Key6043 C6044)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.unregister-source-form (lambda V6050 (lambda B6046 (lambda L6047 (lambda Key6048 (lambda C6049 (is! V6050 (cons symbol (cons --> (cons symbol ()))) B6046 L6047 Key6048 C6049)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> abort (lambda V6055 (lambda B6051 (lambda L6052 (lambda Key6053 (lambda C6054 (let A (shen.newpv B6051) (shen.gc B6051 (is! V6055 (cons --> (cons A ())) B6051 L6052 Key6053 C6054)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> absolute (lambda V6060 (lambda B6056 (lambda L6057 (lambda Key6058 (lambda C6059 (is! V6060 (cons string (cons --> (cons (cons list (cons string ())) ()))) B6056 L6057 Key6058 C6059)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> absvector? (lambda V6065 (lambda B6061 (lambda L6062 (lambda Key6063 (lambda C6064 (let A (shen.newpv B6061) (shen.gc B6061 (is! V6065 (cons A (cons --> (cons boolean ()))) B6061 L6062 Key6063 C6064)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> adjoin (lambda V6071 (lambda B6067 (lambda L6068 (lambda Key6069 (lambda C6070 (let A (shen.newpv B6067) (shen.gc B6067 (is! V6071 (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6067 L6068 Key6069 C6070)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> and (lambda V6076 (lambda B6072 (lambda L6073 (lambda Key6074 (lambda C6075 (is! V6076 (cons boolean (cons --> (cons (cons boolean (cons --> (cons boolean ()))) ()))) B6072 L6073 Key6074 C6075)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.app (lambda V6081 (lambda B6077 (lambda L6078 (lambda Key6079 (lambda C6080 (let A (shen.newpv B6077) (shen.gc B6077 (is! V6081 (cons A (cons --> (cons (cons string (cons --> (cons (cons symbol (cons --> (cons string ()))) ()))) ()))) B6077 L6078 Key6079 C6080)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> append (lambda V6088 (lambda B6084 (lambda L6085 (lambda Key6086 (lambda C6087 (let A (shen.newpv B6084) (shen.gc B6084 (is! V6088 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6084 L6085 Key6086 C6087)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> arity (lambda V6093 (lambda B6089 (lambda L6090 (lambda Key6091 (lambda C6092 (let A (shen.newpv B6089) (shen.gc B6089 (is! V6093 (cons A (cons --> (cons number ()))) B6089 L6090 Key6091 C6092)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> assoc (lambda V6099 (lambda B6095 (lambda L6096 (lambda Key6097 (lambda C6098 (let A (shen.newpv B6095) (shen.gc B6095 (is! V6099 (cons A (cons --> (cons (cons (cons list (cons (cons list (cons A ())) ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6095 L6096 Key6097 C6098)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> atom? (lambda V6104 (lambda B6100 (lambda L6101 (lambda Key6102 (lambda C6103 (let A (shen.newpv B6100) (shen.gc B6100 (is! V6104 (cons A (cons --> (cons boolean ()))) B6100 L6101 Key6102 C6103)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> boolean? (lambda V6109 (lambda B6105 (lambda L6106 (lambda Key6107 (lambda C6108 (let A (shen.newpv B6105) (shen.gc B6105 (is! V6109 (cons A (cons --> (cons boolean ()))) B6105 L6106 Key6107 C6108)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> bootstrap (lambda V6114 (lambda B6110 (lambda L6111 (lambda Key6112 (lambda C6113 (is! V6114 (cons string (cons --> (cons string ()))) B6110 L6111 Key6112 C6113)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> bound? (lambda V6119 (lambda B6115 (lambda L6116 (lambda Key6117 (lambda C6118 (is! V6119 (cons symbol (cons --> (cons boolean ()))) B6115 L6116 Key6117 C6118)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.ccons? (lambda V6124 (lambda B6120 (lambda L6121 (lambda Key6122 (lambda C6123 (let A (shen.newpv B6120) (shen.gc B6120 (is! V6124 (cons (cons list (cons A ())) (cons --> (cons boolean ()))) B6120 L6121 Key6122 C6123)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> cd (lambda V6129 (lambda B6125 (lambda L6126 (lambda Key6127 (lambda C6128 (is! V6129 (cons string (cons --> (cons string ()))) B6125 L6126 Key6127 C6128)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> close (lambda V6135 (lambda B6131 (lambda L6132 (lambda Key6133 (lambda C6134 (let A (shen.newpv B6131) (shen.gc B6131 (let B (shen.newpv B6131) (shen.gc B6131 (is! V6135 (cons (cons stream (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) B6131 L6132 Key6133 C6134)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> cn (lambda V6140 (lambda B6136 (lambda L6137 (lambda Key6138 (lambda C6139 (is! V6140 (cons string (cons --> (cons (cons string (cons --> (cons string ()))) ()))) B6136 L6137 Key6138 C6139)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> char-stream? (lambda V6145 (lambda B6141 (lambda L6142 (lambda Key6143 (lambda C6144 (let A (shen.newpv B6141) (shen.gc B6141 (is! V6145 (cons (cons stream (cons A ())) (cons --> (cons boolean ()))) B6141 L6142 Key6143 C6144)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> compile (lambda V6152 (lambda B6148 (lambda L6149 (lambda Key6150 (lambda C6151 (let A (shen.newpv B6148) (shen.gc B6148 (let B (shen.newpv B6148) (shen.gc B6148 (is! V6152 (cons (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons B ()))) ()))) B6148 L6149 Key6150 C6151)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> cons? (lambda V6157 (lambda B6153 (lambda L6154 (lambda Key6155 (lambda C6156 (let A (shen.newpv B6153) (shen.gc B6153 (is! V6157 (cons A (cons --> (cons boolean ()))) B6153 L6154 Key6155 C6156)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> datatypes (lambda V6162 (lambda B6158 (lambda L6159 (lambda Key6160 (lambda C6161 (is! V6162 (cons --> (cons (cons list (cons symbol ())) ())) B6158 L6159 Key6160 C6161)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> destroy (lambda V6167 (lambda B6163 (lambda L6164 (lambda Key6165 (lambda C6166 (is! V6167 (cons symbol (cons --> (cons symbol ()))) B6163 L6164 Key6165 C6166)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> difference (lambda V6174 (lambda B6170 (lambda L6171 (lambda Key6172 (lambda C6173 (let A (shen.newpv B6170) (shen.gc B6170 (is! V6174 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6170 L6171 Key6172 C6173)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> do (lambda V6179 (lambda B6175 (lambda L6176 (lambda Key6177 (lambda C6178 (let A (shen.newpv B6175) (shen.gc B6175 (let B (shen.newpv B6175) (shen.gc B6175 (is! V6179 (cons A (cons --> (cons (cons B (cons --> (cons B ()))) ()))) B6175 L6176 Key6177 C6178)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> (lambda V6186 (lambda B6182 (lambda L6183 (lambda Key6184 (lambda C6185 (let A (shen.newpv B6182) (shen.gc B6182 (let B (shen.newpv B6182) (shen.gc B6182 (is! V6186 (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons (cons list (cons B ())) ()))) ()))) B6182 L6183 Key6184 C6185)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> (lambda V6193 (lambda B6189 (lambda L6190 (lambda Key6191 (lambda C6192 (let B (shen.newpv B6189) (shen.gc B6189 (let A (shen.newpv B6189) (shen.gc B6189 (is! V6193 (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons B ())) (cons (cons list (cons A ())) ()))) ()))) B6189 L6190 Key6191 C6192)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> (lambda V6200 (lambda B6196 (lambda L6197 (lambda Key6198 (lambda C6199 (let A (shen.newpv B6196) (shen.gc B6196 (let B (shen.newpv B6196) (shen.gc B6196 (is! V6200 (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons (cons list (cons B ())) ()))) ()))) B6196 L6197 Key6198 C6199)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.parse-failure? (lambda V6205 (lambda B6201 (lambda L6202 (lambda Key6203 (lambda C6204 (let A (shen.newpv B6201) (shen.gc B6201 (let B (shen.newpv B6201) (shen.gc B6201 (is! V6205 (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons boolean ()))) B6201 L6202 Key6203 C6204)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.parse-failure (lambda V6210 (lambda B6206 (lambda L6207 (lambda Key6208 (lambda C6209 (let A (shen.newpv B6206) (shen.gc B6206 (let B (shen.newpv B6206) (shen.gc B6206 (is! V6210 (cons --> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) ())) B6206 L6207 Key6208 C6209)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.<-out (lambda V6215 (lambda B6211 (lambda L6212 (lambda Key6213 (lambda C6214 (let A (shen.newpv B6211) (shen.gc B6211 (let B (shen.newpv B6211) (shen.gc B6211 (is! V6215 (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons B ()))) B6211 L6212 Key6213 C6214)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.in-> (lambda V6221 (lambda B6217 (lambda L6218 (lambda Key6219 (lambda C6220 (let B (shen.newpv B6217) (shen.gc B6217 (let A (shen.newpv B6217) (shen.gc B6217 (is! V6221 (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons (cons list (cons A ())) ()))) B6217 L6218 Key6219 C6220)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.comb (lambda V6227 (lambda B6223 (lambda L6224 (lambda Key6225 (lambda C6226 (let A (shen.newpv B6223) (shen.gc B6223 (let B (shen.newpv B6223) (shen.gc B6223 (is! V6227 (cons (cons list (cons A ())) (cons --> (cons (cons B (cons --> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) ()))) ()))) B6223 L6224 Key6225 C6226)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> element? (lambda V6232 (lambda B6228 (lambda L6229 (lambda Key6230 (lambda C6231 (let A (shen.newpv B6228) (shen.gc B6228 (is! V6232 (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons boolean ()))) ()))) B6228 L6229 Key6230 C6231)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> empty? (lambda V6237 (lambda B6233 (lambda L6234 (lambda Key6235 (lambda C6236 (let A (shen.newpv B6233) (shen.gc B6233 (is! V6237 (cons A (cons --> (cons boolean ()))) B6233 L6234 Key6235 C6236)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> enable-type-theory (lambda V6242 (lambda B6238 (lambda L6239 (lambda Key6240 (lambda C6241 (is! V6242 (cons symbol (cons --> (cons boolean ()))) B6238 L6239 Key6240 C6241)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> external (lambda V6247 (lambda B6243 (lambda L6244 (lambda Key6245 (lambda C6246 (is! V6247 (cons symbol (cons --> (cons (cons list (cons symbol ())) ()))) B6243 L6244 Key6245 C6246)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> error-to-string (lambda V6252 (lambda B6248 (lambda L6249 (lambda Key6250 (lambda C6251 (is! V6252 (cons exception (cons --> (cons string ()))) B6248 L6249 Key6250 C6251)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> explode (lambda V6257 (lambda B6253 (lambda L6254 (lambda Key6255 (lambda C6256 (let A (shen.newpv B6253) (shen.gc B6253 (is! V6257 (cons A (cons --> (cons (cons list (cons string ())) ()))) B6253 L6254 Key6255 C6256)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> factorise (lambda V6262 (lambda B6258 (lambda L6259 (lambda Key6260 (lambda C6261 (is! V6262 (cons symbol (cons --> (cons symbol ()))) B6258 L6259 Key6260 C6261)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> factorise? (lambda V6267 (lambda B6263 (lambda L6264 (lambda Key6265 (lambda C6266 (is! V6267 (cons --> (cons boolean ())) B6263 L6264 Key6265 C6266)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> fail (lambda V6272 (lambda B6268 (lambda L6269 (lambda Key6270 (lambda C6271 (is! V6272 (cons --> (cons symbol ())) B6268 L6269 Key6270 C6271)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> fix (lambda V6278 (lambda B6274 (lambda L6275 (lambda Key6276 (lambda C6277 (let A (shen.newpv B6274) (shen.gc B6274 (is! V6278 (cons (cons A (cons --> (cons A ()))) (cons --> (cons (cons A (cons --> (cons A ()))) ()))) B6274 L6275 Key6276 C6277)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> freeze (lambda V6283 (lambda B6279 (lambda L6280 (lambda Key6281 (lambda C6282 (let A (shen.newpv B6279) (shen.gc B6279 (is! V6283 (cons A (cons --> (cons (cons lazy (cons A ())) ()))) B6279 L6280 Key6281 C6282)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> fst (lambda V6288 (lambda B6284 (lambda L6285 (lambda Key6286 (lambda C6287 (let B (shen.newpv B6284) (shen.gc B6284 (let A (shen.newpv B6284) (shen.gc B6284 (is! V6288 (cons (cons A (cons * (cons B ()))) (cons --> (cons A ()))) B6284 L6285 Key6286 C6287)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> gensym (lambda V6293 (lambda B6289 (lambda L6290 (lambda Key6291 (lambda C6292 (is! V6293 (cons symbol (cons --> (cons symbol ()))) B6289 L6290 Key6291 C6292)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.hds=? (lambda V6299 (lambda B6295 (lambda L6296 (lambda Key6297 (lambda C6298 (let A (shen.newpv B6295) (shen.gc B6295 (is! V6299 (cons (cons list (cons A ())) (cons --> (cons (cons A (cons --> (cons boolean ()))) ()))) B6295 L6296 Key6297 C6298)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hush (lambda V6304 (lambda B6300 (lambda L6301 (lambda Key6302 (lambda C6303 (is! V6304 (cons symbol (cons --> (cons boolean ()))) B6300 L6301 Key6302 C6303)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hush? (lambda V6309 (lambda B6305 (lambda L6306 (lambda Key6307 (lambda C6308 (is! V6309 (cons --> (cons boolean ())) B6305 L6306 Key6307 C6308)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> <-vector (lambda V6315 (lambda B6311 (lambda L6312 (lambda Key6313 (lambda C6314 (let A (shen.newpv B6311) (shen.gc B6311 (is! V6315 (cons (cons vector (cons A ())) (cons --> (cons (cons number (cons --> (cons A ()))) ()))) B6311 L6312 Key6313 C6314)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> vector-> (lambda V6321 (lambda B6317 (lambda L6318 (lambda Key6319 (lambda C6320 (let A (shen.newpv B6317) (shen.gc B6317 (is! V6321 (cons (cons vector (cons A ())) (cons --> (cons (cons number (cons --> (cons (cons A (cons --> (cons (cons vector (cons A ())) ()))) ()))) ()))) B6317 L6318 Key6319 C6320)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> vector (lambda V6326 (lambda B6322 (lambda L6323 (lambda Key6324 (lambda C6325 (let A (shen.newpv B6322) (shen.gc B6322 (is! V6326 (cons number (cons --> (cons (cons vector (cons A ())) ()))) B6322 L6323 Key6324 C6325)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> get-time (lambda V6331 (lambda B6327 (lambda L6328 (lambda Key6329 (lambda C6330 (is! V6331 (cons symbol (cons --> (cons number ()))) B6327 L6328 Key6329 C6330)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hash (lambda V6336 (lambda B6332 (lambda L6333 (lambda Key6334 (lambda C6335 (let A (shen.newpv B6332) (shen.gc B6332 (is! V6336 (cons A (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6332 L6333 Key6334 C6335)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> head (lambda V6341 (lambda B6337 (lambda L6338 (lambda Key6339 (lambda C6340 (let A (shen.newpv B6337) (shen.gc B6337 (is! V6341 (cons (cons list (cons A ())) (cons --> (cons A ()))) B6337 L6338 Key6339 C6340)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hdv (lambda V6346 (lambda B6342 (lambda L6343 (lambda Key6344 (lambda C6345 (let A (shen.newpv B6342) (shen.gc B6342 (is! V6346 (cons (cons vector (cons A ())) (cons --> (cons A ()))) B6342 L6343 Key6344 C6345)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hdstr (lambda V6351 (lambda B6347 (lambda L6348 (lambda Key6349 (lambda C6350 (is! V6351 (cons string (cons --> (cons string ()))) B6347 L6348 Key6349 C6350)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> if (lambda V6356 (lambda B6352 (lambda L6353 (lambda Key6354 (lambda C6355 (let A (shen.newpv B6352) (shen.gc B6352 (is! V6356 (cons boolean (cons --> (cons (cons A (cons --> (cons (cons A (cons --> (cons A ()))) ()))) ()))) B6352 L6353 Key6354 C6355)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> in-package (lambda V6361 (lambda B6357 (lambda L6358 (lambda Key6359 (lambda C6360 (is! V6361 (cons symbol (cons --> (cons symbol ()))) B6357 L6358 Key6359 C6360)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> it (lambda V6366 (lambda B6362 (lambda L6363 (lambda Key6364 (lambda C6365 (is! V6366 (cons --> (cons string ())) B6362 L6363 Key6364 C6365)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> implementation (lambda V6371 (lambda B6367 (lambda L6368 (lambda Key6369 (lambda C6370 (is! V6371 (cons --> (cons string ())) B6367 L6368 Key6369 C6370)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> include (lambda V6377 (lambda B6373 (lambda L6374 (lambda Key6375 (lambda C6376 (is! V6377 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) B6373 L6374 Key6375 C6376)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> include-all-but (lambda V6383 (lambda B6379 (lambda L6380 (lambda Key6381 (lambda C6382 (is! V6383 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) B6379 L6380 Key6381 C6382)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> included (lambda V6388 (lambda B6384 (lambda L6385 (lambda Key6386 (lambda C6387 (is! V6388 (cons --> (cons (cons list (cons symbol ())) ())) B6384 L6385 Key6386 C6387)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> inferences (lambda V6393 (lambda B6389 (lambda L6390 (lambda Key6391 (lambda C6392 (is! V6393 (cons --> (cons number ())) B6389 L6390 Key6391 C6392)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.insert (lambda V6398 (lambda B6394 (lambda L6395 (lambda Key6396 (lambda C6397 (let A (shen.newpv B6394) (shen.gc B6394 (is! V6398 (cons A (cons --> (cons (cons string (cons --> (cons string ()))) ()))) B6394 L6395 Key6396 C6397)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> integer? (lambda V6403 (lambda B6399 (lambda L6400 (lambda Key6401 (lambda C6402 (let A (shen.newpv B6399) (shen.gc B6399 (is! V6403 (cons A (cons --> (cons boolean ()))) B6399 L6400 Key6401 C6402)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> internal (lambda V6408 (lambda B6404 (lambda L6405 (lambda Key6406 (lambda C6407 (is! V6408 (cons symbol (cons --> (cons (cons list (cons symbol ())) ()))) B6404 L6405 Key6406 C6407)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> intersection (lambda V6415 (lambda B6411 (lambda L6412 (lambda Key6413 (lambda C6414 (let A (shen.newpv B6411) (shen.gc B6411 (is! V6415 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6411 L6412 Key6413 C6414)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> language (lambda V6420 (lambda B6416 (lambda L6417 (lambda Key6418 (lambda C6419 (is! V6420 (cons --> (cons string ())) B6416 L6417 Key6418 C6419)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> length (lambda V6425 (lambda B6421 (lambda L6422 (lambda Key6423 (lambda C6424 (let A (shen.newpv B6421) (shen.gc B6421 (is! V6425 (cons (cons list (cons A ())) (cons --> (cons number ()))) B6421 L6422 Key6423 C6424)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> limit (lambda V6430 (lambda B6426 (lambda L6427 (lambda Key6428 (lambda C6429 (let A (shen.newpv B6426) (shen.gc B6426 (is! V6430 (cons (cons vector (cons A ())) (cons --> (cons number ()))) B6426 L6427 Key6428 C6429)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> lineread (lambda V6436 (lambda B6432 (lambda L6433 (lambda Key6434 (lambda C6435 (is! V6436 (cons (cons stream (cons in ())) (cons --> (cons (cons list (cons unit ())) ()))) B6432 L6433 Key6434 C6435)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> load (lambda V6441 (lambda B6437 (lambda L6438 (lambda Key6439 (lambda C6440 (is! V6441 (cons string (cons --> (cons symbol ()))) B6437 L6438 Key6439 C6440)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> map (lambda V6448 (lambda B6444 (lambda L6445 (lambda Key6446 (lambda C6447 (let A (shen.newpv B6444) (shen.gc B6444 (let B (shen.newpv B6444) (shen.gc B6444 (is! V6448 (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) ()))) B6444 L6445 Key6446 C6447)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> mapcan (lambda V6455 (lambda B6451 (lambda L6452 (lambda Key6453 (lambda C6454 (let A (shen.newpv B6451) (shen.gc B6451 (let B (shen.newpv B6451) (shen.gc B6451 (is! V6455 (cons (cons A (cons --> (cons (cons list (cons B ())) ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) ()))) B6451 L6452 Key6453 C6454)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> maxinferences (lambda V6460 (lambda B6456 (lambda L6457 (lambda Key6458 (lambda C6459 (is! V6460 (cons number (cons --> (cons number ()))) B6456 L6457 Key6458 C6459)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> n->string (lambda V6465 (lambda B6461 (lambda L6462 (lambda Key6463 (lambda C6464 (is! V6465 (cons number (cons --> (cons string ()))) B6461 L6462 Key6463 C6464)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> nl (lambda V6470 (lambda B6466 (lambda L6467 (lambda Key6468 (lambda C6469 (is! V6470 (cons number (cons --> (cons number ()))) B6466 L6467 Key6468 C6469)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> not (lambda V6475 (lambda B6471 (lambda L6472 (lambda Key6473 (lambda C6474 (is! V6475 (cons boolean (cons --> (cons boolean ()))) B6471 L6472 Key6473 C6474)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> nth (lambda V6480 (lambda B6476 (lambda L6477 (lambda Key6478 (lambda C6479 (let A (shen.newpv B6476) (shen.gc B6476 (is! V6480 (cons number (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons A ()))) ()))) B6476 L6477 Key6478 C6479)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> number? (lambda V6485 (lambda B6481 (lambda L6482 (lambda Key6483 (lambda C6484 (let A (shen.newpv B6481) (shen.gc B6481 (is! V6485 (cons A (cons --> (cons boolean ()))) B6481 L6482 Key6483 C6484)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> occurrences (lambda V6490 (lambda B6486 (lambda L6487 (lambda Key6488 (lambda C6489 (let A (shen.newpv B6486) (shen.gc B6486 (let B (shen.newpv B6486) (shen.gc B6486 (is! V6490 (cons A (cons --> (cons (cons B (cons --> (cons number ()))) ()))) B6486 L6487 Key6488 C6489)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> occurs-check (lambda V6495 (lambda B6491 (lambda L6492 (lambda Key6493 (lambda C6494 (is! V6495 (cons symbol (cons --> (cons boolean ()))) B6491 L6492 Key6493 C6494)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> occurs? (lambda V6500 (lambda B6496 (lambda L6497 (lambda Key6498 (lambda C6499 (is! V6500 (cons --> (cons boolean ())) B6496 L6497 Key6498 C6499)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> optimise (lambda V6505 (lambda B6501 (lambda L6502 (lambda Key6503 (lambda C6504 (is! V6505 (cons symbol (cons --> (cons boolean ()))) B6501 L6502 Key6503 C6504)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> optimise? (lambda V6510 (lambda B6506 (lambda L6507 (lambda Key6508 (lambda C6509 (is! V6510 (cons --> (cons boolean ())) B6506 L6507 Key6508 C6509)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> or (lambda V6515 (lambda B6511 (lambda L6512 (lambda Key6513 (lambda C6514 (is! V6515 (cons boolean (cons --> (cons (cons boolean (cons --> (cons boolean ()))) ()))) B6511 L6512 Key6513 C6514)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> os (lambda V6520 (lambda B6516 (lambda L6517 (lambda Key6518 (lambda C6519 (is! V6520 (cons --> (cons string ())) B6516 L6517 Key6518 C6519)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> package? (lambda V6525 (lambda B6521 (lambda L6522 (lambda Key6523 (lambda C6524 (is! V6525 (cons symbol (cons --> (cons boolean ()))) B6521 L6522 Key6523 C6524)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> port (lambda V6530 (lambda B6526 (lambda L6527 (lambda Key6528 (lambda C6529 (is! V6530 (cons --> (cons string ())) B6526 L6527 Key6528 C6529)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> porters (lambda V6535 (lambda B6531 (lambda L6532 (lambda Key6533 (lambda C6534 (is! V6535 (cons --> (cons string ())) B6531 L6532 Key6533 C6534)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> pos (lambda V6540 (lambda B6536 (lambda L6537 (lambda Key6538 (lambda C6539 (is! V6540 (cons string (cons --> (cons (cons number (cons --> (cons string ()))) ()))) B6536 L6537 Key6538 C6539)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> pr (lambda V6545 (lambda B6541 (lambda L6542 (lambda Key6543 (lambda C6544 (is! V6545 (cons string (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons string ()))) ()))) B6541 L6542 Key6543 C6544)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> print (lambda V6550 (lambda B6546 (lambda L6547 (lambda Key6548 (lambda C6549 (let A (shen.newpv B6546) (shen.gc B6546 (is! V6550 (cons A (cons --> (cons A ()))) B6546 L6547 Key6548 C6549)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> profile (lambda V6555 (lambda B6551 (lambda L6552 (lambda Key6553 (lambda C6554 (is! V6555 (cons symbol (cons --> (cons symbol ()))) B6551 L6552 Key6553 C6554)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> preclude (lambda V6561 (lambda B6557 (lambda L6558 (lambda Key6559 (lambda C6560 (is! V6561 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) B6557 L6558 Key6559 C6560)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.proc-nl (lambda V6566 (lambda B6562 (lambda L6563 (lambda Key6564 (lambda C6565 (is! V6566 (cons string (cons --> (cons string ()))) B6562 L6563 Key6564 C6565)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> profile-results (lambda V6571 (lambda B6567 (lambda L6568 (lambda Key6569 (lambda C6570 (is! V6571 (cons symbol (cons --> (cons (cons symbol (cons * (cons number ()))) ()))) B6567 L6568 Key6569 C6570)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> protect (lambda V6576 (lambda B6572 (lambda L6573 (lambda Key6574 (lambda C6575 (let A (shen.newpv B6572) (shen.gc B6572 (is! V6576 (cons A (cons --> (cons A ()))) B6572 L6573 Key6574 C6575)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> preclude-all-but (lambda V6582 (lambda B6578 (lambda L6579 (lambda Key6580 (lambda C6581 (is! V6582 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) B6578 L6579 Key6580 C6581)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.prhush (lambda V6587 (lambda B6583 (lambda L6584 (lambda Key6585 (lambda C6586 (is! V6587 (cons string (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons string ()))) ()))) B6583 L6584 Key6585 C6586)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> prolog-memory (lambda V6592 (lambda B6588 (lambda L6589 (lambda Key6590 (lambda C6591 (is! V6592 (cons number (cons --> (cons number ()))) B6588 L6589 Key6590 C6591)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> ps (lambda V6597 (lambda B6593 (lambda L6594 (lambda Key6595 (lambda C6596 (is! V6597 (cons symbol (cons --> (cons (cons list (cons unit ())) ()))) B6593 L6594 Key6595 C6596)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read (lambda V6602 (lambda B6598 (lambda L6599 (lambda Key6600 (lambda C6601 (is! V6602 (cons (cons stream (cons in ())) (cons --> (cons unit ()))) B6598 L6599 Key6600 C6601)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-unit-string (lambda V6607 (lambda B6603 (lambda L6604 (lambda Key6605 (lambda C6606 (is! V6607 (cons (cons stream (cons in ())) (cons --> (cons string ()))) B6603 L6604 Key6605 C6606)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-byte (lambda V6612 (lambda B6608 (lambda L6609 (lambda Key6610 (lambda C6611 (is! V6612 (cons (cons stream (cons in ())) (cons --> (cons number ()))) B6608 L6609 Key6610 C6611)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-file-as-bytelist (lambda V6617 (lambda B6613 (lambda L6614 (lambda Key6615 (lambda C6616 (is! V6617 (cons string (cons --> (cons (cons list (cons number ())) ()))) B6613 L6614 Key6615 C6616)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-file-as-string (lambda V6622 (lambda B6618 (lambda L6619 (lambda Key6620 (lambda C6621 (is! V6622 (cons string (cons --> (cons string ()))) B6618 L6619 Key6620 C6621)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-file (lambda V6627 (lambda B6623 (lambda L6624 (lambda Key6625 (lambda C6626 (is! V6627 (cons string (cons --> (cons (cons list (cons unit ())) ()))) B6623 L6624 Key6625 C6626)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-from-string (lambda V6632 (lambda B6628 (lambda L6629 (lambda Key6630 (lambda C6631 (is! V6632 (cons string (cons --> (cons (cons list (cons unit ())) ()))) B6628 L6629 Key6630 C6631)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-from-string-unprocessed (lambda V6637 (lambda B6633 (lambda L6634 (lambda Key6635 (lambda C6636 (is! V6637 (cons string (cons --> (cons (cons list (cons unit ())) ()))) B6633 L6634 Key6635 C6636)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> release (lambda V6642 (lambda B6638 (lambda L6639 (lambda Key6640 (lambda C6641 (is! V6642 (cons --> (cons string ())) B6638 L6639 Key6640 C6641)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> remove (lambda V6648 (lambda B6644 (lambda L6645 (lambda Key6646 (lambda C6647 (let A (shen.newpv B6644) (shen.gc B6644 (is! V6648 (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6644 L6645 Key6646 C6647)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> reverse (lambda V6654 (lambda B6650 (lambda L6651 (lambda Key6652 (lambda C6653 (let A (shen.newpv B6650) (shen.gc B6650 (is! V6654 (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) B6650 L6651 Key6652 C6653)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> simple-error (lambda V6659 (lambda B6655 (lambda L6656 (lambda Key6657 (lambda C6658 (let A (shen.newpv B6655) (shen.gc B6655 (is! V6659 (cons string (cons --> (cons A ()))) B6655 L6656 Key6657 C6658)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> snd (lambda V6664 (lambda B6660 (lambda L6661 (lambda Key6662 (lambda C6663 (let A (shen.newpv B6660) (shen.gc B6660 (let B (shen.newpv B6660) (shen.gc B6660 (is! V6664 (cons (cons A (cons * (cons B ()))) (cons --> (cons B ()))) B6660 L6661 Key6662 C6663)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> specialise (lambda V6669 (lambda B6665 (lambda L6666 (lambda Key6667 (lambda C6668 (is! V6669 (cons symbol (cons --> (cons (cons number (cons --> (cons symbol ()))) ()))) B6665 L6666 Key6667 C6668)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> spy (lambda V6674 (lambda B6670 (lambda L6671 (lambda Key6672 (lambda C6673 (is! V6674 (cons symbol (cons --> (cons boolean ()))) B6670 L6671 Key6672 C6673)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> spy? (lambda V6679 (lambda B6675 (lambda L6676 (lambda Key6677 (lambda C6678 (is! V6679 (cons --> (cons boolean ())) B6675 L6676 Key6677 C6678)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> step (lambda V6684 (lambda B6680 (lambda L6681 (lambda Key6682 (lambda C6683 (is! V6684 (cons symbol (cons --> (cons boolean ()))) B6680 L6681 Key6682 C6683)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> step? (lambda V6689 (lambda B6685 (lambda L6686 (lambda Key6687 (lambda C6688 (is! V6689 (cons --> (cons boolean ())) B6685 L6686 Key6687 C6688)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> stinput (lambda V6694 (lambda B6690 (lambda L6691 (lambda Key6692 (lambda C6693 (is! V6694 (cons --> (cons (cons stream (cons in ())) ())) B6690 L6691 Key6692 C6693)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> sterror (lambda V6699 (lambda B6695 (lambda L6696 (lambda Key6697 (lambda C6698 (is! V6699 (cons --> (cons (cons stream (cons out ())) ())) B6695 L6696 Key6697 C6698)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> stoutput (lambda V6704 (lambda B6700 (lambda L6701 (lambda Key6702 (lambda C6703 (is! V6704 (cons --> (cons (cons stream (cons out ())) ())) B6700 L6701 Key6702 C6703)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> string? (lambda V6709 (lambda B6705 (lambda L6706 (lambda Key6707 (lambda C6708 (let A (shen.newpv B6705) (shen.gc B6705 (is! V6709 (cons A (cons --> (cons boolean ()))) B6705 L6706 Key6707 C6708)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> str (lambda V6714 (lambda B6710 (lambda L6711 (lambda Key6712 (lambda C6713 (let A (shen.newpv B6710) (shen.gc B6710 (is! V6714 (cons A (cons --> (cons string ()))) B6710 L6711 Key6712 C6713)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> string->n (lambda V6719 (lambda B6715 (lambda L6716 (lambda Key6717 (lambda C6718 (is! V6719 (cons string (cons --> (cons number ()))) B6715 L6716 Key6717 C6718)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> string->symbol (lambda V6724 (lambda B6720 (lambda L6721 (lambda Key6722 (lambda C6723 (is! V6724 (cons string (cons --> (cons symbol ()))) B6720 L6721 Key6722 C6723)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> sum (lambda V6729 (lambda B6725 (lambda L6726 (lambda Key6727 (lambda C6728 (is! V6729 (cons (cons list (cons number ())) (cons --> (cons number ()))) B6725 L6726 Key6727 C6728)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> symbol? (lambda V6734 (lambda B6730 (lambda L6731 (lambda Key6732 (lambda C6733 (let A (shen.newpv B6730) (shen.gc B6730 (is! V6734 (cons A (cons --> (cons boolean ()))) B6730 L6731 Key6732 C6733)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> systemf (lambda V6739 (lambda B6735 (lambda L6736 (lambda Key6737 (lambda C6738 (is! V6739 (cons symbol (cons --> (cons symbol ()))) B6735 L6736 Key6737 C6738)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> system-S? (lambda V6744 (lambda B6740 (lambda L6741 (lambda Key6742 (lambda C6743 (is! V6744 (cons --> (cons boolean ())) B6740 L6741 Key6742 C6743)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tail (lambda V6750 (lambda B6746 (lambda L6747 (lambda Key6748 (lambda C6749 (let A (shen.newpv B6746) (shen.gc B6746 (is! V6750 (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) B6746 L6747 Key6748 C6749)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tlstr (lambda V6755 (lambda B6751 (lambda L6752 (lambda Key6753 (lambda C6754 (is! V6755 (cons string (cons --> (cons string ()))) B6751 L6752 Key6753 C6754)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tlv (lambda V6761 (lambda B6757 (lambda L6758 (lambda Key6759 (lambda C6760 (let A (shen.newpv B6757) (shen.gc B6757 (is! V6761 (cons (cons vector (cons A ())) (cons --> (cons (cons vector (cons A ())) ()))) B6757 L6758 Key6759 C6760)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tc (lambda V6766 (lambda B6762 (lambda L6763 (lambda Key6764 (lambda C6765 (is! V6766 (cons symbol (cons --> (cons boolean ()))) B6762 L6763 Key6764 C6765)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tc? (lambda V6771 (lambda B6767 (lambda L6768 (lambda Key6769 (lambda C6770 (is! V6771 (cons --> (cons boolean ())) B6767 L6768 Key6769 C6770)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> thaw (lambda V6776 (lambda B6772 (lambda L6773 (lambda Key6774 (lambda C6775 (let A (shen.newpv B6772) (shen.gc B6772 (is! V6776 (cons (cons lazy (cons A ())) (cons --> (cons A ()))) B6772 L6773 Key6774 C6775)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> track (lambda V6781 (lambda B6777 (lambda L6778 (lambda Key6779 (lambda C6780 (is! V6781 (cons symbol (cons --> (cons symbol ()))) B6777 L6778 Key6779 C6780)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tracked (lambda V6786 (lambda B6782 (lambda L6783 (lambda Key6784 (lambda C6785 (is! V6786 (cons --> (cons (cons list (cons symbol ())) ())) B6782 L6783 Key6784 C6785)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> trap-error (lambda V6791 (lambda B6787 (lambda L6788 (lambda Key6789 (lambda C6790 (let A (shen.newpv B6787) (shen.gc B6787 (is! V6791 (cons A (cons --> (cons (cons (cons exception (cons --> (cons A ()))) (cons --> (cons A ()))) ()))) B6787 L6788 Key6789 C6790)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tuple? (lambda V6796 (lambda B6792 (lambda L6793 (lambda Key6794 (lambda C6795 (let A (shen.newpv B6792) (shen.gc B6792 (is! V6796 (cons A (cons --> (cons boolean ()))) B6792 L6793 Key6794 C6795)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> unabsolute (lambda V6801 (lambda B6797 (lambda L6798 (lambda Key6799 (lambda C6800 (is! V6801 (cons string (cons --> (cons (cons list (cons string ())) ()))) B6797 L6798 Key6799 C6800)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> undefmacro (lambda V6806 (lambda B6802 (lambda L6803 (lambda Key6804 (lambda C6805 (is! V6806 (cons symbol (cons --> (cons symbol ()))) B6802 L6803 Key6804 C6805)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> union (lambda V6813 (lambda B6809 (lambda L6810 (lambda Key6811 (lambda C6812 (let A (shen.newpv B6809) (shen.gc B6809 (is! V6813 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6809 L6810 Key6811 C6812)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> unprofile (lambda V6818 (lambda B6814 (lambda L6815 (lambda Key6816 (lambda C6817 (is! V6818 (cons symbol (cons --> (cons symbol ()))) B6814 L6815 Key6816 C6817)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> untrack (lambda V6823 (lambda B6819 (lambda L6820 (lambda Key6821 (lambda C6822 (is! V6823 (cons symbol (cons --> (cons symbol ()))) B6819 L6820 Key6821 C6822)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> userdefs (lambda V6828 (lambda B6824 (lambda L6825 (lambda Key6826 (lambda C6827 (is! V6828 (cons --> (cons (cons list (cons symbol ())) ())) B6824 L6825 Key6826 C6827)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> variable? (lambda V6833 (lambda B6829 (lambda L6830 (lambda Key6831 (lambda C6832 (let A (shen.newpv B6829) (shen.gc B6829 (is! V6833 (cons A (cons --> (cons boolean ()))) B6829 L6830 Key6831 C6832)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> vector? (lambda V6838 (lambda B6834 (lambda L6835 (lambda Key6836 (lambda C6837 (let A (shen.newpv B6834) (shen.gc B6834 (is! V6838 (cons A (cons --> (cons boolean ()))) B6834 L6835 Key6836 C6837)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> version (lambda V6843 (lambda B6839 (lambda L6840 (lambda Key6841 (lambda C6842 (is! V6843 (cons --> (cons string ())) B6839 L6840 Key6841 C6842)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> write-to-file (lambda V6848 (lambda B6844 (lambda L6845 (lambda Key6846 (lambda C6847 (let A (shen.newpv B6844) (shen.gc B6844 (is! V6848 (cons string (cons --> (cons (cons A (cons --> (cons A ()))) ()))) B6844 L6845 Key6846 C6847)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> write-byte (lambda V6853 (lambda B6849 (lambda L6850 (lambda Key6851 (lambda C6852 (is! V6853 (cons number (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons number ()))) ()))) B6849 L6850 Key6851 C6852)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> write-string (lambda V6858 (lambda B6854 (lambda L6855 (lambda Key6856 (lambda C6857 (is! V6858 (cons string (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons string ()))) ()))) B6854 L6855 Key6856 C6857)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> y-or-n? (lambda V6863 (lambda B6859 (lambda L6860 (lambda Key6861 (lambda C6862 (is! V6863 (cons string (cons --> (cons boolean ()))) B6859 L6860 Key6861 C6862)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> > (lambda V6868 (lambda B6864 (lambda L6865 (lambda Key6866 (lambda C6867 (is! V6868 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) B6864 L6865 Key6866 C6867)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> < (lambda V6873 (lambda B6869 (lambda L6870 (lambda Key6871 (lambda C6872 (is! V6873 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) B6869 L6870 Key6871 C6872)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> >= (lambda V6878 (lambda B6874 (lambda L6875 (lambda Key6876 (lambda C6877 (is! V6878 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) B6874 L6875 Key6876 C6877)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> <= (lambda V6883 (lambda B6879 (lambda L6880 (lambda Key6881 (lambda C6882 (is! V6883 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) B6879 L6880 Key6881 C6882)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> = (lambda V6888 (lambda B6884 (lambda L6885 (lambda Key6886 (lambda C6887 (let A (shen.newpv B6884) (shen.gc B6884 (is! V6888 (cons A (cons --> (cons (cons A (cons --> (cons boolean ()))) ()))) B6884 L6885 Key6886 C6887)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> + (lambda V6893 (lambda B6889 (lambda L6890 (lambda Key6891 (lambda C6892 (is! V6893 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6889 L6890 Key6891 C6892)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> / (lambda V6898 (lambda B6894 (lambda L6895 (lambda Key6896 (lambda C6897 (is! V6898 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6894 L6895 Key6896 C6897)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> - (lambda V6903 (lambda B6899 (lambda L6900 (lambda Key6901 (lambda C6902 (is! V6903 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6899 L6900 Key6901 C6902)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> * (lambda V6908 (lambda B6904 (lambda L6905 (lambda Key6906 (lambda C6907 (is! V6908 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6904 L6905 Key6906 C6907)))))) (value shen.*sigf*))) (set shen.*sigf* (shen.assoc-> == (lambda V6913 (lambda B6909 (lambda L6910 (lambda Key6911 (lambda C6912 (let A (shen.newpv B6909) (shen.gc B6909 (let B (shen.newpv B6909) (shen.gc B6909 (is! V6913 (cons A (cons --> (cons (cons B (cons --> (cons boolean ()))) ()))) B6909 L6910 Key6911 C6912)))))))))) (value shen.*sigf*))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) +(defun shen.initialise-signedfuncs () (do (set shen.*sigf* ()) (do (set shen.*sigf* (shen.assoc-> shen.register-source-form (lambda V6073 (lambda B6069 (lambda L6070 (lambda Key6071 (lambda C6072 (let A (shen.newpv B6069) (shen.gc B6069 (let B (shen.newpv B6069) (shen.gc B6069 (is! V6073 (cons symbol (cons --> (cons (cons (cons A (cons --> (cons (cons list (cons B ())) ()))) (cons --> (cons symbol ()))) ()))) B6069 L6070 Key6071 C6072)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.unregister-source-form (lambda V6078 (lambda B6074 (lambda L6075 (lambda Key6076 (lambda C6077 (is! V6078 (cons symbol (cons --> (cons symbol ()))) B6074 L6075 Key6076 C6077)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> abort (lambda V6083 (lambda B6079 (lambda L6080 (lambda Key6081 (lambda C6082 (let A (shen.newpv B6079) (shen.gc B6079 (is! V6083 (cons --> (cons A ())) B6079 L6080 Key6081 C6082)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> absolute (lambda V6088 (lambda B6084 (lambda L6085 (lambda Key6086 (lambda C6087 (is! V6088 (cons string (cons --> (cons (cons list (cons string ())) ()))) B6084 L6085 Key6086 C6087)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> absvector? (lambda V6093 (lambda B6089 (lambda L6090 (lambda Key6091 (lambda C6092 (let A (shen.newpv B6089) (shen.gc B6089 (is! V6093 (cons A (cons --> (cons boolean ()))) B6089 L6090 Key6091 C6092)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> adjoin (lambda V6099 (lambda B6095 (lambda L6096 (lambda Key6097 (lambda C6098 (let A (shen.newpv B6095) (shen.gc B6095 (is! V6099 (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6095 L6096 Key6097 C6098)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> and (lambda V6104 (lambda B6100 (lambda L6101 (lambda Key6102 (lambda C6103 (is! V6104 (cons boolean (cons --> (cons (cons boolean (cons --> (cons boolean ()))) ()))) B6100 L6101 Key6102 C6103)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.app (lambda V6109 (lambda B6105 (lambda L6106 (lambda Key6107 (lambda C6108 (let A (shen.newpv B6105) (shen.gc B6105 (is! V6109 (cons A (cons --> (cons (cons string (cons --> (cons (cons symbol (cons --> (cons string ()))) ()))) ()))) B6105 L6106 Key6107 C6108)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> append (lambda V6116 (lambda B6112 (lambda L6113 (lambda Key6114 (lambda C6115 (let A (shen.newpv B6112) (shen.gc B6112 (is! V6116 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6112 L6113 Key6114 C6115)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> arity (lambda V6121 (lambda B6117 (lambda L6118 (lambda Key6119 (lambda C6120 (let A (shen.newpv B6117) (shen.gc B6117 (is! V6121 (cons A (cons --> (cons number ()))) B6117 L6118 Key6119 C6120)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> assoc (lambda V6127 (lambda B6123 (lambda L6124 (lambda Key6125 (lambda C6126 (let A (shen.newpv B6123) (shen.gc B6123 (is! V6127 (cons A (cons --> (cons (cons (cons list (cons (cons list (cons A ())) ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6123 L6124 Key6125 C6126)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> atom? (lambda V6132 (lambda B6128 (lambda L6129 (lambda Key6130 (lambda C6131 (let A (shen.newpv B6128) (shen.gc B6128 (is! V6132 (cons A (cons --> (cons boolean ()))) B6128 L6129 Key6130 C6131)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> boolean? (lambda V6137 (lambda B6133 (lambda L6134 (lambda Key6135 (lambda C6136 (let A (shen.newpv B6133) (shen.gc B6133 (is! V6137 (cons A (cons --> (cons boolean ()))) B6133 L6134 Key6135 C6136)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> bootstrap (lambda V6142 (lambda B6138 (lambda L6139 (lambda Key6140 (lambda C6141 (is! V6142 (cons string (cons --> (cons string ()))) B6138 L6139 Key6140 C6141)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> bound? (lambda V6147 (lambda B6143 (lambda L6144 (lambda Key6145 (lambda C6146 (is! V6147 (cons symbol (cons --> (cons boolean ()))) B6143 L6144 Key6145 C6146)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.ccons? (lambda V6152 (lambda B6148 (lambda L6149 (lambda Key6150 (lambda C6151 (let A (shen.newpv B6148) (shen.gc B6148 (is! V6152 (cons (cons list (cons A ())) (cons --> (cons boolean ()))) B6148 L6149 Key6150 C6151)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> cd (lambda V6157 (lambda B6153 (lambda L6154 (lambda Key6155 (lambda C6156 (is! V6157 (cons string (cons --> (cons string ()))) B6153 L6154 Key6155 C6156)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> close (lambda V6163 (lambda B6159 (lambda L6160 (lambda Key6161 (lambda C6162 (let A (shen.newpv B6159) (shen.gc B6159 (let B (shen.newpv B6159) (shen.gc B6159 (is! V6163 (cons (cons stream (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) B6159 L6160 Key6161 C6162)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> cn (lambda V6168 (lambda B6164 (lambda L6165 (lambda Key6166 (lambda C6167 (is! V6168 (cons string (cons --> (cons (cons string (cons --> (cons string ()))) ()))) B6164 L6165 Key6166 C6167)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> char-stream? (lambda V6173 (lambda B6169 (lambda L6170 (lambda Key6171 (lambda C6172 (let A (shen.newpv B6169) (shen.gc B6169 (is! V6173 (cons (cons stream (cons A ())) (cons --> (cons boolean ()))) B6169 L6170 Key6171 C6172)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> compile (lambda V6180 (lambda B6176 (lambda L6177 (lambda Key6178 (lambda C6179 (let A (shen.newpv B6176) (shen.gc B6176 (let B (shen.newpv B6176) (shen.gc B6176 (is! V6180 (cons (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons B ()))) ()))) B6176 L6177 Key6178 C6179)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> cons? (lambda V6185 (lambda B6181 (lambda L6182 (lambda Key6183 (lambda C6184 (let A (shen.newpv B6181) (shen.gc B6181 (is! V6185 (cons A (cons --> (cons boolean ()))) B6181 L6182 Key6183 C6184)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> datatypes (lambda V6190 (lambda B6186 (lambda L6187 (lambda Key6188 (lambda C6189 (is! V6190 (cons --> (cons (cons list (cons symbol ())) ())) B6186 L6187 Key6188 C6189)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> destroy (lambda V6195 (lambda B6191 (lambda L6192 (lambda Key6193 (lambda C6194 (is! V6195 (cons symbol (cons --> (cons symbol ()))) B6191 L6192 Key6193 C6194)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> difference (lambda V6202 (lambda B6198 (lambda L6199 (lambda Key6200 (lambda C6201 (let A (shen.newpv B6198) (shen.gc B6198 (is! V6202 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6198 L6199 Key6200 C6201)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> do (lambda V6207 (lambda B6203 (lambda L6204 (lambda Key6205 (lambda C6206 (let A (shen.newpv B6203) (shen.gc B6203 (let B (shen.newpv B6203) (shen.gc B6203 (is! V6207 (cons A (cons --> (cons (cons B (cons --> (cons B ()))) ()))) B6203 L6204 Key6205 C6206)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> (lambda V6214 (lambda B6210 (lambda L6211 (lambda Key6212 (lambda C6213 (let A (shen.newpv B6210) (shen.gc B6210 (let B (shen.newpv B6210) (shen.gc B6210 (is! V6214 (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons (cons list (cons B ())) ()))) ()))) B6210 L6211 Key6212 C6213)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> (lambda V6221 (lambda B6217 (lambda L6218 (lambda Key6219 (lambda C6220 (let B (shen.newpv B6217) (shen.gc B6217 (let A (shen.newpv B6217) (shen.gc B6217 (is! V6221 (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons B ())) (cons (cons list (cons A ())) ()))) ()))) B6217 L6218 Key6219 C6220)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> (lambda V6228 (lambda B6224 (lambda L6225 (lambda Key6226 (lambda C6227 (let A (shen.newpv B6224) (shen.gc B6224 (let B (shen.newpv B6224) (shen.gc B6224 (is! V6228 (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons (cons list (cons B ())) ()))) ()))) B6224 L6225 Key6226 C6227)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.parse-failure? (lambda V6233 (lambda B6229 (lambda L6230 (lambda Key6231 (lambda C6232 (let A (shen.newpv B6229) (shen.gc B6229 (let B (shen.newpv B6229) (shen.gc B6229 (is! V6233 (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons boolean ()))) B6229 L6230 Key6231 C6232)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.parse-failure (lambda V6238 (lambda B6234 (lambda L6235 (lambda Key6236 (lambda C6237 (let A (shen.newpv B6234) (shen.gc B6234 (let B (shen.newpv B6234) (shen.gc B6234 (is! V6238 (cons --> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) ())) B6234 L6235 Key6236 C6237)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.<-out (lambda V6243 (lambda B6239 (lambda L6240 (lambda Key6241 (lambda C6242 (let A (shen.newpv B6239) (shen.gc B6239 (let B (shen.newpv B6239) (shen.gc B6239 (is! V6243 (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons B ()))) B6239 L6240 Key6241 C6242)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.in-> (lambda V6249 (lambda B6245 (lambda L6246 (lambda Key6247 (lambda C6248 (let B (shen.newpv B6245) (shen.gc B6245 (let A (shen.newpv B6245) (shen.gc B6245 (is! V6249 (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons (cons list (cons A ())) ()))) B6245 L6246 Key6247 C6248)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.comb (lambda V6255 (lambda B6251 (lambda L6252 (lambda Key6253 (lambda C6254 (let A (shen.newpv B6251) (shen.gc B6251 (let B (shen.newpv B6251) (shen.gc B6251 (is! V6255 (cons (cons list (cons A ())) (cons --> (cons (cons B (cons --> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) ()))) ()))) B6251 L6252 Key6253 C6254)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> element? (lambda V6260 (lambda B6256 (lambda L6257 (lambda Key6258 (lambda C6259 (let A (shen.newpv B6256) (shen.gc B6256 (is! V6260 (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons boolean ()))) ()))) B6256 L6257 Key6258 C6259)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> empty? (lambda V6265 (lambda B6261 (lambda L6262 (lambda Key6263 (lambda C6264 (let A (shen.newpv B6261) (shen.gc B6261 (is! V6265 (cons A (cons --> (cons boolean ()))) B6261 L6262 Key6263 C6264)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> enable-type-theory (lambda V6270 (lambda B6266 (lambda L6267 (lambda Key6268 (lambda C6269 (is! V6270 (cons symbol (cons --> (cons boolean ()))) B6266 L6267 Key6268 C6269)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> external (lambda V6275 (lambda B6271 (lambda L6272 (lambda Key6273 (lambda C6274 (is! V6275 (cons symbol (cons --> (cons (cons list (cons symbol ())) ()))) B6271 L6272 Key6273 C6274)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> error-to-string (lambda V6280 (lambda B6276 (lambda L6277 (lambda Key6278 (lambda C6279 (is! V6280 (cons exception (cons --> (cons string ()))) B6276 L6277 Key6278 C6279)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> explode (lambda V6285 (lambda B6281 (lambda L6282 (lambda Key6283 (lambda C6284 (let A (shen.newpv B6281) (shen.gc B6281 (is! V6285 (cons A (cons --> (cons (cons list (cons string ())) ()))) B6281 L6282 Key6283 C6284)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> factorise (lambda V6290 (lambda B6286 (lambda L6287 (lambda Key6288 (lambda C6289 (is! V6290 (cons symbol (cons --> (cons symbol ()))) B6286 L6287 Key6288 C6289)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> factorise? (lambda V6295 (lambda B6291 (lambda L6292 (lambda Key6293 (lambda C6294 (is! V6295 (cons --> (cons boolean ())) B6291 L6292 Key6293 C6294)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> fail (lambda V6300 (lambda B6296 (lambda L6297 (lambda Key6298 (lambda C6299 (is! V6300 (cons --> (cons symbol ())) B6296 L6297 Key6298 C6299)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> fix (lambda V6306 (lambda B6302 (lambda L6303 (lambda Key6304 (lambda C6305 (let A (shen.newpv B6302) (shen.gc B6302 (is! V6306 (cons (cons A (cons --> (cons A ()))) (cons --> (cons (cons A (cons --> (cons A ()))) ()))) B6302 L6303 Key6304 C6305)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> freeze (lambda V6311 (lambda B6307 (lambda L6308 (lambda Key6309 (lambda C6310 (let A (shen.newpv B6307) (shen.gc B6307 (is! V6311 (cons A (cons --> (cons (cons lazy (cons A ())) ()))) B6307 L6308 Key6309 C6310)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> fst (lambda V6316 (lambda B6312 (lambda L6313 (lambda Key6314 (lambda C6315 (let B (shen.newpv B6312) (shen.gc B6312 (let A (shen.newpv B6312) (shen.gc B6312 (is! V6316 (cons (cons A (cons * (cons B ()))) (cons --> (cons A ()))) B6312 L6313 Key6314 C6315)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> gensym (lambda V6321 (lambda B6317 (lambda L6318 (lambda Key6319 (lambda C6320 (is! V6321 (cons symbol (cons --> (cons symbol ()))) B6317 L6318 Key6319 C6320)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.hds=? (lambda V6327 (lambda B6323 (lambda L6324 (lambda Key6325 (lambda C6326 (let A (shen.newpv B6323) (shen.gc B6323 (is! V6327 (cons (cons list (cons A ())) (cons --> (cons (cons A (cons --> (cons boolean ()))) ()))) B6323 L6324 Key6325 C6326)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hush (lambda V6332 (lambda B6328 (lambda L6329 (lambda Key6330 (lambda C6331 (is! V6332 (cons symbol (cons --> (cons boolean ()))) B6328 L6329 Key6330 C6331)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hush? (lambda V6337 (lambda B6333 (lambda L6334 (lambda Key6335 (lambda C6336 (is! V6337 (cons --> (cons boolean ())) B6333 L6334 Key6335 C6336)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> <-vector (lambda V6343 (lambda B6339 (lambda L6340 (lambda Key6341 (lambda C6342 (let A (shen.newpv B6339) (shen.gc B6339 (is! V6343 (cons (cons vector (cons A ())) (cons --> (cons (cons number (cons --> (cons A ()))) ()))) B6339 L6340 Key6341 C6342)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> vector-> (lambda V6349 (lambda B6345 (lambda L6346 (lambda Key6347 (lambda C6348 (let A (shen.newpv B6345) (shen.gc B6345 (is! V6349 (cons (cons vector (cons A ())) (cons --> (cons (cons number (cons --> (cons (cons A (cons --> (cons (cons vector (cons A ())) ()))) ()))) ()))) B6345 L6346 Key6347 C6348)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> vector (lambda V6354 (lambda B6350 (lambda L6351 (lambda Key6352 (lambda C6353 (let A (shen.newpv B6350) (shen.gc B6350 (is! V6354 (cons number (cons --> (cons (cons vector (cons A ())) ()))) B6350 L6351 Key6352 C6353)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> get-time (lambda V6359 (lambda B6355 (lambda L6356 (lambda Key6357 (lambda C6358 (is! V6359 (cons symbol (cons --> (cons number ()))) B6355 L6356 Key6357 C6358)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hash (lambda V6364 (lambda B6360 (lambda L6361 (lambda Key6362 (lambda C6363 (let A (shen.newpv B6360) (shen.gc B6360 (is! V6364 (cons A (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6360 L6361 Key6362 C6363)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> head (lambda V6369 (lambda B6365 (lambda L6366 (lambda Key6367 (lambda C6368 (let A (shen.newpv B6365) (shen.gc B6365 (is! V6369 (cons (cons list (cons A ())) (cons --> (cons A ()))) B6365 L6366 Key6367 C6368)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hdv (lambda V6374 (lambda B6370 (lambda L6371 (lambda Key6372 (lambda C6373 (let A (shen.newpv B6370) (shen.gc B6370 (is! V6374 (cons (cons vector (cons A ())) (cons --> (cons A ()))) B6370 L6371 Key6372 C6373)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hdstr (lambda V6379 (lambda B6375 (lambda L6376 (lambda Key6377 (lambda C6378 (is! V6379 (cons string (cons --> (cons string ()))) B6375 L6376 Key6377 C6378)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> if (lambda V6384 (lambda B6380 (lambda L6381 (lambda Key6382 (lambda C6383 (let A (shen.newpv B6380) (shen.gc B6380 (is! V6384 (cons boolean (cons --> (cons (cons A (cons --> (cons (cons A (cons --> (cons A ()))) ()))) ()))) B6380 L6381 Key6382 C6383)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> in-package (lambda V6389 (lambda B6385 (lambda L6386 (lambda Key6387 (lambda C6388 (is! V6389 (cons symbol (cons --> (cons symbol ()))) B6385 L6386 Key6387 C6388)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> it (lambda V6394 (lambda B6390 (lambda L6391 (lambda Key6392 (lambda C6393 (is! V6394 (cons --> (cons string ())) B6390 L6391 Key6392 C6393)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> implementation (lambda V6399 (lambda B6395 (lambda L6396 (lambda Key6397 (lambda C6398 (is! V6399 (cons --> (cons string ())) B6395 L6396 Key6397 C6398)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> include (lambda V6405 (lambda B6401 (lambda L6402 (lambda Key6403 (lambda C6404 (is! V6405 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) B6401 L6402 Key6403 C6404)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> include-all-but (lambda V6411 (lambda B6407 (lambda L6408 (lambda Key6409 (lambda C6410 (is! V6411 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) B6407 L6408 Key6409 C6410)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> included (lambda V6416 (lambda B6412 (lambda L6413 (lambda Key6414 (lambda C6415 (is! V6416 (cons --> (cons (cons list (cons symbol ())) ())) B6412 L6413 Key6414 C6415)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> inferences (lambda V6421 (lambda B6417 (lambda L6418 (lambda Key6419 (lambda C6420 (is! V6421 (cons --> (cons number ())) B6417 L6418 Key6419 C6420)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.insert (lambda V6426 (lambda B6422 (lambda L6423 (lambda Key6424 (lambda C6425 (let A (shen.newpv B6422) (shen.gc B6422 (is! V6426 (cons A (cons --> (cons (cons string (cons --> (cons string ()))) ()))) B6422 L6423 Key6424 C6425)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> integer? (lambda V6431 (lambda B6427 (lambda L6428 (lambda Key6429 (lambda C6430 (let A (shen.newpv B6427) (shen.gc B6427 (is! V6431 (cons A (cons --> (cons boolean ()))) B6427 L6428 Key6429 C6430)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> internal (lambda V6436 (lambda B6432 (lambda L6433 (lambda Key6434 (lambda C6435 (is! V6436 (cons symbol (cons --> (cons (cons list (cons symbol ())) ()))) B6432 L6433 Key6434 C6435)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> intersection (lambda V6443 (lambda B6439 (lambda L6440 (lambda Key6441 (lambda C6442 (let A (shen.newpv B6439) (shen.gc B6439 (is! V6443 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6439 L6440 Key6441 C6442)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> language (lambda V6448 (lambda B6444 (lambda L6445 (lambda Key6446 (lambda C6447 (is! V6448 (cons --> (cons string ())) B6444 L6445 Key6446 C6447)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> length (lambda V6453 (lambda B6449 (lambda L6450 (lambda Key6451 (lambda C6452 (let A (shen.newpv B6449) (shen.gc B6449 (is! V6453 (cons (cons list (cons A ())) (cons --> (cons number ()))) B6449 L6450 Key6451 C6452)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> limit (lambda V6458 (lambda B6454 (lambda L6455 (lambda Key6456 (lambda C6457 (let A (shen.newpv B6454) (shen.gc B6454 (is! V6458 (cons (cons vector (cons A ())) (cons --> (cons number ()))) B6454 L6455 Key6456 C6457)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> lineread (lambda V6464 (lambda B6460 (lambda L6461 (lambda Key6462 (lambda C6463 (is! V6464 (cons (cons stream (cons in ())) (cons --> (cons (cons list (cons unit ())) ()))) B6460 L6461 Key6462 C6463)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> load (lambda V6469 (lambda B6465 (lambda L6466 (lambda Key6467 (lambda C6468 (is! V6469 (cons string (cons --> (cons symbol ()))) B6465 L6466 Key6467 C6468)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> map (lambda V6476 (lambda B6472 (lambda L6473 (lambda Key6474 (lambda C6475 (let A (shen.newpv B6472) (shen.gc B6472 (let B (shen.newpv B6472) (shen.gc B6472 (is! V6476 (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) ()))) B6472 L6473 Key6474 C6475)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> mapcan (lambda V6483 (lambda B6479 (lambda L6480 (lambda Key6481 (lambda C6482 (let A (shen.newpv B6479) (shen.gc B6479 (let B (shen.newpv B6479) (shen.gc B6479 (is! V6483 (cons (cons A (cons --> (cons (cons list (cons B ())) ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) ()))) B6479 L6480 Key6481 C6482)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> maxinferences (lambda V6488 (lambda B6484 (lambda L6485 (lambda Key6486 (lambda C6487 (is! V6488 (cons number (cons --> (cons number ()))) B6484 L6485 Key6486 C6487)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> n->string (lambda V6493 (lambda B6489 (lambda L6490 (lambda Key6491 (lambda C6492 (is! V6493 (cons number (cons --> (cons string ()))) B6489 L6490 Key6491 C6492)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> nl (lambda V6498 (lambda B6494 (lambda L6495 (lambda Key6496 (lambda C6497 (is! V6498 (cons number (cons --> (cons number ()))) B6494 L6495 Key6496 C6497)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> not (lambda V6503 (lambda B6499 (lambda L6500 (lambda Key6501 (lambda C6502 (is! V6503 (cons boolean (cons --> (cons boolean ()))) B6499 L6500 Key6501 C6502)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> nth (lambda V6508 (lambda B6504 (lambda L6505 (lambda Key6506 (lambda C6507 (let A (shen.newpv B6504) (shen.gc B6504 (is! V6508 (cons number (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons A ()))) ()))) B6504 L6505 Key6506 C6507)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> number? (lambda V6513 (lambda B6509 (lambda L6510 (lambda Key6511 (lambda C6512 (let A (shen.newpv B6509) (shen.gc B6509 (is! V6513 (cons A (cons --> (cons boolean ()))) B6509 L6510 Key6511 C6512)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> occurrences (lambda V6518 (lambda B6514 (lambda L6515 (lambda Key6516 (lambda C6517 (let A (shen.newpv B6514) (shen.gc B6514 (let B (shen.newpv B6514) (shen.gc B6514 (is! V6518 (cons A (cons --> (cons (cons B (cons --> (cons number ()))) ()))) B6514 L6515 Key6516 C6517)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> occurs-check (lambda V6523 (lambda B6519 (lambda L6520 (lambda Key6521 (lambda C6522 (is! V6523 (cons symbol (cons --> (cons boolean ()))) B6519 L6520 Key6521 C6522)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> occurs? (lambda V6528 (lambda B6524 (lambda L6525 (lambda Key6526 (lambda C6527 (is! V6528 (cons --> (cons boolean ())) B6524 L6525 Key6526 C6527)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> optimise (lambda V6533 (lambda B6529 (lambda L6530 (lambda Key6531 (lambda C6532 (is! V6533 (cons symbol (cons --> (cons boolean ()))) B6529 L6530 Key6531 C6532)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> optimise? (lambda V6538 (lambda B6534 (lambda L6535 (lambda Key6536 (lambda C6537 (is! V6538 (cons --> (cons boolean ())) B6534 L6535 Key6536 C6537)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> or (lambda V6543 (lambda B6539 (lambda L6540 (lambda Key6541 (lambda C6542 (is! V6543 (cons boolean (cons --> (cons (cons boolean (cons --> (cons boolean ()))) ()))) B6539 L6540 Key6541 C6542)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> os (lambda V6548 (lambda B6544 (lambda L6545 (lambda Key6546 (lambda C6547 (is! V6548 (cons --> (cons string ())) B6544 L6545 Key6546 C6547)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> package? (lambda V6553 (lambda B6549 (lambda L6550 (lambda Key6551 (lambda C6552 (is! V6553 (cons symbol (cons --> (cons boolean ()))) B6549 L6550 Key6551 C6552)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> port (lambda V6558 (lambda B6554 (lambda L6555 (lambda Key6556 (lambda C6557 (is! V6558 (cons --> (cons string ())) B6554 L6555 Key6556 C6557)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> porters (lambda V6563 (lambda B6559 (lambda L6560 (lambda Key6561 (lambda C6562 (is! V6563 (cons --> (cons string ())) B6559 L6560 Key6561 C6562)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> pos (lambda V6568 (lambda B6564 (lambda L6565 (lambda Key6566 (lambda C6567 (is! V6568 (cons string (cons --> (cons (cons number (cons --> (cons string ()))) ()))) B6564 L6565 Key6566 C6567)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> pr (lambda V6573 (lambda B6569 (lambda L6570 (lambda Key6571 (lambda C6572 (is! V6573 (cons string (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons string ()))) ()))) B6569 L6570 Key6571 C6572)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> print (lambda V6578 (lambda B6574 (lambda L6575 (lambda Key6576 (lambda C6577 (let A (shen.newpv B6574) (shen.gc B6574 (is! V6578 (cons A (cons --> (cons A ()))) B6574 L6575 Key6576 C6577)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> profile (lambda V6583 (lambda B6579 (lambda L6580 (lambda Key6581 (lambda C6582 (is! V6583 (cons symbol (cons --> (cons symbol ()))) B6579 L6580 Key6581 C6582)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> preclude (lambda V6589 (lambda B6585 (lambda L6586 (lambda Key6587 (lambda C6588 (is! V6589 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) B6585 L6586 Key6587 C6588)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.proc-nl (lambda V6594 (lambda B6590 (lambda L6591 (lambda Key6592 (lambda C6593 (is! V6594 (cons string (cons --> (cons string ()))) B6590 L6591 Key6592 C6593)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> profile-results (lambda V6599 (lambda B6595 (lambda L6596 (lambda Key6597 (lambda C6598 (is! V6599 (cons symbol (cons --> (cons (cons symbol (cons * (cons number ()))) ()))) B6595 L6596 Key6597 C6598)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> protect (lambda V6604 (lambda B6600 (lambda L6601 (lambda Key6602 (lambda C6603 (let A (shen.newpv B6600) (shen.gc B6600 (is! V6604 (cons A (cons --> (cons A ()))) B6600 L6601 Key6602 C6603)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> preclude-all-but (lambda V6610 (lambda B6606 (lambda L6607 (lambda Key6608 (lambda C6609 (is! V6610 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) B6606 L6607 Key6608 C6609)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.prhush (lambda V6615 (lambda B6611 (lambda L6612 (lambda Key6613 (lambda C6614 (is! V6615 (cons string (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons string ()))) ()))) B6611 L6612 Key6613 C6614)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> prolog-memory (lambda V6620 (lambda B6616 (lambda L6617 (lambda Key6618 (lambda C6619 (is! V6620 (cons number (cons --> (cons number ()))) B6616 L6617 Key6618 C6619)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> ps (lambda V6625 (lambda B6621 (lambda L6622 (lambda Key6623 (lambda C6624 (is! V6625 (cons symbol (cons --> (cons (cons list (cons unit ())) ()))) B6621 L6622 Key6623 C6624)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read (lambda V6630 (lambda B6626 (lambda L6627 (lambda Key6628 (lambda C6629 (is! V6630 (cons (cons stream (cons in ())) (cons --> (cons unit ()))) B6626 L6627 Key6628 C6629)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-unit-string (lambda V6635 (lambda B6631 (lambda L6632 (lambda Key6633 (lambda C6634 (is! V6635 (cons (cons stream (cons in ())) (cons --> (cons string ()))) B6631 L6632 Key6633 C6634)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-byte (lambda V6640 (lambda B6636 (lambda L6637 (lambda Key6638 (lambda C6639 (is! V6640 (cons (cons stream (cons in ())) (cons --> (cons number ()))) B6636 L6637 Key6638 C6639)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-file-as-bytelist (lambda V6645 (lambda B6641 (lambda L6642 (lambda Key6643 (lambda C6644 (is! V6645 (cons string (cons --> (cons (cons list (cons number ())) ()))) B6641 L6642 Key6643 C6644)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-file-as-string (lambda V6650 (lambda B6646 (lambda L6647 (lambda Key6648 (lambda C6649 (is! V6650 (cons string (cons --> (cons string ()))) B6646 L6647 Key6648 C6649)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-file (lambda V6655 (lambda B6651 (lambda L6652 (lambda Key6653 (lambda C6654 (is! V6655 (cons string (cons --> (cons (cons list (cons unit ())) ()))) B6651 L6652 Key6653 C6654)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-from-string (lambda V6660 (lambda B6656 (lambda L6657 (lambda Key6658 (lambda C6659 (is! V6660 (cons string (cons --> (cons (cons list (cons unit ())) ()))) B6656 L6657 Key6658 C6659)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-from-string-unprocessed (lambda V6665 (lambda B6661 (lambda L6662 (lambda Key6663 (lambda C6664 (is! V6665 (cons string (cons --> (cons (cons list (cons unit ())) ()))) B6661 L6662 Key6663 C6664)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> release (lambda V6670 (lambda B6666 (lambda L6667 (lambda Key6668 (lambda C6669 (is! V6670 (cons --> (cons string ())) B6666 L6667 Key6668 C6669)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> remove (lambda V6676 (lambda B6672 (lambda L6673 (lambda Key6674 (lambda C6675 (let A (shen.newpv B6672) (shen.gc B6672 (is! V6676 (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6672 L6673 Key6674 C6675)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> reverse (lambda V6682 (lambda B6678 (lambda L6679 (lambda Key6680 (lambda C6681 (let A (shen.newpv B6678) (shen.gc B6678 (is! V6682 (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) B6678 L6679 Key6680 C6681)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> simple-error (lambda V6687 (lambda B6683 (lambda L6684 (lambda Key6685 (lambda C6686 (let A (shen.newpv B6683) (shen.gc B6683 (is! V6687 (cons string (cons --> (cons A ()))) B6683 L6684 Key6685 C6686)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> snd (lambda V6692 (lambda B6688 (lambda L6689 (lambda Key6690 (lambda C6691 (let A (shen.newpv B6688) (shen.gc B6688 (let B (shen.newpv B6688) (shen.gc B6688 (is! V6692 (cons (cons A (cons * (cons B ()))) (cons --> (cons B ()))) B6688 L6689 Key6690 C6691)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> specialise (lambda V6697 (lambda B6693 (lambda L6694 (lambda Key6695 (lambda C6696 (is! V6697 (cons symbol (cons --> (cons (cons number (cons --> (cons symbol ()))) ()))) B6693 L6694 Key6695 C6696)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> spy (lambda V6702 (lambda B6698 (lambda L6699 (lambda Key6700 (lambda C6701 (is! V6702 (cons symbol (cons --> (cons boolean ()))) B6698 L6699 Key6700 C6701)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> spy? (lambda V6707 (lambda B6703 (lambda L6704 (lambda Key6705 (lambda C6706 (is! V6707 (cons --> (cons boolean ())) B6703 L6704 Key6705 C6706)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> step (lambda V6712 (lambda B6708 (lambda L6709 (lambda Key6710 (lambda C6711 (is! V6712 (cons symbol (cons --> (cons boolean ()))) B6708 L6709 Key6710 C6711)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> step? (lambda V6717 (lambda B6713 (lambda L6714 (lambda Key6715 (lambda C6716 (is! V6717 (cons --> (cons boolean ())) B6713 L6714 Key6715 C6716)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> stinput (lambda V6722 (lambda B6718 (lambda L6719 (lambda Key6720 (lambda C6721 (is! V6722 (cons --> (cons (cons stream (cons in ())) ())) B6718 L6719 Key6720 C6721)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> sterror (lambda V6727 (lambda B6723 (lambda L6724 (lambda Key6725 (lambda C6726 (is! V6727 (cons --> (cons (cons stream (cons out ())) ())) B6723 L6724 Key6725 C6726)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> stoutput (lambda V6732 (lambda B6728 (lambda L6729 (lambda Key6730 (lambda C6731 (is! V6732 (cons --> (cons (cons stream (cons out ())) ())) B6728 L6729 Key6730 C6731)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> string? (lambda V6737 (lambda B6733 (lambda L6734 (lambda Key6735 (lambda C6736 (let A (shen.newpv B6733) (shen.gc B6733 (is! V6737 (cons A (cons --> (cons boolean ()))) B6733 L6734 Key6735 C6736)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> str (lambda V6742 (lambda B6738 (lambda L6739 (lambda Key6740 (lambda C6741 (let A (shen.newpv B6738) (shen.gc B6738 (is! V6742 (cons A (cons --> (cons string ()))) B6738 L6739 Key6740 C6741)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> string->n (lambda V6747 (lambda B6743 (lambda L6744 (lambda Key6745 (lambda C6746 (is! V6747 (cons string (cons --> (cons number ()))) B6743 L6744 Key6745 C6746)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> string->symbol (lambda V6752 (lambda B6748 (lambda L6749 (lambda Key6750 (lambda C6751 (is! V6752 (cons string (cons --> (cons symbol ()))) B6748 L6749 Key6750 C6751)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> sum (lambda V6757 (lambda B6753 (lambda L6754 (lambda Key6755 (lambda C6756 (is! V6757 (cons (cons list (cons number ())) (cons --> (cons number ()))) B6753 L6754 Key6755 C6756)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> symbol? (lambda V6762 (lambda B6758 (lambda L6759 (lambda Key6760 (lambda C6761 (let A (shen.newpv B6758) (shen.gc B6758 (is! V6762 (cons A (cons --> (cons boolean ()))) B6758 L6759 Key6760 C6761)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> systemf (lambda V6767 (lambda B6763 (lambda L6764 (lambda Key6765 (lambda C6766 (is! V6767 (cons symbol (cons --> (cons symbol ()))) B6763 L6764 Key6765 C6766)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> system-S? (lambda V6772 (lambda B6768 (lambda L6769 (lambda Key6770 (lambda C6771 (is! V6772 (cons --> (cons boolean ())) B6768 L6769 Key6770 C6771)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tail (lambda V6778 (lambda B6774 (lambda L6775 (lambda Key6776 (lambda C6777 (let A (shen.newpv B6774) (shen.gc B6774 (is! V6778 (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) B6774 L6775 Key6776 C6777)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tlstr (lambda V6783 (lambda B6779 (lambda L6780 (lambda Key6781 (lambda C6782 (is! V6783 (cons string (cons --> (cons string ()))) B6779 L6780 Key6781 C6782)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tlv (lambda V6789 (lambda B6785 (lambda L6786 (lambda Key6787 (lambda C6788 (let A (shen.newpv B6785) (shen.gc B6785 (is! V6789 (cons (cons vector (cons A ())) (cons --> (cons (cons vector (cons A ())) ()))) B6785 L6786 Key6787 C6788)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tc (lambda V6794 (lambda B6790 (lambda L6791 (lambda Key6792 (lambda C6793 (is! V6794 (cons symbol (cons --> (cons boolean ()))) B6790 L6791 Key6792 C6793)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tc? (lambda V6799 (lambda B6795 (lambda L6796 (lambda Key6797 (lambda C6798 (is! V6799 (cons --> (cons boolean ())) B6795 L6796 Key6797 C6798)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> thaw (lambda V6804 (lambda B6800 (lambda L6801 (lambda Key6802 (lambda C6803 (let A (shen.newpv B6800) (shen.gc B6800 (is! V6804 (cons (cons lazy (cons A ())) (cons --> (cons A ()))) B6800 L6801 Key6802 C6803)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> track (lambda V6809 (lambda B6805 (lambda L6806 (lambda Key6807 (lambda C6808 (is! V6809 (cons symbol (cons --> (cons symbol ()))) B6805 L6806 Key6807 C6808)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tracked (lambda V6814 (lambda B6810 (lambda L6811 (lambda Key6812 (lambda C6813 (is! V6814 (cons --> (cons (cons list (cons symbol ())) ())) B6810 L6811 Key6812 C6813)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> trap-error (lambda V6819 (lambda B6815 (lambda L6816 (lambda Key6817 (lambda C6818 (let A (shen.newpv B6815) (shen.gc B6815 (is! V6819 (cons A (cons --> (cons (cons (cons exception (cons --> (cons A ()))) (cons --> (cons A ()))) ()))) B6815 L6816 Key6817 C6818)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tuple? (lambda V6824 (lambda B6820 (lambda L6821 (lambda Key6822 (lambda C6823 (let A (shen.newpv B6820) (shen.gc B6820 (is! V6824 (cons A (cons --> (cons boolean ()))) B6820 L6821 Key6822 C6823)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> unabsolute (lambda V6829 (lambda B6825 (lambda L6826 (lambda Key6827 (lambda C6828 (is! V6829 (cons string (cons --> (cons (cons list (cons string ())) ()))) B6825 L6826 Key6827 C6828)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> undefmacro (lambda V6834 (lambda B6830 (lambda L6831 (lambda Key6832 (lambda C6833 (is! V6834 (cons symbol (cons --> (cons symbol ()))) B6830 L6831 Key6832 C6833)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> union (lambda V6841 (lambda B6837 (lambda L6838 (lambda Key6839 (lambda C6840 (let A (shen.newpv B6837) (shen.gc B6837 (is! V6841 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6837 L6838 Key6839 C6840)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> unprofile (lambda V6846 (lambda B6842 (lambda L6843 (lambda Key6844 (lambda C6845 (is! V6846 (cons symbol (cons --> (cons symbol ()))) B6842 L6843 Key6844 C6845)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> untrack (lambda V6851 (lambda B6847 (lambda L6848 (lambda Key6849 (lambda C6850 (is! V6851 (cons symbol (cons --> (cons symbol ()))) B6847 L6848 Key6849 C6850)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> userdefs (lambda V6856 (lambda B6852 (lambda L6853 (lambda Key6854 (lambda C6855 (is! V6856 (cons --> (cons (cons list (cons symbol ())) ())) B6852 L6853 Key6854 C6855)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> variable? (lambda V6861 (lambda B6857 (lambda L6858 (lambda Key6859 (lambda C6860 (let A (shen.newpv B6857) (shen.gc B6857 (is! V6861 (cons A (cons --> (cons boolean ()))) B6857 L6858 Key6859 C6860)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> vector? (lambda V6866 (lambda B6862 (lambda L6863 (lambda Key6864 (lambda C6865 (let A (shen.newpv B6862) (shen.gc B6862 (is! V6866 (cons A (cons --> (cons boolean ()))) B6862 L6863 Key6864 C6865)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> version (lambda V6871 (lambda B6867 (lambda L6868 (lambda Key6869 (lambda C6870 (is! V6871 (cons --> (cons string ())) B6867 L6868 Key6869 C6870)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> write-to-file (lambda V6876 (lambda B6872 (lambda L6873 (lambda Key6874 (lambda C6875 (let A (shen.newpv B6872) (shen.gc B6872 (is! V6876 (cons string (cons --> (cons (cons A (cons --> (cons A ()))) ()))) B6872 L6873 Key6874 C6875)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> write-byte (lambda V6881 (lambda B6877 (lambda L6878 (lambda Key6879 (lambda C6880 (is! V6881 (cons number (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons number ()))) ()))) B6877 L6878 Key6879 C6880)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> write-string (lambda V6886 (lambda B6882 (lambda L6883 (lambda Key6884 (lambda C6885 (is! V6886 (cons string (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons string ()))) ()))) B6882 L6883 Key6884 C6885)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> y-or-n? (lambda V6891 (lambda B6887 (lambda L6888 (lambda Key6889 (lambda C6890 (is! V6891 (cons string (cons --> (cons boolean ()))) B6887 L6888 Key6889 C6890)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> > (lambda V6896 (lambda B6892 (lambda L6893 (lambda Key6894 (lambda C6895 (is! V6896 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) B6892 L6893 Key6894 C6895)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> < (lambda V6901 (lambda B6897 (lambda L6898 (lambda Key6899 (lambda C6900 (is! V6901 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) B6897 L6898 Key6899 C6900)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> >= (lambda V6906 (lambda B6902 (lambda L6903 (lambda Key6904 (lambda C6905 (is! V6906 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) B6902 L6903 Key6904 C6905)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> <= (lambda V6911 (lambda B6907 (lambda L6908 (lambda Key6909 (lambda C6910 (is! V6911 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) B6907 L6908 Key6909 C6910)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> = (lambda V6916 (lambda B6912 (lambda L6913 (lambda Key6914 (lambda C6915 (let A (shen.newpv B6912) (shen.gc B6912 (is! V6916 (cons A (cons --> (cons (cons A (cons --> (cons boolean ()))) ()))) B6912 L6913 Key6914 C6915)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> + (lambda V6921 (lambda B6917 (lambda L6918 (lambda Key6919 (lambda C6920 (is! V6921 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6917 L6918 Key6919 C6920)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> / (lambda V6926 (lambda B6922 (lambda L6923 (lambda Key6924 (lambda C6925 (is! V6926 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6922 L6923 Key6924 C6925)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> - (lambda V6931 (lambda B6927 (lambda L6928 (lambda Key6929 (lambda C6930 (is! V6931 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6927 L6928 Key6929 C6930)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> * (lambda V6936 (lambda B6932 (lambda L6933 (lambda Key6934 (lambda C6935 (is! V6936 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6932 L6933 Key6934 C6935)))))) (value shen.*sigf*))) (set shen.*sigf* (shen.assoc-> == (lambda V6941 (lambda B6937 (lambda L6938 (lambda Key6939 (lambda C6940 (let A (shen.newpv B6937) (shen.gc B6937 (let B (shen.newpv B6937) (shen.gc B6937 (is! V6941 (cons A (cons --> (cons (cons B (cons --> (cons boolean ()))) ()))) B6937 L6938 Key6939 C6940)))))))))) (value shen.*sigf*))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (defun shen.initialise-lambda-forms () (do (shen.set-lambda-form-entry (cons shen.tuple (lambda Y954 (shen.tuple Y954)))) (do (shen.set-lambda-form-entry (cons shen.pvar (lambda Y955 (shen.pvar Y955)))) (do (shen.set-lambda-form-entry (cons shen.dictionary (lambda Y956 (shen.dictionary Y956)))) (do (shen.set-lambda-form-entry (cons shen.print-prolog-vector (lambda Y957 (shen.print-prolog-vector Y957)))) (do (shen.set-lambda-form-entry (cons shen.print-freshterm (lambda Y958 (shen.print-freshterm Y958)))) (do (shen.set-lambda-form-entry (cons shen.printF (lambda Y959 (shen.printF Y959)))) (do (shen.set-lambda-form-entry (cons absolute (lambda Y960 (absolute Y960)))) (do (shen.set-lambda-form-entry (cons absvector? (lambda Y961 (absvector? Y961)))) (do (shen.set-lambda-form-entry (cons absvector (lambda Y962 (absvector Y962)))) (do (shen.set-lambda-form-entry (cons address-> (lambda Y963 (lambda Y964 (lambda Y965 (address-> Y963 Y964 Y965)))))) (do (shen.set-lambda-form-entry (cons adjoin (lambda Y966 (lambda Y967 (adjoin Y966 Y967))))) (do (shen.set-lambda-form-entry (cons and (lambda Y968 (lambda Y969 (and Y968 Y969))))) (do (shen.set-lambda-form-entry (cons append (lambda Y970 (lambda Y971 (append Y970 Y971))))) (do (shen.set-lambda-form-entry (cons arity (lambda Y972 (arity Y972)))) (do (shen.set-lambda-form-entry (cons assoc (lambda Y973 (lambda Y974 (assoc Y973 Y974))))) (do (shen.set-lambda-form-entry (cons atom? (lambda Y975 (atom? Y975)))) (do (shen.set-lambda-form-entry (cons boolean? (lambda Y976 (boolean? Y976)))) (do (shen.set-lambda-form-entry (cons bootstrap (lambda Y977 (bootstrap Y977)))) (do (shen.set-lambda-form-entry (cons bound? (lambda Y978 (bound? Y978)))) (do (shen.set-lambda-form-entry (cons bind (lambda Y979 (lambda Y980 (lambda Y981 (lambda Y982 (lambda Y983 (lambda Y984 (bind Y979 Y980 Y981 Y982 Y983 Y984))))))))) (do (shen.set-lambda-form-entry (cons call (lambda Y985 (lambda Y986 (lambda Y987 (lambda Y988 (lambda Y989 (call Y985 Y986 Y987 Y988 Y989)))))))) (do (shen.set-lambda-form-entry (cons cd (lambda Y990 (cd Y990)))) (do (shen.set-lambda-form-entry (cons char-stream? (lambda Y991 (char-stream? Y991)))) (do (shen.set-lambda-form-entry (cons compile (lambda Y992 (lambda Y993 (compile Y992 Y993))))) (do (shen.set-lambda-form-entry (cons concat (lambda Y994 (lambda Y995 (concat Y994 Y995))))) (do (shen.set-lambda-form-entry (cons cons (lambda Y996 (lambda Y997 (cons Y996 Y997))))) (do (shen.set-lambda-form-entry (cons cons? (lambda Y998 (cons? Y998)))) (do (shen.set-lambda-form-entry (cons cn (lambda Y999 (lambda Y1000 (cn Y999 Y1000))))) (do (shen.set-lambda-form-entry (cons close (lambda Y1001 (close Y1001)))) (do (shen.set-lambda-form-entry (cons declare (lambda Y1002 (lambda Y1003 (declare Y1002 Y1003))))) (do (shen.set-lambda-form-entry (cons destroy (lambda Y1004 (destroy Y1004)))) (do (shen.set-lambda-form-entry (cons difference (lambda Y1005 (lambda Y1006 (difference Y1005 Y1006))))) (do (shen.set-lambda-form-entry (cons do (lambda Y1007 (lambda Y1008 (do Y1007 Y1008))))) (do (shen.set-lambda-form-entry (cons element? (lambda Y1009 (lambda Y1010 (element? Y1009 Y1010))))) (do (shen.set-lambda-form-entry (cons empty? (lambda Y1011 (empty? Y1011)))) (do (shen.set-lambda-form-entry (cons enable-type-theory (lambda Y1012 (enable-type-theory Y1012)))) (do (shen.set-lambda-form-entry (cons external (lambda Y1013 (external Y1013)))) (do (shen.set-lambda-form-entry (cons error-to-string (lambda Y1014 (error-to-string Y1014)))) (do (shen.set-lambda-form-entry (cons eval (lambda Y1015 (eval Y1015)))) (do (shen.set-lambda-form-entry (cons eval-kl (lambda Y1016 (eval-kl Y1016)))) (do (shen.set-lambda-form-entry (cons explode (lambda Y1017 (explode Y1017)))) (do (shen.set-lambda-form-entry (cons external (lambda Y1018 (external Y1018)))) (do (shen.set-lambda-form-entry (cons factorise (lambda Y1019 (factorise Y1019)))) (do (shen.set-lambda-form-entry (cons fail-if (lambda Y1020 (lambda Y1021 (fail-if Y1020 Y1021))))) (do (shen.set-lambda-form-entry (cons fix (lambda Y1022 (lambda Y1023 (fix Y1022 Y1023))))) (do (shen.set-lambda-form-entry (cons findall (lambda Y1024 (lambda Y1025 (lambda Y1026 (lambda Y1027 (lambda Y1028 (lambda Y1029 (lambda Y1030 (findall Y1024 Y1025 Y1026 Y1027 Y1028 Y1029 Y1030)))))))))) (do (shen.set-lambda-form-entry (cons fork (lambda Y1031 (lambda Y1032 (lambda Y1033 (lambda Y1034 (lambda Y1035 (fork Y1031 Y1032 Y1033 Y1034 Y1035)))))))) (do (shen.set-lambda-form-entry (cons freeze (lambda Y1036 (freeze Y1036)))) (do (shen.set-lambda-form-entry (cons fst (lambda Y1037 (fst Y1037)))) (do (shen.set-lambda-form-entry (cons fn (lambda Y1038 (fn Y1038)))) (do (shen.set-lambda-form-entry (cons function (lambda Y1039 (function Y1039)))) (do (shen.set-lambda-form-entry (cons gensym (lambda Y1040 (gensym Y1040)))) (do (shen.set-lambda-form-entry (cons get (lambda Y1041 (lambda Y1042 (lambda Y1043 (get Y1041 Y1042 Y1043)))))) (do (shen.set-lambda-form-entry (cons get-time (lambda Y1044 (get-time Y1044)))) (do (shen.set-lambda-form-entry (cons address-> (lambda Y1045 (lambda Y1046 (lambda Y1047 (address-> Y1045 Y1046 Y1047)))))) (do (shen.set-lambda-form-entry (cons <-address (lambda Y1048 (lambda Y1049 (<-address Y1048 Y1049))))) (do (shen.set-lambda-form-entry (cons <-vector (lambda Y1050 (lambda Y1051 (<-vector Y1050 Y1051))))) (do (shen.set-lambda-form-entry (cons > (lambda Y1052 (lambda Y1053 (> Y1052 Y1053))))) (do (shen.set-lambda-form-entry (cons >= (lambda Y1054 (lambda Y1055 (>= Y1054 Y1055))))) (do (shen.set-lambda-form-entry (cons = (lambda Y1056 (lambda Y1057 (= Y1056 Y1057))))) (do (shen.set-lambda-form-entry (cons hash (lambda Y1058 (lambda Y1059 (hash Y1058 Y1059))))) (do (shen.set-lambda-form-entry (cons hd (lambda Y1060 (hd Y1060)))) (do (shen.set-lambda-form-entry (cons hdv (lambda Y1061 (hdv Y1061)))) (do (shen.set-lambda-form-entry (cons hdstr (lambda Y1062 (hdstr Y1062)))) (do (shen.set-lambda-form-entry (cons head (lambda Y1063 (head Y1063)))) (do (shen.set-lambda-form-entry (cons hush (lambda Y1064 (hush Y1064)))) (do (shen.set-lambda-form-entry (cons if (lambda Y1065 (lambda Y1066 (lambda Y1067 (if Y1065 Y1066 Y1067)))))) (do (shen.set-lambda-form-entry (cons include (lambda Y1068 (include Y1068)))) (do (shen.set-lambda-form-entry (cons in-package (lambda Y1069 (in-package Y1069)))) (do (shen.set-lambda-form-entry (cons integer? (lambda Y1070 (integer? Y1070)))) (do (shen.set-lambda-form-entry (cons internal (lambda Y1071 (internal Y1071)))) (do (shen.set-lambda-form-entry (cons intern (lambda Y1072 (intern Y1072)))) (do (shen.set-lambda-form-entry (cons input (lambda Y1073 (input Y1073)))) (do (shen.set-lambda-form-entry (cons input+ (lambda Y1074 (lambda Y1075 (input+ Y1074 Y1075))))) (do (shen.set-lambda-form-entry (cons include-all-but (lambda Y1076 (include-all-but Y1076)))) (do (shen.set-lambda-form-entry (cons intersection (lambda Y1077 (lambda Y1078 (intersection Y1077 Y1078))))) (do (shen.set-lambda-form-entry (cons internal (lambda Y1079 (internal Y1079)))) (do (shen.set-lambda-form-entry (cons is (lambda Y1080 (lambda Y1081 (lambda Y1082 (lambda Y1083 (lambda Y1084 (lambda Y1085 (is Y1080 Y1081 Y1082 Y1083 Y1084 Y1085))))))))) (do (shen.set-lambda-form-entry (cons is! (lambda Y1086 (lambda Y1087 (lambda Y1088 (lambda Y1089 (lambda Y1090 (lambda Y1091 (is! Y1086 Y1087 Y1088 Y1089 Y1090 Y1091))))))))) (do (shen.set-lambda-form-entry (cons length (lambda Y1092 (length Y1092)))) (do (shen.set-lambda-form-entry (cons limit (lambda Y1093 (limit Y1093)))) (do (shen.set-lambda-form-entry (cons lineread (lambda Y1094 (lineread Y1094)))) (do (shen.set-lambda-form-entry (cons load (lambda Y1095 (load Y1095)))) (do (shen.set-lambda-form-entry (cons < (lambda Y1096 (lambda Y1097 (< Y1096 Y1097))))) (do (shen.set-lambda-form-entry (cons <= (lambda Y1098 (lambda Y1099 (<= Y1098 Y1099))))) (do (shen.set-lambda-form-entry (cons vector (lambda Y1100 (vector Y1100)))) (do (shen.set-lambda-form-entry (cons macroexpand (lambda Y1101 (macroexpand Y1101)))) (do (shen.set-lambda-form-entry (cons map (lambda Y1102 (lambda Y1103 (map Y1102 Y1103))))) (do (shen.set-lambda-form-entry (cons mapcan (lambda Y1104 (lambda Y1105 (mapcan Y1104 Y1105))))) (do (shen.set-lambda-form-entry (cons maxinferences (lambda Y1106 (maxinferences Y1106)))) (do (shen.set-lambda-form-entry (cons nl (lambda Y1107 (nl Y1107)))) (do (shen.set-lambda-form-entry (cons not (lambda Y1108 (not Y1108)))) (do (shen.set-lambda-form-entry (cons nth (lambda Y1109 (lambda Y1110 (nth Y1109 Y1110))))) (do (shen.set-lambda-form-entry (cons n->string (lambda Y1111 (n->string Y1111)))) (do (shen.set-lambda-form-entry (cons number? (lambda Y1112 (number? Y1112)))) (do (shen.set-lambda-form-entry (cons occurs-check (lambda Y1113 (occurs-check Y1113)))) (do (shen.set-lambda-form-entry (cons occurrences (lambda Y1114 (lambda Y1115 (occurrences Y1114 Y1115))))) (do (shen.set-lambda-form-entry (cons occurs-check (lambda Y1116 (occurs-check Y1116)))) (do (shen.set-lambda-form-entry (cons open (lambda Y1117 (lambda Y1118 (open Y1117 Y1118))))) (do (shen.set-lambda-form-entry (cons optimise (lambda Y1119 (optimise Y1119)))) (do (shen.set-lambda-form-entry (cons or (lambda Y1120 (lambda Y1121 (or Y1120 Y1121))))) (do (shen.set-lambda-form-entry (cons package? (lambda Y1122 (package? Y1122)))) (do (shen.set-lambda-form-entry (cons pos (lambda Y1123 (lambda Y1124 (pos Y1123 Y1124))))) (do (shen.set-lambda-form-entry (cons preclude-all-but (lambda Y1125 (preclude-all-but Y1125)))) (do (shen.set-lambda-form-entry (cons print (lambda Y1126 (print Y1126)))) (do (shen.set-lambda-form-entry (cons profile (lambda Y1127 (profile Y1127)))) (do (shen.set-lambda-form-entry (cons shen.print-prolog-vector (lambda Y1128 (shen.print-prolog-vector Y1128)))) (do (shen.set-lambda-form-entry (cons shen.print-freshterm (lambda Y1129 (shen.print-freshterm Y1129)))) (do (shen.set-lambda-form-entry (cons shen.printF (lambda Y1130 (shen.printF Y1130)))) (do (shen.set-lambda-form-entry (cons prolog-memory (lambda Y1131 (prolog-memory Y1131)))) (do (shen.set-lambda-form-entry (cons profile-results (lambda Y1132 (profile-results Y1132)))) (do (shen.set-lambda-form-entry (cons pr (lambda Y1133 (lambda Y1134 (pr Y1133 Y1134))))) (do (shen.set-lambda-form-entry (cons ps (lambda Y1135 (ps Y1135)))) (do (shen.set-lambda-form-entry (cons preclude (lambda Y1136 (preclude Y1136)))) (do (shen.set-lambda-form-entry (cons preclude-all-but (lambda Y1137 (preclude-all-but Y1137)))) (do (shen.set-lambda-form-entry (cons protect (lambda Y1138 (protect Y1138)))) (do (shen.set-lambda-form-entry (cons put (lambda Y1139 (lambda Y1140 (lambda Y1141 (lambda Y1142 (put Y1139 Y1140 Y1141 Y1142))))))) (do (shen.set-lambda-form-entry (cons read-file-as-string (lambda Y1143 (read-file-as-string Y1143)))) (do (shen.set-lambda-form-entry (cons read-file-as-bytelist (lambda Y1144 (read-file-as-bytelist Y1144)))) (do (shen.set-lambda-form-entry (cons read-file (lambda Y1145 (read-file Y1145)))) (do (shen.set-lambda-form-entry (cons read (lambda Y1146 (read Y1146)))) (do (shen.set-lambda-form-entry (cons read-byte (lambda Y1147 (read-byte Y1147)))) (do (shen.set-lambda-form-entry (cons read-from-string (lambda Y1148 (read-from-string Y1148)))) (do (shen.set-lambda-form-entry (cons read-from-string-unprocessed (lambda Y1149 (read-from-string-unprocessed Y1149)))) (do (shen.set-lambda-form-entry (cons read-unit-string (lambda Y1150 (read-unit-string Y1150)))) (do (shen.set-lambda-form-entry (cons shen.register-source-form (lambda Y1151 (lambda Y1152 (shen.register-source-form Y1151 Y1152))))) (do (shen.set-lambda-form-entry (cons shen.unregister-source-form (lambda Y1153 (shen.unregister-source-form Y1153)))) (do (shen.set-lambda-form-entry (cons remove (lambda Y1154 (lambda Y1155 (remove Y1154 Y1155))))) (do (shen.set-lambda-form-entry (cons reverse (lambda Y1156 (reverse Y1156)))) (do (shen.set-lambda-form-entry (cons set (lambda Y1157 (lambda Y1158 (set Y1157 Y1158))))) (do (shen.set-lambda-form-entry (cons simple-error (lambda Y1159 (simple-error Y1159)))) (do (shen.set-lambda-form-entry (cons snd (lambda Y1160 (snd Y1160)))) (do (shen.set-lambda-form-entry (cons specialise (lambda Y1161 (lambda Y1162 (specialise Y1161 Y1162))))) (do (shen.set-lambda-form-entry (cons spy (lambda Y1163 (spy Y1163)))) (do (shen.set-lambda-form-entry (cons step (lambda Y1164 (step Y1164)))) (do (shen.set-lambda-form-entry (cons str (lambda Y1165 (str Y1165)))) (do (shen.set-lambda-form-entry (cons string->n (lambda Y1166 (string->n Y1166)))) (do (shen.set-lambda-form-entry (cons string->symbol (lambda Y1167 (string->symbol Y1167)))) (do (shen.set-lambda-form-entry (cons string? (lambda Y1168 (string? Y1168)))) (do (shen.set-lambda-form-entry (cons subst (lambda Y1169 (lambda Y1170 (lambda Y1171 (subst Y1169 Y1170 Y1171)))))) (do (shen.set-lambda-form-entry (cons sum (lambda Y1172 (sum Y1172)))) (do (shen.set-lambda-form-entry (cons symbol? (lambda Y1173 (symbol? Y1173)))) (do (shen.set-lambda-form-entry (cons systemf (lambda Y1174 (systemf Y1174)))) (do (shen.set-lambda-form-entry (cons tail (lambda Y1175 (tail Y1175)))) (do (shen.set-lambda-form-entry (cons tl (lambda Y1176 (tl Y1176)))) (do (shen.set-lambda-form-entry (cons tc (lambda Y1177 (tc Y1177)))) (do (shen.set-lambda-form-entry (cons thaw (lambda Y1178 (thaw Y1178)))) (do (shen.set-lambda-form-entry (cons tlstr (lambda Y1179 (tlstr Y1179)))) (do (shen.set-lambda-form-entry (cons track (lambda Y1180 (track Y1180)))) (do (shen.set-lambda-form-entry (cons trap-error (lambda Y1181 (lambda Y1182 (trap-error Y1181 Y1182))))) (do (shen.set-lambda-form-entry (cons tuple? (lambda Y1183 (tuple? Y1183)))) (do (shen.set-lambda-form-entry (cons type (lambda Y1184 (lambda Y1185 (type Y1184 Y1185))))) (do (shen.set-lambda-form-entry (cons return (lambda Y1186 (lambda Y1187 (lambda Y1188 (lambda Y1189 (lambda Y1190 (return Y1186 Y1187 Y1188 Y1189 Y1190)))))))) (do (shen.set-lambda-form-entry (cons unabsolute (lambda Y1191 (unabsolute Y1191)))) (do (shen.set-lambda-form-entry (cons undefmacro (lambda Y1192 (undefmacro Y1192)))) (do (shen.set-lambda-form-entry (cons unput (lambda Y1193 (lambda Y1194 (lambda Y1195 (unput Y1193 Y1194 Y1195)))))) (do (shen.set-lambda-form-entry (cons unprofile (lambda Y1196 (unprofile Y1196)))) (do (shen.set-lambda-form-entry (cons union (lambda Y1197 (lambda Y1198 (union Y1197 Y1198))))) (do (shen.set-lambda-form-entry (cons untrack (lambda Y1199 (untrack Y1199)))) (do (shen.set-lambda-form-entry (cons undefmacro (lambda Y1200 (undefmacro Y1200)))) (do (shen.set-lambda-form-entry (cons update-lambda-table (lambda Y1201 (lambda Y1202 (update-lambda-table Y1201 Y1202))))) (do (shen.set-lambda-form-entry (cons vector (lambda Y1203 (vector Y1203)))) (do (shen.set-lambda-form-entry (cons vector? (lambda Y1204 (vector? Y1204)))) (do (shen.set-lambda-form-entry (cons vector-> (lambda Y1205 (lambda Y1206 (lambda Y1207 (vector-> Y1205 Y1206 Y1207)))))) (do (shen.set-lambda-form-entry (cons value (lambda Y1208 (value Y1208)))) (do (shen.set-lambda-form-entry (cons variable? (lambda Y1209 (variable? Y1209)))) (do (shen.set-lambda-form-entry (cons var? (lambda Y1210 (lambda Y1211 (lambda Y1212 (lambda Y1213 (lambda Y1214 (var? Y1210 Y1211 Y1212 Y1213 Y1214)))))))) (do (shen.set-lambda-form-entry (cons when (lambda Y1215 (lambda Y1216 (lambda Y1217 (lambda Y1218 (lambda Y1219 (when Y1215 Y1216 Y1217 Y1218 Y1219)))))))) (do (shen.set-lambda-form-entry (cons write-byte (lambda Y1220 (lambda Y1221 (write-byte Y1220 Y1221))))) (do (shen.set-lambda-form-entry (cons write-string (lambda Y1222 (lambda Y1223 (write-string Y1222 Y1223))))) (do (shen.set-lambda-form-entry (cons write-to-file (lambda Y1224 (lambda Y1225 (write-to-file Y1224 Y1225))))) (do (shen.set-lambda-form-entry (cons y-or-n? (lambda Y1226 (y-or-n? Y1226)))) (do (shen.set-lambda-form-entry (cons + (lambda Y1227 (lambda Y1228 (+ Y1227 Y1228))))) (do (shen.set-lambda-form-entry (cons * (lambda Y1229 (lambda Y1230 (* Y1229 Y1230))))) (do (shen.set-lambda-form-entry (cons / (lambda Y1231 (lambda Y1232 (/ Y1231 Y1232))))) (do (shen.set-lambda-form-entry (cons - (lambda Y1233 (lambda Y1234 (- Y1233 Y1234))))) (do (shen.set-lambda-form-entry (cons == (lambda Y1235 (lambda Y1236 (== Y1235 Y1236))))) (do (shen.set-lambda-form-entry (cons (lambda Y1237 ( Y1237)))) (do (shen.set-lambda-form-entry (cons (lambda Y1238 ( Y1238)))) (do (shen.set-lambda-form-entry (cons (lambda Y1239 ( Y1239)))) (do (shen.set-lambda-form-entry (cons @p (lambda Y1240 (lambda Y1241 (@p Y1240 Y1241))))) (do (shen.set-lambda-form-entry (cons @v (lambda Y1242 (lambda Y1243 (@v Y1242 Y1243))))) (shen.set-lambda-form-entry (cons @s (lambda Y1244 (lambda Y1245 (@s Y1244 Y1245)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) diff --git a/klambda/macros.kl b/klambda/macros.kl index 49f6b85..c94e9e2 100644 --- a/klambda/macros.kl +++ b/klambda/macros.kl @@ -1,69 +1,69 @@ -(defun macroexpand (V7101) (let W7102 (map (lambda Z7103 (tl Z7103)) (value *macros*)) (shen.macroexpand-h V7101 W7102 W7102 (value shen.*source-form-handlers*)))) +(defun macroexpand (V7129) (let W7130 (map (lambda Z7131 (tl Z7131)) (value *macros*)) (shen.macroexpand-h V7129 W7130 W7130 (value shen.*source-form-handlers*)))) -(defun shen.macroexpand-h (V7116 V7117 V7118 V7119) (if (= () V7117) V7116 (if (cons? V7117) (let W7120 (shen.source-macro-walk (hd V7117) V7116 V7119) (if (= V7116 W7120) (shen.macroexpand-h V7116 (tl V7117) V7118 V7119) (shen.macroexpand-h W7120 V7118 V7118 V7119))) (simple-error "implementation error in shen.macroexpand-h")))) +(defun shen.macroexpand-h (V7144 V7145 V7146 V7147) (if (= () V7145) V7144 (if (cons? V7145) (let W7148 (shen.source-macro-walk (hd V7145) V7144 V7147) (if (= V7144 W7148) (shen.macroexpand-h V7144 (tl V7145) V7146 V7147) (shen.macroexpand-h W7148 V7146 V7146 V7147))) (simple-error "implementation error in shen.macroexpand-h")))) -(defun shen.source-macro-walk (V7124 V7125 V7126) (if (= () V7126) (shen.walk V7124 V7125) (if (cons? (shen.source-form-handler V7125 V7126)) V7125 (if (cons? V7125) (V7124 (map (lambda Z7127 (shen.source-macro-walk V7124 Z7127 V7126)) V7125)) (V7124 V7125))))) +(defun shen.source-macro-walk (V7152 V7153 V7154) (if (= () V7154) (shen.walk V7152 V7153) (if (cons? (shen.source-form-handler V7153 V7154)) V7153 (if (cons? V7153) (V7152 (map (lambda Z7155 (shen.source-macro-walk V7152 Z7155 V7154)) V7153)) (V7152 V7153))))) -(defun shen.walk (V7128 V7129) (if (cons? V7129) (V7128 (map (lambda Z7130 (shen.walk V7128 Z7130)) V7129)) (V7128 V7129))) +(defun shen.walk (V7156 V7157) (if (cons? V7157) (V7156 (map (lambda Z7158 (shen.walk V7156 Z7158)) V7157)) (V7156 V7157))) -(defun shen.macros (V7131) (let GoTo7132 (freeze V7131) (if (cons? V7131) (let Select7146 (hd V7131) (let Select7147 (tl V7131) (if (and (= defmacro Select7146) (cons? Select7147)) (shen.process-def (hd Select7147) (tl Select7147)) (if (= defcc Select7146) (shen.yacc->shen Select7147) (if (and (= u! Select7146) (and (cons? Select7147) (= () (tl Select7147)))) (cons protect (cons (shen.make-uppercase (hd Select7147)) ())) (if (and (= error Select7146) (cons? Select7147)) (cons simple-error (cons (shen.mkstr (hd Select7147) (tl Select7147)) ())) (if (and (= output Select7146) (cons? Select7147)) (cons pr (cons (shen.mkstr (hd Select7147) (tl Select7147)) (cons (cons stoutput ()) ()))) (if (and (= pr Select7146) (and (cons? Select7147) (= () (tl Select7147)))) (cons pr (cons (hd Select7147) (cons (cons stoutput ()) ()))) (if (and (= make-string Select7146) (cons? Select7147)) (shen.mkstr (hd Select7147) (tl Select7147)) (if (and (= lineread Select7146) (= () Select7147)) (cons lineread (cons (cons stinput ()) ())) (if (and (= input Select7146) (= () Select7147)) (cons input (cons (cons stinput ()) ())) (if (and (= read Select7146) (= () Select7147)) (cons read (cons (cons stinput ()) ())) (if (and (= input+ Select7146) (cons? Select7147)) (shen.process-input+ V7131) (if (and (= read-byte Select7146) (= () Select7147)) (shen.process-read-byte) (if (= prolog? Select7146) (shen.call-prolog Select7147) (if (and (= defprolog Select7146) (cons? Select7147)) (shen.compile-prolog (hd Select7147) (tl Select7147)) (if (and (= datatype Select7146) (cons? Select7147)) (shen.process-datatype (hd Select7147) (tl Select7147)) (if (= @s Select7146) (shen.process-@s V7131) (if (= synonyms Select7146) (shen.process-synonyms Select7147) (if (and (= nl Select7146) (= () Select7147)) (cons nl (cons 1 ())) (if (= let Select7146) (shen.process-let V7131) (if (= /. Select7146) (shen.process-lambda V7131) (if (= cases Select7146) (shen.process-cases V7131) (if (and (= time Select7146) (and (cons? Select7147) (= () (tl Select7147)))) (shen.process-time (hd Select7147)) (if (and (= put Select7146) (and (cons? Select7147) (let Select7133 (tl Select7147) (and (cons? Select7133) (let Select7135 (tl Select7133) (and (cons? Select7135) (= () (tl Select7135)))))))) (let Select7134 (tl Select7147) (cons put (cons (hd Select7147) (cons (hd Select7134) (cons (hd (tl Select7134)) (cons (cons value (cons *property-vector* ())) ())))))) (if (and (= get Select7146) (and (cons? Select7147) (let Select7136 (tl Select7147) (and (cons? Select7136) (= () (tl Select7136)))))) (cons get (cons (hd Select7147) (cons (hd (tl Select7147)) (cons (cons value (cons *property-vector* ())) ())))) (if (and (= unput Select7146) (and (cons? Select7147) (let Select7137 (tl Select7147) (and (cons? Select7137) (= () (tl Select7137)))))) (cons unput (cons (hd Select7147) (cons (hd (tl Select7147)) (cons (cons value (cons *property-vector* ())) ())))) (if (and (= shen.@c Select7146) (and (cons? Select7147) (= () (tl Select7147)))) (shen.rcons_form (hd Select7147)) (let GoTo7139 (freeze (if (and (cons? Select7147) (let Select7138 (tl Select7147) (and (cons? Select7138) (and (cons? (tl Select7138)) (element? Select7146 (cons @p (cons @v (cons append (cons and (cons or (cons + (cons * (cons do ()))))))))))))) (cons Select7146 (cons (hd Select7147) (cons (shen.process-assoc (cons Select7146 (tl Select7147))) ()))) (thaw GoTo7132))) (if (= shen.@ch Select7146) (if (cons? Select7147) (let Select7144 (hd Select7147) (let Select7145 (tl Select7147) (if (and (cons? Select7144) (let Select7141 (tl Select7144) (and (cons? Select7141) (let Select7143 (tl Select7141) (and (cons? Select7143) (and (= () (tl Select7143)) (and (= () Select7145) (= (hd Select7141) (intern ":"))))))))) (let Select7142 (tl Select7144) (shen.cons-form-respect-modes (cons - (cons (cons (hd Select7144) (cons (hd Select7142) (cons (cons + (tl Select7142)) ()))) ())))) (if (= () Select7145) (shen.cons-form-respect-modes Select7144) (thaw GoTo7139))))) (thaw GoTo7139)) (thaw GoTo7139))))))))))))))))))))))))))))))) (thaw GoTo7132)))) +(defun shen.macros (V7159) (let GoTo7160 (freeze V7159) (if (cons? V7159) (let Select7174 (hd V7159) (let Select7175 (tl V7159) (if (and (= defmacro Select7174) (cons? Select7175)) (shen.process-def (hd Select7175) (tl Select7175)) (if (= defcc Select7174) (shen.yacc->shen Select7175) (if (and (= u! Select7174) (and (cons? Select7175) (= () (tl Select7175)))) (cons protect (cons (shen.make-uppercase (hd Select7175)) ())) (if (and (= error Select7174) (cons? Select7175)) (cons simple-error (cons (shen.mkstr (hd Select7175) (tl Select7175)) ())) (if (and (= output Select7174) (cons? Select7175)) (cons pr (cons (shen.mkstr (hd Select7175) (tl Select7175)) (cons (cons stoutput ()) ()))) (if (and (= pr Select7174) (and (cons? Select7175) (= () (tl Select7175)))) (cons pr (cons (hd Select7175) (cons (cons stoutput ()) ()))) (if (and (= make-string Select7174) (cons? Select7175)) (shen.mkstr (hd Select7175) (tl Select7175)) (if (and (= lineread Select7174) (= () Select7175)) (cons lineread (cons (cons stinput ()) ())) (if (and (= input Select7174) (= () Select7175)) (cons input (cons (cons stinput ()) ())) (if (and (= read Select7174) (= () Select7175)) (cons read (cons (cons stinput ()) ())) (if (and (= input+ Select7174) (cons? Select7175)) (shen.process-input+ V7159) (if (and (= read-byte Select7174) (= () Select7175)) (shen.process-read-byte) (if (= prolog? Select7174) (shen.call-prolog Select7175) (if (and (= defprolog Select7174) (cons? Select7175)) (shen.compile-prolog (hd Select7175) (tl Select7175)) (if (and (= datatype Select7174) (cons? Select7175)) (shen.process-datatype (hd Select7175) (tl Select7175)) (if (= @s Select7174) (shen.process-@s V7159) (if (= synonyms Select7174) (shen.process-synonyms Select7175) (if (and (= nl Select7174) (= () Select7175)) (cons nl (cons 1 ())) (if (= let Select7174) (shen.process-let V7159) (if (= /. Select7174) (shen.process-lambda V7159) (if (= cases Select7174) (shen.process-cases V7159) (if (and (= time Select7174) (and (cons? Select7175) (= () (tl Select7175)))) (shen.process-time (hd Select7175)) (if (and (= put Select7174) (and (cons? Select7175) (let Select7161 (tl Select7175) (and (cons? Select7161) (let Select7163 (tl Select7161) (and (cons? Select7163) (= () (tl Select7163)))))))) (let Select7162 (tl Select7175) (cons put (cons (hd Select7175) (cons (hd Select7162) (cons (hd (tl Select7162)) (cons (cons value (cons *property-vector* ())) ())))))) (if (and (= get Select7174) (and (cons? Select7175) (let Select7164 (tl Select7175) (and (cons? Select7164) (= () (tl Select7164)))))) (cons get (cons (hd Select7175) (cons (hd (tl Select7175)) (cons (cons value (cons *property-vector* ())) ())))) (if (and (= unput Select7174) (and (cons? Select7175) (let Select7165 (tl Select7175) (and (cons? Select7165) (= () (tl Select7165)))))) (cons unput (cons (hd Select7175) (cons (hd (tl Select7175)) (cons (cons value (cons *property-vector* ())) ())))) (if (and (= shen.@c Select7174) (and (cons? Select7175) (= () (tl Select7175)))) (shen.rcons_form (hd Select7175)) (let GoTo7167 (freeze (if (and (cons? Select7175) (let Select7166 (tl Select7175) (and (cons? Select7166) (and (cons? (tl Select7166)) (element? Select7174 (cons @p (cons @v (cons append (cons and (cons or (cons + (cons * (cons do ()))))))))))))) (cons Select7174 (cons (hd Select7175) (cons (shen.process-assoc (cons Select7174 (tl Select7175))) ()))) (thaw GoTo7160))) (if (= shen.@ch Select7174) (if (cons? Select7175) (let Select7172 (hd Select7175) (let Select7173 (tl Select7175) (if (and (cons? Select7172) (let Select7169 (tl Select7172) (and (cons? Select7169) (let Select7171 (tl Select7169) (and (cons? Select7171) (and (= () (tl Select7171)) (and (= () Select7173) (= (hd Select7169) (intern ":"))))))))) (let Select7170 (tl Select7172) (shen.cons-form-respect-modes (cons - (cons (cons (hd Select7172) (cons (hd Select7170) (cons (cons + (tl Select7170)) ()))) ())))) (if (= () Select7173) (shen.cons-form-respect-modes Select7172) (thaw GoTo7167))))) (thaw GoTo7167)) (thaw GoTo7167))))))))))))))))))))))))))))))) (thaw GoTo7160)))) -(defun shen.process-input+ (V7148) (let GoTo7149 (freeze (shen.f-error shen.process-input+)) (if (cons? V7148) (let Select7154 (tl V7148) (if (= input+ (hd V7148)) (if (cons? Select7154) (let Select7152 (hd Select7154) (let Select7153 (tl Select7154) (if (= () Select7153) (cons shen.input-h+ (cons (shen.rcons_form Select7152) (cons (cons stinput ()) ()))) (if (and (cons? Select7153) (= () (tl Select7153))) (cons shen.input-h+ (cons (shen.rcons_form Select7152) Select7153)) (thaw GoTo7149))))) (thaw GoTo7149)) (thaw GoTo7149))) (thaw GoTo7149)))) +(defun shen.process-input+ (V7176) (let GoTo7177 (freeze (shen.f-error shen.process-input+)) (if (cons? V7176) (let Select7182 (tl V7176) (if (= input+ (hd V7176)) (if (cons? Select7182) (let Select7180 (hd Select7182) (let Select7181 (tl Select7182) (if (= () Select7181) (cons shen.input-h+ (cons (shen.rcons_form Select7180) (cons (cons stinput ()) ()))) (if (and (cons? Select7181) (= () (tl Select7181))) (cons shen.input-h+ (cons (shen.rcons_form Select7180) Select7181)) (thaw GoTo7177))))) (thaw GoTo7177)) (thaw GoTo7177))) (thaw GoTo7177)))) -(defun shen.cons-form-respect-modes (V7155) (let GoTo7156 (freeze V7155) (if (cons? V7155) (let Select7157 (hd V7155) (let Select7158 (tl V7155) (if (and (= + Select7157) (and (cons? Select7158) (= () (tl Select7158)))) (cons + (cons (shen.cons-form-respect-modes (hd Select7158)) ())) (if (and (= - Select7157) (and (cons? Select7158) (= () (tl Select7158)))) (cons - (cons (shen.cons-form-respect-modes (hd Select7158)) ())) (if (and (= bar! Select7157) (and (cons? Select7158) (= () (tl Select7158)))) (hd Select7158) (cons cons (cons (shen.cons-form-respect-modes Select7157) (cons (shen.cons-form-respect-modes Select7158) ())))))))) (thaw GoTo7156)))) +(defun shen.cons-form-respect-modes (V7183) (let GoTo7184 (freeze V7183) (if (cons? V7183) (let Select7185 (hd V7183) (let Select7186 (tl V7183) (if (and (= + Select7185) (and (cons? Select7186) (= () (tl Select7186)))) (cons + (cons (shen.cons-form-respect-modes (hd Select7186)) ())) (if (and (= - Select7185) (and (cons? Select7186) (= () (tl Select7186)))) (cons - (cons (shen.cons-form-respect-modes (hd Select7186)) ())) (if (and (= bar! Select7185) (and (cons? Select7186) (= () (tl Select7186)))) (hd Select7186) (cons cons (cons (shen.cons-form-respect-modes Select7185) (cons (shen.cons-form-respect-modes Select7186) ())))))))) (thaw GoTo7184)))) -(defun shen.process-def (V7159 V7160) (let W7161 (cons X (cons -> (cons X ()))) (let W7162 (eval (cons define (cons V7159 (append V7160 W7161)))) (let W7163 (shen.record-macro V7159 (fn V7159)) V7159)))) +(defun shen.process-def (V7187 V7188) (let W7189 (cons X (cons -> (cons X ()))) (let W7190 (eval (cons define (cons V7187 (append V7188 W7189)))) (let W7191 (shen.record-macro V7187 (fn V7187)) V7187)))) -(defun shen.process-let (V7164) (if (and (cons? V7164) (let Select7165 (tl V7164) (and (= let (hd V7164)) (and (cons? Select7165) (let Select7167 (tl Select7165) (and (cons? Select7167) (let Select7168 (tl Select7167) (and (cons? Select7168) (cons? (tl Select7168)))))))))) (let Select7166 (tl V7164) (cons let (cons (hd Select7166) (cons (hd (tl Select7166)) (cons (cons let (tl (tl Select7166))) ()))))) V7164)) +(defun shen.process-let (V7192) (if (and (cons? V7192) (let Select7193 (tl V7192) (and (= let (hd V7192)) (and (cons? Select7193) (let Select7195 (tl Select7193) (and (cons? Select7195) (let Select7196 (tl Select7195) (and (cons? Select7196) (cons? (tl Select7196)))))))))) (let Select7194 (tl V7192) (cons let (cons (hd Select7194) (cons (hd (tl Select7194)) (cons (cons let (tl (tl Select7194))) ()))))) V7192)) -(defun shen.process-@s (V7169) (let GoTo7171 (freeze V7169) (if (cons? V7169) (let Select7178 (tl V7169) (if (= @s (hd V7169)) (if (cons? Select7178) (let Select7176 (hd Select7178) (let Select7177 (tl Select7178) (if (cons? Select7177) (let Select7175 (tl Select7177) (if (cons? Select7175) (cons @s (cons Select7176 (cons (shen.process-@s (cons @s Select7177)) ()))) (if (and (= () Select7175) (string? Select7176)) (let W7170 (explode Select7176) (if (> (length W7170) 1) (shen.process-@s (cons @s (append W7170 Select7177))) V7169)) (thaw GoTo7171)))) (thaw GoTo7171)))) (thaw GoTo7171)) (thaw GoTo7171))) (thaw GoTo7171)))) +(defun shen.process-@s (V7197) (let GoTo7199 (freeze V7197) (if (cons? V7197) (let Select7206 (tl V7197) (if (= @s (hd V7197)) (if (cons? Select7206) (let Select7204 (hd Select7206) (let Select7205 (tl Select7206) (if (cons? Select7205) (let Select7203 (tl Select7205) (if (cons? Select7203) (cons @s (cons Select7204 (cons (shen.process-@s (cons @s Select7205)) ()))) (if (and (= () Select7203) (string? Select7204)) (let W7198 (explode Select7204) (if (> (length W7198) 1) (shen.process-@s (cons @s (append W7198 Select7205))) V7197)) (thaw GoTo7199)))) (thaw GoTo7199)))) (thaw GoTo7199)) (thaw GoTo7199))) (thaw GoTo7199)))) -(defun shen.process-datatype (V7179 V7180) (let W7181 (shen.intern-type V7179) (let W7182 (compile (lambda Z7183 (shen. Z7183)) (cons W7181 V7180)) W7181))) +(defun shen.process-datatype (V7207 V7208) (let W7209 (shen.intern-type V7207) (let W7210 (compile (lambda Z7211 (shen. Z7211)) (cons W7209 V7208)) W7209))) -(defun shen.intern-type (V7184) (intern (cn (str V7184) "#type"))) +(defun shen.intern-type (V7212) (intern (cn (str V7212) "#type"))) -(defun shen.process-synonyms (V7185) (shen.synonyms-h (set shen.*synonyms* (append V7185 (value shen.*synonyms*))))) +(defun shen.process-synonyms (V7213) (shen.synonyms-h (set shen.*synonyms* (append V7213 (value shen.*synonyms*))))) -(defun shen.lambda-of-defun (V7188) (if (and (cons? V7188) (let Select7189 (tl V7188) (and (= defun (hd V7188)) (and (cons? Select7189) (let Select7191 (tl Select7189) (and (cons? Select7191) (let Select7192 (hd Select7191) (let Select7193 (tl Select7191) (and (cons? Select7192) (and (= () (tl Select7192)) (and (cons? Select7193) (= () (tl Select7193))))))))))))) (let Select7190 (tl V7188) (eval (cons /. (cons (hd (hd (tl Select7190))) (tl (tl Select7190)))))) (shen.f-error shen.lambda-of-defun))) +(defun shen.lambda-of-defun (V7216) (if (and (cons? V7216) (let Select7217 (tl V7216) (and (= defun (hd V7216)) (and (cons? Select7217) (let Select7219 (tl Select7217) (and (cons? Select7219) (let Select7220 (hd Select7219) (let Select7221 (tl Select7219) (and (cons? Select7220) (and (= () (tl Select7220)) (and (cons? Select7221) (= () (tl Select7221))))))))))))) (let Select7218 (tl V7216) (eval (cons /. (cons (hd (hd (tl Select7218))) (tl (tl Select7218)))))) (shen.f-error shen.lambda-of-defun))) -(defun shen.synonyms-h (V7194) (let W7195 (map (lambda Z7196 (shen.curry-type Z7196)) V7194) (let W7197 (shen.lambda-of-defun (shen.shendef->kldef shen.demod (shen.compile-synonyms W7195))) (let W7198 (set shen.*demodulation-function* W7197) synonyms)))) +(defun shen.synonyms-h (V7222) (let W7223 (map (lambda Z7224 (shen.curry-type Z7224)) V7222) (let W7225 (shen.lambda-of-defun (shen.shendef->kldef shen.demod (shen.compile-synonyms W7223))) (let W7226 (set shen.*demodulation-function* W7225) synonyms)))) -(defun shen.compile-synonyms (V7201) (if (= () V7201) (let W7202 (gensym X) (cons W7202 (cons -> (cons W7202 ())))) (if (and (cons? V7201) (cons? (tl V7201))) (let Select7203 (tl V7201) (cons (shen.rcons_form (hd V7201)) (cons -> (cons (shen.rcons_form (hd Select7203)) (shen.compile-synonyms (tl Select7203)))))) (simple-error "synonyms requires an even number of arguments +(defun shen.compile-synonyms (V7229) (if (= () V7229) (let W7230 (gensym X) (cons W7230 (cons -> (cons W7230 ())))) (if (and (cons? V7229) (cons? (tl V7229))) (let Select7231 (tl V7229) (cons (shen.rcons_form (hd V7229)) (cons -> (cons (shen.rcons_form (hd Select7231)) (shen.compile-synonyms (tl Select7231)))))) (simple-error "synonyms requires an even number of arguments ")))) -(defun shen.process-lambda (V7204) (let GoTo7205 (freeze V7204) (if (cons? V7204) (let Select7212 (tl V7204) (if (= /. (hd V7204)) (if (cons? Select7212) (let Select7210 (hd Select7212) (let Select7211 (tl Select7212) (if (cons? Select7211) (let Select7209 (tl Select7211) (if (cons? Select7209) (cons lambda (cons Select7210 (cons (shen.process-lambda (cons /. Select7211)) ()))) (if (= () Select7209) (if (variable? Select7210) (cons lambda Select7212) (simple-error (shen.app Select7210 " is not a variable -" shen.s))) (thaw GoTo7205)))) (thaw GoTo7205)))) (thaw GoTo7205)) (thaw GoTo7205))) (thaw GoTo7205)))) +(defun shen.process-lambda (V7232) (let GoTo7233 (freeze V7232) (if (cons? V7232) (let Select7240 (tl V7232) (if (= /. (hd V7232)) (if (cons? Select7240) (let Select7238 (hd Select7240) (let Select7239 (tl Select7240) (if (cons? Select7239) (let Select7237 (tl Select7239) (if (cons? Select7237) (cons lambda (cons Select7238 (cons (shen.process-lambda (cons /. Select7239)) ()))) (if (= () Select7237) (if (variable? Select7238) (cons lambda Select7240) (simple-error (shen.app Select7238 " is not a variable +" shen.s))) (thaw GoTo7233)))) (thaw GoTo7233)))) (thaw GoTo7233)) (thaw GoTo7233))) (thaw GoTo7233)))) -(defun shen.process-cases (V7215) (let GoTo7216 (freeze V7215) (if (cons? V7215) (let Select7224 (tl V7215) (if (= cases (hd V7215)) (if (cons? Select7224) (let Select7222 (hd Select7224) (let Select7223 (tl Select7224) (if (and (= true Select7222) (cons? Select7223)) (hd Select7223) (let GoTo7219 (freeze (if (= () Select7223) (simple-error "error: odd number of case elements -") (thaw GoTo7216))) (if (cons? Select7223) (let Select7220 (hd Select7223) (let Select7221 (tl Select7223) (if (= () Select7221) (cons if (cons Select7222 (cons Select7220 (cons (cons simple-error (cons "error: cases exhausted" ())) ())))) (cons if (cons Select7222 (cons Select7220 (cons (shen.process-cases (cons cases Select7221)) ()))))))) (thaw GoTo7219)))))) (thaw GoTo7216)) (thaw GoTo7216))) (thaw GoTo7216)))) +(defun shen.process-cases (V7243) (let GoTo7244 (freeze V7243) (if (cons? V7243) (let Select7252 (tl V7243) (if (= cases (hd V7243)) (if (cons? Select7252) (let Select7250 (hd Select7252) (let Select7251 (tl Select7252) (if (and (= true Select7250) (cons? Select7251)) (hd Select7251) (let GoTo7247 (freeze (if (= () Select7251) (simple-error "error: odd number of case elements +") (thaw GoTo7244))) (if (cons? Select7251) (let Select7248 (hd Select7251) (let Select7249 (tl Select7251) (if (= () Select7249) (cons if (cons Select7250 (cons Select7248 (cons (cons simple-error (cons "error: cases exhausted" ())) ())))) (cons if (cons Select7250 (cons Select7248 (cons (shen.process-cases (cons cases Select7249)) ()))))))) (thaw GoTo7247)))))) (thaw GoTo7244)) (thaw GoTo7244))) (thaw GoTo7244)))) -(defun shen.process-time (V7225) (cons let (cons Start (cons (cons get-time (cons run ())) (cons Result (cons V7225 (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 (V7253) (cons let (cons Start (cons (cons get-time (cons run ())) (cons Result (cons V7253 (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 (V7226) (if (and (cons? V7226) (let Select7227 (tl V7226) (and (cons? Select7227) (let Select7230 (tl Select7227) (and (cons? Select7230) (cons? (tl Select7230))))))) (let Select7228 (hd V7226) (let Select7229 (tl V7226) (cons Select7228 (cons (hd Select7229) (cons (cons Select7228 (tl Select7229)) ()))))) V7226)) +(defun shen.process-assoc (V7254) (if (and (cons? V7254) (let Select7255 (tl V7254) (and (cons? Select7255) (let Select7258 (tl Select7255) (and (cons? Select7258) (cons? (tl Select7258))))))) (let Select7256 (hd V7254) (let Select7257 (tl V7254) (cons Select7256 (cons (hd Select7257) (cons (cons Select7256 (tl Select7257)) ()))))) V7254)) -(defun shen.make-uppercase (V7231) (intern (shen.mu-h (str V7231)))) +(defun shen.make-uppercase (V7259) (intern (shen.mu-h (str V7259)))) -(defun shen.mu-h (V7232) (if (= "" V7232) "" (if (shen.+string? V7232) (let W7233 (string->n (hdstr V7232)) (let W7234 (- W7233 32) (let W7235 (if (and (>= W7233 97) (<= W7233 122)) (n->string W7234) (hdstr V7232)) (@s W7235 (shen.mu-h (tlstr V7232)))))) (shen.f-error shen.mu-h)))) +(defun shen.mu-h (V7260) (if (= "" V7260) "" (if (shen.+string? V7260) (let W7261 (string->n (hdstr V7260)) (let W7262 (- W7261 32) (let W7263 (if (and (>= W7261 97) (<= W7261 122)) (n->string W7262) (hdstr V7260)) (@s W7263 (shen.mu-h (tlstr V7260)))))) (shen.f-error shen.mu-h)))) -(defun shen.record-macro (V7236 V7237) (set *macros* (shen.update-assoc V7236 V7237 (value *macros*)))) +(defun shen.record-macro (V7264 V7265) (set *macros* (shen.update-assoc V7264 V7265 (value *macros*)))) -(defun shen.update-assoc (V7247 V7248 V7249) (if (= () V7249) (cons (cons V7247 V7248) ()) (let GoTo7250 (freeze (simple-error "implementation error in shen.update-assoc")) (if (cons? V7249) (let Select7251 (hd V7249) (let Select7252 (tl V7249) (if (and (cons? Select7251) (= V7247 (hd Select7251))) (cons (cons (hd Select7251) V7248) Select7252) (cons Select7251 (shen.update-assoc V7247 V7248 Select7252))))) (thaw GoTo7250))))) +(defun shen.update-assoc (V7275 V7276 V7277) (if (= () V7277) (cons (cons V7275 V7276) ()) (let GoTo7278 (freeze (simple-error "implementation error in shen.update-assoc")) (if (cons? V7277) (let Select7279 (hd V7277) (let Select7280 (tl V7277) (if (and (cons? Select7279) (= V7275 (hd Select7279))) (cons (cons (hd Select7279) V7276) Select7280) (cons Select7279 (shen.update-assoc V7275 V7276 Select7280))))) (thaw GoTo7278))))) (defun shen.process-read-byte () (if (char-stream? (stinput)) (cons string->n (cons (cons read-unit-string (cons (cons stinput ()) ())) ())) (cons read-byte (cons (cons stinput ()) ())))) -(defun shen.call-prolog (V7253) (let W7254 (cons shen.prolog-vector ()) (let W7255 (cons @v (cons true (cons 0 (cons (cons vector (cons 0 ())) ())))) (let W7256 0 (let W7257 (cons freeze (cons true ())) (let W7258 (compile (lambda Z7259 (shen. Z7259)) V7253) (let W7260 (shen.received V7253) (let W7261 (gensym V) (let W7262 (gensym L) (let W7263 (gensym K) (let W7264 (gensym C) (let W7265 (cons lambda (cons W7261 (cons (cons lambda (cons W7262 (cons (cons lambda (cons W7263 (cons (cons lambda (cons W7264 (cons (shen.continue W7260 W7258 W7261 W7262 W7263 W7264) ()))) ()))) ()))) ()))) (cons W7265 (cons W7254 (cons W7255 (cons W7256 (cons W7257 ()))))))))))))))))) +(defun shen.call-prolog (V7281) (let W7282 (cons shen.prolog-vector ()) (let W7283 (cons @v (cons true (cons 0 (cons (cons vector (cons 0 ())) ())))) (let W7284 0 (let W7285 (cons freeze (cons true ())) (let W7286 (compile (lambda Z7287 (shen. Z7287)) V7281) (let W7288 (shen.received V7281) (let W7289 (gensym V) (let W7290 (gensym L) (let W7291 (gensym K) (let W7292 (gensym C) (let W7293 (cons lambda (cons W7289 (cons (cons lambda (cons W7290 (cons (cons lambda (cons W7291 (cons (cons lambda (cons W7292 (cons (shen.continue W7288 W7286 W7289 W7290 W7291 W7292) ()))) ()))) ()))) ()))) (cons W7293 (cons W7282 (cons W7283 (cons W7284 (cons W7285 ()))))))))))))))))) -(defun shen.received (V7268) (let GoTo7269 (freeze ()) (if (cons? V7268) (let Select7270 (hd V7268) (let Select7271 (tl V7268) (if (and (= receive Select7270) (and (cons? Select7271) (= () (tl Select7271)))) Select7271 (union (shen.received Select7270) (shen.received Select7271))))) (thaw GoTo7269)))) +(defun shen.received (V7296) (let GoTo7297 (freeze ()) (if (cons? V7296) (let Select7298 (hd V7296) (let Select7299 (tl V7296) (if (and (= receive Select7298) (and (cons? Select7299) (= () (tl Select7299)))) Select7299 (union (shen.received Select7298) (shen.received Select7299))))) (thaw GoTo7297)))) -(defun shen.prolog-vector () (let W7272 (absvector (value shen.*prolog-memory*)) (let W7273 (address-> W7272 0 shen.print-prolog-vector) (let W7274 (address-> W7272 1 2) W7274)))) +(defun shen.prolog-vector () (let W7300 (absvector (value shen.*prolog-memory*)) (let W7301 (address-> W7300 0 shen.print-prolog-vector) (let W7302 (address-> W7300 1 2) W7302)))) -(defun receive (V7275) V7275) +(defun receive (V7303) V7303) -(defun shen.rcons_form (V7276) (let GoTo7277 (freeze V7276) (if (cons? V7276) (let Select7278 (hd V7276) (let Select7279 (tl V7276) (if (and (= bar! Select7278) (and (cons? Select7279) (= () (tl Select7279)))) (hd Select7279) (cons cons (cons (shen.rcons_form Select7278) (cons (shen.rcons_form Select7279) ())))))) (thaw GoTo7277)))) +(defun shen.rcons_form (V7304) (let GoTo7305 (freeze V7304) (if (cons? V7304) (let Select7306 (hd V7304) (let Select7307 (tl V7304) (if (and (= bar! Select7306) (and (cons? Select7307) (= () (tl Select7307)))) (hd Select7307) (cons cons (cons (shen.rcons_form Select7306) (cons (shen.rcons_form Select7307) ())))))) (thaw GoTo7305)))) -(defun shen.tuple-up (V7280) (if (cons? V7280) (cons @p (cons (hd V7280) (cons (shen.tuple-up (tl V7280)) ()))) V7280)) +(defun shen.tuple-up (V7308) (if (cons? V7308) (cons @p (cons (hd V7308) (cons (shen.tuple-up (tl V7308)) ()))) V7308)) -(defun undefmacro (V7281) (do (set *macros* (remove (assoc V7281 (value *macros*)) (value *macros*))) V7281)) +(defun undefmacro (V7309) (do (set *macros* (remove (assoc V7309 (value *macros*)) (value *macros*))) V7309)) diff --git a/klambda/t-star.kl b/klambda/t-star.kl index 2a377f3..f54b3d7 100644 --- a/klambda/t-star.kl +++ b/klambda/t-star.kl @@ -1,108 +1,112 @@ -(defun shen.typecheck (V4901 V4902) (let W4903 (shen.extract-vars V4902) (let W4904 (shen.rectify-type V4902) (let W4905 (shen.curry V4901) (((((lambda Z4906 (lambda Z4907 (lambda Z4908 (lambda Z4909 (let W4910 (shen.newpv Z4906) (shen.gc Z4906 (do (shen.incinfs) (shen.insert-prolog-variables (receive (shen.deref W4903 Z4906)) (receive (shen.deref W4904 Z4906)) W4910 Z4906 Z4907 Z4908 (freeze (shen.toplevel-forms (receive (shen.deref W4905 Z4906)) W4910 Z4906 Z4907 Z4908 (freeze (return W4910 Z4906 Z4907 Z4908 Z4909)))))))))))) (shen.prolog-vector)) (@v true (@v 0 (vector 0)))) 0) (freeze true)))))) +(defun shen.typecheck (V4915 V4916) (let W4917 (shen.extract-vars V4916) (let W4918 (shen.rectify-type V4916) (let W4919 (shen.curry V4915) (((((lambda Z4920 (lambda Z4921 (lambda Z4922 (lambda Z4923 (let W4924 (shen.newpv Z4920) (shen.gc Z4920 (do (shen.incinfs) (shen.insert-prolog-variables (receive (shen.deref W4917 Z4920)) (receive (shen.deref W4918 Z4920)) W4924 Z4920 Z4921 Z4922 (freeze (shen.toplevel-forms (receive (shen.deref W4919 Z4920)) W4924 Z4920 Z4921 Z4922 (freeze (return W4924 Z4920 Z4921 Z4922 Z4923)))))))))))) (shen.prolog-vector)) (@v true (@v 0 (vector 0)))) 0) (freeze true)))))) -(defun shen.insert-prolog-variables (V4911 V4912 V4913 V4914 V4915 V4916 V4917) (let W4918 (if (shen.unlocked? V4915) (let W4919 (shen.lazyderef V4911 V4914) (if (= W4919 ()) (do (shen.incinfs) (is! V4912 V4913 V4914 V4915 V4916 V4917)) false)) false) (if (= W4918 false) (if (shen.unlocked? V4915) (let W4920 (shen.lazyderef V4911 V4914) (if (cons? W4920) (let W4921 (hd W4920) (let W4922 (tl W4920) (let W4923 (shen.newpv V4914) (shen.gc V4914 (do (shen.incinfs) (shen.insert-prolog-variables W4922 (subst (shen.deref W4923 V4914) W4921 V4912) V4913 V4914 V4915 V4916 V4917)))))) false)) false) W4918))) +(defun shen.insert-prolog-variables (V4925 V4926 V4927 V4928 V4929 V4930 V4931) (let W4932 (if (shen.unlocked? V4929) (let W4933 (shen.lazyderef V4925 V4928) (if (= W4933 ()) (do (shen.incinfs) (is! V4926 V4927 V4928 V4929 V4930 V4931)) false)) false) (if (= W4932 false) (if (shen.unlocked? V4929) (let W4934 (shen.lazyderef V4925 V4928) (if (cons? W4934) (let W4935 (hd W4934) (let W4936 (tl W4934) (let W4937 (shen.newpv V4928) (shen.gc V4928 (do (shen.incinfs) (shen.insert-prolog-variables W4936 (subst (shen.deref W4937 V4928) W4935 V4926) V4927 V4928 V4929 V4930 V4931)))))) false)) false) W4932))) -(defun shen.toplevel-forms (V4924 V4925 V4926 V4927 V4928 V4929) (let W4930 (+ V4928 1) (let W4931 (if (shen.unlocked? V4927) (let W4932 (shen.lazyderef V4924 V4926) (if (cons? W4932) (let W4933 (shen.lazyderef (hd W4932) V4926) (if (= W4933 define) (let W4934 (shen.lazyderef (tl W4932) V4926) (if (cons? W4934) (let W4935 (hd W4934) (let W4936 (tl W4934) (do (shen.incinfs) (when (shen.type-theory-enabled?) V4926 V4927 W4930 (freeze (shen.cut V4926 V4927 W4930 (freeze (shen.signal-def (value shen.*spy*) W4935 V4926 V4927 W4930 (freeze (shen.t* (cons define (cons W4935 W4936)) V4925 V4926 V4927 W4930 V4929)))))))))) false)) false)) false)) false) (if (= W4931 false) (let W4937 (if (shen.unlocked? V4927) (do (shen.incinfs) (shen.system-S (cons V4924 (cons (intern ":") (cons V4925 ()))) () V4926 V4927 W4930 V4929)) false) (if (= W4937 false) (shen.unlock V4927 W4930) W4937)) W4931)))) +(defun shen.toplevel-forms (V4938 V4939 V4940 V4941 V4942 V4943) (let W4944 (+ V4942 1) (let W4945 (if (shen.unlocked? V4941) (let W4946 (shen.lazyderef V4938 V4940) (if (cons? W4946) (let W4947 (shen.lazyderef (hd W4946) V4940) (if (= W4947 define) (let W4948 (shen.lazyderef (tl W4946) V4940) (if (cons? W4948) (let W4949 (hd W4948) (let W4950 (tl W4948) (do (shen.incinfs) (when (shen.type-theory-enabled?) V4940 V4941 W4944 (freeze (shen.cut V4940 V4941 W4944 (freeze (shen.signal-def (value shen.*spy*) W4949 V4940 V4941 W4944 (freeze (shen.t* (cons define (cons W4949 W4950)) V4939 V4940 V4941 W4944 V4943)))))))))) false)) false)) false)) false) (if (= W4945 false) (let W4951 (if (shen.unlocked? V4941) (do (shen.incinfs) (shen.system-S (cons V4938 (cons (intern ":") (cons V4939 ()))) () V4940 V4941 W4944 V4943)) false) (if (= W4951 false) (shen.unlock V4941 W4944) W4951)) W4945)))) -(defun shen.signal-def (V4938 V4939 V4940 V4941 V4942 V4943) (let W4944 (if (shen.unlocked? V4941) (let W4945 (shen.lazyderef V4938 V4940) (if (= W4945 false) (do (shen.incinfs) (thaw V4943)) false)) false) (if (= W4944 false) (if (shen.unlocked? V4941) (let W4946 (shen.lazyderef V4938 V4940) (if (= W4946 true) (let W4947 (shen.newpv V4940) (shen.gc V4940 (do (shen.incinfs) (is W4947 (pr (cn " -typechecking (fn " (shen.app (shen.deref V4939 V4940) ") -" shen.a)) (stoutput)) V4940 V4941 V4942 V4943)))) false)) false) W4944))) +(defun shen.signal-def (V4952 V4953 V4954 V4955 V4956 V4957) (let W4958 (if (shen.unlocked? V4955) (let W4959 (shen.lazyderef V4952 V4954) (if (= W4959 false) (do (shen.incinfs) (thaw V4957)) false)) false) (if (= W4958 false) (if (shen.unlocked? V4955) (let W4960 (shen.lazyderef V4952 V4954) (if (= W4960 true) (let W4961 (shen.newpv V4954) (shen.gc V4954 (do (shen.incinfs) (is W4961 (pr (cn " +typechecking (fn " (shen.app (shen.deref V4953 V4954) ") +" shen.a)) (stoutput)) V4954 V4955 V4956 V4957)))) false)) false) W4958))) -(defun shen.rectify-type (V4948) (shen.demodulate (shen.curry-type V4948))) +(defun shen.rectify-type (V4962) (shen.demodulate (shen.curry-type V4962))) -(defun shen.demodulate (V4949) (trap-error (let W4950 (shen.walk (lambda Z4951 (shen.demod Z4951)) V4949) (if (= W4950 V4949) V4949 (shen.demodulate W4950))) (lambda Z4952 V4949))) +(defun shen.demodulate (V4963) (trap-error (let W4964 (shen.walk (lambda Z4965 (shen.demod Z4965)) V4963) (if (= W4964 V4963) V4963 (shen.demodulate W4964))) (lambda Z4966 V4963))) -(defun shen.curry-type (V4953) (cond ((and (cons? V4953) (and (cons? (tl V4953)) (and (= --> (hd (tl V4953))) (and (cons? (tl (tl V4953))) (and (cons? (tl (tl (tl V4953)))) (= --> (hd (tl (tl (tl V4953)))))))))) (shen.curry-type (cons (hd V4953) (cons --> (cons (tl (tl V4953)) ()))))) ((and (cons? V4953) (and (cons? (hd V4953)) (and (= list (hd (hd V4953))) (and (cons? (tl (hd V4953))) (and (= () (tl (tl (hd V4953)))) (and (cons? (tl V4953)) (and (= ==> (hd (tl V4953))) (and (cons? (tl (tl V4953))) (= () (tl (tl (tl V4953)))))))))))) (shen.curry-type (cons (hd V4953) (cons --> (cons (cons str (cons (hd V4953) (tl (tl V4953)))) ()))))) ((and (cons? V4953) (and (cons? (tl V4953)) (and (= * (hd (tl V4953))) (and (cons? (tl (tl V4953))) (and (cons? (tl (tl (tl V4953)))) (= * (hd (tl (tl (tl V4953)))))))))) (shen.curry-type (cons (hd V4953) (cons * (cons (tl (tl V4953)) ()))))) ((cons? V4953) (map (lambda Z4954 (shen.curry-type Z4954)) V4953)) (true V4953))) +(defun shen.curry-type (V4967) (cond ((and (cons? V4967) (and (cons? (tl V4967)) (and (= --> (hd (tl V4967))) (and (cons? (tl (tl V4967))) (and (cons? (tl (tl (tl V4967)))) (= --> (hd (tl (tl (tl V4967)))))))))) (shen.curry-type (cons (hd V4967) (cons --> (cons (tl (tl V4967)) ()))))) ((and (cons? V4967) (and (cons? (hd V4967)) (and (= list (hd (hd V4967))) (and (cons? (tl (hd V4967))) (and (= () (tl (tl (hd V4967)))) (and (cons? (tl V4967)) (and (= ==> (hd (tl V4967))) (and (cons? (tl (tl V4967))) (= () (tl (tl (tl V4967)))))))))))) (shen.curry-type (cons (hd V4967) (cons --> (cons (cons str (cons (hd V4967) (tl (tl V4967)))) ()))))) ((and (cons? V4967) (and (cons? (tl V4967)) (and (= * (hd (tl V4967))) (and (cons? (tl (tl V4967))) (and (cons? (tl (tl (tl V4967)))) (= * (hd (tl (tl (tl V4967)))))))))) (shen.curry-type (cons (hd V4967) (cons * (cons (tl (tl V4967)) ()))))) ((cons? V4967) (map (lambda Z4968 (shen.curry-type Z4968)) V4967)) (true V4967))) -(defun shen.curry (V4955) (cond ((and (cons? V4955) (and (= define (hd V4955)) (cons? (tl V4955)))) V4955) ((and (cons? V4955) (and (= type (hd V4955)) (and (cons? (tl V4955)) (and (cons? (tl (tl V4955))) (= () (tl (tl (tl V4955)))))))) (cons type (cons (shen.curry (hd (tl V4955))) (tl (tl V4955))))) ((and (cons? V4955) (shen.special? (hd V4955))) (cons (hd V4955) (map (lambda Z4956 (shen.curry Z4956)) (tl V4955)))) ((and (cons? V4955) (shen.extraspecial? (hd V4955))) V4955) ((and (cons? V4955) (and (cons? (tl V4955)) (cons? (tl (tl V4955))))) (shen.curry (cons (cons (hd V4955) (cons (hd (tl V4955)) ())) (tl (tl V4955))))) ((and (cons? V4955) (and (cons? (tl V4955)) (= () (tl (tl V4955))))) (cons (shen.curry (hd V4955)) (cons (shen.curry (hd (tl V4955))) ()))) (true V4955))) +(defun shen.curry (V4969) (cond ((and (cons? V4969) (and (= define (hd V4969)) (cons? (tl V4969)))) V4969) ((and (cons? V4969) (and (= type (hd V4969)) (and (cons? (tl V4969)) (and (cons? (tl (tl V4969))) (= () (tl (tl (tl V4969)))))))) (cons type (cons (shen.curry (hd (tl V4969))) (tl (tl V4969))))) ((and (cons? V4969) (shen.special? (hd V4969))) (cons (hd V4969) (map (lambda Z4970 (shen.curry Z4970)) (tl V4969)))) ((and (cons? V4969) (shen.extraspecial? (hd V4969))) V4969) ((and (cons? V4969) (and (cons? (tl V4969)) (cons? (tl (tl V4969))))) (shen.curry (cons (cons (hd V4969) (cons (hd (tl V4969)) ())) (tl (tl V4969))))) ((and (cons? V4969) (and (cons? (tl V4969)) (= () (tl (tl V4969))))) (cons (shen.curry (hd V4969)) (cons (shen.curry (hd (tl V4969))) ()))) (true V4969))) -(defun shen.special? (V4957) (element? V4957 (value shen.*special*))) +(defun shen.special? (V4971) (element? V4971 (value shen.*special*))) -(defun shen.extraspecial? (V4958) (element? V4958 (value shen.*extraspecial*))) +(defun shen.extraspecial? (V4972) (element? V4972 (value shen.*extraspecial*))) -(defun shen.system-S (V4959 V4960 V4961 V4962 V4963 V4964) (let W4965 (+ V4963 1) (let W4966 (if (shen.unlocked? V4962) (do (shen.incinfs) (when (shen.maxinfexceeded?) V4961 V4962 W4965 V4964)) false) (if (= W4966 false) (let W4967 (if (shen.unlocked? V4962) (let W4968 (shen.lazyderef V4959 V4961) (if (cons? W4968) (let W4969 (hd W4968) (let W4970 (shen.lazyderef (tl W4968) V4961) (if (cons? W4970) (let W4971 (hd W4970) (let W4972 (shen.lazyderef (tl W4970) V4961) (if (cons? W4972) (let W4973 (hd W4972) (let W4974 (shen.lazyderef (tl W4972) V4961) (if (= W4974 ()) (do (shen.incinfs) (when (= (shen.deref W4971 V4961) (intern ":")) V4961 V4962 W4965 (freeze (when (shen.type-theory-enabled?) V4961 V4962 W4965 (freeze (shen.cut V4961 V4962 W4965 (freeze (shen.system-S-h W4969 W4973 V4960 V4961 V4962 W4965 V4964)))))))) false))) false))) false))) false)) false) (if (= W4967 false) (let W4975 (if (shen.unlocked? V4962) (do (shen.incinfs) (when (value shen.*spy*) V4961 V4962 W4965 (freeze (shen.show V4959 V4960 V4961 V4962 W4965 V4964)))) false) (if (= W4975 false) (let W4976 (if (shen.unlocked? V4962) (do (shen.incinfs) (shen.search-user-datatypes V4959 V4960 (value shen.*datatypes*) V4961 V4962 W4965 V4964)) false) (if (= W4976 false) (shen.unlock V4962 W4965) W4976)) W4975)) W4967)) W4966)))) +(defun shen.system-S (V4973 V4974 V4975 V4976 V4977 V4978) (let W4979 (+ V4977 1) (let W4980 (if (shen.unlocked? V4976) (do (shen.incinfs) (when (shen.maxinfexceeded?) V4975 V4976 W4979 V4978)) false) (if (= W4980 false) (let W4981 (if (shen.unlocked? V4976) (let W4982 (shen.lazyderef V4973 V4975) (if (cons? W4982) (let W4983 (hd W4982) (let W4984 (shen.lazyderef (tl W4982) V4975) (if (cons? W4984) (let W4985 (hd W4984) (let W4986 (shen.lazyderef (tl W4984) V4975) (if (cons? W4986) (let W4987 (hd W4986) (let W4988 (shen.lazyderef (tl W4986) V4975) (if (= W4988 ()) (do (shen.incinfs) (when (= (shen.deref W4985 V4975) (intern ":")) V4975 V4976 W4979 (freeze (when (shen.type-theory-enabled?) V4975 V4976 W4979 (freeze (shen.cut V4975 V4976 W4979 (freeze (shen.system-S-h W4983 W4987 V4974 V4975 V4976 W4979 V4978)))))))) false))) false))) false))) false)) false) (if (= W4981 false) (let W4989 (if (shen.unlocked? V4976) (do (shen.incinfs) (when (value shen.*spy*) V4975 V4976 W4979 (freeze (shen.show V4973 V4974 V4975 V4976 W4979 V4978)))) false) (if (= W4989 false) (let W4990 (if (shen.unlocked? V4976) (do (shen.incinfs) (shen.search-user-datatypes V4973 V4974 (value shen.*datatypes*) V4975 V4976 W4979 V4978)) false) (if (= W4990 false) (shen.unlock V4976 W4979) W4990)) W4989)) W4981)) W4980)))) -(defun shen.show (V4983 V4984 V4985 V4986 V4987 V4988) (do (shen.line) (do (shen.show-p (shen.deref V4983 V4985)) (do (nl 2) (do (shen.show-assumptions (shen.deref V4984 V4985) 1) (do (shen.pause-for-user) false)))))) +(defun shen.show (V4997 V4998 V4999 V5000 V5001 V5002) (do (shen.line) (do (shen.show-p (shen.deref V4997 V4999)) (do (nl 2) (do (shen.show-assumptions (shen.deref V4998 V4999) 1) (do (shen.pause-for-user) false)))))) -(defun shen.line () (let W4989 (inferences) (pr (cn "____________________________________________________________ " (shen.app W4989 (cn " inference" (shen.app (if (= 1 W4989) "" "s") " +(defun shen.line () (let W5003 (inferences) (pr (cn "____________________________________________________________ " (shen.app W5003 (cn " inference" (shen.app (if (= 1 W5003) "" "s") " ?- " shen.a)) shen.a)) (stoutput)))) -(defun shen.show-p (V4990) (cond ((and (cons? V4990) (and (cons? (tl V4990)) (and (cons? (tl (tl V4990))) (and (= () (tl (tl (tl V4990)))) (= (hd (tl V4990)) (intern ":")))))) (do (shen.prterm (hd V4990)) (do (pr " : " (stoutput)) (pr (shen.app (hd (tl (tl V4990))) "" shen.r) (stoutput))))) (true (shen.prterm V4990)))) +(defun shen.show-p (V5004) (cond ((and (cons? V5004) (and (cons? (tl V5004)) (and (cons? (tl (tl V5004))) (and (= () (tl (tl (tl V5004)))) (= (hd (tl V5004)) (intern ":")))))) (do (shen.prterm (hd V5004)) (do (pr " : " (stoutput)) (pr (shen.app (hd (tl (tl V5004))) "" shen.r) (stoutput))))) (true (shen.prterm V5004)))) -(defun shen.prterm (V4991) (cond ((and (cons? V4991) (and (= cons (hd V4991)) (and (cons? (tl V4991)) (and (cons? (tl (tl V4991))) (= () (tl (tl (tl V4991)))))))) (do (pr "[" (stoutput)) (do (shen.prterm (hd (tl V4991))) (do (shen.prtl (hd (tl (tl V4991)))) (pr "]" (stoutput)))))) ((cons? V4991) (do (pr "(" (stoutput)) (do (shen.prterm (hd V4991)) (do (map (lambda Z4992 (do (pr " " (stoutput)) (shen.prterm Z4992))) (tl V4991)) (pr ")" (stoutput)))))) (true (print V4991)))) +(defun shen.prterm (V5005) (cond ((and (cons? V5005) (and (= cons (hd V5005)) (and (cons? (tl V5005)) (and (cons? (tl (tl V5005))) (= () (tl (tl (tl V5005)))))))) (do (pr "[" (stoutput)) (do (shen.prterm (hd (tl V5005))) (do (shen.prtl (hd (tl (tl V5005)))) (pr "]" (stoutput)))))) ((cons? V5005) (do (pr "(" (stoutput)) (do (shen.prterm (hd V5005)) (do (map (lambda Z5006 (do (pr " " (stoutput)) (shen.prterm Z5006))) (tl V5005)) (pr ")" (stoutput)))))) (true (print V5005)))) -(defun shen.prtl (V4993) (cond ((= () V4993) "") ((and (cons? V4993) (and (= cons (hd V4993)) (and (cons? (tl V4993)) (and (cons? (tl (tl V4993))) (= () (tl (tl (tl V4993)))))))) (do (pr " " (stoutput)) (do (shen.prterm (hd (tl V4993))) (shen.prtl (hd (tl (tl V4993))))))) (true (do (pr " | " (stoutput)) (shen.prterm V4993))))) +(defun shen.prtl (V5007) (cond ((= () V5007) "") ((and (cons? V5007) (and (= cons (hd V5007)) (and (cons? (tl V5007)) (and (cons? (tl (tl V5007))) (= () (tl (tl (tl V5007)))))))) (do (pr " " (stoutput)) (do (shen.prterm (hd (tl V5007))) (shen.prtl (hd (tl (tl V5007))))))) (true (do (pr " | " (stoutput)) (shen.prterm V5007))))) -(defun shen.show-assumptions (V5000 V5001) (cond ((= () V5000) (pr " -> " (stoutput))) ((cons? V5000) (do (pr (shen.app V5001 ". " shen.a) (stoutput)) (do (shen.show-p (hd V5000)) (do (nl 1) (shen.show-assumptions (tl V5000) (+ V5001 1)))))) (true (simple-error "implementation error in shen.show-assumptions")))) +(defun shen.show-assumptions (V5014 V5015) (cond ((= () V5014) (pr " +> " (stoutput))) ((cons? V5014) (do (pr (shen.app V5015 ". " shen.a) (stoutput)) (do (shen.show-p (hd V5014)) (do (nl 1) (shen.show-assumptions (tl V5014) (+ V5015 1)))))) (true (simple-error "implementation error in shen.show-assumptions")))) -(defun shen.pause-for-user () (let W5002 (read-byte (stinput)) (if (= W5002 94) (simple-error "input aborted +(defun shen.pause-for-user () (let W5016 (read-byte (stinput)) (if (= W5016 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 (V5003 V5004 V5005 V5006 V5007 V5008 V5009) (let W5010 (+ V5008 1) (let W5011 (if (shen.unlocked? V5007) (do (shen.incinfs) (when (value shen.*spy*) V5006 V5007 W5010 (freeze (shen.show (cons V5003 (cons (intern ":") (cons V5004 ()))) V5005 V5006 V5007 W5010 V5009)))) false) (if (= W5011 false) (let W5012 (if (shen.unlocked? V5007) (do (shen.incinfs) (when (not (cons? (shen.lazyderef V5003 V5006))) V5006 V5007 W5010 (freeze (shen.primitive V5003 V5004 V5006 V5007 W5010 V5009)))) false) (if (= W5012 false) (let W5013 (if (shen.unlocked? V5007) (do (shen.incinfs) (shen.by-hypothesis V5003 V5004 V5005 V5006 V5007 W5010 V5009)) false) (if (= W5013 false) (let W5014 (if (shen.unlocked? V5007) (let W5015 (shen.lazyderef V5003 V5006) (if (cons? W5015) (let W5016 (hd W5015) (let W5017 (shen.lazyderef (tl W5015) V5006) (if (= W5017 ()) (do (shen.incinfs) (shen.lookupsig W5016 (cons --> (cons V5004 ())) V5006 V5007 W5010 V5009)) false))) false)) false) (if (= W5014 false) (let W5018 (if (shen.unlocked? V5007) (let W5019 (shen.lazyderef V5003 V5006) (if (cons? W5019) (let W5020 (shen.lazyderef (hd W5019) V5006) (if (= W5020 fn) (let W5021 (shen.lazyderef (tl W5019) V5006) (if (cons? W5021) (let W5022 (hd W5021) (let W5023 (shen.lazyderef (tl W5021) V5006) (if (= W5023 ()) (do (shen.incinfs) (when (= (arity (shen.deref W5022 V5006)) 0) V5006 V5007 W5010 (freeze (shen.cut V5006 V5007 W5010 (freeze (shen.system-S-h (cons W5022 ()) V5004 V5005 V5006 V5007 W5010 V5009)))))) false))) false)) false)) false)) false) (if (= W5018 false) (let W5024 (if (shen.unlocked? V5007) (let W5025 (shen.lazyderef V5003 V5006) (if (cons? W5025) (let W5026 (shen.lazyderef (hd W5025) V5006) (if (= W5026 fn) (let W5027 (shen.lazyderef (tl W5025) V5006) (if (cons? W5027) (let W5028 (hd W5027) (let W5029 (shen.lazyderef (tl W5027) V5006) (if (= W5029 ()) (do (shen.incinfs) (shen.lookupsig W5028 V5004 V5006 V5007 W5010 V5009)) false))) false)) false)) false)) false) (if (= W5024 false) (let W5030 (if (shen.unlocked? V5007) (let W5031 (shen.lazyderef V5003 V5006) (if (cons? W5031) (let W5032 (hd W5031) (let W5033 (shen.lazyderef (tl W5031) V5006) (if (cons? W5033) (let W5034 (hd W5033) (let W5035 (shen.lazyderef (tl W5033) V5006) (if (= W5035 ()) (let W5036 (shen.newpv V5006) (shen.gc V5006 (do (shen.incinfs) (when (not (cons? (shen.lazyderef W5032 V5006))) V5006 V5007 W5010 (freeze (shen.lookupsig W5032 (cons W5036 (cons --> (cons V5004 ()))) V5006 V5007 W5010 (freeze (shen.system-S-h W5034 W5036 V5005 V5006 V5007 W5010 V5009)))))))) false))) false))) false)) false) (if (= W5030 false) (let W5037 (if (shen.unlocked? V5007) (let W5038 (shen.lazyderef V5003 V5006) (if (cons? W5038) (let W5039 (hd W5038) (let W5040 (shen.lazyderef (tl W5038) V5006) (if (cons? W5040) (let W5041 (hd W5040) (let W5042 (shen.lazyderef (tl W5040) V5006) (if (= W5042 ()) (let W5043 (shen.newpv V5006) (shen.gc V5006 (do (shen.incinfs) (shen.system-S-h W5039 (cons W5043 (cons --> (cons V5004 ()))) V5005 V5006 V5007 W5010 (freeze (shen.system-S-h W5041 W5043 V5005 V5006 V5007 W5010 V5009)))))) false))) false))) false)) false) (if (= W5037 false) (let W5044 (if (shen.unlocked? V5007) (let W5045 (shen.lazyderef V5003 V5006) (if (cons? W5045) (let W5046 (shen.lazyderef (hd W5045) V5006) (if (= W5046 cons) (let W5047 (shen.lazyderef (tl W5045) V5006) (if (cons? W5047) (let W5048 (hd W5047) (let W5049 (shen.lazyderef (tl W5047) V5006) (if (cons? W5049) (let W5050 (hd W5049) (let W5051 (shen.lazyderef (tl W5049) V5006) (if (= W5051 ()) (let W5052 (shen.lazyderef V5004 V5006) (let W5053 (lambda Z5054 (do (shen.incinfs) (shen.system-S-h W5048 Z5054 V5005 V5006 V5007 W5010 (freeze (shen.system-S-h W5050 (cons list (cons Z5054 ())) V5005 V5006 V5007 W5010 V5009))))) (if (cons? W5052) (let W5055 (shen.lazyderef (hd W5052) V5006) (let W5056 (freeze (let W5057 (shen.lazyderef (tl W5052) V5006) (let W5058 (lambda Z5059 (W5053 Z5059)) (if (cons? W5057) (let W5060 (hd W5057) (let W5061 (shen.lazyderef (tl W5057) V5006) (let W5062 (freeze (W5058 W5060)) (if (= W5061 ()) (thaw W5062) (if (shen.pvar? W5061) (shen.bind! W5061 () V5006 W5062) false))))) (if (shen.pvar? W5057) (let W5063 (shen.newpv V5006) (shen.gc V5006 (shen.bind! W5057 (cons W5063 ()) V5006 (freeze (W5058 W5063))))) false))))) (if (= W5055 list) (thaw W5056) (if (shen.pvar? W5055) (shen.bind! W5055 list V5006 W5056) false)))) (if (shen.pvar? W5052) (let W5064 (shen.newpv V5006) (shen.gc V5006 (shen.bind! W5052 (cons list (cons W5064 ())) V5006 (freeze (W5053 W5064))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5044 false) (let W5065 (if (shen.unlocked? V5007) (let W5066 (shen.lazyderef V5003 V5006) (if (cons? W5066) (let W5067 (shen.lazyderef (hd W5066) V5006) (if (= W5067 @p) (let W5068 (shen.lazyderef (tl W5066) V5006) (if (cons? W5068) (let W5069 (hd W5068) (let W5070 (shen.lazyderef (tl W5068) V5006) (if (cons? W5070) (let W5071 (hd W5070) (let W5072 (shen.lazyderef (tl W5070) V5006) (if (= W5072 ()) (let W5073 (shen.lazyderef V5004 V5006) (let W5074 (lambda Z5075 (lambda Z5076 (do (shen.incinfs) (shen.system-S-h W5069 Z5075 V5005 V5006 V5007 W5010 (freeze (shen.system-S-h W5071 Z5076 V5005 V5006 V5007 W5010 V5009)))))) (if (cons? W5073) (let W5077 (hd W5073) (let W5078 (shen.lazyderef (tl W5073) V5006) (let W5079 (lambda Z5080 ((W5074 W5077) Z5080)) (if (cons? W5078) (let W5081 (shen.lazyderef (hd W5078) V5006) (let W5082 (freeze (let W5083 (shen.lazyderef (tl W5078) V5006) (let W5084 (lambda Z5085 (W5079 Z5085)) (if (cons? W5083) (let W5086 (hd W5083) (let W5087 (shen.lazyderef (tl W5083) V5006) (let W5088 (freeze (W5084 W5086)) (if (= W5087 ()) (thaw W5088) (if (shen.pvar? W5087) (shen.bind! W5087 () V5006 W5088) false))))) (if (shen.pvar? W5083) (let W5089 (shen.newpv V5006) (shen.gc V5006 (shen.bind! W5083 (cons W5089 ()) V5006 (freeze (W5084 W5089))))) false))))) (if (= W5081 *) (thaw W5082) (if (shen.pvar? W5081) (shen.bind! W5081 * V5006 W5082) false)))) (if (shen.pvar? W5078) (let W5090 (shen.newpv V5006) (shen.gc V5006 (shen.bind! W5078 (cons * (cons W5090 ())) V5006 (freeze (W5079 W5090))))) false))))) (if (shen.pvar? W5073) (let W5091 (shen.newpv V5006) (shen.gc V5006 (let W5092 (shen.newpv V5006) (shen.gc V5006 (shen.bind! W5073 (cons W5091 (cons * (cons W5092 ()))) V5006 (freeze ((W5074 W5091) W5092))))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5065 false) (let W5093 (if (shen.unlocked? V5007) (let W5094 (shen.lazyderef V5003 V5006) (if (cons? W5094) (let W5095 (shen.lazyderef (hd W5094) V5006) (if (= W5095 @v) (let W5096 (shen.lazyderef (tl W5094) V5006) (if (cons? W5096) (let W5097 (hd W5096) (let W5098 (shen.lazyderef (tl W5096) V5006) (if (cons? W5098) (let W5099 (hd W5098) (let W5100 (shen.lazyderef (tl W5098) V5006) (if (= W5100 ()) (let W5101 (shen.lazyderef V5004 V5006) (let W5102 (lambda Z5103 (do (shen.incinfs) (shen.system-S-h W5097 Z5103 V5005 V5006 V5007 W5010 (freeze (shen.system-S-h W5099 (cons vector (cons Z5103 ())) V5005 V5006 V5007 W5010 V5009))))) (if (cons? W5101) (let W5104 (shen.lazyderef (hd W5101) V5006) (let W5105 (freeze (let W5106 (shen.lazyderef (tl W5101) V5006) (let W5107 (lambda Z5108 (W5102 Z5108)) (if (cons? W5106) (let W5109 (hd W5106) (let W5110 (shen.lazyderef (tl W5106) V5006) (let W5111 (freeze (W5107 W5109)) (if (= W5110 ()) (thaw W5111) (if (shen.pvar? W5110) (shen.bind! W5110 () V5006 W5111) false))))) (if (shen.pvar? W5106) (let W5112 (shen.newpv V5006) (shen.gc V5006 (shen.bind! W5106 (cons W5112 ()) V5006 (freeze (W5107 W5112))))) false))))) (if (= W5104 vector) (thaw W5105) (if (shen.pvar? W5104) (shen.bind! W5104 vector V5006 W5105) false)))) (if (shen.pvar? W5101) (let W5113 (shen.newpv V5006) (shen.gc V5006 (shen.bind! W5101 (cons vector (cons W5113 ())) V5006 (freeze (W5102 W5113))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5093 false) (let W5114 (if (shen.unlocked? V5007) (let W5115 (shen.lazyderef V5003 V5006) (if (cons? W5115) (let W5116 (shen.lazyderef (hd W5115) V5006) (if (= W5116 @s) (let W5117 (shen.lazyderef (tl W5115) V5006) (if (cons? W5117) (let W5118 (hd W5117) (let W5119 (shen.lazyderef (tl W5117) V5006) (if (cons? W5119) (let W5120 (hd W5119) (let W5121 (shen.lazyderef (tl W5119) V5006) (if (= W5121 ()) (let W5122 (shen.lazyderef V5004 V5006) (let W5123 (freeze (do (shen.incinfs) (shen.system-S-h W5118 string V5005 V5006 V5007 W5010 (freeze (shen.system-S-h W5120 string V5005 V5006 V5007 W5010 V5009))))) (if (= W5122 string) (thaw W5123) (if (shen.pvar? W5122) (shen.bind! W5122 string V5006 W5123) false)))) false))) false))) false)) false)) false)) false) (if (= W5114 false) (let W5124 (if (shen.unlocked? V5007) (let W5125 (shen.lazyderef V5003 V5006) (if (cons? W5125) (let W5126 (shen.lazyderef (hd W5125) V5006) (if (= W5126 lambda) (let W5127 (shen.lazyderef (tl W5125) V5006) (if (cons? W5127) (let W5128 (hd W5127) (let W5129 (shen.lazyderef (tl W5127) V5006) (if (cons? W5129) (let W5130 (hd W5129) (let W5131 (shen.lazyderef (tl W5129) V5006) (if (= W5131 ()) (let W5132 (shen.lazyderef V5004 V5006) (let W5133 (lambda Z5134 (lambda Z5135 (let W5136 (shen.newpv V5006) (shen.gc V5006 (let W5137 (shen.newpv V5006) (shen.gc V5006 (do (shen.incinfs) (bind W5137 (shen.freshterm (shen.lazyderef W5128 V5006)) V5006 V5007 W5010 (freeze (bind W5136 (shen.beta (shen.lazyderef W5128 V5006) (shen.deref W5137 V5006) (shen.deref W5130 V5006)) V5006 V5007 W5010 (freeze (shen.system-S-h W5136 Z5135 (cons (cons W5137 (cons (intern ":") (cons Z5134 ()))) V5005) V5006 V5007 W5010 V5009)))))))))))) (if (cons? W5132) (let W5138 (hd W5132) (let W5139 (shen.lazyderef (tl W5132) V5006) (let W5140 (lambda Z5141 ((W5133 W5138) Z5141)) (if (cons? W5139) (let W5142 (shen.lazyderef (hd W5139) V5006) (let W5143 (freeze (let W5144 (shen.lazyderef (tl W5139) V5006) (let W5145 (lambda Z5146 (W5140 Z5146)) (if (cons? W5144) (let W5147 (hd W5144) (let W5148 (shen.lazyderef (tl W5144) V5006) (let W5149 (freeze (W5145 W5147)) (if (= W5148 ()) (thaw W5149) (if (shen.pvar? W5148) (shen.bind! W5148 () V5006 W5149) false))))) (if (shen.pvar? W5144) (let W5150 (shen.newpv V5006) (shen.gc V5006 (shen.bind! W5144 (cons W5150 ()) V5006 (freeze (W5145 W5150))))) false))))) (if (= W5142 -->) (thaw W5143) (if (shen.pvar? W5142) (shen.bind! W5142 --> V5006 W5143) false)))) (if (shen.pvar? W5139) (let W5151 (shen.newpv V5006) (shen.gc V5006 (shen.bind! W5139 (cons --> (cons W5151 ())) V5006 (freeze (W5140 W5151))))) false))))) (if (shen.pvar? W5132) (let W5152 (shen.newpv V5006) (shen.gc V5006 (let W5153 (shen.newpv V5006) (shen.gc V5006 (shen.bind! W5132 (cons W5152 (cons --> (cons W5153 ()))) V5006 (freeze ((W5133 W5152) W5153))))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5124 false) (let W5154 (if (shen.unlocked? V5007) (let W5155 (shen.lazyderef V5003 V5006) (if (cons? W5155) (let W5156 (shen.lazyderef (hd W5155) V5006) (if (= W5156 let) (let W5157 (shen.lazyderef (tl W5155) V5006) (if (cons? W5157) (let W5158 (hd W5157) (let W5159 (shen.lazyderef (tl W5157) V5006) (if (cons? W5159) (let W5160 (hd W5159) (let W5161 (shen.lazyderef (tl W5159) V5006) (if (cons? W5161) (let W5162 (hd W5161) (let W5163 (shen.lazyderef (tl W5161) V5006) (if (= W5163 ()) (let W5164 (shen.newpv V5006) (shen.gc V5006 (let W5165 (shen.newpv V5006) (shen.gc V5006 (let W5166 (shen.newpv V5006) (shen.gc V5006 (do (shen.incinfs) (shen.system-S-h W5160 W5166 V5005 V5006 V5007 W5010 (freeze (bind W5165 (shen.freshterm (shen.lazyderef W5158 V5006)) V5006 V5007 W5010 (freeze (bind W5164 (shen.beta (shen.lazyderef W5158 V5006) (shen.lazyderef W5165 V5006) (shen.lazyderef W5162 V5006)) V5006 V5007 W5010 (freeze (shen.system-S-h W5164 V5004 (cons (cons W5165 (cons (intern ":") (cons W5166 ()))) V5005) V5006 V5007 W5010 V5009)))))))))))))) false))) false))) false))) false)) false)) false)) false) (if (= W5154 false) (let W5167 (if (shen.unlocked? V5007) (let W5168 (shen.lazyderef V5003 V5006) (if (cons? W5168) (let W5169 (shen.lazyderef (hd W5168) V5006) (if (= W5169 open) (let W5170 (shen.lazyderef (tl W5168) V5006) (if (cons? W5170) (let W5171 (hd W5170) (let W5172 (shen.lazyderef (tl W5170) V5006) (if (cons? W5172) (let W5173 (hd W5172) (let W5174 (shen.lazyderef (tl W5172) V5006) (if (= W5174 ()) (let W5175 (shen.lazyderef V5004 V5006) (let W5176 (lambda Z5177 (do (shen.incinfs) (is! W5173 Z5177 V5006 V5007 W5010 (freeze (when (element? (shen.lazyderef Z5177 V5006) (cons in (cons out ()))) V5006 V5007 W5010 (freeze (shen.system-S-h W5171 string V5005 V5006 V5007 W5010 V5009))))))) (if (cons? W5175) (let W5178 (shen.lazyderef (hd W5175) V5006) (let W5179 (freeze (let W5180 (shen.lazyderef (tl W5175) V5006) (let W5181 (lambda Z5182 (W5176 Z5182)) (if (cons? W5180) (let W5183 (hd W5180) (let W5184 (shen.lazyderef (tl W5180) V5006) (let W5185 (freeze (W5181 W5183)) (if (= W5184 ()) (thaw W5185) (if (shen.pvar? W5184) (shen.bind! W5184 () V5006 W5185) false))))) (if (shen.pvar? W5180) (let W5186 (shen.newpv V5006) (shen.gc V5006 (shen.bind! W5180 (cons W5186 ()) V5006 (freeze (W5181 W5186))))) false))))) (if (= W5178 stream) (thaw W5179) (if (shen.pvar? W5178) (shen.bind! W5178 stream V5006 W5179) false)))) (if (shen.pvar? W5175) (let W5187 (shen.newpv V5006) (shen.gc V5006 (shen.bind! W5175 (cons stream (cons W5187 ())) V5006 (freeze (W5176 W5187))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5167 false) (let W5188 (if (shen.unlocked? V5007) (let W5189 (shen.lazyderef V5003 V5006) (if (cons? W5189) (let W5190 (shen.lazyderef (hd W5189) V5006) (if (= W5190 type) (let W5191 (shen.lazyderef (tl W5189) V5006) (if (cons? W5191) (let W5192 (hd W5191) (let W5193 (shen.lazyderef (tl W5191) V5006) (if (cons? W5193) (let W5194 (hd W5193) (let W5195 (shen.lazyderef (tl W5193) V5006) (if (= W5195 ()) (do (shen.incinfs) (shen.cut V5006 V5007 W5010 (freeze (is! (shen.rectify-type (shen.deref W5194 V5006)) V5004 V5006 V5007 W5010 (freeze (shen.system-S-h W5192 V5004 V5005 V5006 V5007 W5010 V5009)))))) false))) false))) false)) false)) false)) false) (if (= W5188 false) (let W5196 (if (shen.unlocked? V5007) (let W5197 (shen.lazyderef V5003 V5006) (if (cons? W5197) (let W5198 (shen.lazyderef (hd W5197) V5006) (if (= W5198 shen.input-h+) (let W5199 (shen.lazyderef (tl W5197) V5006) (if (cons? W5199) (let W5200 (hd W5199) (let W5201 (shen.lazyderef (tl W5199) V5006) (if (cons? W5201) (let W5202 (hd W5201) (let W5203 (shen.lazyderef (tl W5201) V5006) (if (= W5203 ()) (do (shen.incinfs) (is V5004 (shen.rectify-type (shen.rdecons (shen.deref W5200 V5006))) V5006 V5007 W5010 (freeze (shen.system-S-h W5202 (cons stream (cons in ())) V5005 V5006 V5007 W5010 V5009)))) false))) false))) false)) false)) false)) false) (if (= W5196 false) (let W5204 (if (shen.unlocked? V5007) (let W5205 (shen.lazyderef V5003 V5006) (if (cons? W5205) (let W5206 (shen.lazyderef (hd W5205) V5006) (if (= W5206 set) (let W5207 (shen.lazyderef (tl W5205) V5006) (if (cons? W5207) (let W5208 (hd W5207) (let W5209 (shen.lazyderef (tl W5207) V5006) (if (cons? W5209) (let W5210 (hd W5209) (let W5211 (shen.lazyderef (tl W5209) V5006) (if (= W5211 ()) (do (shen.incinfs) (shen.system-S-h W5208 symbol V5005 V5006 V5007 W5010 (freeze (shen.system-S-h (cons value (cons W5208 ())) V5004 V5005 V5006 V5007 W5010 (freeze (shen.system-S-h W5210 V5004 V5005 V5006 V5007 W5010 V5009)))))) false))) false))) false)) false)) false)) false) (if (= W5204 false) (let W5212 (if (shen.unlocked? V5007) (let W5213 (shen.newpv V5006) (shen.gc V5006 (do (shen.incinfs) (shen.l-rules V5005 W5213 false V5006 V5007 W5010 (freeze (shen.cut V5006 V5007 W5010 (freeze (shen.system-S-h V5003 V5004 W5213 V5006 V5007 W5010 V5009)))))))) false) (if (= W5212 false) (let W5214 (if (shen.unlocked? V5007) (do (shen.incinfs) (shen.search-user-datatypes (cons V5003 (cons (intern ":") (cons V5004 ()))) V5005 (value shen.*datatypes*) V5006 V5007 W5010 V5009)) false) (if (= W5214 false) (shen.unlock V5007 W5010) W5214)) W5212)) W5204)) W5196)) W5188)) W5167)) W5154)) W5124)) W5114)) W5093)) W5065)) W5044)) W5037)) W5030)) W5024)) W5018)) W5014)) W5013)) W5012)) W5011)))) +(defun shen.system-S-h (V5017 V5018 V5019 V5020 V5021 V5022 V5023) (let W5024 (+ V5022 1) (let W5025 (if (shen.unlocked? V5021) (do (shen.incinfs) (when (value shen.*spy*) V5020 V5021 W5024 (freeze (shen.show (cons V5017 (cons (intern ":") (cons V5018 ()))) V5019 V5020 V5021 W5024 V5023)))) false) (if (= W5025 false) (let W5026 (if (shen.unlocked? V5021) (do (shen.incinfs) (when (not (cons? (shen.lazyderef V5017 V5020))) V5020 V5021 W5024 (freeze (shen.primitive V5017 V5018 V5020 V5021 W5024 V5023)))) false) (if (= W5026 false) (let W5027 (if (shen.unlocked? V5021) (do (shen.incinfs) (shen.by-hypothesis V5017 V5018 V5019 V5020 V5021 W5024 V5023)) false) (if (= W5027 false) (let W5028 (if (shen.unlocked? V5021) (let W5029 (shen.lazyderef V5017 V5020) (if (cons? W5029) (let W5030 (hd W5029) (let W5031 (shen.lazyderef (tl W5029) V5020) (if (= W5031 ()) (do (shen.incinfs) (shen.lookupsig W5030 (cons --> (cons V5018 ())) V5020 V5021 W5024 V5023)) false))) false)) false) (if (= W5028 false) (let W5032 (if (shen.unlocked? V5021) (let W5033 (shen.lazyderef V5017 V5020) (if (cons? W5033) (let W5034 (shen.lazyderef (hd W5033) V5020) (if (= W5034 fn) (let W5035 (shen.lazyderef (tl W5033) V5020) (if (cons? W5035) (let W5036 (hd W5035) (let W5037 (shen.lazyderef (tl W5035) V5020) (if (= W5037 ()) (do (shen.incinfs) (when (= (arity (shen.deref W5036 V5020)) 0) V5020 V5021 W5024 (freeze (shen.cut V5020 V5021 W5024 (freeze (shen.system-S-h (cons W5036 ()) V5018 V5019 V5020 V5021 W5024 V5023)))))) false))) false)) false)) false)) false) (if (= W5032 false) (let W5038 (if (shen.unlocked? V5021) (let W5039 (shen.lazyderef V5017 V5020) (if (cons? W5039) (let W5040 (shen.lazyderef (hd W5039) V5020) (if (= W5040 fn) (let W5041 (shen.lazyderef (tl W5039) V5020) (if (cons? W5041) (let W5042 (hd W5041) (let W5043 (shen.lazyderef (tl W5041) V5020) (if (= W5043 ()) (do (shen.incinfs) (shen.lookupsig W5042 V5018 V5020 V5021 W5024 V5023)) false))) false)) false)) false)) false) (if (= W5038 false) (let W5044 (if (shen.unlocked? V5021) (let W5045 (shen.lazyderef V5017 V5020) (if (cons? W5045) (let W5046 (hd W5045) (let W5047 (shen.lazyderef (tl W5045) V5020) (if (cons? W5047) (let W5048 (hd W5047) (let W5049 (shen.lazyderef (tl W5047) V5020) (if (= W5049 ()) (let W5050 (shen.newpv V5020) (shen.gc V5020 (do (shen.incinfs) (when (not (cons? (shen.lazyderef W5046 V5020))) V5020 V5021 W5024 (freeze (shen.lookupsig W5046 (cons W5050 (cons --> (cons V5018 ()))) V5020 V5021 W5024 (freeze (shen.system-S-h W5048 W5050 V5019 V5020 V5021 W5024 V5023)))))))) false))) false))) false)) false) (if (= W5044 false) (let W5051 (if (shen.unlocked? V5021) (let W5052 (shen.lazyderef V5017 V5020) (if (cons? W5052) (let W5053 (hd W5052) (let W5054 (shen.lazyderef (tl W5052) V5020) (if (cons? W5054) (let W5055 (hd W5054) (let W5056 (shen.lazyderef (tl W5054) V5020) (if (= W5056 ()) (let W5057 (shen.newpv V5020) (shen.gc V5020 (do (shen.incinfs) (shen.system-S-h W5053 (cons W5057 (cons --> (cons V5018 ()))) V5019 V5020 V5021 W5024 (freeze (shen.system-S-h W5055 W5057 V5019 V5020 V5021 W5024 V5023)))))) false))) false))) false)) false) (if (= W5051 false) (let W5058 (if (shen.unlocked? V5021) (let W5059 (shen.lazyderef V5017 V5020) (if (cons? W5059) (let W5060 (shen.lazyderef (hd W5059) V5020) (if (= W5060 cons) (let W5061 (shen.lazyderef (tl W5059) V5020) (if (cons? W5061) (let W5062 (hd W5061) (let W5063 (shen.lazyderef (tl W5061) V5020) (if (cons? W5063) (let W5064 (hd W5063) (let W5065 (shen.lazyderef (tl W5063) V5020) (if (= W5065 ()) (let W5066 (shen.lazyderef V5018 V5020) (let W5067 (lambda Z5068 (do (shen.incinfs) (shen.system-S-h W5062 Z5068 V5019 V5020 V5021 W5024 (freeze (shen.system-S-h W5064 (cons list (cons Z5068 ())) V5019 V5020 V5021 W5024 V5023))))) (if (cons? W5066) (let W5069 (shen.lazyderef (hd W5066) V5020) (let W5070 (freeze (let W5071 (shen.lazyderef (tl W5066) V5020) (let W5072 (lambda Z5073 (W5067 Z5073)) (if (cons? W5071) (let W5074 (hd W5071) (let W5075 (shen.lazyderef (tl W5071) V5020) (let W5076 (freeze (W5072 W5074)) (if (= W5075 ()) (thaw W5076) (if (shen.pvar? W5075) (shen.bind! W5075 () V5020 W5076) false))))) (if (shen.pvar? W5071) (let W5077 (shen.newpv V5020) (shen.gc V5020 (shen.bind! W5071 (cons W5077 ()) V5020 (freeze (W5072 W5077))))) false))))) (if (= W5069 list) (thaw W5070) (if (shen.pvar? W5069) (shen.bind! W5069 list V5020 W5070) false)))) (if (shen.pvar? W5066) (let W5078 (shen.newpv V5020) (shen.gc V5020 (shen.bind! W5066 (cons list (cons W5078 ())) V5020 (freeze (W5067 W5078))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5058 false) (let W5079 (if (shen.unlocked? V5021) (let W5080 (shen.lazyderef V5017 V5020) (if (cons? W5080) (let W5081 (shen.lazyderef (hd W5080) V5020) (if (= W5081 @p) (let W5082 (shen.lazyderef (tl W5080) V5020) (if (cons? W5082) (let W5083 (hd W5082) (let W5084 (shen.lazyderef (tl W5082) V5020) (if (cons? W5084) (let W5085 (hd W5084) (let W5086 (shen.lazyderef (tl W5084) V5020) (if (= W5086 ()) (let W5087 (shen.lazyderef V5018 V5020) (let W5088 (lambda Z5089 (lambda Z5090 (do (shen.incinfs) (shen.system-S-h W5083 Z5089 V5019 V5020 V5021 W5024 (freeze (shen.system-S-h W5085 Z5090 V5019 V5020 V5021 W5024 V5023)))))) (if (cons? W5087) (let W5091 (hd W5087) (let W5092 (shen.lazyderef (tl W5087) V5020) (let W5093 (lambda Z5094 ((W5088 W5091) Z5094)) (if (cons? W5092) (let W5095 (shen.lazyderef (hd W5092) V5020) (let W5096 (freeze (let W5097 (shen.lazyderef (tl W5092) V5020) (let W5098 (lambda Z5099 (W5093 Z5099)) (if (cons? W5097) (let W5100 (hd W5097) (let W5101 (shen.lazyderef (tl W5097) V5020) (let W5102 (freeze (W5098 W5100)) (if (= W5101 ()) (thaw W5102) (if (shen.pvar? W5101) (shen.bind! W5101 () V5020 W5102) false))))) (if (shen.pvar? W5097) (let W5103 (shen.newpv V5020) (shen.gc V5020 (shen.bind! W5097 (cons W5103 ()) V5020 (freeze (W5098 W5103))))) false))))) (if (= W5095 *) (thaw W5096) (if (shen.pvar? W5095) (shen.bind! W5095 * V5020 W5096) false)))) (if (shen.pvar? W5092) (let W5104 (shen.newpv V5020) (shen.gc V5020 (shen.bind! W5092 (cons * (cons W5104 ())) V5020 (freeze (W5093 W5104))))) false))))) (if (shen.pvar? W5087) (let W5105 (shen.newpv V5020) (shen.gc V5020 (let W5106 (shen.newpv V5020) (shen.gc V5020 (shen.bind! W5087 (cons W5105 (cons * (cons W5106 ()))) V5020 (freeze ((W5088 W5105) W5106))))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5079 false) (let W5107 (if (shen.unlocked? V5021) (let W5108 (shen.lazyderef V5017 V5020) (if (cons? W5108) (let W5109 (shen.lazyderef (hd W5108) V5020) (if (= W5109 @v) (let W5110 (shen.lazyderef (tl W5108) V5020) (if (cons? W5110) (let W5111 (hd W5110) (let W5112 (shen.lazyderef (tl W5110) V5020) (if (cons? W5112) (let W5113 (hd W5112) (let W5114 (shen.lazyderef (tl W5112) V5020) (if (= W5114 ()) (let W5115 (shen.lazyderef V5018 V5020) (let W5116 (lambda Z5117 (do (shen.incinfs) (shen.system-S-h W5111 Z5117 V5019 V5020 V5021 W5024 (freeze (shen.system-S-h W5113 (cons vector (cons Z5117 ())) V5019 V5020 V5021 W5024 V5023))))) (if (cons? W5115) (let W5118 (shen.lazyderef (hd W5115) V5020) (let W5119 (freeze (let W5120 (shen.lazyderef (tl W5115) V5020) (let W5121 (lambda Z5122 (W5116 Z5122)) (if (cons? W5120) (let W5123 (hd W5120) (let W5124 (shen.lazyderef (tl W5120) V5020) (let W5125 (freeze (W5121 W5123)) (if (= W5124 ()) (thaw W5125) (if (shen.pvar? W5124) (shen.bind! W5124 () V5020 W5125) false))))) (if (shen.pvar? W5120) (let W5126 (shen.newpv V5020) (shen.gc V5020 (shen.bind! W5120 (cons W5126 ()) V5020 (freeze (W5121 W5126))))) false))))) (if (= W5118 vector) (thaw W5119) (if (shen.pvar? W5118) (shen.bind! W5118 vector V5020 W5119) false)))) (if (shen.pvar? W5115) (let W5127 (shen.newpv V5020) (shen.gc V5020 (shen.bind! W5115 (cons vector (cons W5127 ())) V5020 (freeze (W5116 W5127))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5107 false) (let W5128 (if (shen.unlocked? V5021) (let W5129 (shen.lazyderef V5017 V5020) (if (cons? W5129) (let W5130 (shen.lazyderef (hd W5129) V5020) (if (= W5130 @s) (let W5131 (shen.lazyderef (tl W5129) V5020) (if (cons? W5131) (let W5132 (hd W5131) (let W5133 (shen.lazyderef (tl W5131) V5020) (if (cons? W5133) (let W5134 (hd W5133) (let W5135 (shen.lazyderef (tl W5133) V5020) (if (= W5135 ()) (let W5136 (shen.lazyderef V5018 V5020) (let W5137 (freeze (do (shen.incinfs) (shen.system-S-h W5132 string V5019 V5020 V5021 W5024 (freeze (shen.system-S-h W5134 string V5019 V5020 V5021 W5024 V5023))))) (if (= W5136 string) (thaw W5137) (if (shen.pvar? W5136) (shen.bind! W5136 string V5020 W5137) false)))) false))) false))) false)) false)) false)) false) (if (= W5128 false) (let W5138 (if (shen.unlocked? V5021) (let W5139 (shen.lazyderef V5017 V5020) (if (cons? W5139) (let W5140 (shen.lazyderef (hd W5139) V5020) (if (= W5140 lambda) (let W5141 (shen.lazyderef (tl W5139) V5020) (if (cons? W5141) (let W5142 (hd W5141) (let W5143 (shen.lazyderef (tl W5141) V5020) (if (cons? W5143) (let W5144 (hd W5143) (let W5145 (shen.lazyderef (tl W5143) V5020) (if (= W5145 ()) (let W5146 (shen.lazyderef V5018 V5020) (let W5147 (lambda Z5148 (lambda Z5149 (let W5150 (shen.newpv V5020) (shen.gc V5020 (let W5151 (shen.newpv V5020) (shen.gc V5020 (do (shen.incinfs) (bind W5151 (shen.freshterm (shen.lazyderef W5142 V5020)) V5020 V5021 W5024 (freeze (bind W5150 (shen.beta (shen.lazyderef W5142 V5020) (shen.deref W5151 V5020) (shen.deref W5144 V5020)) V5020 V5021 W5024 (freeze (shen.system-S-h W5150 Z5149 (cons (cons W5151 (cons (intern ":") (cons Z5148 ()))) V5019) V5020 V5021 W5024 V5023)))))))))))) (if (cons? W5146) (let W5152 (hd W5146) (let W5153 (shen.lazyderef (tl W5146) V5020) (let W5154 (lambda Z5155 ((W5147 W5152) Z5155)) (if (cons? W5153) (let W5156 (shen.lazyderef (hd W5153) V5020) (let W5157 (freeze (let W5158 (shen.lazyderef (tl W5153) V5020) (let W5159 (lambda Z5160 (W5154 Z5160)) (if (cons? W5158) (let W5161 (hd W5158) (let W5162 (shen.lazyderef (tl W5158) V5020) (let W5163 (freeze (W5159 W5161)) (if (= W5162 ()) (thaw W5163) (if (shen.pvar? W5162) (shen.bind! W5162 () V5020 W5163) false))))) (if (shen.pvar? W5158) (let W5164 (shen.newpv V5020) (shen.gc V5020 (shen.bind! W5158 (cons W5164 ()) V5020 (freeze (W5159 W5164))))) false))))) (if (= W5156 -->) (thaw W5157) (if (shen.pvar? W5156) (shen.bind! W5156 --> V5020 W5157) false)))) (if (shen.pvar? W5153) (let W5165 (shen.newpv V5020) (shen.gc V5020 (shen.bind! W5153 (cons --> (cons W5165 ())) V5020 (freeze (W5154 W5165))))) false))))) (if (shen.pvar? W5146) (let W5166 (shen.newpv V5020) (shen.gc V5020 (let W5167 (shen.newpv V5020) (shen.gc V5020 (shen.bind! W5146 (cons W5166 (cons --> (cons W5167 ()))) V5020 (freeze ((W5147 W5166) W5167))))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5138 false) (let W5168 (if (shen.unlocked? V5021) (let W5169 (shen.lazyderef V5017 V5020) (if (cons? W5169) (let W5170 (shen.lazyderef (hd W5169) V5020) (if (= W5170 let) (let W5171 (shen.lazyderef (tl W5169) V5020) (if (cons? W5171) (let W5172 (hd W5171) (let W5173 (shen.lazyderef (tl W5171) V5020) (if (cons? W5173) (let W5174 (hd W5173) (let W5175 (shen.lazyderef (tl W5173) V5020) (if (cons? W5175) (let W5176 (hd W5175) (let W5177 (shen.lazyderef (tl W5175) V5020) (if (= W5177 ()) (let W5178 (shen.newpv V5020) (shen.gc V5020 (let W5179 (shen.newpv V5020) (shen.gc V5020 (let W5180 (shen.newpv V5020) (shen.gc V5020 (do (shen.incinfs) (shen.system-S-h W5174 W5180 V5019 V5020 V5021 W5024 (freeze (bind W5179 (shen.freshterm (shen.lazyderef W5172 V5020)) V5020 V5021 W5024 (freeze (bind W5178 (shen.beta (shen.lazyderef W5172 V5020) (shen.lazyderef W5179 V5020) (shen.lazyderef W5176 V5020)) V5020 V5021 W5024 (freeze (shen.system-S-h W5178 V5018 (cons (cons W5179 (cons (intern ":") (cons W5180 ()))) V5019) V5020 V5021 W5024 V5023)))))))))))))) false))) false))) false))) false)) false)) false)) false) (if (= W5168 false) (let W5181 (if (shen.unlocked? V5021) (let W5182 (shen.lazyderef V5017 V5020) (if (cons? W5182) (let W5183 (shen.lazyderef (hd W5182) V5020) (if (= W5183 open) (let W5184 (shen.lazyderef (tl W5182) V5020) (if (cons? W5184) (let W5185 (hd W5184) (let W5186 (shen.lazyderef (tl W5184) V5020) (if (cons? W5186) (let W5187 (hd W5186) (let W5188 (shen.lazyderef (tl W5186) V5020) (if (= W5188 ()) (let W5189 (shen.lazyderef V5018 V5020) (let W5190 (lambda Z5191 (do (shen.incinfs) (is! W5187 Z5191 V5020 V5021 W5024 (freeze (when (element? (shen.lazyderef Z5191 V5020) (cons in (cons out ()))) V5020 V5021 W5024 (freeze (shen.system-S-h W5185 string V5019 V5020 V5021 W5024 V5023))))))) (if (cons? W5189) (let W5192 (shen.lazyderef (hd W5189) V5020) (let W5193 (freeze (let W5194 (shen.lazyderef (tl W5189) V5020) (let W5195 (lambda Z5196 (W5190 Z5196)) (if (cons? W5194) (let W5197 (hd W5194) (let W5198 (shen.lazyderef (tl W5194) V5020) (let W5199 (freeze (W5195 W5197)) (if (= W5198 ()) (thaw W5199) (if (shen.pvar? W5198) (shen.bind! W5198 () V5020 W5199) false))))) (if (shen.pvar? W5194) (let W5200 (shen.newpv V5020) (shen.gc V5020 (shen.bind! W5194 (cons W5200 ()) V5020 (freeze (W5195 W5200))))) false))))) (if (= W5192 stream) (thaw W5193) (if (shen.pvar? W5192) (shen.bind! W5192 stream V5020 W5193) false)))) (if (shen.pvar? W5189) (let W5201 (shen.newpv V5020) (shen.gc V5020 (shen.bind! W5189 (cons stream (cons W5201 ())) V5020 (freeze (W5190 W5201))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5181 false) (let W5202 (if (shen.unlocked? V5021) (let W5203 (shen.lazyderef V5017 V5020) (if (cons? W5203) (let W5204 (shen.lazyderef (hd W5203) V5020) (if (= W5204 type) (let W5205 (shen.lazyderef (tl W5203) V5020) (if (cons? W5205) (let W5206 (hd W5205) (let W5207 (shen.lazyderef (tl W5205) V5020) (if (cons? W5207) (let W5208 (hd W5207) (let W5209 (shen.lazyderef (tl W5207) V5020) (if (= W5209 ()) (do (shen.incinfs) (shen.cut V5020 V5021 W5024 (freeze (is! (shen.rectify-type (shen.deref W5208 V5020)) V5018 V5020 V5021 W5024 (freeze (shen.system-S-h W5206 V5018 V5019 V5020 V5021 W5024 V5023)))))) false))) false))) false)) false)) false)) false) (if (= W5202 false) (let W5210 (if (shen.unlocked? V5021) (let W5211 (shen.lazyderef V5017 V5020) (if (cons? W5211) (let W5212 (shen.lazyderef (hd W5211) V5020) (if (= W5212 shen.input-h+) (let W5213 (shen.lazyderef (tl W5211) V5020) (if (cons? W5213) (let W5214 (hd W5213) (let W5215 (shen.lazyderef (tl W5213) V5020) (if (cons? W5215) (let W5216 (hd W5215) (let W5217 (shen.lazyderef (tl W5215) V5020) (if (= W5217 ()) (do (shen.incinfs) (is V5018 (shen.rectify-type (shen.rdecons (shen.deref W5214 V5020))) V5020 V5021 W5024 (freeze (shen.system-S-h W5216 (cons stream (cons in ())) V5019 V5020 V5021 W5024 V5023)))) false))) false))) false)) false)) false)) false) (if (= W5210 false) (let W5218 (if (shen.unlocked? V5021) (let W5219 (shen.lazyderef V5017 V5020) (if (cons? W5219) (let W5220 (shen.lazyderef (hd W5219) V5020) (if (= W5220 set) (let W5221 (shen.lazyderef (tl W5219) V5020) (if (cons? W5221) (let W5222 (hd W5221) (let W5223 (shen.lazyderef (tl W5221) V5020) (if (cons? W5223) (let W5224 (hd W5223) (let W5225 (shen.lazyderef (tl W5223) V5020) (if (= W5225 ()) (do (shen.incinfs) (shen.system-S-h W5222 symbol V5019 V5020 V5021 W5024 (freeze (shen.system-S-h (cons value (cons W5222 ())) V5018 V5019 V5020 V5021 W5024 (freeze (shen.system-S-h W5224 V5018 V5019 V5020 V5021 W5024 V5023)))))) false))) false))) false)) false)) false)) false) (if (= W5218 false) (let W5226 (if (shen.unlocked? V5021) (let W5227 (shen.newpv V5020) (shen.gc V5020 (do (shen.incinfs) (shen.l-rules V5019 W5227 false V5020 V5021 W5024 (freeze (shen.cut V5020 V5021 W5024 (freeze (shen.system-S-h V5017 V5018 W5227 V5020 V5021 W5024 V5023)))))))) false) (if (= W5226 false) (let W5228 (if (shen.unlocked? V5021) (do (shen.incinfs) (shen.search-user-datatypes (cons V5017 (cons (intern ":") (cons V5018 ()))) V5019 (value shen.*datatypes*) V5020 V5021 W5024 V5023)) false) (if (= W5228 false) (shen.unlock V5021 W5024) W5228)) W5226)) W5218)) W5210)) W5202)) W5181)) W5168)) W5138)) W5128)) W5107)) W5079)) W5058)) W5051)) W5044)) W5038)) W5032)) W5028)) W5027)) W5026)) W5025)))) -(defun shen.rdecons (V5215) (cond ((and (cons? V5215) (and (= cons (hd V5215)) (and (cons? (tl V5215)) (and (cons? (tl (tl V5215))) (= () (tl (tl (tl V5215)))))))) (cons (shen.rdecons (hd (tl V5215))) (shen.rdecons (hd (tl (tl V5215)))))) ((cons? V5215) (cons (shen.rdecons (hd V5215)) (shen.rdecons (tl V5215)))) (true V5215))) +(defun shen.rdecons (V5229) (cond ((and (cons? V5229) (and (= cons (hd V5229)) (and (cons? (tl V5229)) (and (cons? (tl (tl V5229))) (= () (tl (tl (tl V5229)))))))) (cons (shen.rdecons (hd (tl V5229))) (shen.rdecons (hd (tl (tl V5229)))))) ((cons? V5229) (cons (shen.rdecons (hd V5229)) (shen.rdecons (tl V5229)))) (true V5229))) -(defun shen.primitive (V5216 V5217 V5218 V5219 V5220 V5221) (let W5222 (if (shen.unlocked? V5219) (let W5223 (shen.lazyderef V5217 V5218) (let W5224 (freeze (do (shen.incinfs) (when (number? (shen.lazyderef V5216 V5218)) V5218 V5219 V5220 V5221))) (if (= W5223 number) (thaw W5224) (if (shen.pvar? W5223) (shen.bind! W5223 number V5218 W5224) false)))) false) (if (= W5222 false) (let W5225 (if (shen.unlocked? V5219) (let W5226 (shen.lazyderef V5217 V5218) (let W5227 (freeze (do (shen.incinfs) (when (boolean? (shen.lazyderef V5216 V5218)) V5218 V5219 V5220 V5221))) (if (= W5226 boolean) (thaw W5227) (if (shen.pvar? W5226) (shen.bind! W5226 boolean V5218 W5227) false)))) false) (if (= W5225 false) (let W5228 (if (shen.unlocked? V5219) (let W5229 (shen.lazyderef V5217 V5218) (let W5230 (freeze (do (shen.incinfs) (when (string? (shen.lazyderef V5216 V5218)) V5218 V5219 V5220 V5221))) (if (= W5229 string) (thaw W5230) (if (shen.pvar? W5229) (shen.bind! W5229 string V5218 W5230) false)))) false) (if (= W5228 false) (let W5231 (if (shen.unlocked? V5219) (let W5232 (shen.lazyderef V5217 V5218) (let W5233 (freeze (do (shen.incinfs) (when (symbol? (shen.lazyderef V5216 V5218)) V5218 V5219 V5220 V5221))) (if (= W5232 symbol) (thaw W5233) (if (shen.pvar? W5232) (shen.bind! W5232 symbol V5218 W5233) false)))) false) (if (= W5231 false) (if (shen.unlocked? V5219) (let W5234 (shen.lazyderef V5216 V5218) (if (= W5234 ()) (let W5235 (shen.lazyderef V5217 V5218) (let W5236 (lambda Z5237 (do (shen.incinfs) (thaw V5221))) (if (cons? W5235) (let W5238 (shen.lazyderef (hd W5235) V5218) (let W5239 (freeze (let W5240 (shen.lazyderef (tl W5235) V5218) (let W5241 (lambda Z5242 (W5236 Z5242)) (if (cons? W5240) (let W5243 (hd W5240) (let W5244 (shen.lazyderef (tl W5240) V5218) (let W5245 (freeze (W5241 W5243)) (if (= W5244 ()) (thaw W5245) (if (shen.pvar? W5244) (shen.bind! W5244 () V5218 W5245) false))))) (if (shen.pvar? W5240) (let W5246 (shen.newpv V5218) (shen.gc V5218 (shen.bind! W5240 (cons W5246 ()) V5218 (freeze (W5241 W5246))))) false))))) (if (= W5238 list) (thaw W5239) (if (shen.pvar? W5238) (shen.bind! W5238 list V5218 W5239) false)))) (if (shen.pvar? W5235) (let W5247 (shen.newpv V5218) (shen.gc V5218 (shen.bind! W5235 (cons list (cons W5247 ())) V5218 (freeze (W5236 W5247))))) false)))) false)) false) W5231)) W5228)) W5225)) W5222))) +(defun shen.primitive (V5230 V5231 V5232 V5233 V5234 V5235) (let W5236 (if (shen.unlocked? V5233) (let W5237 (shen.lazyderef V5231 V5232) (let W5238 (freeze (do (shen.incinfs) (when (number? (shen.lazyderef V5230 V5232)) V5232 V5233 V5234 V5235))) (if (= W5237 number) (thaw W5238) (if (shen.pvar? W5237) (shen.bind! W5237 number V5232 W5238) false)))) false) (if (= W5236 false) (let W5239 (if (shen.unlocked? V5233) (let W5240 (shen.lazyderef V5231 V5232) (let W5241 (freeze (do (shen.incinfs) (when (boolean? (shen.lazyderef V5230 V5232)) V5232 V5233 V5234 V5235))) (if (= W5240 boolean) (thaw W5241) (if (shen.pvar? W5240) (shen.bind! W5240 boolean V5232 W5241) false)))) false) (if (= W5239 false) (let W5242 (if (shen.unlocked? V5233) (let W5243 (shen.lazyderef V5231 V5232) (let W5244 (freeze (do (shen.incinfs) (when (string? (shen.lazyderef V5230 V5232)) V5232 V5233 V5234 V5235))) (if (= W5243 string) (thaw W5244) (if (shen.pvar? W5243) (shen.bind! W5243 string V5232 W5244) false)))) false) (if (= W5242 false) (let W5245 (if (shen.unlocked? V5233) (let W5246 (shen.lazyderef V5231 V5232) (let W5247 (freeze (do (shen.incinfs) (when (symbol? (shen.lazyderef V5230 V5232)) V5232 V5233 V5234 V5235))) (if (= W5246 symbol) (thaw W5247) (if (shen.pvar? W5246) (shen.bind! W5246 symbol V5232 W5247) false)))) false) (if (= W5245 false) (if (shen.unlocked? V5233) (let W5248 (shen.lazyderef V5230 V5232) (if (= W5248 ()) (let W5249 (shen.lazyderef V5231 V5232) (let W5250 (lambda Z5251 (do (shen.incinfs) (thaw V5235))) (if (cons? W5249) (let W5252 (shen.lazyderef (hd W5249) V5232) (let W5253 (freeze (let W5254 (shen.lazyderef (tl W5249) V5232) (let W5255 (lambda Z5256 (W5250 Z5256)) (if (cons? W5254) (let W5257 (hd W5254) (let W5258 (shen.lazyderef (tl W5254) V5232) (let W5259 (freeze (W5255 W5257)) (if (= W5258 ()) (thaw W5259) (if (shen.pvar? W5258) (shen.bind! W5258 () V5232 W5259) false))))) (if (shen.pvar? W5254) (let W5260 (shen.newpv V5232) (shen.gc V5232 (shen.bind! W5254 (cons W5260 ()) V5232 (freeze (W5255 W5260))))) false))))) (if (= W5252 list) (thaw W5253) (if (shen.pvar? W5252) (shen.bind! W5252 list V5232 W5253) false)))) (if (shen.pvar? W5249) (let W5261 (shen.newpv V5232) (shen.gc V5232 (shen.bind! W5249 (cons list (cons W5261 ())) V5232 (freeze (W5250 W5261))))) false)))) false)) false) W5245)) W5242)) W5239)) W5236))) -(defun shen.by-hypothesis (V5248 V5249 V5250 V5251 V5252 V5253 V5254) (let W5255 (if (shen.unlocked? V5252) (let W5256 (shen.lazyderef V5250 V5251) (if (cons? W5256) (let W5257 (shen.lazyderef (hd W5256) V5251) (if (cons? W5257) (let W5258 (hd W5257) (let W5259 (shen.lazyderef (tl W5257) V5251) (if (cons? W5259) (let W5260 (hd W5259) (let W5261 (shen.lazyderef (tl W5259) V5251) (if (cons? W5261) (let W5262 (hd W5261) (let W5263 (shen.lazyderef (tl W5261) V5251) (if (= W5263 ()) (do (shen.incinfs) (when (= (shen.deref W5260 V5251) (intern ":")) V5251 V5252 V5253 (freeze (when (= (shen.deref V5248 V5251) (shen.deref W5258 V5251)) V5251 V5252 V5253 (freeze (is! V5249 W5262 V5251 V5252 V5253 V5254)))))) false))) false))) false))) false)) false)) false) (if (= W5255 false) (if (shen.unlocked? V5252) (let W5264 (shen.lazyderef V5250 V5251) (if (cons? W5264) (let W5265 (tl W5264) (do (shen.incinfs) (shen.by-hypothesis V5248 V5249 W5265 V5251 V5252 V5253 V5254))) false)) false) W5255))) +(defun shen.by-hypothesis (V5262 V5263 V5264 V5265 V5266 V5267 V5268) (if (= (shen.lazyderef V5264 V5265) ()) false (shen.by-hypothesis-h (shen.deref V5262 V5265) V5263 V5264 V5265 V5266 V5267 V5268))) -(defun shen.lookupsig (V5266 V5267 V5268 V5269 V5270 V5271) (if (shen.unlocked? V5269) (do (shen.incinfs) (shen.sigf (assoc V5266 (value shen.*sigf*)) V5267 V5268 V5269 V5270 V5271)) false)) +(defun shen.by-hypothesis-h (V5269 V5270 V5271 V5272 V5273 V5274 V5275) (let W5276 (if (shen.unlocked? V5273) (let W5277 (shen.lazyderef V5271 V5272) (if (cons? W5277) (let W5278 (shen.lazyderef (hd W5277) V5272) (if (cons? W5278) (let W5279 (hd W5278) (let W5280 (shen.lazyderef (tl W5278) V5272) (if (cons? W5280) (let W5281 (hd W5280) (let W5282 (shen.lazyderef (tl W5280) V5272) (if (cons? W5282) (let W5283 (hd W5282) (let W5284 (shen.lazyderef (tl W5282) V5272) (if (= W5284 ()) (do (shen.incinfs) (when (= (shen.deref W5281 V5272) (intern ":")) V5272 V5273 V5274 (freeze (when (= V5269 (shen.deref W5279 V5272)) V5272 V5273 V5274 (freeze (is! V5270 W5283 V5272 V5273 V5274 V5275)))))) false))) false))) false))) false)) false)) false) (if (= W5276 false) (if (shen.unlocked? V5273) (let W5285 (shen.lazyderef V5271 V5272) (if (cons? W5285) (let W5286 (tl W5285) (do (shen.incinfs) (shen.by-hypothesis-h V5269 V5270 W5286 V5272 V5273 V5274 V5275))) false)) false) W5276))) -(defun shen.sigf (V5286 V5287 V5288 V5289 V5290 V5291) (cond ((cons? V5286) ((((((tl V5286) V5287) V5288) V5289) V5290) V5291)) (true false))) +(defun shen.lookupsig (V5287 V5288 V5289 V5290 V5291 V5292) (if (shen.unlocked? V5290) (do (shen.incinfs) (shen.sigf (assoc V5287 (value shen.*sigf*)) V5288 V5289 V5290 V5291 V5292)) false)) -(defun shen.freshterm (V5292) (let W5293 (absvector 3) (let W5294 (address-> W5293 0 shen.print-freshterm) (let W5295 (address-> W5294 1 V5292) (let W5296 (address-> W5295 2 (set shen.*gensym* (+ 1 (value shen.*gensym*)))) W5296))))) +(defun shen.sigf (V5307 V5308 V5309 V5310 V5311 V5312) (cond ((cons? V5307) ((((((tl V5307) V5308) V5309) V5310) V5311) V5312)) (true false))) -(defun shen.print-freshterm (V5297) (cn "&&" (shen.app (<-address V5297 1) "" shen.a))) +(defun shen.freshterm (V5313) (let W5314 (absvector 3) (let W5315 (address-> W5314 0 shen.print-freshterm) (let W5316 (address-> W5315 1 V5313) (let W5317 (address-> W5316 2 (set shen.*gensym* (+ 1 (value shen.*gensym*)))) W5317))))) -(defun shen.search-user-datatypes (V5298 V5299 V5300 V5301 V5302 V5303 V5304) (let W5305 (if (shen.unlocked? V5302) (let W5306 (shen.lazyderef V5300 V5301) (if (cons? W5306) (let W5307 (shen.lazyderef (hd W5306) V5301) (if (cons? W5307) (let W5308 (tl W5307) (do (shen.incinfs) (call (((shen.deref W5308 V5301) (shen.deref V5298 V5301)) (shen.deref V5299 V5301)) V5301 V5302 V5303 V5304))) false)) false)) false) (if (= W5305 false) (if (shen.unlocked? V5302) (let W5309 (shen.lazyderef V5300 V5301) (if (cons? W5309) (let W5310 (tl W5309) (do (shen.incinfs) (shen.search-user-datatypes V5298 V5299 W5310 V5301 V5302 V5303 V5304))) false)) false) W5305))) +(defun shen.print-freshterm (V5318) (cn "&&" (shen.app (<-address V5318 1) "" shen.a))) -(defun shen.l-rules (V5311 V5312 V5313 V5314 V5315 V5316 V5317) (let W5318 (+ V5316 1) (let W5319 (if (shen.unlocked? V5315) (let W5320 (shen.lazyderef V5311 V5314) (if (= W5320 ()) (let W5321 (shen.lazyderef V5313 V5314) (if (= W5321 true) (do (shen.incinfs) (shen.cut V5314 V5315 W5318 (freeze (bind V5312 () V5314 V5315 W5318 V5317)))) false)) false)) false) (if (= W5319 false) (let W5322 (if (shen.unlocked? V5315) (let W5323 (shen.lazyderef V5311 V5314) (if (cons? W5323) (let W5324 (shen.lazyderef (hd W5323) V5314) (if (cons? W5324) (let W5325 (shen.lazyderef (hd W5324) V5314) (if (cons? W5325) (let W5326 (shen.lazyderef (hd W5325) V5314) (if (= W5326 cons) (let W5327 (shen.lazyderef (tl W5325) V5314) (if (cons? W5327) (let W5328 (hd W5327) (let W5329 (shen.lazyderef (tl W5327) V5314) (if (cons? W5329) (let W5330 (hd W5329) (let W5331 (shen.lazyderef (tl W5329) V5314) (if (= W5331 ()) (let W5332 (shen.lazyderef (tl W5324) V5314) (if (cons? W5332) (let W5333 (hd W5332) (let W5334 (shen.lazyderef (tl W5332) V5314) (if (cons? W5334) (let W5335 (shen.lazyderef (hd W5334) V5314) (if (cons? W5335) (let W5336 (shen.lazyderef (hd W5335) V5314) (if (= W5336 list) (let W5337 (shen.lazyderef (tl W5335) V5314) (if (cons? W5337) (let W5338 (hd W5337) (let W5339 (shen.lazyderef (tl W5337) V5314) (if (= W5339 ()) (let W5340 (shen.lazyderef (tl W5334) V5314) (if (= W5340 ()) (let W5341 (tl W5323) (do (shen.incinfs) (when (= (shen.deref W5333 V5314) (intern ":")) V5314 V5315 W5318 (freeze (shen.cut V5314 V5315 W5318 (freeze (shen.l-rules (cons (cons W5328 (cons W5333 (cons W5338 ()))) (cons (cons W5330 (cons W5333 (cons (cons list (cons W5338 ())) ()))) W5341)) V5312 true V5314 V5315 W5318 V5317))))))) false)) false))) false)) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W5322 false) (let W5342 (if (shen.unlocked? V5315) (let W5343 (shen.lazyderef V5311 V5314) (if (cons? W5343) (let W5344 (shen.lazyderef (hd W5343) V5314) (if (cons? W5344) (let W5345 (shen.lazyderef (hd W5344) V5314) (if (cons? W5345) (let W5346 (shen.lazyderef (hd W5345) V5314) (if (= W5346 @p) (let W5347 (shen.lazyderef (tl W5345) V5314) (if (cons? W5347) (let W5348 (hd W5347) (let W5349 (shen.lazyderef (tl W5347) V5314) (if (cons? W5349) (let W5350 (hd W5349) (let W5351 (shen.lazyderef (tl W5349) V5314) (if (= W5351 ()) (let W5352 (shen.lazyderef (tl W5344) V5314) (if (cons? W5352) (let W5353 (hd W5352) (let W5354 (shen.lazyderef (tl W5352) V5314) (if (cons? W5354) (let W5355 (shen.lazyderef (hd W5354) V5314) (if (cons? W5355) (let W5356 (hd W5355) (let W5357 (shen.lazyderef (tl W5355) V5314) (if (cons? W5357) (let W5358 (shen.lazyderef (hd W5357) V5314) (if (= W5358 *) (let W5359 (shen.lazyderef (tl W5357) V5314) (if (cons? W5359) (let W5360 (hd W5359) (let W5361 (shen.lazyderef (tl W5359) V5314) (if (= W5361 ()) (let W5362 (shen.lazyderef (tl W5354) V5314) (if (= W5362 ()) (let W5363 (tl W5343) (do (shen.incinfs) (when (= (shen.deref W5353 V5314) (intern ":")) V5314 V5315 W5318 (freeze (shen.cut V5314 V5315 W5318 (freeze (shen.l-rules (cons (cons W5348 (cons W5353 (cons W5356 ()))) (cons (cons W5350 (cons W5353 (cons W5360 ()))) W5363)) V5312 true V5314 V5315 W5318 V5317))))))) false)) false))) false)) false)) false))) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W5342 false) (let W5364 (if (shen.unlocked? V5315) (let W5365 (shen.lazyderef V5311 V5314) (if (cons? W5365) (let W5366 (shen.lazyderef (hd W5365) V5314) (if (cons? W5366) (let W5367 (shen.lazyderef (hd W5366) V5314) (if (cons? W5367) (let W5368 (shen.lazyderef (hd W5367) V5314) (if (= W5368 @s) (let W5369 (shen.lazyderef (tl W5367) V5314) (if (cons? W5369) (let W5370 (hd W5369) (let W5371 (shen.lazyderef (tl W5369) V5314) (if (cons? W5371) (let W5372 (hd W5371) (let W5373 (shen.lazyderef (tl W5371) V5314) (if (= W5373 ()) (let W5374 (shen.lazyderef (tl W5366) V5314) (if (cons? W5374) (let W5375 (hd W5374) (let W5376 (shen.lazyderef (tl W5374) V5314) (if (cons? W5376) (let W5377 (shen.lazyderef (hd W5376) V5314) (if (= W5377 string) (let W5378 (shen.lazyderef (tl W5376) V5314) (if (= W5378 ()) (let W5379 (tl W5365) (do (shen.incinfs) (when (= (shen.deref W5375 V5314) (intern ":")) V5314 V5315 W5318 (freeze (shen.cut V5314 V5315 W5318 (freeze (shen.l-rules (cons (cons W5370 (cons W5375 (cons string ()))) (cons (cons W5372 (cons W5375 (cons string ()))) W5379)) V5312 true V5314 V5315 W5318 V5317))))))) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W5364 false) (let W5380 (if (shen.unlocked? V5315) (let W5381 (shen.lazyderef V5311 V5314) (if (cons? W5381) (let W5382 (shen.lazyderef (hd W5381) V5314) (if (cons? W5382) (let W5383 (shen.lazyderef (hd W5382) V5314) (if (cons? W5383) (let W5384 (shen.lazyderef (hd W5383) V5314) (if (= W5384 @v) (let W5385 (shen.lazyderef (tl W5383) V5314) (if (cons? W5385) (let W5386 (hd W5385) (let W5387 (shen.lazyderef (tl W5385) V5314) (if (cons? W5387) (let W5388 (hd W5387) (let W5389 (shen.lazyderef (tl W5387) V5314) (if (= W5389 ()) (let W5390 (shen.lazyderef (tl W5382) V5314) (if (cons? W5390) (let W5391 (hd W5390) (let W5392 (shen.lazyderef (tl W5390) V5314) (if (cons? W5392) (let W5393 (shen.lazyderef (hd W5392) V5314) (if (cons? W5393) (let W5394 (shen.lazyderef (hd W5393) V5314) (if (= W5394 vector) (let W5395 (shen.lazyderef (tl W5393) V5314) (if (cons? W5395) (let W5396 (hd W5395) (let W5397 (shen.lazyderef (tl W5395) V5314) (if (= W5397 ()) (let W5398 (shen.lazyderef (tl W5392) V5314) (if (= W5398 ()) (let W5399 (tl W5381) (do (shen.incinfs) (when (= (shen.deref W5391 V5314) (intern ":")) V5314 V5315 W5318 (freeze (shen.cut V5314 V5315 W5318 (freeze (shen.l-rules (cons (cons W5386 (cons W5391 (cons W5396 ()))) (cons (cons W5388 (cons W5391 (cons (cons vector (cons W5396 ())) ()))) W5399)) V5312 true V5314 V5315 W5318 V5317))))))) false)) false))) false)) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W5380 false) (let W5400 (if (shen.unlocked? V5315) (let W5401 (shen.lazyderef V5311 V5314) (if (cons? W5401) (let W5402 (hd W5401) (let W5403 (tl W5401) (let W5404 (shen.lazyderef V5312 V5314) (let W5405 (lambda Z5406 (lambda Z5407 (do (shen.incinfs) (bind Z5406 W5402 V5314 V5315 W5318 (freeze (shen.l-rules W5403 Z5407 V5313 V5314 V5315 W5318 V5317)))))) (if (cons? W5404) (let W5408 (hd W5404) (let W5409 (tl W5404) ((W5405 W5408) W5409))) (if (shen.pvar? W5404) (let W5410 (shen.newpv V5314) (shen.gc V5314 (let W5411 (shen.newpv V5314) (shen.gc V5314 (shen.bind! W5404 (cons W5410 W5411) V5314 (freeze ((W5405 W5410) W5411))))))) false)))))) false)) false) (if (= W5400 false) (shen.unlock V5315 W5318) W5400)) W5380)) W5364)) W5342)) W5322)) W5319)))) +(defun shen.search-user-datatypes (V5319 V5320 V5321 V5322 V5323 V5324 V5325) (if (= (shen.lazyderef V5321 V5322) ()) false (shen.search-user-datatypes-h (shen.deref V5319 V5322) (shen.deref V5320 V5322) V5321 V5322 V5323 V5324 V5325))) -(defun shen.t* (V5412 V5413 V5414 V5415 V5416 V5417) (let W5418 (+ V5416 1) (let W5419 (if (shen.unlocked? V5415) (let W5420 (shen.lazyderef V5412 V5414) (if (cons? W5420) (let W5421 (shen.lazyderef (hd W5420) V5414) (if (= W5421 define) (let W5422 (shen.lazyderef (tl W5420) V5414) (if (cons? W5422) (let W5423 (hd W5422) (let W5424 (tl W5422) (let W5425 (shen.newpv V5414) (shen.gc V5414 (let W5426 (shen.newpv V5414) (shen.gc V5414 (let W5427 (shen.newpv V5414) (shen.gc V5414 (let W5428 (shen.newpv V5414) (shen.gc V5414 (do (shen.incinfs) (shen.cut V5414 V5415 W5418 (freeze (bind W5425 (shen.sigxrules (cons W5423 W5424)) V5414 V5415 W5418 (freeze (bind W5428 (fst (shen.lazyderef W5425 V5414)) V5414 V5415 W5418 (freeze (bind W5426 (snd (shen.lazyderef W5425 V5414)) V5414 V5415 W5418 (freeze (bind W5427 (shen.freshen-sig (shen.deref W5428 V5414)) V5414 V5415 W5418 (freeze (shen.t*-rules W5423 W5426 W5427 1 V5414 V5415 W5418 (freeze (is W5428 V5413 V5414 V5415 W5418 V5417)))))))))))))))))))))))) false)) false)) false)) false) (if (= W5419 false) (shen.unlock V5415 W5418) W5419)))) +(defun shen.search-user-datatypes-h (V5326 V5327 V5328 V5329 V5330 V5331 V5332) (let W5333 (if (shen.unlocked? V5330) (let W5334 (shen.lazyderef V5328 V5329) (if (cons? W5334) (let W5335 (shen.lazyderef (hd W5334) V5329) (if (cons? W5335) (let W5336 (tl W5335) (do (shen.incinfs) (call (((shen.deref W5336 V5329) V5326) V5327) V5329 V5330 V5331 V5332))) false)) false)) false) (if (= W5333 false) (if (shen.unlocked? V5330) (let W5337 (shen.lazyderef V5328 V5329) (if (cons? W5337) (let W5338 (tl W5337) (do (shen.incinfs) (shen.search-user-datatypes-h V5326 V5327 W5338 V5329 V5330 V5331 V5332))) false)) false) W5333))) -(defun shen.sigxrules (V5429) (let W5430 (compile (lambda Z5431 (shen. Z5431)) V5429) (@p (fst W5430) (map (lambda Z5432 (shen.unmark-rule-custom-patterns Z5432)) (snd W5430))))) +(defun shen.l-rules (V5339 V5340 V5341 V5342 V5343 V5344 V5345) (let W5346 (+ V5344 1) (let W5347 (if (shen.unlocked? V5343) (let W5348 (shen.lazyderef V5339 V5342) (if (= W5348 ()) (let W5349 (shen.lazyderef V5341 V5342) (if (= W5349 true) (do (shen.incinfs) (shen.cut V5342 V5343 W5346 (freeze (bind V5340 () V5342 V5343 W5346 V5345)))) false)) false)) false) (if (= W5347 false) (let W5350 (if (shen.unlocked? V5343) (let W5351 (shen.lazyderef V5339 V5342) (if (cons? W5351) (let W5352 (shen.lazyderef (hd W5351) V5342) (if (cons? W5352) (let W5353 (shen.lazyderef (hd W5352) V5342) (if (cons? W5353) (let W5354 (shen.lazyderef (hd W5353) V5342) (if (= W5354 cons) (let W5355 (shen.lazyderef (tl W5353) V5342) (if (cons? W5355) (let W5356 (hd W5355) (let W5357 (shen.lazyderef (tl W5355) V5342) (if (cons? W5357) (let W5358 (hd W5357) (let W5359 (shen.lazyderef (tl W5357) V5342) (if (= W5359 ()) (let W5360 (shen.lazyderef (tl W5352) V5342) (if (cons? W5360) (let W5361 (hd W5360) (let W5362 (shen.lazyderef (tl W5360) V5342) (if (cons? W5362) (let W5363 (shen.lazyderef (hd W5362) V5342) (if (cons? W5363) (let W5364 (shen.lazyderef (hd W5363) V5342) (if (= W5364 list) (let W5365 (shen.lazyderef (tl W5363) V5342) (if (cons? W5365) (let W5366 (hd W5365) (let W5367 (shen.lazyderef (tl W5365) V5342) (if (= W5367 ()) (let W5368 (shen.lazyderef (tl W5362) V5342) (if (= W5368 ()) (let W5369 (tl W5351) (do (shen.incinfs) (when (= (shen.deref W5361 V5342) (intern ":")) V5342 V5343 W5346 (freeze (shen.cut V5342 V5343 W5346 (freeze (shen.l-rules (cons (cons W5356 (cons W5361 (cons W5366 ()))) (cons (cons W5358 (cons W5361 (cons (cons list (cons W5366 ())) ()))) W5369)) V5340 true V5342 V5343 W5346 V5345))))))) false)) false))) false)) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W5350 false) (let W5370 (if (shen.unlocked? V5343) (let W5371 (shen.lazyderef V5339 V5342) (if (cons? W5371) (let W5372 (shen.lazyderef (hd W5371) V5342) (if (cons? W5372) (let W5373 (shen.lazyderef (hd W5372) V5342) (if (cons? W5373) (let W5374 (shen.lazyderef (hd W5373) V5342) (if (= W5374 @p) (let W5375 (shen.lazyderef (tl W5373) V5342) (if (cons? W5375) (let W5376 (hd W5375) (let W5377 (shen.lazyderef (tl W5375) V5342) (if (cons? W5377) (let W5378 (hd W5377) (let W5379 (shen.lazyderef (tl W5377) V5342) (if (= W5379 ()) (let W5380 (shen.lazyderef (tl W5372) V5342) (if (cons? W5380) (let W5381 (hd W5380) (let W5382 (shen.lazyderef (tl W5380) V5342) (if (cons? W5382) (let W5383 (shen.lazyderef (hd W5382) V5342) (if (cons? W5383) (let W5384 (hd W5383) (let W5385 (shen.lazyderef (tl W5383) V5342) (if (cons? W5385) (let W5386 (shen.lazyderef (hd W5385) V5342) (if (= W5386 *) (let W5387 (shen.lazyderef (tl W5385) V5342) (if (cons? W5387) (let W5388 (hd W5387) (let W5389 (shen.lazyderef (tl W5387) V5342) (if (= W5389 ()) (let W5390 (shen.lazyderef (tl W5382) V5342) (if (= W5390 ()) (let W5391 (tl W5371) (do (shen.incinfs) (when (= (shen.deref W5381 V5342) (intern ":")) V5342 V5343 W5346 (freeze (shen.cut V5342 V5343 W5346 (freeze (shen.l-rules (cons (cons W5376 (cons W5381 (cons W5384 ()))) (cons (cons W5378 (cons W5381 (cons W5388 ()))) W5391)) V5340 true V5342 V5343 W5346 V5345))))))) false)) false))) false)) false)) false))) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W5370 false) (let W5392 (if (shen.unlocked? V5343) (let W5393 (shen.lazyderef V5339 V5342) (if (cons? W5393) (let W5394 (shen.lazyderef (hd W5393) V5342) (if (cons? W5394) (let W5395 (shen.lazyderef (hd W5394) V5342) (if (cons? W5395) (let W5396 (shen.lazyderef (hd W5395) V5342) (if (= W5396 @s) (let W5397 (shen.lazyderef (tl W5395) V5342) (if (cons? W5397) (let W5398 (hd W5397) (let W5399 (shen.lazyderef (tl W5397) V5342) (if (cons? W5399) (let W5400 (hd W5399) (let W5401 (shen.lazyderef (tl W5399) V5342) (if (= W5401 ()) (let W5402 (shen.lazyderef (tl W5394) V5342) (if (cons? W5402) (let W5403 (hd W5402) (let W5404 (shen.lazyderef (tl W5402) V5342) (if (cons? W5404) (let W5405 (shen.lazyderef (hd W5404) V5342) (if (= W5405 string) (let W5406 (shen.lazyderef (tl W5404) V5342) (if (= W5406 ()) (let W5407 (tl W5393) (do (shen.incinfs) (when (= (shen.deref W5403 V5342) (intern ":")) V5342 V5343 W5346 (freeze (shen.cut V5342 V5343 W5346 (freeze (shen.l-rules (cons (cons W5398 (cons W5403 (cons string ()))) (cons (cons W5400 (cons W5403 (cons string ()))) W5407)) V5340 true V5342 V5343 W5346 V5345))))))) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W5392 false) (let W5408 (if (shen.unlocked? V5343) (let W5409 (shen.lazyderef V5339 V5342) (if (cons? W5409) (let W5410 (shen.lazyderef (hd W5409) V5342) (if (cons? W5410) (let W5411 (shen.lazyderef (hd W5410) V5342) (if (cons? W5411) (let W5412 (shen.lazyderef (hd W5411) V5342) (if (= W5412 @v) (let W5413 (shen.lazyderef (tl W5411) V5342) (if (cons? W5413) (let W5414 (hd W5413) (let W5415 (shen.lazyderef (tl W5413) V5342) (if (cons? W5415) (let W5416 (hd W5415) (let W5417 (shen.lazyderef (tl W5415) V5342) (if (= W5417 ()) (let W5418 (shen.lazyderef (tl W5410) V5342) (if (cons? W5418) (let W5419 (hd W5418) (let W5420 (shen.lazyderef (tl W5418) V5342) (if (cons? W5420) (let W5421 (shen.lazyderef (hd W5420) V5342) (if (cons? W5421) (let W5422 (shen.lazyderef (hd W5421) V5342) (if (= W5422 vector) (let W5423 (shen.lazyderef (tl W5421) V5342) (if (cons? W5423) (let W5424 (hd W5423) (let W5425 (shen.lazyderef (tl W5423) V5342) (if (= W5425 ()) (let W5426 (shen.lazyderef (tl W5420) V5342) (if (= W5426 ()) (let W5427 (tl W5409) (do (shen.incinfs) (when (= (shen.deref W5419 V5342) (intern ":")) V5342 V5343 W5346 (freeze (shen.cut V5342 V5343 W5346 (freeze (shen.l-rules (cons (cons W5414 (cons W5419 (cons W5424 ()))) (cons (cons W5416 (cons W5419 (cons (cons vector (cons W5424 ())) ()))) W5427)) V5340 true V5342 V5343 W5346 V5345))))))) false)) false))) false)) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W5408 false) (let W5428 (if (shen.unlocked? V5343) (let W5429 (shen.lazyderef V5339 V5342) (if (cons? W5429) (let W5430 (hd W5429) (let W5431 (tl W5429) (let W5432 (shen.lazyderef V5340 V5342) (let W5433 (lambda Z5434 (lambda Z5435 (do (shen.incinfs) (bind Z5434 W5430 V5342 V5343 W5346 (freeze (shen.l-rules W5431 Z5435 V5341 V5342 V5343 W5346 V5345)))))) (if (cons? W5432) (let W5436 (hd W5432) (let W5437 (tl W5432) ((W5433 W5436) W5437))) (if (shen.pvar? W5432) (let W5438 (shen.newpv V5342) (shen.gc V5342 (let W5439 (shen.newpv V5342) (shen.gc V5342 (shen.bind! W5432 (cons W5438 W5439) V5342 (freeze ((W5433 W5438) W5439))))))) false)))))) false)) false) (if (= W5428 false) (shen.unlock V5343 W5346) W5428)) W5408)) W5392)) W5370)) W5350)) W5347)))) -(defun shen.unmark-rule-custom-patterns (V5433) (cond ((tuple? V5433) (@p (map (lambda Z5434 (shen.unmark-custom-pattern Z5434)) (fst V5433)) (snd V5433))) (true (shen.f-error shen.unmark-rule-custom-patterns)))) +(defun shen.t* (V5440 V5441 V5442 V5443 V5444 V5445) (let W5446 (+ V5444 1) (let W5447 (if (shen.unlocked? V5443) (let W5448 (shen.lazyderef V5440 V5442) (if (cons? W5448) (let W5449 (shen.lazyderef (hd W5448) V5442) (if (= W5449 define) (let W5450 (shen.lazyderef (tl W5448) V5442) (if (cons? W5450) (let W5451 (hd W5450) (let W5452 (tl W5450) (let W5453 (shen.newpv V5442) (shen.gc V5442 (let W5454 (shen.newpv V5442) (shen.gc V5442 (let W5455 (shen.newpv V5442) (shen.gc V5442 (let W5456 (shen.newpv V5442) (shen.gc V5442 (do (shen.incinfs) (shen.cut V5442 V5443 W5446 (freeze (bind W5453 (shen.sigxrules (cons W5451 W5452)) V5442 V5443 W5446 (freeze (bind W5456 (fst (shen.lazyderef W5453 V5442)) V5442 V5443 W5446 (freeze (bind W5454 (snd (shen.lazyderef W5453 V5442)) V5442 V5443 W5446 (freeze (bind W5455 (shen.freshen-sig (shen.deref W5456 V5442)) V5442 V5443 W5446 (freeze (shen.t*-rules W5451 W5454 W5455 1 V5442 V5443 W5446 (freeze (is W5456 V5441 V5442 V5443 W5446 V5445)))))))))))))))))))))))) false)) false)) false)) false) (if (= W5447 false) (shen.unlock V5443 W5446) W5447)))) -(defun shen.unmark-custom-pattern (V5435) (cond ((and (cons? V5435) (and (= @p (hd V5435)) (and (cons? (tl V5435)) (and (= shen.custom-pattern (hd (tl V5435))) (and (cons? (tl (tl V5435))) (= () (tl (tl (tl V5435))))))))) (shen.unmark-custom-pattern (shen.curry (hd (tl (tl V5435)))))) ((cons? V5435) (cons (shen.unmark-custom-pattern (hd V5435)) (shen.unmark-custom-pattern (tl V5435)))) (true V5435))) +(defun shen.sigxrules (V5457) (let W5458 (compile (lambda Z5459 (shen. Z5459)) V5457) (@p (fst W5458) (map (lambda Z5460 (shen.unmark-rule-custom-patterns Z5460)) (snd W5458))))) -(defun shen. (V5436) (let W5437 (if (cons? V5436) (let W5438 (tail V5436) (if (shen.hds=? W5438 {) (let W5439 (tail W5438) (let W5440 (shen. W5439) (if (shen.parse-failure? W5440) (shen.parse-failure) (let W5441 (shen.<-out W5440) (let W5442 (shen.in-> W5440) (if (shen.hds=? W5442 }) (let W5443 (tail W5442) (let W5444 (shen. W5443) (if (shen.parse-failure? W5444) (shen.parse-failure) (let W5445 (shen.<-out W5444) (let W5446 (shen.in-> W5444) (shen.comb W5446 (let W5447 (shen.rectify-type W5441) (@p W5447 W5445)))))))) (shen.parse-failure))))))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W5437) (shen.parse-failure) W5437))) +(defun shen.unmark-rule-custom-patterns (V5461) (cond ((tuple? V5461) (@p (map (lambda Z5462 (shen.unmark-custom-pattern Z5462)) (fst V5461)) (snd V5461))) (true (shen.f-error shen.unmark-rule-custom-patterns)))) -(defun shen.freshen-sig (V5448) (let W5449 (shen.extract-vars V5448) (let W5450 (map (lambda Z5451 (cons Z5451 (shen.freshterm (concat & Z5451)))) W5449) (shen.freshen-type W5450 V5448)))) +(defun shen.unmark-custom-pattern (V5463) (cond ((and (cons? V5463) (and (= @p (hd V5463)) (and (cons? (tl V5463)) (and (= shen.custom-pattern (hd (tl V5463))) (and (cons? (tl (tl V5463))) (= () (tl (tl (tl V5463))))))))) (shen.unmark-custom-pattern (shen.curry (hd (tl (tl V5463)))))) ((cons? V5463) (cons (shen.unmark-custom-pattern (hd V5463)) (shen.unmark-custom-pattern (tl V5463)))) (true V5463))) -(defun shen.freshen-type (V5452 V5453) (cond ((= () V5452) V5453) ((and (cons? V5452) (cons? (hd V5452))) (shen.freshen-type (tl V5452) (subst (tl (hd V5452)) (hd (hd V5452)) V5453))) (true (shen.f-error shen.freshen-type)))) +(defun shen. (V5464) (let W5465 (if (cons? V5464) (let W5466 (tail V5464) (if (shen.hds=? W5466 {) (let W5467 (tail W5466) (let W5468 (shen. W5467) (if (shen.parse-failure? W5468) (shen.parse-failure) (let W5469 (shen.<-out W5468) (let W5470 (shen.in-> W5468) (if (shen.hds=? W5470 }) (let W5471 (tail W5470) (let W5472 (shen. W5471) (if (shen.parse-failure? W5472) (shen.parse-failure) (let W5473 (shen.<-out W5472) (let W5474 (shen.in-> W5472) (shen.comb W5474 (let W5475 (shen.rectify-type W5469) (@p W5475 W5473)))))))) (shen.parse-failure))))))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W5465) (shen.parse-failure) W5465))) -(defun shen. (V5454) (let W5455 (let W5456 (shen. V5454) (if (shen.parse-failure? W5456) (shen.parse-failure) (let W5457 (shen.<-out W5456) (let W5458 (shen.in-> W5456) (let W5459 (shen. W5458) (if (shen.parse-failure? W5459) (shen.parse-failure) (let W5460 (shen.<-out W5459) (let W5461 (shen.in-> W5459) (shen.comb W5461 (cons W5457 W5460)))))))))) (if (shen.parse-failure? W5455) (let W5462 (let W5463 (shen. V5454) (if (shen.parse-failure? W5463) (shen.parse-failure) (let W5464 (shen.<-out W5463) (let W5465 (shen.in-> W5463) (shen.comb W5465 (cons W5464 ())))))) (if (shen.parse-failure? W5462) (shen.parse-failure) W5462)) W5455))) +(defun shen.freshen-sig (V5476) (let W5477 (shen.extract-vars V5476) (let W5478 (map (lambda Z5479 (cons Z5479 (shen.freshterm (concat & Z5479)))) W5477) (shen.freshen-type W5478 V5476)))) -(defun shen. (V5466) (let W5467 (let W5468 (shen. V5466) (if (shen.parse-failure? W5468) (shen.parse-failure) (let W5469 (shen.<-out W5468) (let W5470 (shen.in-> W5468) (if (shen.hds=? W5470 ->) (let W5471 (tail W5470) (if (cons? W5471) (let W5472 (head W5471) (let W5473 (tail W5471) (if (shen.hds=? W5473 where) (let W5474 (tail W5473) (if (cons? W5474) (let W5475 (head W5474) (let W5476 (tail W5474) (shen.comb W5476 (@p W5469 (cons where (cons W5475 (cons W5472 ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5467) (let W5477 (let W5478 (shen. V5466) (if (shen.parse-failure? W5478) (shen.parse-failure) (let W5479 (shen.<-out W5478) (let W5480 (shen.in-> W5478) (if (shen.hds=? W5480 <-) (let W5481 (tail W5480) (if (cons? W5481) (let W5482 (head W5481) (let W5483 (tail W5481) (if (shen.hds=? W5483 where) (let W5484 (tail W5483) (if (cons? W5484) (let W5485 (head W5484) (let W5486 (tail W5484) (shen.comb W5486 (@p W5479 (shen.correct (cons where (cons W5485 (cons W5482 ())))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5477) (let W5487 (let W5488 (shen. V5466) (if (shen.parse-failure? W5488) (shen.parse-failure) (let W5489 (shen.<-out W5488) (let W5490 (shen.in-> W5488) (if (shen.hds=? W5490 <-) (let W5491 (tail W5490) (if (cons? W5491) (let W5492 (head W5491) (let W5493 (tail W5491) (shen.comb W5493 (@p W5489 (shen.correct W5492))))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5487) (let W5494 (let W5495 (shen. V5466) (if (shen.parse-failure? W5495) (shen.parse-failure) (let W5496 (shen.<-out W5495) (let W5497 (shen.in-> W5495) (if (shen.hds=? W5497 ->) (let W5498 (tail W5497) (if (cons? W5498) (let W5499 (head W5498) (let W5500 (tail W5498) (shen.comb W5500 (@p W5496 W5499)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5494) (shen.parse-failure) W5494)) W5487)) W5477)) W5467))) +(defun shen.freshen-type (V5480 V5481) (cond ((= () V5480) V5481) ((and (cons? V5480) (cons? (hd V5480))) (shen.freshen-type (tl V5480) (subst (tl (hd V5480)) (hd (hd V5480)) V5481))) (true (shen.f-error shen.freshen-type)))) -(defun shen.correct (V5501) (cond ((and (cons? V5501) (and (= where (hd V5501)) (and (cons? (tl V5501)) (and (cons? (tl (tl V5501))) (and (cons? (hd (tl (tl V5501)))) (and (= fail-if (hd (hd (tl (tl V5501))))) (and (cons? (tl (hd (tl (tl V5501))))) (and (cons? (tl (tl (hd (tl (tl V5501)))))) (and (= () (tl (tl (tl (hd (tl (tl V5501))))))) (= () (tl (tl (tl V5501))))))))))))) (cons where (cons (cons and (cons (hd (tl V5501)) (cons (cons not (cons (tl (hd (tl (tl V5501)))) ())) ()))) (tl (tl (hd (tl (tl V5501)))))))) ((and (cons? V5501) (and (= where (hd V5501)) (and (cons? (tl V5501)) (and (cons? (tl (tl V5501))) (= () (tl (tl (tl V5501)))))))) (cons where (cons (cons and (cons (hd (tl V5501)) (cons (cons not (cons (cons == (cons (hd (tl (tl V5501))) (cons (cons fail ()) ()))) ())) ()))) (tl (tl V5501))))) ((and (cons? V5501) (and (= fail-if (hd V5501)) (and (cons? (tl V5501)) (and (cons? (tl (tl V5501))) (= () (tl (tl (tl V5501)))))))) (cons where (cons (cons not (cons (tl V5501) ())) (tl (tl V5501))))) (true (cons where (cons (cons not (cons (cons == (cons V5501 (cons (cons fail ()) ()))) ())) (cons V5501 ())))))) +(defun shen. (V5482) (let W5483 (let W5484 (shen. V5482) (if (shen.parse-failure? W5484) (shen.parse-failure) (let W5485 (shen.<-out W5484) (let W5486 (shen.in-> W5484) (let W5487 (shen. W5486) (if (shen.parse-failure? W5487) (shen.parse-failure) (let W5488 (shen.<-out W5487) (let W5489 (shen.in-> W5487) (shen.comb W5489 (cons W5485 W5488)))))))))) (if (shen.parse-failure? W5483) (let W5490 (let W5491 (shen. V5482) (if (shen.parse-failure? W5491) (shen.parse-failure) (let W5492 (shen.<-out W5491) (let W5493 (shen.in-> W5491) (shen.comb W5493 (cons W5492 ())))))) (if (shen.parse-failure? W5490) (shen.parse-failure) W5490)) W5483))) -(defun shen.t*-rules (V5502 V5503 V5504 V5505 V5506 V5507 V5508 V5509) (let W5510 (+ V5508 1) (let W5511 (if (shen.unlocked? V5507) (let W5512 (shen.lazyderef V5503 V5506) (if (= W5512 ()) (do (shen.incinfs) (thaw V5509)) false)) false) (if (= W5511 false) (let W5513 (if (shen.unlocked? V5507) (let W5514 (shen.lazyderef V5503 V5506) (if (cons? W5514) (let W5515 (hd W5514) (let W5516 (tl W5514) (let W5517 (shen.newpv V5506) (shen.gc V5506 (do (shen.incinfs) (bind W5517 (shen.freshen-rule (shen.deref W5515 V5506)) V5506 V5507 W5510 (freeze (shen.t*-rule V5502 V5505 (fst (shen.lazyderef W5517 V5506)) (snd (shen.lazyderef W5517 V5506)) V5504 V5506 V5507 W5510 (freeze (shen.cut V5506 V5507 W5510 (freeze (shen.t*-rules V5502 W5516 V5504 (+ V5505 1) V5506 V5507 W5510 V5509)))))))))))) false)) false) (if (= W5513 false) (shen.unlock V5507 W5510) W5513)) W5511)))) +(defun shen. (V5494) (let W5495 (let W5496 (shen. V5494) (if (shen.parse-failure? W5496) (shen.parse-failure) (let W5497 (shen.<-out W5496) (let W5498 (shen.in-> W5496) (if (shen.hds=? W5498 ->) (let W5499 (tail W5498) (if (cons? W5499) (let W5500 (head W5499) (let W5501 (tail W5499) (if (shen.hds=? W5501 where) (let W5502 (tail W5501) (if (cons? W5502) (let W5503 (head W5502) (let W5504 (tail W5502) (shen.comb W5504 (@p W5497 (cons where (cons W5503 (cons W5500 ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5495) (let W5505 (let W5506 (shen. V5494) (if (shen.parse-failure? W5506) (shen.parse-failure) (let W5507 (shen.<-out W5506) (let W5508 (shen.in-> W5506) (if (shen.hds=? W5508 <-) (let W5509 (tail W5508) (if (cons? W5509) (let W5510 (head W5509) (let W5511 (tail W5509) (if (shen.hds=? W5511 where) (let W5512 (tail W5511) (if (cons? W5512) (let W5513 (head W5512) (let W5514 (tail W5512) (shen.comb W5514 (@p W5507 (shen.correct (cons where (cons W5513 (cons W5510 ())))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5505) (let W5515 (let W5516 (shen. V5494) (if (shen.parse-failure? W5516) (shen.parse-failure) (let W5517 (shen.<-out W5516) (let W5518 (shen.in-> W5516) (if (shen.hds=? W5518 <-) (let W5519 (tail W5518) (if (cons? W5519) (let W5520 (head W5519) (let W5521 (tail W5519) (shen.comb W5521 (@p W5517 (shen.correct W5520))))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5515) (let W5522 (let W5523 (shen. V5494) (if (shen.parse-failure? W5523) (shen.parse-failure) (let W5524 (shen.<-out W5523) (let W5525 (shen.in-> W5523) (if (shen.hds=? W5525 ->) (let W5526 (tail W5525) (if (cons? W5526) (let W5527 (head W5526) (let W5528 (tail W5526) (shen.comb W5528 (@p W5524 W5527)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5522) (shen.parse-failure) W5522)) W5515)) W5505)) W5495))) -(defun shen.freshen-rule (V5518) (cond ((tuple? V5518) (let W5519 (shen.extract-vars (fst V5518)) (let W5520 (map (lambda Z5521 (cons Z5521 (shen.freshterm Z5521))) W5519) (@p (shen.freshen W5520 (fst V5518)) (shen.freshen W5520 (snd V5518)))))) (true (shen.f-error shen.freshen-rule)))) +(defun shen.correct (V5529) (cond ((and (cons? V5529) (and (= where (hd V5529)) (and (cons? (tl V5529)) (and (cons? (tl (tl V5529))) (and (cons? (hd (tl (tl V5529)))) (and (= fail-if (hd (hd (tl (tl V5529))))) (and (cons? (tl (hd (tl (tl V5529))))) (and (cons? (tl (tl (hd (tl (tl V5529)))))) (and (= () (tl (tl (tl (hd (tl (tl V5529))))))) (= () (tl (tl (tl V5529))))))))))))) (cons where (cons (cons and (cons (hd (tl V5529)) (cons (cons not (cons (tl (hd (tl (tl V5529)))) ())) ()))) (tl (tl (hd (tl (tl V5529)))))))) ((and (cons? V5529) (and (= where (hd V5529)) (and (cons? (tl V5529)) (and (cons? (tl (tl V5529))) (= () (tl (tl (tl V5529)))))))) (cons where (cons (cons and (cons (hd (tl V5529)) (cons (cons not (cons (cons == (cons (hd (tl (tl V5529))) (cons (cons fail ()) ()))) ())) ()))) (tl (tl V5529))))) ((and (cons? V5529) (and (= fail-if (hd V5529)) (and (cons? (tl V5529)) (and (cons? (tl (tl V5529))) (= () (tl (tl (tl V5529)))))))) (cons where (cons (cons not (cons (tl V5529) ())) (tl (tl V5529))))) (true (cons where (cons (cons not (cons (cons == (cons V5529 (cons (cons fail ()) ()))) ())) (cons V5529 ())))))) -(defun shen.freshen (V5522 V5523) (cond ((= () V5522) V5523) ((and (cons? V5522) (cons? (hd V5522))) (shen.freshen (tl V5522) (shen.beta (hd (hd V5522)) (tl (hd V5522)) V5523))) (true (shen.f-error shen.freshen)))) +(defun shen.t*-rules (V5530 V5531 V5532 V5533 V5534 V5535 V5536 V5537) (let W5538 (+ V5536 1) (let W5539 (if (shen.unlocked? V5535) (let W5540 (shen.lazyderef V5531 V5534) (if (= W5540 ()) (do (shen.incinfs) (thaw V5537)) false)) false) (if (= W5539 false) (let W5541 (if (shen.unlocked? V5535) (let W5542 (shen.lazyderef V5531 V5534) (if (cons? W5542) (let W5543 (hd W5542) (let W5544 (tl W5542) (let W5545 (shen.newpv V5534) (shen.gc V5534 (do (shen.incinfs) (bind W5545 (shen.freshen-rule (shen.deref W5543 V5534)) V5534 V5535 W5538 (freeze (shen.t*-rule V5530 V5533 (fst (shen.lazyderef W5545 V5534)) (snd (shen.lazyderef W5545 V5534)) V5532 V5534 V5535 W5538 (freeze (shen.cut V5534 V5535 W5538 (freeze (shen.t*-rules V5530 W5544 V5532 (+ V5533 1) V5534 V5535 W5538 V5537)))))))))))) false)) false) (if (= W5541 false) (shen.unlock V5535 W5538) W5541)) W5539)))) -(defun shen.t*-rule (V5524 V5525 V5526 V5527 V5528 V5529 V5530 V5531 V5532) (let W5533 (if (shen.unlocked? V5530) (do (shen.incinfs) (shen.t*-rule-h V5526 V5527 V5528 V5529 V5530 V5531 V5532)) false) (if (= W5533 false) (if (shen.unlocked? V5530) (let W5534 (shen.newpv V5529) (shen.gc V5529 (do (shen.incinfs) (bind W5534 (simple-error (cn "type error in rule " (shen.app V5525 (cn " of " (shen.app V5524 " -" shen.a)) shen.a))) V5529 V5530 V5531 V5532)))) false) W5533))) +(defun shen.freshen-rule (V5546) (cond ((tuple? V5546) (let W5547 (shen.extract-vars (fst V5546)) (let W5548 (map (lambda Z5549 (cons Z5549 (shen.freshterm Z5549))) W5547) (@p (shen.freshen W5548 (fst V5546)) (shen.freshen W5548 (snd V5546)))))) (true (shen.f-error shen.freshen-rule)))) -(defun shen.t*-rule-h (V5535 V5536 V5537 V5538 V5539 V5540 V5541) (let W5542 (+ V5540 1) (let W5543 (if (shen.unlocked? V5539) (let W5544 (shen.lazyderef V5535 V5538) (if (= W5544 ()) (let W5545 (shen.lazyderef V5537 V5538) (if (cons? W5545) (let W5546 (shen.lazyderef (hd W5545) V5538) (if (= W5546 -->) (let W5547 (shen.lazyderef (tl W5545) V5538) (if (cons? W5547) (let W5548 (hd W5547) (let W5549 (shen.lazyderef (tl W5547) V5538) (if (= W5549 ()) (do (shen.incinfs) (shen.cut V5538 V5539 W5542 (freeze (shen.t*-correct V5536 W5548 () V5538 V5539 W5542 V5541)))) false))) false)) false)) false)) false)) false) (if (= W5543 false) (let W5550 (if (shen.unlocked? V5539) (let W5551 (shen.newpv V5538) (shen.gc V5538 (let W5552 (shen.newpv V5538) (shen.gc V5538 (let W5553 (shen.newpv V5538) (shen.gc V5538 (do (shen.incinfs) (shen.p-hyps (shen.freshterms V5535) W5551 V5538 V5539 W5542 (freeze (shen.t*-integrity V5535 V5537 W5551 W5552 V5538 V5539 W5542 (freeze (shen.cut V5538 V5539 W5542 (freeze (shen.myassume V5535 V5537 W5553 V5538 V5539 W5542 (freeze (shen.t*-correct V5536 W5552 W5553 V5538 V5539 W5542 V5541)))))))))))))))) false) (if (= W5550 false) (shen.unlock V5539 W5542) W5550)) W5543)))) +(defun shen.freshen (V5550 V5551) (cond ((= () V5550) V5551) ((and (cons? V5550) (cons? (hd V5550))) (shen.freshen (tl V5550) (shen.beta (hd (hd V5550)) (tl (hd V5550)) V5551))) (true (shen.f-error shen.freshen)))) -(defun shen.myassume (V5554 V5555 V5556 V5557 V5558 V5559 V5560) (let W5561 (if (shen.unlocked? V5558) (let W5562 (shen.lazyderef V5554 V5557) (if (= W5562 ()) (let W5563 (shen.lazyderef V5556 V5557) (let W5564 (freeze (do (shen.incinfs) (thaw V5560))) (if (= W5563 ()) (thaw W5564) (if (shen.pvar? W5563) (shen.bind! W5563 () V5557 W5564) false)))) false)) false) (if (= W5561 false) (if (shen.unlocked? V5558) (let W5565 (shen.lazyderef V5554 V5557) (if (cons? W5565) (let W5566 (hd W5565) (let W5567 (tl W5565) (let W5568 (shen.lazyderef V5555 V5557) (if (cons? W5568) (let W5569 (hd W5568) (let W5570 (shen.lazyderef (tl W5568) V5557) (if (cons? W5570) (let W5571 (shen.lazyderef (hd W5570) V5557) (if (= W5571 -->) (let W5572 (shen.lazyderef (tl W5570) V5557) (if (cons? W5572) (let W5573 (hd W5572) (let W5574 (shen.lazyderef (tl W5572) V5557) (if (= W5574 ()) (let W5575 (shen.lazyderef V5556 V5557) (let W5576 (lambda Z5577 (lambda Z5578 (lambda Z5579 (lambda Z5580 (do (shen.incinfs) (is! W5569 Z5579 V5557 V5558 V5559 (freeze (is! W5566 Z5577 V5557 V5558 V5559 (freeze (bind Z5578 (intern ":") V5557 V5558 V5559 (freeze (shen.myassume W5567 W5573 Z5580 V5557 V5558 V5559 V5560)))))))))))) (if (cons? W5575) (let W5581 (shen.lazyderef (hd W5575) V5557) (let W5582 (lambda Z5583 (lambda Z5584 (lambda Z5585 (let W5586 (tl W5575) ((((W5576 Z5583) Z5584) Z5585) W5586))))) (if (cons? W5581) (let W5587 (hd W5581) (let W5588 (shen.lazyderef (tl W5581) V5557) (let W5589 (lambda Z5590 (lambda Z5591 (((W5582 W5587) Z5590) Z5591))) (if (cons? W5588) (let W5592 (hd W5588) (let W5593 (shen.lazyderef (tl W5588) V5557) (let W5594 (lambda Z5595 ((W5589 W5592) Z5595)) (if (cons? W5593) (let W5596 (hd W5593) (let W5597 (shen.lazyderef (tl W5593) V5557) (let W5598 (freeze (W5594 W5596)) (if (= W5597 ()) (thaw W5598) (if (shen.pvar? W5597) (shen.bind! W5597 () V5557 W5598) false))))) (if (shen.pvar? W5593) (let W5599 (shen.newpv V5557) (shen.gc V5557 (shen.bind! W5593 (cons W5599 ()) V5557 (freeze (W5594 W5599))))) false))))) (if (shen.pvar? W5588) (let W5600 (shen.newpv V5557) (shen.gc V5557 (let W5601 (shen.newpv V5557) (shen.gc V5557 (shen.bind! W5588 (cons W5600 (cons W5601 ())) V5557 (freeze ((W5589 W5600) W5601))))))) false))))) (if (shen.pvar? W5581) (let W5602 (shen.newpv V5557) (shen.gc V5557 (let W5603 (shen.newpv V5557) (shen.gc V5557 (let W5604 (shen.newpv V5557) (shen.gc V5557 (shen.bind! W5581 (cons W5602 (cons W5603 (cons W5604 ()))) V5557 (freeze (((W5582 W5602) W5603) W5604))))))))) false)))) (if (shen.pvar? W5575) (let W5605 (shen.newpv V5557) (shen.gc V5557 (let W5606 (shen.newpv V5557) (shen.gc V5557 (let W5607 (shen.newpv V5557) (shen.gc V5557 (let W5608 (shen.newpv V5557) (shen.gc V5557 (shen.bind! W5575 (cons (cons W5605 (cons W5606 (cons W5607 ()))) W5608) V5557 (freeze ((((W5576 W5605) W5606) W5607) W5608))))))))))) false)))) false))) false)) false)) false))) false)))) false)) false) W5561))) +(defun shen.t*-rule (V5552 V5553 V5554 V5555 V5556 V5557 V5558 V5559 V5560) (let W5561 (if (shen.unlocked? V5558) (do (shen.incinfs) (shen.t*-rule-h V5554 V5555 V5556 V5557 V5558 V5559 V5560)) false) (if (= W5561 false) (if (shen.unlocked? V5558) (let W5562 (shen.newpv V5557) (shen.gc V5557 (do (shen.incinfs) (bind W5562 (simple-error (cn "type error in rule " (shen.app V5553 (cn " of " (shen.app V5552 " +" shen.a)) shen.a))) V5557 V5558 V5559 V5560)))) false) W5561))) -(defun shen.freshterms (V5611) (cond ((= () V5611) ()) ((and (cons? V5611) (cons? (hd V5611))) (shen.freshterms (append (hd V5611) (tl V5611)))) ((and (cons? V5611) (shen.freshterm? (hd V5611))) (adjoin (hd V5611) (shen.freshterms (tl V5611)))) ((cons? V5611) (shen.freshterms (tl V5611))) (true (shen.f-error shen.freshterms)))) +(defun shen.t*-rule-h (V5563 V5564 V5565 V5566 V5567 V5568 V5569) (let W5570 (+ V5568 1) (let W5571 (if (shen.unlocked? V5567) (let W5572 (shen.lazyderef V5563 V5566) (if (= W5572 ()) (let W5573 (shen.lazyderef V5565 V5566) (if (cons? W5573) (let W5574 (shen.lazyderef (hd W5573) V5566) (if (= W5574 -->) (let W5575 (shen.lazyderef (tl W5573) V5566) (if (cons? W5575) (let W5576 (hd W5575) (let W5577 (shen.lazyderef (tl W5575) V5566) (if (= W5577 ()) (do (shen.incinfs) (shen.cut V5566 V5567 W5570 (freeze (shen.t*-correct V5564 W5576 () V5566 V5567 W5570 V5569)))) false))) false)) false)) false)) false)) false) (if (= W5571 false) (let W5578 (if (shen.unlocked? V5567) (let W5579 (shen.newpv V5566) (shen.gc V5566 (let W5580 (shen.newpv V5566) (shen.gc V5566 (let W5581 (shen.newpv V5566) (shen.gc V5566 (do (shen.incinfs) (shen.p-hyps (shen.freshterms V5563) W5579 V5566 V5567 W5570 (freeze (shen.t*-integrity V5563 V5565 W5579 W5580 V5566 V5567 W5570 (freeze (shen.cut V5566 V5567 W5570 (freeze (shen.myassume V5563 V5565 W5581 V5566 V5567 W5570 (freeze (shen.t*-correct V5564 W5580 W5581 V5566 V5567 W5570 V5569)))))))))))))))) false) (if (= W5578 false) (shen.unlock V5567 W5570) W5578)) W5571)))) -(defun shen.p-hyps (V5612 V5613 V5614 V5615 V5616 V5617) (let W5618 (if (shen.unlocked? V5615) (let W5619 (shen.lazyderef V5612 V5614) (if (= W5619 ()) (let W5620 (shen.lazyderef V5613 V5614) (let W5621 (freeze (do (shen.incinfs) (thaw V5617))) (if (= W5620 ()) (thaw W5621) (if (shen.pvar? W5620) (shen.bind! W5620 () V5614 W5621) false)))) false)) false) (if (= W5618 false) (if (shen.unlocked? V5615) (let W5622 (shen.lazyderef V5612 V5614) (if (cons? W5622) (let W5623 (hd W5622) (let W5624 (tl W5622) (let W5625 (shen.lazyderef V5613 V5614) (let W5626 (lambda Z5627 (lambda Z5628 (lambda Z5629 (lambda Z5630 (do (shen.incinfs) (bind Z5627 W5623 V5614 V5615 V5616 (freeze (bind Z5628 (intern ":") V5614 V5615 V5616 (freeze (shen.p-hyps W5624 Z5630 V5614 V5615 V5616 V5617)))))))))) (if (cons? W5625) (let W5631 (shen.lazyderef (hd W5625) V5614) (let W5632 (lambda Z5633 (lambda Z5634 (lambda Z5635 (let W5636 (tl W5625) ((((W5626 Z5633) Z5634) Z5635) W5636))))) (if (cons? W5631) (let W5637 (hd W5631) (let W5638 (shen.lazyderef (tl W5631) V5614) (let W5639 (lambda Z5640 (lambda Z5641 (((W5632 W5637) Z5640) Z5641))) (if (cons? W5638) (let W5642 (hd W5638) (let W5643 (shen.lazyderef (tl W5638) V5614) (let W5644 (lambda Z5645 ((W5639 W5642) Z5645)) (if (cons? W5643) (let W5646 (hd W5643) (let W5647 (shen.lazyderef (tl W5643) V5614) (let W5648 (freeze (W5644 W5646)) (if (= W5647 ()) (thaw W5648) (if (shen.pvar? W5647) (shen.bind! W5647 () V5614 W5648) false))))) (if (shen.pvar? W5643) (let W5649 (shen.newpv V5614) (shen.gc V5614 (shen.bind! W5643 (cons W5649 ()) V5614 (freeze (W5644 W5649))))) false))))) (if (shen.pvar? W5638) (let W5650 (shen.newpv V5614) (shen.gc V5614 (let W5651 (shen.newpv V5614) (shen.gc V5614 (shen.bind! W5638 (cons W5650 (cons W5651 ())) V5614 (freeze ((W5639 W5650) W5651))))))) false))))) (if (shen.pvar? W5631) (let W5652 (shen.newpv V5614) (shen.gc V5614 (let W5653 (shen.newpv V5614) (shen.gc V5614 (let W5654 (shen.newpv V5614) (shen.gc V5614 (shen.bind! W5631 (cons W5652 (cons W5653 (cons W5654 ()))) V5614 (freeze (((W5632 W5652) W5653) W5654))))))))) false)))) (if (shen.pvar? W5625) (let W5655 (shen.newpv V5614) (shen.gc V5614 (let W5656 (shen.newpv V5614) (shen.gc V5614 (let W5657 (shen.newpv V5614) (shen.gc V5614 (let W5658 (shen.newpv V5614) (shen.gc V5614 (shen.bind! W5625 (cons (cons W5655 (cons W5656 (cons W5657 ()))) W5658) V5614 (freeze ((((W5626 W5655) W5656) W5657) W5658))))))))))) false)))))) false)) false) W5618))) +(defun shen.myassume (V5582 V5583 V5584 V5585 V5586 V5587 V5588) (let W5589 (if (shen.unlocked? V5586) (let W5590 (shen.lazyderef V5582 V5585) (if (= W5590 ()) (let W5591 (shen.lazyderef V5584 V5585) (let W5592 (freeze (do (shen.incinfs) (thaw V5588))) (if (= W5591 ()) (thaw W5592) (if (shen.pvar? W5591) (shen.bind! W5591 () V5585 W5592) false)))) false)) false) (if (= W5589 false) (if (shen.unlocked? V5586) (let W5593 (shen.lazyderef V5582 V5585) (if (cons? W5593) (let W5594 (hd W5593) (let W5595 (tl W5593) (let W5596 (shen.lazyderef V5583 V5585) (if (cons? W5596) (let W5597 (hd W5596) (let W5598 (shen.lazyderef (tl W5596) V5585) (if (cons? W5598) (let W5599 (shen.lazyderef (hd W5598) V5585) (if (= W5599 -->) (let W5600 (shen.lazyderef (tl W5598) V5585) (if (cons? W5600) (let W5601 (hd W5600) (let W5602 (shen.lazyderef (tl W5600) V5585) (if (= W5602 ()) (let W5603 (shen.lazyderef V5584 V5585) (let W5604 (lambda Z5605 (lambda Z5606 (lambda Z5607 (lambda Z5608 (do (shen.incinfs) (is! W5597 Z5607 V5585 V5586 V5587 (freeze (is! W5594 Z5605 V5585 V5586 V5587 (freeze (bind Z5606 (intern ":") V5585 V5586 V5587 (freeze (shen.myassume W5595 W5601 Z5608 V5585 V5586 V5587 V5588)))))))))))) (if (cons? W5603) (let W5609 (shen.lazyderef (hd W5603) V5585) (let W5610 (lambda Z5611 (lambda Z5612 (lambda Z5613 (let W5614 (tl W5603) ((((W5604 Z5611) Z5612) Z5613) W5614))))) (if (cons? W5609) (let W5615 (hd W5609) (let W5616 (shen.lazyderef (tl W5609) V5585) (let W5617 (lambda Z5618 (lambda Z5619 (((W5610 W5615) Z5618) Z5619))) (if (cons? W5616) (let W5620 (hd W5616) (let W5621 (shen.lazyderef (tl W5616) V5585) (let W5622 (lambda Z5623 ((W5617 W5620) Z5623)) (if (cons? W5621) (let W5624 (hd W5621) (let W5625 (shen.lazyderef (tl W5621) V5585) (let W5626 (freeze (W5622 W5624)) (if (= W5625 ()) (thaw W5626) (if (shen.pvar? W5625) (shen.bind! W5625 () V5585 W5626) false))))) (if (shen.pvar? W5621) (let W5627 (shen.newpv V5585) (shen.gc V5585 (shen.bind! W5621 (cons W5627 ()) V5585 (freeze (W5622 W5627))))) false))))) (if (shen.pvar? W5616) (let W5628 (shen.newpv V5585) (shen.gc V5585 (let W5629 (shen.newpv V5585) (shen.gc V5585 (shen.bind! W5616 (cons W5628 (cons W5629 ())) V5585 (freeze ((W5617 W5628) W5629))))))) false))))) (if (shen.pvar? W5609) (let W5630 (shen.newpv V5585) (shen.gc V5585 (let W5631 (shen.newpv V5585) (shen.gc V5585 (let W5632 (shen.newpv V5585) (shen.gc V5585 (shen.bind! W5609 (cons W5630 (cons W5631 (cons W5632 ()))) V5585 (freeze (((W5610 W5630) W5631) W5632))))))))) false)))) (if (shen.pvar? W5603) (let W5633 (shen.newpv V5585) (shen.gc V5585 (let W5634 (shen.newpv V5585) (shen.gc V5585 (let W5635 (shen.newpv V5585) (shen.gc V5585 (let W5636 (shen.newpv V5585) (shen.gc V5585 (shen.bind! W5603 (cons (cons W5633 (cons W5634 (cons W5635 ()))) W5636) V5585 (freeze ((((W5604 W5633) W5634) W5635) W5636))))))))))) false)))) false))) false)) false)) false))) false)))) false)) false) W5589))) -(defun shen.t*-correct (V5659 V5660 V5661 V5662 V5663 V5664 V5665) (let W5666 (+ V5664 1) (let W5667 (if (shen.unlocked? V5663) (let W5668 (shen.lazyderef V5659 V5662) (if (cons? W5668) (let W5669 (shen.lazyderef (hd W5668) V5662) (if (= W5669 where) (let W5670 (shen.lazyderef (tl W5668) V5662) (if (cons? W5670) (let W5671 (hd W5670) (let W5672 (shen.lazyderef (tl W5670) V5662) (if (cons? W5672) (let W5673 (hd W5672) (let W5674 (shen.lazyderef (tl W5672) V5662) (if (= W5674 ()) (let W5675 (shen.newpv V5662) (shen.gc V5662 (do (shen.incinfs) (shen.cut V5662 V5663 W5666 (freeze (bind W5675 (shen.curry W5671) V5662 V5663 W5666 (freeze (shen.system-S-h W5675 boolean V5661 V5662 V5663 W5666 (freeze (shen.cut V5662 V5663 W5666 (freeze (shen.t*-correct W5673 V5660 (cons (cons W5675 (cons (intern ":") (cons verified ()))) V5661) V5662 V5663 W5666 V5665)))))))))))) false))) false))) false)) false)) false)) false) (if (= W5667 false) (let W5676 (if (shen.unlocked? V5663) (do (shen.incinfs) (shen.system-S-h (shen.curry V5659) V5660 V5661 V5662 V5663 W5666 V5665)) false) (if (= W5676 false) (shen.unlock V5663 W5666) W5676)) W5667)))) +(defun shen.freshterms (V5639) (cond ((= () V5639) ()) ((and (cons? V5639) (cons? (hd V5639))) (shen.freshterms (append (hd V5639) (tl V5639)))) ((and (cons? V5639) (shen.freshterm? (hd V5639))) (adjoin (hd V5639) (shen.freshterms (tl V5639)))) ((cons? V5639) (shen.freshterms (tl V5639))) (true (shen.f-error shen.freshterms)))) -(defun shen.t*-integrity (V5677 V5678 V5679 V5680 V5681 V5682 V5683 V5684) (let W5685 (if (shen.unlocked? V5682) (let W5686 (shen.lazyderef V5677 V5681) (if (= W5686 ()) (do (shen.incinfs) (is! V5678 V5680 V5681 V5682 V5683 V5684)) false)) false) (if (= W5685 false) (if (shen.unlocked? V5682) (let W5687 (shen.lazyderef V5677 V5681) (if (cons? W5687) (let W5688 (hd W5687) (let W5689 (tl W5687) (let W5690 (shen.lazyderef V5678 V5681) (if (cons? W5690) (let W5691 (hd W5690) (let W5692 (shen.lazyderef (tl W5690) V5681) (if (cons? W5692) (let W5693 (shen.lazyderef (hd W5692) V5681) (if (= W5693 -->) (let W5694 (shen.lazyderef (tl W5692) V5681) (if (cons? W5694) (let W5695 (hd W5694) (let W5696 (shen.lazyderef (tl W5694) V5681) (if (= W5696 ()) (do (shen.incinfs) (shen.system-S-h W5688 W5691 V5679 V5681 V5682 V5683 (freeze (shen.t*-integrity W5689 W5695 V5679 V5680 V5681 V5682 V5683 V5684)))) false))) false)) false)) false))) false)))) false)) false) W5685))) +(defun shen.p-hyps (V5640 V5641 V5642 V5643 V5644 V5645) (let W5646 (if (shen.unlocked? V5643) (let W5647 (shen.lazyderef V5640 V5642) (if (= W5647 ()) (let W5648 (shen.lazyderef V5641 V5642) (let W5649 (freeze (do (shen.incinfs) (thaw V5645))) (if (= W5648 ()) (thaw W5649) (if (shen.pvar? W5648) (shen.bind! W5648 () V5642 W5649) false)))) false)) false) (if (= W5646 false) (if (shen.unlocked? V5643) (let W5650 (shen.lazyderef V5640 V5642) (if (cons? W5650) (let W5651 (hd W5650) (let W5652 (tl W5650) (let W5653 (shen.lazyderef V5641 V5642) (let W5654 (lambda Z5655 (lambda Z5656 (lambda Z5657 (lambda Z5658 (do (shen.incinfs) (bind Z5655 W5651 V5642 V5643 V5644 (freeze (bind Z5656 (intern ":") V5642 V5643 V5644 (freeze (shen.p-hyps W5652 Z5658 V5642 V5643 V5644 V5645)))))))))) (if (cons? W5653) (let W5659 (shen.lazyderef (hd W5653) V5642) (let W5660 (lambda Z5661 (lambda Z5662 (lambda Z5663 (let W5664 (tl W5653) ((((W5654 Z5661) Z5662) Z5663) W5664))))) (if (cons? W5659) (let W5665 (hd W5659) (let W5666 (shen.lazyderef (tl W5659) V5642) (let W5667 (lambda Z5668 (lambda Z5669 (((W5660 W5665) Z5668) Z5669))) (if (cons? W5666) (let W5670 (hd W5666) (let W5671 (shen.lazyderef (tl W5666) V5642) (let W5672 (lambda Z5673 ((W5667 W5670) Z5673)) (if (cons? W5671) (let W5674 (hd W5671) (let W5675 (shen.lazyderef (tl W5671) V5642) (let W5676 (freeze (W5672 W5674)) (if (= W5675 ()) (thaw W5676) (if (shen.pvar? W5675) (shen.bind! W5675 () V5642 W5676) false))))) (if (shen.pvar? W5671) (let W5677 (shen.newpv V5642) (shen.gc V5642 (shen.bind! W5671 (cons W5677 ()) V5642 (freeze (W5672 W5677))))) false))))) (if (shen.pvar? W5666) (let W5678 (shen.newpv V5642) (shen.gc V5642 (let W5679 (shen.newpv V5642) (shen.gc V5642 (shen.bind! W5666 (cons W5678 (cons W5679 ())) V5642 (freeze ((W5667 W5678) W5679))))))) false))))) (if (shen.pvar? W5659) (let W5680 (shen.newpv V5642) (shen.gc V5642 (let W5681 (shen.newpv V5642) (shen.gc V5642 (let W5682 (shen.newpv V5642) (shen.gc V5642 (shen.bind! W5659 (cons W5680 (cons W5681 (cons W5682 ()))) V5642 (freeze (((W5660 W5680) W5681) W5682))))))))) false)))) (if (shen.pvar? W5653) (let W5683 (shen.newpv V5642) (shen.gc V5642 (let W5684 (shen.newpv V5642) (shen.gc V5642 (let W5685 (shen.newpv V5642) (shen.gc V5642 (let W5686 (shen.newpv V5642) (shen.gc V5642 (shen.bind! W5653 (cons (cons W5683 (cons W5684 (cons W5685 ()))) W5686) V5642 (freeze ((((W5654 W5683) W5684) W5685) W5686))))))))))) false)))))) false)) false) W5646))) -(defun shen.freshterm? (V5697) (and (absvector? V5697) (and (not (string? V5697)) (= (<-address V5697 0) shen.print-freshterm)))) +(defun shen.t*-correct (V5687 V5688 V5689 V5690 V5691 V5692 V5693) (let W5694 (+ V5692 1) (let W5695 (if (shen.unlocked? V5691) (let W5696 (shen.lazyderef V5687 V5690) (if (cons? W5696) (let W5697 (shen.lazyderef (hd W5696) V5690) (if (= W5697 where) (let W5698 (shen.lazyderef (tl W5696) V5690) (if (cons? W5698) (let W5699 (hd W5698) (let W5700 (shen.lazyderef (tl W5698) V5690) (if (cons? W5700) (let W5701 (hd W5700) (let W5702 (shen.lazyderef (tl W5700) V5690) (if (= W5702 ()) (let W5703 (shen.newpv V5690) (shen.gc V5690 (do (shen.incinfs) (shen.cut V5690 V5691 W5694 (freeze (bind W5703 (shen.curry W5699) V5690 V5691 W5694 (freeze (shen.system-S-h W5703 boolean V5689 V5690 V5691 W5694 (freeze (shen.cut V5690 V5691 W5694 (freeze (shen.t*-correct W5701 V5688 (cons (cons W5703 (cons (intern ":") (cons verified ()))) V5689) V5690 V5691 W5694 V5693)))))))))))) false))) false))) false)) false)) false)) false) (if (= W5695 false) (let W5704 (if (shen.unlocked? V5691) (do (shen.incinfs) (shen.system-S-h (shen.curry V5687) V5688 V5689 V5690 V5691 W5694 V5693)) false) (if (= W5704 false) (shen.unlock V5691 W5694) W5704)) W5695)))) + +(defun shen.t*-integrity (V5705 V5706 V5707 V5708 V5709 V5710 V5711 V5712) (let W5713 (if (shen.unlocked? V5710) (let W5714 (shen.lazyderef V5705 V5709) (if (= W5714 ()) (do (shen.incinfs) (is! V5706 V5708 V5709 V5710 V5711 V5712)) false)) false) (if (= W5713 false) (if (shen.unlocked? V5710) (let W5715 (shen.lazyderef V5705 V5709) (if (cons? W5715) (let W5716 (hd W5715) (let W5717 (tl W5715) (let W5718 (shen.lazyderef V5706 V5709) (if (cons? W5718) (let W5719 (hd W5718) (let W5720 (shen.lazyderef (tl W5718) V5709) (if (cons? W5720) (let W5721 (shen.lazyderef (hd W5720) V5709) (if (= W5721 -->) (let W5722 (shen.lazyderef (tl W5720) V5709) (if (cons? W5722) (let W5723 (hd W5722) (let W5724 (shen.lazyderef (tl W5722) V5709) (if (= W5724 ()) (do (shen.incinfs) (shen.system-S-h W5716 W5719 V5707 V5709 V5710 V5711 (freeze (shen.t*-integrity W5717 W5723 V5707 V5708 V5709 V5710 V5711 V5712)))) false))) false)) false)) false))) false)))) false)) false) W5713))) + +(defun shen.freshterm? (V5725) (and (absvector? V5725) (and (not (string? V5725)) (= (<-address V5725 0) shen.print-freshterm)))) diff --git a/klambda/toplevel.kl b/klambda/toplevel.kl index bad0584..014e563 100644 --- a/klambda/toplevel.kl +++ b/klambda/toplevel.kl @@ -1,8 +1,8 @@ (defun shen.repl () (do (shen.credits) (shen.loop))) -(defun shen.loop () (do (shen.initialise_environment) (do (shen.prompt) (do (trap-error (shen.read-evaluate-print) (lambda Z5720 (shen.toplevel-display-exception Z5720))) (shen.loop))))) +(defun shen.loop () (do (shen.initialise_environment) (do (shen.prompt) (do (trap-error (shen.read-evaluate-print) (lambda Z5748 (shen.toplevel-display-exception Z5748))) (shen.loop))))) -(defun shen.toplevel-display-exception (V5721) (do (pr (error-to-string V5721) (stoutput)) (nl 0))) +(defun shen.toplevel-display-exception (V5749) (do (pr (error-to-string V5749) (stoutput)) (nl 0))) (defun shen.credits () (do (pr " Shen, www.shenlanguage.org, copyright (C) 2010-2026, Mark Tarver @@ -17,32 +17,32 @@ Shen, www.shenlanguage.org, copyright (C) 2010-2026, 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 W5722 (value shen.*package*) (let W5723 (shen.package-user-input W5722 (lineread (stinput))) (let W5724 (shen.update-history) (shen.evaluate-lineread W5723 W5724 (value shen.*tc*)))))) +(defun shen.read-evaluate-print () (let W5750 (value shen.*package*) (let W5751 (shen.package-user-input W5750 (lineread (stinput))) (let W5752 (shen.update-history) (shen.evaluate-lineread W5751 W5752 (value shen.*tc*)))))) -(defun shen.package-user-input (V5725 V5726) (cond ((= null V5725) V5726) (true (let W5727 (str V5725) (let W5728 (external V5725) (map (lambda Z5729 (shen.pui-h W5727 W5728 Z5729)) V5726)))))) +(defun shen.package-user-input (V5753 V5754) (cond ((= null V5753) V5754) (true (let W5755 (str V5753) (let W5756 (external V5753) (map (lambda Z5757 (shen.pui-h W5755 W5756 Z5757)) V5754)))))) -(defun shen.pui-h (V5734 V5735 V5736) (cond ((and (cons? V5736) (and (= fn (hd V5736)) (and (cons? (tl V5736)) (= () (tl (tl V5736)))))) (if (shen.internal? (hd (tl V5736)) V5734 V5735) (cons fn (cons (shen.intern-in-package V5734 (hd (tl V5736))) ())) V5736)) ((cons? V5736) (if (shen.internal? (hd V5736) V5734 V5735) (cons (shen.intern-in-package V5734 (hd V5736)) (map (lambda Z5737 (shen.pui-h V5734 V5735 Z5737)) (tl V5736))) (if (cons? (hd V5736)) (map (lambda Z5738 (shen.pui-h V5734 V5735 Z5738)) V5736) (cons (hd V5736) (map (lambda Z5739 (shen.pui-h V5734 V5735 Z5739)) (tl V5736)))))) (true V5736))) +(defun shen.pui-h (V5762 V5763 V5764) (cond ((and (cons? V5764) (and (= fn (hd V5764)) (and (cons? (tl V5764)) (= () (tl (tl V5764)))))) (if (shen.internal? (hd (tl V5764)) V5762 V5763) (cons fn (cons (shen.intern-in-package V5762 (hd (tl V5764))) ())) V5764)) ((cons? V5764) (if (shen.internal? (hd V5764) V5762 V5763) (cons (shen.intern-in-package V5762 (hd V5764)) (map (lambda Z5765 (shen.pui-h V5762 V5763 Z5765)) (tl V5764))) (if (cons? (hd V5764)) (map (lambda Z5766 (shen.pui-h V5762 V5763 Z5766)) V5764) (cons (hd V5764) (map (lambda Z5767 (shen.pui-h V5762 V5763 Z5767)) (tl V5764)))))) (true V5764))) (defun shen.update-history () (set shen.*history* (cons (shen.trim-it (it)) (value shen.*history*)))) -(defun shen.trim-it (V5740) (cond ((and (shen.+string? V5740) (shen.whitespace? (string->n (hdstr V5740)))) (shen.trim-it (tlstr V5740))) (true V5740))) +(defun shen.trim-it (V5768) (cond ((and (shen.+string? V5768) (shen.whitespace? (string->n (hdstr V5768)))) (shen.trim-it (tlstr V5768))) (true V5768))) -(defun shen.evaluate-lineread (V5759 V5760 V5761) (cond ((and (cons? V5759) (and (= () (tl V5759)) (and (cons? V5760) (and (shen.+string? (hd V5760)) (and (= "!" (hdstr (hd V5760))) (and (shen.+string? (tlstr (hd V5760))) (and (= "!" (hdstr (tlstr (hd V5760)))) (cons? (tl V5760))))))))) (let W5762 (read-from-string (hd (tl V5760))) (let W5763 (set shen.*history* (cons (hd (tl V5760)) (tl V5760))) (let W5764 (pr (shen.app (hd (tl V5760)) " -" shen.a) (stoutput)) (shen.evaluate-lineread W5762 W5763 V5761))))) ((and (cons? V5759) (and (= () (tl V5759)) (and (cons? V5760) (and (shen.+string? (hd V5760)) (= "!" (hdstr (hd V5760))))))) (let W5765 (if (= (tlstr (hd V5760)) "") () (hd (read-from-string (tlstr (hd V5760))))) (let W5766 (shen.use-history W5765 (tlstr (hd V5760)) (tl V5760)) (let W5767 (pr (shen.app W5766 " -" shen.a) (stoutput)) (let W5768 (read-from-string W5766) (let W5769 (set shen.*history* (cons W5766 (tl V5760))) (shen.evaluate-lineread W5768 W5769 V5761))))))) ((and (cons? V5759) (and (= () (tl V5759)) (and (cons? V5760) (and (shen.+string? (hd V5760)) (= "%" (hdstr (hd V5760))))))) (let W5770 (if (= (tlstr (hd V5760)) "") () (hd (read-from-string (tlstr (hd V5760))))) (let W5771 (shen.peek-history W5770 (tlstr (hd V5760)) (tl V5760)) (let W5772 (set shen.*history* (tl V5760)) (abort))))) ((= true V5761) (shen.check-eval-and-print V5759)) ((= false V5761) (shen.eval-and-print V5759)) (true (simple-error "implementation error in shen.evaluate-lineread")))) +(defun shen.evaluate-lineread (V5787 V5788 V5789) (cond ((and (cons? V5787) (and (= () (tl V5787)) (and (cons? V5788) (and (shen.+string? (hd V5788)) (and (= "!" (hdstr (hd V5788))) (and (shen.+string? (tlstr (hd V5788))) (and (= "!" (hdstr (tlstr (hd V5788)))) (cons? (tl V5788))))))))) (let W5790 (read-from-string (hd (tl V5788))) (let W5791 (set shen.*history* (cons (hd (tl V5788)) (tl V5788))) (let W5792 (pr (shen.app (hd (tl V5788)) " +" shen.a) (stoutput)) (shen.evaluate-lineread W5790 W5791 V5789))))) ((and (cons? V5787) (and (= () (tl V5787)) (and (cons? V5788) (and (shen.+string? (hd V5788)) (= "!" (hdstr (hd V5788))))))) (let W5793 (if (= (tlstr (hd V5788)) "") () (hd (read-from-string (tlstr (hd V5788))))) (let W5794 (shen.use-history W5793 (tlstr (hd V5788)) (tl V5788)) (let W5795 (pr (shen.app W5794 " +" shen.a) (stoutput)) (let W5796 (read-from-string W5794) (let W5797 (set shen.*history* (cons W5794 (tl V5788))) (shen.evaluate-lineread W5796 W5797 V5789))))))) ((and (cons? V5787) (and (= () (tl V5787)) (and (cons? V5788) (and (shen.+string? (hd V5788)) (= "%" (hdstr (hd V5788))))))) (let W5798 (if (= (tlstr (hd V5788)) "") () (hd (read-from-string (tlstr (hd V5788))))) (let W5799 (shen.peek-history W5798 (tlstr (hd V5788)) (tl V5788)) (let W5800 (set shen.*history* (tl V5788)) (abort))))) ((= true V5789) (shen.check-eval-and-print V5787)) ((= false V5789) (shen.eval-and-print V5787)) (true (simple-error "implementation error in shen.evaluate-lineread")))) -(defun shen.use-history (V5773 V5774 V5775) (if (integer? V5773) (nth (+ 1 V5773) (reverse V5775)) (if (symbol? V5773) (shen.string-match V5774 V5775) (simple-error "! expects a number or a symbol +(defun shen.use-history (V5801 V5802 V5803) (if (integer? V5801) (nth (+ 1 V5801) (reverse V5803)) (if (symbol? V5801) (shen.string-match V5802 V5803) (simple-error "! expects a number or a symbol ")))) -(defun shen.peek-history (V5776 V5777 V5778) (if (integer? V5776) (pr (cn " -" (shen.app (nth (+ 1 V5776) (reverse V5778)) "" shen.a)) (stoutput)) (if (or (= V5777 "") (symbol? V5776)) (shen.recursive-string-match 0 V5777 (reverse V5778)) (simple-error "% expects a number or a symbol +(defun shen.peek-history (V5804 V5805 V5806) (if (integer? V5804) (pr (cn " +" (shen.app (nth (+ 1 V5804) (reverse V5806)) "" shen.a)) (stoutput)) (if (or (= V5805 "") (symbol? V5804)) (shen.recursive-string-match 0 V5805 (reverse V5806)) (simple-error "% expects a number or a symbol ")))) -(defun shen.string-match (V5788 V5789) (cond ((= () V5789) (simple-error " -input not found")) ((and (cons? V5789) (shen.string-prefix? V5788 (hd V5789))) (hd V5789)) ((cons? V5789) (shen.string-match V5788 (tl V5789))) (true (simple-error "implementation error in shen.string-match")))) +(defun shen.string-match (V5816 V5817) (cond ((= () V5817) (simple-error " +input not found")) ((and (cons? V5817) (shen.string-prefix? V5816 (hd V5817))) (hd V5817)) ((cons? V5817) (shen.string-match V5816 (tl V5817))) (true (simple-error "implementation error in shen.string-match")))) -(defun shen.string-prefix? (V5797 V5798) (cond ((= "" V5797) true) ((and (shen.+string? V5797) (shen.whitespace? (string->n (hdstr V5797)))) (shen.string-prefix? (tlstr V5797) V5798)) ((and (shen.+string? V5798) (shen.whitespace? (string->n (hdstr V5798)))) (shen.string-prefix? V5797 (tlstr V5798))) ((and (shen.+string? V5798) (= "(" (hdstr V5798))) (shen.string-prefix? V5797 (tlstr V5798))) ((and (shen.+string? V5797) (and (shen.+string? V5798) (= (hdstr V5797) (hdstr V5798)))) (shen.string-prefix? (tlstr V5797) (tlstr V5798))) (true false))) +(defun shen.string-prefix? (V5825 V5826) (cond ((= "" V5825) true) ((and (shen.+string? V5825) (shen.whitespace? (string->n (hdstr V5825)))) (shen.string-prefix? (tlstr V5825) V5826)) ((and (shen.+string? V5826) (shen.whitespace? (string->n (hdstr V5826)))) (shen.string-prefix? V5825 (tlstr V5826))) ((and (shen.+string? V5826) (= "(" (hdstr V5826))) (shen.string-prefix? V5825 (tlstr V5826))) ((and (shen.+string? V5825) (and (shen.+string? V5826) (= (hdstr V5825) (hdstr V5826)))) (shen.string-prefix? (tlstr V5825) (tlstr V5826))) (true false))) -(defun shen.recursive-string-match (V5809 V5810 V5811) (cond ((= () V5811) shen.skip) ((cons? V5811) (do (if (shen.string-prefix? V5810 (hd V5811)) (pr (shen.app V5809 (cn ". " (shen.app (hd V5811) " -" shen.a)) shen.a) (stoutput)) shen.skip) (shen.recursive-string-match (+ V5809 1) V5810 (tl V5811)))) (true (simple-error "implementation error in shen.recursive-string-match")))) +(defun shen.recursive-string-match (V5837 V5838 V5839) (cond ((= () V5839) shen.skip) ((cons? V5839) (do (if (shen.string-prefix? V5838 (hd V5839)) (pr (shen.app V5837 (cn ". " (shen.app (hd V5839) " +" shen.a)) shen.a) (stoutput)) shen.skip) (shen.recursive-string-match (+ V5837 1) V5838 (tl V5839)))) (true (simple-error "implementation error in shen.recursive-string-match")))) diff --git a/klambda/track.kl b/klambda/track.kl index ae243f0..8fe9262 100644 --- a/klambda/track.kl +++ b/klambda/track.kl @@ -1,66 +1,66 @@ -(defun shen.f-error (V5843) (do (pr (cn "partial function " (shen.app V5843 "; -" shen.a)) (stoutput)) (do (if (and (not (shen.tracked? V5843)) (y-or-n? (cn "track " (shen.app V5843 "? " shen.a)))) (shen.track-function (ps V5843)) shen.ok) (simple-error "aborted")))) +(defun shen.f-error (V5871) (do (pr (cn "partial function " (shen.app V5871 "; +" shen.a)) (stoutput)) (do (if (and (not (shen.tracked? V5871)) (y-or-n? (cn "track " (shen.app V5871 "? " shen.a)))) (shen.track-function (ps V5871)) shen.ok) (simple-error "aborted")))) -(defun shen.tracked? (V5844) (element? V5844 (value shen.*tracking*))) +(defun shen.tracked? (V5872) (element? V5872 (value shen.*tracking*))) -(defun track (V5845) (let W5846 (ps V5845) (shen.track-function W5846))) +(defun track (V5873) (let W5874 (ps V5873) (shen.track-function W5874))) -(defun shen.track-function (V5849) (cond ((and (cons? V5849) (and (= defun (hd V5849)) (and (cons? (tl V5849)) (and (cons? (tl (tl V5849))) (and (cons? (tl (tl (tl V5849)))) (= () (tl (tl (tl (tl V5849)))))))))) (let W5850 (cons defun (cons (hd (tl V5849)) (cons (hd (tl (tl V5849))) (cons (shen.insert-tracking-code (hd (tl V5849)) (hd (tl (tl V5849))) (hd (tl (tl (tl V5849))))) ())))) (let W5851 (eval-kl W5850) (let W5852 (set shen.*tracking* (adjoin (hd (tl V5849)) (value shen.*tracking*))) (hd (tl V5849)))))) (true (simple-error "implementation error in shen.track-function")))) +(defun shen.track-function (V5877) (cond ((and (cons? V5877) (and (= defun (hd V5877)) (and (cons? (tl V5877)) (and (cons? (tl (tl V5877))) (and (cons? (tl (tl (tl V5877)))) (= () (tl (tl (tl (tl V5877)))))))))) (let W5878 (cons defun (cons (hd (tl V5877)) (cons (hd (tl (tl V5877))) (cons (shen.insert-tracking-code (hd (tl V5877)) (hd (tl (tl V5877))) (hd (tl (tl (tl V5877))))) ())))) (let W5879 (eval-kl W5878) (let W5880 (set shen.*tracking* (adjoin (hd (tl V5877)) (value shen.*tracking*))) (hd (tl V5877)))))) (true (simple-error "implementation error in shen.track-function")))) -(defun shen.insert-tracking-code (V5853 V5854 V5855) (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 V5853 (cons (shen.cons-form (shen.prolog-track V5855 V5854)) ())))) (cons (cons do (cons (cons shen.terpri-or-read-char ()) (cons (cons let (cons Result (cons V5855 (cons (cons do (cons (cons shen.output-track (cons (cons value (cons shen.*call* ())) (cons V5853 (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 (V5881 V5882 V5883) (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 V5881 (cons (shen.cons-form (shen.prolog-track V5883 V5882)) ())))) (cons (cons do (cons (cons shen.terpri-or-read-char ()) (cons (cons let (cons Result (cons V5883 (cons (cons do (cons (cons shen.output-track (cons (cons value (cons shen.*call* ())) (cons V5881 (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 (V5856 V5857) (cond ((= (occurrences shen.incinfs V5856) 0) V5857) (true (shen.vector-dereference V5857 (shen.vector-parameter V5857))))) +(defun shen.prolog-track (V5884 V5885) (cond ((= (occurrences shen.incinfs V5884) 0) V5885) (true (shen.vector-dereference V5885 (shen.vector-parameter V5885))))) -(defun shen.vector-parameter (V5860) (cond ((= () V5860) ()) ((and (cons? V5860) (and (cons? (tl V5860)) (and (cons? (tl (tl V5860))) (and (cons? (tl (tl (tl V5860)))) (= () (tl (tl (tl (tl V5860))))))))) (hd V5860)) ((cons? V5860) (shen.vector-parameter (tl V5860))) (true (shen.f-error shen.vector-parameter)))) +(defun shen.vector-parameter (V5888) (cond ((= () V5888) ()) ((and (cons? V5888) (and (cons? (tl V5888)) (and (cons? (tl (tl V5888))) (and (cons? (tl (tl (tl V5888)))) (= () (tl (tl (tl (tl V5888))))))))) (hd V5888)) ((cons? V5888) (shen.vector-parameter (tl V5888))) (true (shen.f-error shen.vector-parameter)))) -(defun shen.vector-dereference (V5863 V5864) (cond ((= () V5864) V5863) ((and (cons? V5863) (and (cons? (tl V5863)) (and (cons? (tl (tl V5863))) (and (cons? (tl (tl (tl V5863)))) (= () (tl (tl (tl (tl V5863))))))))) V5863) ((cons? V5863) (cons (cons shen.deref (cons (hd V5863) (cons V5864 ()))) (shen.vector-dereference (tl V5863) V5864))) (true (shen.f-error shen.vector-dereference)))) +(defun shen.vector-dereference (V5891 V5892) (cond ((= () V5892) V5891) ((and (cons? V5891) (and (cons? (tl V5891)) (and (cons? (tl (tl V5891))) (and (cons? (tl (tl (tl V5891)))) (= () (tl (tl (tl (tl V5891))))))))) V5891) ((cons? V5891) (cons (cons shen.deref (cons (hd V5891) (cons V5892 ()))) (shen.vector-dereference (tl V5891) V5892))) (true (shen.f-error shen.vector-dereference)))) -(defun step (V5867) (cond ((= + V5867) (set shen.*step* true)) ((= - V5867) (set shen.*step* false)) (true (simple-error "step expects a + or a -. +(defun step (V5895) (cond ((= + V5895) (set shen.*step* true)) ((= - V5895) (set shen.*step* false)) (true (simple-error "step expects a + or a -. ")))) (defun step? () (value shen.*step*)) -(defun spy (V5870) (cond ((= + V5870) (set shen.*spy* true)) ((= - V5870) (set shen.*spy* false)) (true (simple-error "spy expects a + or a -. +(defun spy (V5898) (cond ((= + V5898) (set shen.*spy* true)) ((= - V5898) (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 (V5873) (cond ((= 94 V5873) (simple-error "aborted")) (true true))) +(defun shen.check-byte (V5901) (cond ((= 94 V5901) (simple-error "aborted")) (true true))) -(defun shen.input-track (V5874 V5875 V5876) (do (pr (cn " -" (shen.app (shen.spaces V5874) (cn "<" (shen.app V5874 (cn "> Inputs to " (shen.app V5875 (cn " -" (shen.app (shen.spaces V5874) "" shen.a)) shen.a)) shen.a)) shen.a)) (stoutput)) (shen.recursively-print V5876))) +(defun shen.input-track (V5902 V5903 V5904) (do (pr (cn " +" (shen.app (shen.spaces V5902) (cn "<" (shen.app V5902 (cn "> Inputs to " (shen.app V5903 (cn " +" (shen.app (shen.spaces V5902) "" shen.a)) shen.a)) shen.a)) shen.a)) (stoutput)) (shen.recursively-print V5904))) -(defun shen.recursively-print (V5879) (cond ((= () V5879) (pr " ==>" (stoutput))) ((cons? V5879) (do (print (hd V5879)) (do (pr ", " (stoutput)) (shen.recursively-print (tl V5879))))) (true (simple-error "implementation error in shen.recursively-print")))) +(defun shen.recursively-print (V5907) (cond ((= () V5907) (pr " ==>" (stoutput))) ((cons? V5907) (do (print (hd V5907)) (do (pr ", " (stoutput)) (shen.recursively-print (tl V5907))))) (true (simple-error "implementation error in shen.recursively-print")))) -(defun shen.spaces (V5880) (cond ((= 0 V5880) "") (true (cn " " (shen.spaces (- V5880 1)))))) +(defun shen.spaces (V5908) (cond ((= 0 V5908) "") (true (cn " " (shen.spaces (- V5908 1)))))) -(defun shen.output-track (V5881 V5882 V5883) (pr (cn " -" (shen.app (shen.spaces V5881) (cn "<" (shen.app V5881 (cn "> Output from " (shen.app V5882 (cn " -" (shen.app (shen.spaces V5881) (cn "==> " (shen.app V5883 "" shen.s)) shen.a)) shen.a)) shen.a)) shen.a)) (stoutput))) +(defun shen.output-track (V5909 V5910 V5911) (pr (cn " +" (shen.app (shen.spaces V5909) (cn "<" (shen.app V5909 (cn "> Output from " (shen.app V5910 (cn " +" (shen.app (shen.spaces V5909) (cn "==> " (shen.app V5911 "" shen.s)) shen.a)) shen.a)) shen.a)) shen.a)) (stoutput))) -(defun untrack (V5884) (do (set shen.*tracking* (remove V5884 (value shen.*tracking*))) (do (trap-error (eval (ps V5884)) (lambda Z5885 V5884)) V5884))) +(defun untrack (V5912) (do (set shen.*tracking* (remove V5912 (value shen.*tracking*))) (do (trap-error (eval (ps V5912)) (lambda Z5913 V5912)) V5912))) -(defun remove (V5886 V5887) (shen.remove-h V5886 V5887 ())) +(defun remove (V5914 V5915) (shen.remove-h V5914 V5915 ())) -(defun shen.remove-h (V5897 V5898 V5899) (cond ((= () V5898) (reverse V5899)) ((and (cons? V5898) (= V5897 (hd V5898))) (shen.remove-h (hd V5898) (tl V5898) V5899)) ((cons? V5898) (shen.remove-h V5897 (tl V5898) (cons (hd V5898) V5899))) (true (simple-error "implementation error in shen.remove-h")))) +(defun shen.remove-h (V5925 V5926 V5927) (cond ((= () V5926) (reverse V5927)) ((and (cons? V5926) (= V5925 (hd V5926))) (shen.remove-h (hd V5926) (tl V5926) V5927)) ((cons? V5926) (shen.remove-h V5925 (tl V5926) (cons (hd V5926) V5927))) (true (simple-error "implementation error in shen.remove-h")))) -(defun profile (V5900) (do (set shen.*profiled* (cons V5900 (value shen.*profiled*))) (shen.profile-help (ps V5900)))) +(defun profile (V5928) (do (set shen.*profiled* (cons V5928 (value shen.*profiled*))) (shen.profile-help (ps V5928)))) -(defun shen.profile-help (V5903) (cond ((and (cons? V5903) (and (= defun (hd V5903)) (and (cons? (tl V5903)) (and (cons? (tl (tl V5903))) (and (cons? (tl (tl (tl V5903)))) (= () (tl (tl (tl (tl V5903)))))))))) (let W5904 (gensym shen.f) (let W5905 (cons defun (cons (hd (tl V5903)) (cons (hd (tl (tl V5903))) (cons (shen.profile-func (hd (tl V5903)) (hd (tl (tl V5903))) (cons W5904 (hd (tl (tl V5903))))) ())))) (let W5906 (cons defun (cons W5904 (cons (hd (tl (tl V5903))) (cons (subst W5904 (hd (tl V5903)) (hd (tl (tl (tl V5903))))) ())))) (let W5907 (eval-kl W5905) (let W5908 (eval-kl W5906) (hd (tl V5903)))))))) (true (simple-error "Cannot profile. +(defun shen.profile-help (V5931) (cond ((and (cons? V5931) (and (= defun (hd V5931)) (and (cons? (tl V5931)) (and (cons? (tl (tl V5931))) (and (cons? (tl (tl (tl V5931)))) (= () (tl (tl (tl (tl V5931)))))))))) (let W5932 (gensym shen.f) (let W5933 (cons defun (cons (hd (tl V5931)) (cons (hd (tl (tl V5931))) (cons (shen.profile-func (hd (tl V5931)) (hd (tl (tl V5931))) (cons W5932 (hd (tl (tl V5931))))) ())))) (let W5934 (cons defun (cons W5932 (cons (hd (tl (tl V5931))) (cons (subst W5932 (hd (tl V5931)) (hd (tl (tl (tl V5931))))) ())))) (let W5935 (eval-kl W5933) (let W5936 (eval-kl W5934) (hd (tl V5931)))))))) (true (simple-error "Cannot profile. ")))) -(defun unprofile (V5909) (do (set shen.*profiled* (remove V5909 (value shen.*profiled*))) (trap-error (eval (ps V5909)) (lambda Z5910 V5909)))) +(defun unprofile (V5937) (do (set shen.*profiled* (remove V5937 (value shen.*profiled*))) (trap-error (eval (ps V5937)) (lambda Z5938 V5937)))) -(defun shen.profiled? (V5911) (element? V5911 (value shen.*profiled*))) +(defun shen.profiled? (V5939) (element? V5939 (value shen.*profiled*))) -(defun shen.profile-func (V5912 V5913 V5914) (cons let (cons Start (cons (cons get-time (cons run ())) (cons (cons let (cons Result (cons V5914 (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 V5912 (cons (cons + (cons (cons shen.get-profile (cons V5912 ())) (cons Finish ()))) ()))) (cons Result ())))) ())))) ())))) ()))))) +(defun shen.profile-func (V5940 V5941 V5942) (cons let (cons Start (cons (cons get-time (cons run ())) (cons (cons let (cons Result (cons V5942 (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 V5940 (cons (cons + (cons (cons shen.get-profile (cons V5940 ())) (cons Finish ()))) ()))) (cons Result ())))) ())))) ())))) ()))))) -(defun profile-results (V5915) (let W5916 (shen.get-profile V5915) (let W5917 (shen.put-profile V5915 0) (@p V5915 W5916)))) +(defun profile-results (V5943) (let W5944 (shen.get-profile V5943) (let W5945 (shen.put-profile V5943 0) (@p V5943 W5944)))) -(defun shen.get-profile (V5918) (trap-error (get V5918 profile (value *property-vector*)) (lambda Z5919 0))) +(defun shen.get-profile (V5946) (trap-error (get V5946 profile (value *property-vector*)) (lambda Z5947 0))) -(defun shen.put-profile (V5920 V5921) (put V5920 profile V5921 (value *property-vector*))) +(defun shen.put-profile (V5948 V5949) (put V5948 profile V5949 (value *property-vector*))) diff --git a/klambda/types.kl b/klambda/types.kl index 74a82be..636e382 100644 --- a/klambda/types.kl +++ b/klambda/types.kl @@ -1,13 +1,13 @@ -(defun declare (V5982 V5983) (let W5984 (shen.rectify-type V5983) (let W5985 (((((lambda Z5986 (lambda Z5987 (lambda Z5988 (lambda Z5989 (do (shen.incinfs) (shen.variancy (receive (shen.deref V5982 Z5986)) (receive (shen.deref W5984 Z5986)) Z5986 Z5987 Z5988 Z5989)))))) (shen.prolog-vector)) (@v true (@v 0 (vector 0)))) 0) (freeze true)) (let W5990 (eval-kl (shen.prolog-abstraction V5983)) (let W5991 (set shen.*sigf* (shen.assoc-> V5982 W5990 (value shen.*sigf*))) V5982))))) +(defun declare (V6010 V6011) (let W6012 (shen.rectify-type V6011) (let W6013 (((((lambda Z6014 (lambda Z6015 (lambda Z6016 (lambda Z6017 (do (shen.incinfs) (shen.variancy (receive (shen.deref V6010 Z6014)) (receive (shen.deref W6012 Z6014)) Z6014 Z6015 Z6016 Z6017)))))) (shen.prolog-vector)) (@v true (@v 0 (vector 0)))) 0) (freeze true)) (let W6018 (eval-kl (shen.prolog-abstraction V6011)) (let W6019 (set shen.*sigf* (shen.assoc-> V6010 W6018 (value shen.*sigf*))) V6010))))) -(defun shen.variancy (V5992 V5993 V5994 V5995 V5996 V5997) (if (shen.unlocked? V5995) (let W5998 (shen.newpv V5994) (shen.gc V5994 (let W5999 (shen.newpv V5994) (shen.gc V5994 (do (shen.incinfs) (shen.system-S-h (cons fn (cons V5992 ())) W5998 () V5994 V5995 V5996 (freeze (shen.variancy-signature V5992 W5998 W5999 V5994 V5995 V5996 (freeze (shen.variants? V5992 W5999 V5993 V5994 V5995 V5996 V5997)))))))))) false)) +(defun shen.variancy (V6020 V6021 V6022 V6023 V6024 V6025) (if (shen.unlocked? V6023) (let W6026 (shen.newpv V6022) (shen.gc V6022 (let W6027 (shen.newpv V6022) (shen.gc V6022 (do (shen.incinfs) (shen.system-S-h (cons fn (cons V6020 ())) W6026 () V6022 V6023 V6024 (freeze (shen.variancy-signature V6020 W6026 W6027 V6022 V6023 V6024 (freeze (shen.variants? V6020 W6027 V6021 V6022 V6023 V6024 V6025)))))))))) false)) -(defun shen.variancy-signature (V6000 V6001 V6002 V6003 V6004 V6005 V6006) (let W6007 (+ V6005 1) (let W6008 (if (shen.unlocked? V6004) (let W6009 (shen.lazyderef V6002 V6003) (let W6010 (lambda Z6011 (do (shen.incinfs) (is! V6001 Z6011 V6003 V6004 W6007 (freeze (when (= (arity (shen.deref V6000 V6003)) 0) V6003 V6004 W6007 (freeze (shen.cut V6003 V6004 W6007 V6006))))))) (if (cons? W6009) (let W6012 (shen.lazyderef (hd W6009) V6003) (let W6013 (freeze (let W6014 (shen.lazyderef (tl W6009) V6003) (let W6015 (lambda Z6016 (W6010 Z6016)) (if (cons? W6014) (let W6017 (hd W6014) (let W6018 (shen.lazyderef (tl W6014) V6003) (let W6019 (freeze (W6015 W6017)) (if (= W6018 ()) (thaw W6019) (if (shen.pvar? W6018) (shen.bind! W6018 () V6003 W6019) false))))) (if (shen.pvar? W6014) (let W6020 (shen.newpv V6003) (shen.gc V6003 (shen.bind! W6014 (cons W6020 ()) V6003 (freeze (W6015 W6020))))) false))))) (if (= W6012 -->) (thaw W6013) (if (shen.pvar? W6012) (shen.bind! W6012 --> V6003 W6013) false)))) (if (shen.pvar? W6009) (let W6021 (shen.newpv V6003) (shen.gc V6003 (shen.bind! W6009 (cons --> (cons W6021 ())) V6003 (freeze (W6010 W6021))))) false)))) false) (if (= W6008 false) (let W6022 (if (shen.unlocked? V6004) (do (shen.incinfs) (is! V6001 V6002 V6003 V6004 W6007 V6006)) false) (if (= W6022 false) (shen.unlock V6004 W6007) W6022)) W6008)))) +(defun shen.variancy-signature (V6028 V6029 V6030 V6031 V6032 V6033 V6034) (let W6035 (+ V6033 1) (let W6036 (if (shen.unlocked? V6032) (let W6037 (shen.lazyderef V6030 V6031) (let W6038 (lambda Z6039 (do (shen.incinfs) (is! V6029 Z6039 V6031 V6032 W6035 (freeze (when (= (arity (shen.deref V6028 V6031)) 0) V6031 V6032 W6035 (freeze (shen.cut V6031 V6032 W6035 V6034))))))) (if (cons? W6037) (let W6040 (shen.lazyderef (hd W6037) V6031) (let W6041 (freeze (let W6042 (shen.lazyderef (tl W6037) V6031) (let W6043 (lambda Z6044 (W6038 Z6044)) (if (cons? W6042) (let W6045 (hd W6042) (let W6046 (shen.lazyderef (tl W6042) V6031) (let W6047 (freeze (W6043 W6045)) (if (= W6046 ()) (thaw W6047) (if (shen.pvar? W6046) (shen.bind! W6046 () V6031 W6047) false))))) (if (shen.pvar? W6042) (let W6048 (shen.newpv V6031) (shen.gc V6031 (shen.bind! W6042 (cons W6048 ()) V6031 (freeze (W6043 W6048))))) false))))) (if (= W6040 -->) (thaw W6041) (if (shen.pvar? W6040) (shen.bind! W6040 --> V6031 W6041) false)))) (if (shen.pvar? W6037) (let W6049 (shen.newpv V6031) (shen.gc V6031 (shen.bind! W6037 (cons --> (cons W6049 ())) V6031 (freeze (W6038 W6049))))) false)))) false) (if (= W6036 false) (let W6050 (if (shen.unlocked? V6032) (do (shen.incinfs) (is! V6029 V6030 V6031 V6032 W6035 V6034)) false) (if (= W6050 false) (shen.unlock V6032 W6035) W6050)) W6036)))) -(defun shen.variants? (V6023 V6024 V6025 V6026 V6027 V6028 V6029) (let W6030 (if (shen.unlocked? V6027) (do (shen.incinfs) (is! V6024 V6025 V6026 V6027 V6028 V6029)) false) (if (= W6030 false) (if (shen.unlocked? V6027) (let W6031 (shen.newpv V6026) (shen.gc V6026 (do (shen.incinfs) (is W6031 (pr (cn "warning: changing the type of " (shen.app (shen.deref V6023 V6026) " may create errors -" shen.a)) (stoutput)) V6026 V6027 V6028 V6029)))) false) W6030))) +(defun shen.variants? (V6051 V6052 V6053 V6054 V6055 V6056 V6057) (let W6058 (if (shen.unlocked? V6055) (do (shen.incinfs) (is! V6052 V6053 V6054 V6055 V6056 V6057)) false) (if (= W6058 false) (if (shen.unlocked? V6055) (let W6059 (shen.newpv V6054) (shen.gc V6054 (do (shen.incinfs) (is W6059 (pr (cn "warning: changing the type of " (shen.app (shen.deref V6051 V6054) " may create errors +" shen.a)) (stoutput)) V6054 V6055 V6056 V6057)))) false) W6058))) -(defun shen.prolog-abstraction (V6032) (let W6033 (gensym B) (let W6034 (gensym L) (let W6035 (gensym Key) (let W6036 (gensym C) (let W6037 (gensym V) (let W6038 (shen.extract-vars V6032) (cons lambda (cons W6037 (cons (cons lambda (cons W6033 (cons (cons lambda (cons W6034 (cons (cons lambda (cons W6035 (cons (cons lambda (cons W6036 (cons (shen.stpart W6038 (cons is! (cons W6037 (cons (shen.rcons_form V6032) (cons W6033 (cons W6034 (cons W6035 (cons W6036 ()))))))) W6033) ()))) ()))) ()))) ()))) ())))))))))) +(defun shen.prolog-abstraction (V6060) (let W6061 (gensym B) (let W6062 (gensym L) (let W6063 (gensym Key) (let W6064 (gensym C) (let W6065 (gensym V) (let W6066 (shen.extract-vars V6060) (cons lambda (cons W6065 (cons (cons lambda (cons W6061 (cons (cons lambda (cons W6062 (cons (cons lambda (cons W6063 (cons (cons lambda (cons W6064 (cons (shen.stpart W6066 (cons is! (cons W6065 (cons (shen.rcons_form V6060) (cons W6061 (cons W6062 (cons W6063 (cons W6064 ()))))))) W6061) ()))) ()))) ()))) ()))) ())))))))))) -(defun shen.demod (V6039) (let W6040 (value shen.*demodulation-function*) (W6040 V6039))) +(defun shen.demod (V6067) (let W6068 (value shen.*demodulation-function*) (W6068 V6067))) diff --git a/klambda/writer.kl b/klambda/writer.kl index 59a39c8..dc851e3 100644 --- a/klambda/writer.kl +++ b/klambda/writer.kl @@ -1,56 +1,56 @@ -(defun print (V6960) (let W6961 (shen.insert V6960 "~S") (let W6962 (pr W6961 (stoutput)) V6960))) +(defun print (V6988) (let W6989 (shen.insert V6988 "~S") (let W6990 (pr W6989 (stoutput)) V6988))) -(defun pr (V6963 V6964) (if (value *hush*) V6963 (if (char-stream? V6964) (write-string V6963 V6964) (shen.write-chars V6963 V6964 (shen.string->byte V6963 0) 1)))) +(defun pr (V6991 V6992) (if (value *hush*) V6991 (if (char-stream? V6992) (write-string V6991 V6992) (shen.write-chars V6991 V6992 (shen.string->byte V6991 0) 1)))) -(defun shen.string->byte (V6965 V6966) (trap-error (string->n (pos V6965 V6966)) (lambda Z6967 shen.eos))) +(defun shen.string->byte (V6993 V6994) (trap-error (string->n (pos V6993 V6994)) (lambda Z6995 shen.eos))) -(defun shen.write-chars (V6968 V6969 V6970 V6971) (cond ((= shen.eos V6970) V6968) (true (shen.write-chars V6968 V6969 (do (write-byte V6970 V6969) (shen.string->byte V6968 V6971)) (+ V6971 1))))) +(defun shen.write-chars (V6996 V6997 V6998 V6999) (cond ((= shen.eos V6998) V6996) (true (shen.write-chars V6996 V6997 (do (write-byte V6998 V6997) (shen.string->byte V6996 V6999)) (+ V6999 1))))) -(defun shen.mkstr (V6972 V6973) (cond ((string? V6972) (shen.mkstr-l (shen.proc-nl V6972) V6973)) (true (shen.mkstr-r (cons shen.proc-nl (cons V6972 ())) V6973)))) +(defun shen.mkstr (V7000 V7001) (cond ((string? V7000) (shen.mkstr-l (shen.proc-nl V7000) V7001)) (true (shen.mkstr-r (cons shen.proc-nl (cons V7000 ())) V7001)))) -(defun shen.mkstr-l (V6978 V6979) (cond ((= () V6979) V6978) ((cons? V6979) (shen.mkstr-l (shen.insert-l (hd V6979) V6978) (tl V6979))) (true (simple-error "implementation error in shen.mkstr-l")))) +(defun shen.mkstr-l (V7006 V7007) (cond ((= () V7007) V7006) ((cons? V7007) (shen.mkstr-l (shen.insert-l (hd V7007) V7006) (tl V7007))) (true (simple-error "implementation error in shen.mkstr-l")))) -(defun shen.insert-l (V6986 V6987) (cond ((= "" V6987) "") ((and (shen.+string? V6987) (and (= "~" (hdstr V6987)) (and (shen.+string? (tlstr V6987)) (= "A" (hdstr (tlstr V6987)))))) (cons shen.app (cons V6986 (cons (tlstr (tlstr V6987)) (cons shen.a ()))))) ((and (shen.+string? V6987) (and (= "~" (hdstr V6987)) (and (shen.+string? (tlstr V6987)) (= "R" (hdstr (tlstr V6987)))))) (cons shen.app (cons V6986 (cons (tlstr (tlstr V6987)) (cons shen.r ()))))) ((and (shen.+string? V6987) (and (= "~" (hdstr V6987)) (and (shen.+string? (tlstr V6987)) (= "S" (hdstr (tlstr V6987)))))) (cons shen.app (cons V6986 (cons (tlstr (tlstr V6987)) (cons shen.s ()))))) ((shen.+string? V6987) (shen.factor-cn (cons cn (cons (hdstr V6987) (cons (shen.insert-l V6986 (tlstr V6987)) ()))))) ((and (cons? V6987) (and (= cn (hd V6987)) (and (cons? (tl V6987)) (and (cons? (tl (tl V6987))) (= () (tl (tl (tl V6987)))))))) (cons cn (cons (hd (tl V6987)) (cons (shen.insert-l V6986 (hd (tl (tl V6987)))) ())))) ((and (cons? V6987) (and (= shen.app (hd V6987)) (and (cons? (tl V6987)) (and (cons? (tl (tl V6987))) (and (cons? (tl (tl (tl V6987)))) (= () (tl (tl (tl (tl V6987)))))))))) (cons shen.app (cons (hd (tl V6987)) (cons (shen.insert-l V6986 (hd (tl (tl V6987)))) (tl (tl (tl V6987))))))) (true (simple-error "implementation error in shen.insert-l")))) +(defun shen.insert-l (V7014 V7015) (cond ((= "" V7015) "") ((and (shen.+string? V7015) (and (= "~" (hdstr V7015)) (and (shen.+string? (tlstr V7015)) (= "A" (hdstr (tlstr V7015)))))) (cons shen.app (cons V7014 (cons (tlstr (tlstr V7015)) (cons shen.a ()))))) ((and (shen.+string? V7015) (and (= "~" (hdstr V7015)) (and (shen.+string? (tlstr V7015)) (= "R" (hdstr (tlstr V7015)))))) (cons shen.app (cons V7014 (cons (tlstr (tlstr V7015)) (cons shen.r ()))))) ((and (shen.+string? V7015) (and (= "~" (hdstr V7015)) (and (shen.+string? (tlstr V7015)) (= "S" (hdstr (tlstr V7015)))))) (cons shen.app (cons V7014 (cons (tlstr (tlstr V7015)) (cons shen.s ()))))) ((shen.+string? V7015) (shen.factor-cn (cons cn (cons (hdstr V7015) (cons (shen.insert-l V7014 (tlstr V7015)) ()))))) ((and (cons? V7015) (and (= cn (hd V7015)) (and (cons? (tl V7015)) (and (cons? (tl (tl V7015))) (= () (tl (tl (tl V7015)))))))) (cons cn (cons (hd (tl V7015)) (cons (shen.insert-l V7014 (hd (tl (tl V7015)))) ())))) ((and (cons? V7015) (and (= shen.app (hd V7015)) (and (cons? (tl V7015)) (and (cons? (tl (tl V7015))) (and (cons? (tl (tl (tl V7015)))) (= () (tl (tl (tl (tl V7015)))))))))) (cons shen.app (cons (hd (tl V7015)) (cons (shen.insert-l V7014 (hd (tl (tl V7015)))) (tl (tl (tl V7015))))))) (true (simple-error "implementation error in shen.insert-l")))) -(defun shen.factor-cn (V6988) (cond ((and (cons? V6988) (and (= cn (hd V6988)) (and (cons? (tl V6988)) (and (cons? (tl (tl V6988))) (and (cons? (hd (tl (tl V6988)))) (and (= cn (hd (hd (tl (tl V6988))))) (and (cons? (tl (hd (tl (tl V6988))))) (and (cons? (tl (tl (hd (tl (tl V6988)))))) (and (= () (tl (tl (tl (hd (tl (tl V6988))))))) (and (= () (tl (tl (tl V6988)))) (and (string? (hd (tl V6988))) (string? (hd (tl (hd (tl (tl V6988))))))))))))))))) (cons cn (cons (cn (hd (tl V6988)) (hd (tl (hd (tl (tl V6988)))))) (tl (tl (hd (tl (tl V6988)))))))) (true V6988))) +(defun shen.factor-cn (V7016) (cond ((and (cons? V7016) (and (= cn (hd V7016)) (and (cons? (tl V7016)) (and (cons? (tl (tl V7016))) (and (cons? (hd (tl (tl V7016)))) (and (= cn (hd (hd (tl (tl V7016))))) (and (cons? (tl (hd (tl (tl V7016))))) (and (cons? (tl (tl (hd (tl (tl V7016)))))) (and (= () (tl (tl (tl (hd (tl (tl V7016))))))) (and (= () (tl (tl (tl V7016)))) (and (string? (hd (tl V7016))) (string? (hd (tl (hd (tl (tl V7016))))))))))))))))) (cons cn (cons (cn (hd (tl V7016)) (hd (tl (hd (tl (tl V7016)))))) (tl (tl (hd (tl (tl V7016)))))))) (true V7016))) -(defun shen.proc-nl (V6991) (cond ((= "" V6991) "") ((and (shen.+string? V6991) (and (= "~" (hdstr V6991)) (and (shen.+string? (tlstr V6991)) (= "%" (hdstr (tlstr V6991)))))) (cn (n->string 10) (shen.proc-nl (tlstr (tlstr V6991))))) ((shen.+string? V6991) (cn (hdstr V6991) (shen.proc-nl (tlstr V6991)))) (true (simple-error "implementation error in shen.proc-nl")))) +(defun shen.proc-nl (V7019) (cond ((= "" V7019) "") ((and (shen.+string? V7019) (and (= "~" (hdstr V7019)) (and (shen.+string? (tlstr V7019)) (= "%" (hdstr (tlstr V7019)))))) (cn (n->string 10) (shen.proc-nl (tlstr (tlstr V7019))))) ((shen.+string? V7019) (cn (hdstr V7019) (shen.proc-nl (tlstr V7019)))) (true (simple-error "implementation error in shen.proc-nl")))) -(defun shen.mkstr-r (V6996 V6997) (cond ((= () V6997) V6996) ((cons? V6997) (shen.mkstr-r (cons shen.insert (cons (hd V6997) (cons V6996 ()))) (tl V6997))) (true (simple-error "implementation error in shen.mkstr-r")))) +(defun shen.mkstr-r (V7024 V7025) (cond ((= () V7025) V7024) ((cons? V7025) (shen.mkstr-r (cons shen.insert (cons (hd V7025) (cons V7024 ()))) (tl V7025))) (true (simple-error "implementation error in shen.mkstr-r")))) -(defun shen.insert (V6998 V6999) (shen.insert-h V6998 V6999 "")) +(defun shen.insert (V7026 V7027) (shen.insert-h V7026 V7027 "")) -(defun shen.insert-h (V7008 V7009 V7010) (cond ((= "" V7009) V7010) ((and (shen.+string? V7009) (and (= "~" (hdstr V7009)) (and (shen.+string? (tlstr V7009)) (= "A" (hdstr (tlstr V7009)))))) (cn V7010 (shen.app V7008 (tlstr (tlstr V7009)) shen.a))) ((and (shen.+string? V7009) (and (= "~" (hdstr V7009)) (and (shen.+string? (tlstr V7009)) (= "R" (hdstr (tlstr V7009)))))) (cn V7010 (shen.app V7008 (tlstr (tlstr V7009)) shen.r))) ((and (shen.+string? V7009) (and (= "~" (hdstr V7009)) (and (shen.+string? (tlstr V7009)) (= "S" (hdstr (tlstr V7009)))))) (cn V7010 (shen.app V7008 (tlstr (tlstr V7009)) shen.s))) ((shen.+string? V7009) (shen.insert-h V7008 (tlstr V7009) (cn V7010 (hdstr V7009)))) (true (simple-error "implementation error in shen.insert-h")))) +(defun shen.insert-h (V7036 V7037 V7038) (cond ((= "" V7037) V7038) ((and (shen.+string? V7037) (and (= "~" (hdstr V7037)) (and (shen.+string? (tlstr V7037)) (= "A" (hdstr (tlstr V7037)))))) (cn V7038 (shen.app V7036 (tlstr (tlstr V7037)) shen.a))) ((and (shen.+string? V7037) (and (= "~" (hdstr V7037)) (and (shen.+string? (tlstr V7037)) (= "R" (hdstr (tlstr V7037)))))) (cn V7038 (shen.app V7036 (tlstr (tlstr V7037)) shen.r))) ((and (shen.+string? V7037) (and (= "~" (hdstr V7037)) (and (shen.+string? (tlstr V7037)) (= "S" (hdstr (tlstr V7037)))))) (cn V7038 (shen.app V7036 (tlstr (tlstr V7037)) shen.s))) ((shen.+string? V7037) (shen.insert-h V7036 (tlstr V7037) (cn V7038 (hdstr V7037)))) (true (simple-error "implementation error in shen.insert-h")))) -(defun shen.app (V7011 V7012 V7013) (cn (shen.arg->str V7011 V7013) V7012)) +(defun shen.app (V7039 V7040 V7041) (cn (shen.arg->str V7039 V7041) V7040)) -(defun shen.arg->str (V7017 V7018) (cond ((= V7017 (fail)) "...") ((shen.list? V7017) (shen.list->str V7017 V7018)) ((string? V7017) (shen.str->str V7017 V7018)) ((absvector? V7017) (shen.vector->str V7017 V7018)) (true (shen.atom->str V7017)))) +(defun shen.arg->str (V7045 V7046) (cond ((= V7045 (fail)) "...") ((shen.list? V7045) (shen.list->str V7045 V7046)) ((string? V7045) (shen.str->str V7045 V7046)) ((absvector? V7045) (shen.vector->str V7045 V7046)) (true (shen.atom->str V7045)))) -(defun shen.list->str (V7019 V7020) (cond ((= shen.r V7020) (@s "(" (@s (shen.iter-list V7019 shen.r (shen.maxseq)) ")"))) (true (@s "[" (@s (shen.iter-list V7019 V7020 (shen.maxseq)) "]"))))) +(defun shen.list->str (V7047 V7048) (cond ((= shen.r V7048) (@s "(" (@s (shen.iter-list V7047 shen.r (shen.maxseq)) ")"))) (true (@s "[" (@s (shen.iter-list V7047 V7048 (shen.maxseq)) "]"))))) (defun shen.maxseq () (value *maximum-print-sequence-size*)) -(defun shen.iter-list (V7031 V7032 V7033) (cond ((= () V7031) "") ((= 0 V7033) "... etc") ((and (cons? V7031) (= () (tl V7031))) (shen.arg->str (hd V7031) V7032)) ((cons? V7031) (@s (shen.arg->str (hd V7031) V7032) (@s " " (shen.iter-list (tl V7031) V7032 (- V7033 1))))) (true (@s "|" (@s " " (shen.arg->str V7031 V7032)))))) +(defun shen.iter-list (V7059 V7060 V7061) (cond ((= () V7059) "") ((= 0 V7061) "... etc") ((and (cons? V7059) (= () (tl V7059))) (shen.arg->str (hd V7059) V7060)) ((cons? V7059) (@s (shen.arg->str (hd V7059) V7060) (@s " " (shen.iter-list (tl V7059) V7060 (- V7061 1))))) (true (@s "|" (@s " " (shen.arg->str V7059 V7060)))))) -(defun shen.str->str (V7036 V7037) (cond ((= shen.a V7037) V7036) (true (@s (n->string 34) (@s V7036 (n->string 34)))))) +(defun shen.str->str (V7064 V7065) (cond ((= shen.a V7065) V7064) (true (@s (n->string 34) (@s V7064 (n->string 34)))))) -(defun shen.vector->str (V7038 V7039) (if (shen.print-vector? V7038) ((fn (<-address V7038 0)) V7038) (if (vector? V7038) (@s "<" (@s (shen.iter-vector V7038 1 V7039 (shen.maxseq)) ">")) (@s "<" (@s "<" (@s (shen.iter-vector V7038 0 V7039 (shen.maxseq)) ">>")))))) +(defun shen.vector->str (V7066 V7067) (if (shen.print-vector? V7066) ((fn (<-address V7066 0)) V7066) (if (vector? V7066) (@s "<" (@s (shen.iter-vector V7066 1 V7067 (shen.maxseq)) ">")) (@s "<" (@s "<" (@s (shen.iter-vector V7066 0 V7067 (shen.maxseq)) ">>")))))) -(defun shen.empty-absvector? (V7040) (= V7040 (value shen.*empty-absvector*))) +(defun shen.empty-absvector? (V7068) (= V7068 (value shen.*empty-absvector*))) -(defun shen.print-vector? (V7041) (and (not (shen.empty-absvector? V7041)) (let W7042 (<-address V7041 0) (or (= W7042 shen.tuple) (or (= W7042 shen.pvar) (or (= W7042 shen.dictionary) (and (not (number? W7042)) (shen.fbound? W7042)))))))) +(defun shen.print-vector? (V7069) (and (not (shen.empty-absvector? V7069)) (let W7070 (<-address V7069 0) (or (= W7070 shen.tuple) (or (= W7070 shen.pvar) (or (= W7070 shen.dictionary) (and (not (number? W7070)) (shen.fbound? W7070)))))))) -(defun shen.fbound? (V7043) (not (= (arity V7043) -1))) +(defun shen.fbound? (V7071) (not (= (arity V7071) -1))) -(defun shen.tuple (V7044) (cn "(@p " (shen.app (<-address V7044 1) (cn " " (shen.app (<-address V7044 2) ")" shen.s)) shen.s))) +(defun shen.tuple (V7072) (cn "(@p " (shen.app (<-address V7072 1) (cn " " (shen.app (<-address V7072 2) ")" shen.s)) shen.s))) -(defun shen.dictionary (V7045) "(dict ...)") +(defun shen.dictionary (V7073) "(dict ...)") -(defun shen.iter-vector (V7052 V7053 V7054 V7055) (cond ((= 0 V7055) "... etc") (true (let W7056 (trap-error (<-address V7052 V7053) (lambda Z7057 shen.out-of-bounds)) (let W7058 (trap-error (<-address V7052 (+ V7053 1)) (lambda Z7059 shen.out-of-bounds)) (if (= W7056 shen.out-of-bounds) "" (if (= W7058 shen.out-of-bounds) (shen.arg->str W7056 V7054) (@s (shen.arg->str W7056 V7054) (@s " " (shen.iter-vector V7052 (+ V7053 1) V7054 (- V7055 1))))))))))) +(defun shen.iter-vector (V7080 V7081 V7082 V7083) (cond ((= 0 V7083) "... etc") (true (let W7084 (trap-error (<-address V7080 V7081) (lambda Z7085 shen.out-of-bounds)) (let W7086 (trap-error (<-address V7080 (+ V7081 1)) (lambda Z7087 shen.out-of-bounds)) (if (= W7084 shen.out-of-bounds) "" (if (= W7086 shen.out-of-bounds) (shen.arg->str W7084 V7082) (@s (shen.arg->str W7084 V7082) (@s " " (shen.iter-vector V7080 (+ V7081 1) V7082 (- V7083 1))))))))))) -(defun shen.atom->str (V7060) (trap-error (str V7060) (lambda Z7061 (shen.funexstring)))) +(defun shen.atom->str (V7088) (trap-error (str V7088) (lambda Z7089 (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? (V7062) (or (empty? V7062) (cons? V7062))) +(defun shen.list? (V7090) (or (empty? V7090) (cons? V7090))) diff --git a/prolog_compile.lua b/prolog_compile.lua index 1865416..0389c37 100644 --- a/prolog_compile.lua +++ b/prolog_compile.lua @@ -555,8 +555,19 @@ compile_value = function(ctx, e, env, out, d) -- (= A B) if h == SYM["="] and is_cons(args) and is_cons(args[2]) then local a, b = args[1], args[2][1] - local akind = is_klvar(a) and env[a.name] and env[a.name].kind - local bkind = is_klvar(b) and env[b.name] and env[b.name].kind + -- a side is an engine term when it is a term variable, or a + -- (shen.lazyderef X B) of one (compiled to LZD): upstream ec16a9f's + -- by-hypothesis tests (= (shen.lazyderef Hyp B) ()) before descending + local function termkind(x) + if is_klvar(x) then return env[x.name] and env[x.name].kind end + if is_cons(x) and x[1] == SYM["shen.lazyderef"] + and is_cons(x[2]) and is_klvar(x[2][1]) then + local v = env[x[2][1].name] + return v and v.kind == "term" and "term" or nil + end + return nil + end + local akind, bkind = termkind(a), termkind(b) if akind == "term" or bkind == "term" then local al = compile_term(ctx, a, env, out, d) local bl = compile_term(ctx, b, env, out, d) diff --git a/test/kernel_conformance_spec.lua b/test/kernel_conformance_spec.lua index 50ac4aa..d1e5644 100644 --- a/test/kernel_conformance_spec.lua +++ b/test/kernel_conformance_spec.lua @@ -20,7 +20,8 @@ -- expectations. -- -- Kernels: --- vendored klambda/ (ShenOSKernel 43.1) +-- vendored klambda/ (ShenOSKernel 43.1 at upstream ec16a9f: the deref hoist +-- plus an empty-list guard, shen-sources#117) -- hoist 43.1 with the deref hoist (test/fixtures/kernel-43.1-deref-hoist) -- mutated 43.1 whose shen.search-user-datatypes never consults a -- datatype: the hand port no longer implements it @@ -244,9 +245,12 @@ for _, k in ipairs({ "vendored", "hoist" }) do end do + -- klambda/ is upstream ec16a9f (the 43.1 release plus shen-sources#117): + -- the deref-hoisted drivers, plus an empty-list guard in + -- shen.by-hypothesis / shen.search-user-datatypes local v = child(KDIR.vendored) - check(v.added == nil or v.added == "", "vendored: driver closure adds nothing (" .. tostring(v.added) .. ")") - check(v.eqterm["shen.by-hypothesis"] == "yes", "vendored: by-hypothesis compares on the arena") + check(v.added == "shen.by-hypothesis-h", "vendored: driver closure adds shen.by-hypothesis-h (" .. tostring(v.added) .. ")") + check(v.eqterm["shen.by-hypothesis-h"] == "yes", "vendored: by-hypothesis-h compares on the arena") local h = child(KDIR.hoist) check(h.added == "shen.by-hypothesis-h", "hoist: driver closure adds shen.by-hypothesis-h (" .. tostring(h.added) .. ")") check(h.eqterm["shen.by-hypothesis-h"] == "yes", "hoist: by-hypothesis-h compares on the arena") diff --git a/typecheck_native.lua b/typecheck_native.lua index ec9f8df..994f345 100644 --- a/typecheck_native.lua +++ b/typecheck_native.lua @@ -165,10 +165,17 @@ local KNOWN = { -- outside their loops, through new -h helpers. The native -- search-user-datatypes hand port implements both shapes (it never -- copies on deref); by-hypothesis(-h) are translated, not hand-ported. + -- 43.1@ec16a9f = upstream shen-sources ec16a9f, the merge of #117: the + -- deref hoist above plus bdb8582, where search-user-datatypes and + -- by-hypothesis return false at once on an empty datatype/hypothesis list + -- without dereferencing. The hand port already fails on an empty list + -- before any clause, with no inference counted (as -h's clauses never + -- match one), and never copies on deref, so it implements this shape too. + -- Only search-user-datatypes changes fingerprint; -h is the hoist's. ["shen.typecheck"] = { ["53f17a8525d2d3ab"] = "43.1, 43.1+deref-hoist" }, ["shen.lookupsig"] = { ["7613493146348a37"] = "43.1, 43.1+deref-hoist" }, ["shen.sigf"] = { ["9224dc17fb22e027"] = "43.1, 43.1+deref-hoist" }, - ["shen.search-user-datatypes"] = { ["f19996b77935e2cd"] = "43.1", ["bbdfd9a9f7dfc457"] = "43.1+deref-hoist" }, + ["shen.search-user-datatypes"] = { ["f19996b77935e2cd"] = "43.1", ["bbdfd9a9f7dfc457"] = "43.1+deref-hoist", ["483d69ab4d98d601"] = "43.1@ec16a9f" }, ["shen.search-user-datatypes-h"] = { ["absent"] = "43.1", ["a3924a95ecff6737"] = "43.1+deref-hoist" }, ["shen.show"] = { ["832effe9caab5eb7"] = "43.1, 43.1+deref-hoist" }, ["shen.maxinfexceeded?"] = { ["effe20ceadf236e0"] = "43.1, 43.1+deref-hoist" },